Add operands to syntax help message

This commit is contained in:
Alexander Rosenberg 2024-09-16 04:17:24 -07:00
parent f9091ad7c1
commit 421eff906d
Signed by: Zander671
GPG Key ID: 5FD0394ADBD72730
4 changed files with 69 additions and 31 deletions

View File

@ -11,6 +11,7 @@
#:parse-error-proposition #:parse-error-proposition
#:parse-error-message #:parse-error-message
#:*operator-symbol-table* #:*operator-symbol-table*
#:*operand-symbol-table*
#:*operator-descriptions* #:*operator-descriptions*
#:operator-symbol #:operator-symbol
#:operator-precedence #:operator-precedence

View File

@ -84,36 +84,63 @@ functions involved in evaluating and typesetting."
do (return-from ascii-string-p)) do (return-from ascii-string-p))
t) t)
(defun format-syntax-string (syntax-list &key ascii-only)
"Format SYNTAX-LIST into a string suitable for printing in a table in
`print-syntax-help'."
(format nil "~{~a~^, ~}"
(sort (copy-list
(if ascii-only
(remove-if-not 'ascii-string-p
syntax-list)
syntax-list))
'string<)))
(defun print-syntax-help (ascii-only) (defun print-syntax-help (ascii-only)
"Print the syntax help message." "Print the syntax help message."
(loop (loop
for ((sym (name . nicks) desc examples) . rest-desc) for ((sym (name . nicks) desc examples) . rest-desc)
= *operator-descriptions* then rest-desc = *operator-descriptions* then rest-desc
for ((_sym . syntax) . rest-st) = *operator-symbol-table* then rest-st for ((_sym . syntax) . rest-st) = *operator-symbol-table* then rest-st
for syntax-str = (format nil "~{~a~^, ~}" for syntax-str = (format-syntax-string syntax :ascii-only ascii-only)
(sort (copy-list
(if ascii-only
(remove-if-not 'ascii-string-p
syntax)
syntax))
'string<))
while sym while sym
maximize (length name) into name-col-len maximize (length name) into name-col-len
maximize (length syntax-str) into syntax-col-len maximize (length syntax-str) into syntax-col-len
collect syntax-str into syntax-entries collect syntax-str into syntax-entries
finally finally
(let ((col-widths (list name-col-len syntax-col-len)) (setq name-col-len (max name-col-len (length "Operator"))
(box-lookup-table (if ascii-only syntax-col-len (max syntax-col-len (length "Syntax")))
(with-draw-table (t (list name-col-len syntax-col-len)
(if ascii-only
*table-border-ascii-alist* *table-border-ascii-alist*
*table-border-unicode-alist*))) *table-border-unicode-alist*)
(with-draw-table (t col-widths box-lookup-table
:padding 1 :align :left) :padding 1 :align :left)
(:row (list "Operator" "Syntax")) (:row '("Operator" "Syntax"))
(:seperator) (:seperator)
(loop for (sym (name . nicks) desct) in *operator-descriptions* (loop for (sym (name . nicks) desct) in *operator-descriptions*
for syntax-str in syntax-entries do for syntax-str in syntax-entries do
(:row (list name syntax-str)))))) (:row (list name syntax-str)))))
(format t "~%~%~a~%Example:~% abc|d = ~a~%" (terpri)
(loop for (sym . syntax) in *operand-symbol-table*
for name = (symbol-name sym)
for syntax-str = (format-syntax-string syntax :ascii-only ascii-only)
collect (string-downcase name) into names
maximize (length name) into name-col-len
collect syntax-str into syntax-strs
maximize (length syntax-str) into syntax-col-len
finally
(setq name-col-len (max name-col-len (length "Operand"))
syntax-col-len (max syntax-col-len (length "Syntax")))
(with-draw-table (t (list name-col-len syntax-col-len)
(if ascii-only
*table-border-ascii-alist*
*table-border-unicode-alist*)
:padding 1 :align :left)
(:row '("Operand" "Syntax"))
(:seperator)
(loop for name in names
for syntax-str in syntax-strs
do (:row (list name syntax-str)))))
(format t "~%~a~%Example:~% abc|d = ~a~%"
(word-wrap-string "Two operands next to each other is treated as an (word-wrap-string "Two operands next to each other is treated as an
'implicit and' (unless this feature is disabled).") 'implicit and' (unless this feature is disabled).")
(typeset-proposition '(or (and "a" "b" "c") "d") (typeset-proposition '(or (and "a" "b" "c") "d")

View File

@ -197,19 +197,23 @@ are useful for use in things like syntax explanation messages.")
"Return whether OPER is a unary operator or not." "Return whether OPER is a unary operator or not."
(eq oper 'not)) (eq oper 'not))
(defparameter *operand-symbol-table*
'((true "t" "true" "" "1")
(false "f" "false" "⊥" "0"))
"Alist mapping operand symbols (true and false) to their textual
representations.")
(defun interpret-operand (oper-str) (defun interpret-operand (oper-str)
"Return a symbol representing OPER-STR, or the string itself if it represents "Return a symbol representing OPER-STR, or the string itself if it represents
a variable." a variable."
(cond (dolist (entry *operand-symbol-table*)
((member oper-str '("t" "true" "" "1") :test 'equalp) (when (member oper-str (cdr entry) :test 'equalp)
'true) (return-from interpret-operand (car entry))))
((member oper-str '("f" "false" "⊥" "0") :test 'equalp) ;; check if OPER-STR is a valid variable name
'false) (if (or (zerop (length oper-str))
(t (find-if-not 'symbol-char-p oper-str))
(loop for char across oper-str nil
unless (symbol-char-p char) oper-str))
do (return nil)
finally (return oper-str)))))
(defun string-first-char-safe (str) (defun string-first-char-safe (str)
"Return the first character of STR, or nil if it is empty." "Return the first character of STR, or nil if it is empty."

View File

@ -50,7 +50,7 @@
(:span :id "help-close-button" (:span :id "help-close-button"
:onclick "document.querySelector(\".help-overlay\").style.display = \"none\"" :onclick "document.querySelector(\".help-overlay\").style.display = \"none\""
"Close")) "Close"))
(:table (:table ;:style "margin-bottom: 10px;"
(:tr (:th "Operator") (:th "Syntax")) (:tr (:th "Operator") (:th "Syntax"))
(loop for ((sym (name . nics) desc (examples)) . rest-desc) (loop for ((sym (name . nics) desc (examples)) . rest-desc)
= *operator-descriptions* then rest-desc = *operator-descriptions* then rest-desc
@ -60,6 +60,12 @@
do do
(:tr (:tr
(:td name) (:td name)
(:td (format nil "~{~a~^, ~}" (sort (copy-list syntax)
'string<)))))
(:tr (:th "Operand") (:th "Syntax"))
(loop for (sym . syntax) in *operand-symbol-table* do
(:tr
(:td (string-downcase (symbol-name sym)))
(:td (format nil "~{~a~^, ~}" (sort (copy-list syntax) (:td (format nil "~{~a~^, ~}" (sort (copy-list syntax)
'string<)))))) 'string<))))))
(:p "You can input multiple propositions by separating them with" (:p "You can input multiple propositions by separating them with"