diff options
author | Darren Bane <darren.bane@emdalo.com> | 2020-08-04 12:30:56 +0100 |
---|---|---|
committer | Darren Bane <darren.bane@emdalo.com> | 2020-08-04 12:30:56 +0100 |
commit | 1167e1207e3c0928f04aa3ed51fc315fb5b8729a (patch) | |
tree | aa7d0bb009a5495f4ba524cfcbd4e36704c0d9eb /cpprint.lisp | |
parent | 546c54613a397996e3faa04173bfa73a08a6ee47 (diff) | |
download | lsp-1167e1207e3c0928f04aa3ed51fc315fb5b8729a.tar.gz |
Flip-flop back to CL.
Diffstat (limited to 'cpprint.lisp')
-rw-r--r-- | cpprint.lisp | 83 |
1 files changed, 83 insertions, 0 deletions
diff --git a/cpprint.lisp b/cpprint.lisp new file mode 100644 index 0000000..84dbfc1 --- /dev/null +++ b/cpprint.lisp @@ -0,0 +1,83 @@ +(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)))) |