Zander671/truth-table
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix incorrect parenthesis

Browse Source
This commit is contained in:
Alexander Rosenberg
2024-09-10 23:05:14 -07:00
parent edd4f53a68
commit 2bdf936160
4 changed files with 60 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
typeset.lisp
View File

@ -117,11 +117,41 @@
else
collect char)))
(defun flattenable-p (oper)
"Return t if OPER is able to be flattened. That is, it does not care a bout
argument ordering."
(multiple-value-bind (min max)
(operator-argument-count oper)
(declare (ignorable min))
;; currently, all unordered operators take any number of arguments max, and
;; all ordered operators have some max number of arguments (as a
;; proposition: an operator is unordered if and only if it takes any number
;; of arguments)
(not max)))
(defun flatten-proposition (prop)
"Flatten PROP, such that adjacent operators with the same precedence and with
no ordering (such as \"and\" or \"or\") are not surrounded by parenthesis when
typeset."
(if (consp prop)
(loop with my-oper = (car prop)
for raw-sub-expr in (cdr prop)
for sub-expr = (flatten-proposition raw-sub-expr)
when (and (flattenable-p my-oper)
(consp sub-expr)
(eq (car sub-expr) my-oper))
append (cdr sub-expr) into out-args
else
collect sub-expr into out-args
finally (return (cons my-oper out-args)))
prop))
(defun typeset-proposition (expr &key
(lookup-table *operator-ascii-lookup-alist*)
var-name-transform
(parent-prec most-positive-fixnum)
latin-truths)
latin-truths
(flatten-prop t))
"Typeset the propositional expression EXPR to plain text. LOOKUP-TABLE should
be a table mapping operators to their textual representation. VAR-NAME-TRANSFORM
(if non-nil) should take a single string argument which is a variable name and
@ -147,10 +177,13 @@ use (it controls when parentheses are applied.)"
(cdr (assoc 'false lookup-table))))
;; expr is a compound expression
(t
(destructuring-bind (oper first-arg &rest args) expr
(destructuring-bind (oper first-arg &rest args)
(if flatten-prop
(flatten-proposition expr)
expr)
(let* ((our-prec (operator-precedence oper))
(oper-ascii (cdr (assoc oper lookup-table)))
(prefix-suffix (if (< parent-prec our-prec)
(prefix-suffix (if (<= parent-prec our-prec)
(cons (cdr (assoc 'open-paren lookup-table))
(cdr (assoc 'close-paren lookup-table)))
'("" . ""))))
@ -161,7 +194,8 @@ use (it controls when parentheses are applied.)"
:lookup-table lookup-table
:var-name-transform var-name-transform
:latin-truths latin-truths
:parent-prec our-prec)
:parent-prec our-prec
:flatten-prop nil)
(cdr prefix-suffix))
;; we have many arguments
(loop for arg in args
@ -171,19 +205,20 @@ use (it controls when parentheses are applied.)"
:lookup-table lookup-table
:var-name-transform var-name-transform
:latin-truths latin-truths
:parent-prec our-prec)
:parent-prec our-prec
:flatten-prop nil)
into output
finally
(push (typeset-proposition first-arg
:lookup-table lookup-table
:var-name-transform var-name-transform
:latin-truths latin-truths
:parent-prec our-prec)
:parent-prec our-prec
:flatten-prop nil)
output)
(return (format nil "~A~{~A~^ ~}~A" (car prefix-suffix)
output (cdr prefix-suffix))))))))))
(defun convert-truth-table-to-latex (table &key pretty-print latin-truths)
"Convert TABLE, which should be a truth table as returned by
`create-truth-table' to latex. If PRETTY-PRINT, add newlines to make the