blob: 84dbfc1d142294f0ff42d1d60e3f7a39ee85c782 (
plain) (
tree)
|
|
(defun pp-binop (bin-op)
(case bin-op
((plus) "+")
((mult) "*")
((mod) "%")
((minus) "-")
((div) "/")
((equal) " = ")
((less) " < ")
((lesseq) " <= ")
((great) " > ")
((greateq) " >= ")
((diff) " <> ")
((and) " & ")
((or) " | ")))
(defun pp-unrop (unr-op)
(case unr-op
((uminus) "-")
((not) "!")))
(defun parenthesis (x)
(string-append "(" x ")"))
(defgeneric ppl (pr expr))
(defmethod ppl (pr (expr <exp-int>))
(convert (num expr) <string>))
(defmethod ppl (pr (expr <exp-var>))
(var expr))
(defmethod ppl (pr (expr <exp-str>))
(string-append "\"" (str expr) "\""))
(defmethod ppl (pr (expr <exp-unr>))
(let* ((op (op expr))
(res-op (pp-unrop op))
(pr2 (priority-uop op))
(res-e (ppl pr2 (expr expr))))
(if (= pr 0)
(parenthesis (string-append res-op res-e))
(string-append res-op res-e))))
(defmethod ppl (pr (expr <exp-bin>))
(let* ((op (op expr))
(pr2 (priority-binop op))
(res (string-append (ppl pr2 (expr1 expr)) (pp-binop op) (ppr pr2 (expr2 expr)))))
(if (>= pr2 pr)
res
(parenthesis res))))
(defgeneric ppr (pr expr))
(defmethod ppr (pr (expr <exp-bin>))
(let* ((op (op expr))
(pr2 (priority-binop op))
(res (string-append (ppl pr2 (expr1 expr)) (pp-binop op) (ppr pr2 (expr2 expr)))))
(if (> pr2 pr)
res
(parenthesis res))))
(defmethod ppr (pr (expr <exp-int>))
(ppl pr expr))
(defmethod ppr (pr (expr <exp-var>))
(ppl pr expr))
(defmethod ppr (pr (expr <exp-str>))
(ppl pr expr))
(defmethod ppr (pr (expr <exp-unr>))
(ppl pr expr))
(defun pp-expression (expr)
(ppl 0 expr))
(defgeneric pp-command (cmd))
(defmethod pp-command ((cmd <cmd-rem>))
(string-append "REM " (str cmd)))
(defmethod pp-command ((cmd <cmd-goto>))
(string-append "GOTO " (convert (num cmd) <string>)))
(defmethod pp-command ((cmd <cmd-print>))
(string-append "PRNT " (pp-expression (expr cmd))))
(defmethod pp-command ((cmd <cmd-input>))
(string-append "INPUT " (var cmd)))
(defmethod pp-command ((cmd <cmd-if>))
(string-append "IF " (pp-expression (expr cmd)) " THEN " (convert (num cmd) <string>)))
(defmethod pp-command ((cmd <cmd-let>))
(string-append "LET " (var cmd) " = " (pp-expression (expr cmd))))
(defun pp-line (l)
(string-append (convert (car l) <string>) " " (pp-command (cdr l))))
|