about summary refs log tree commit diff stats
path: root/cpprint.lisp
diff options
context:
space:
mode:
authorDarren Bane <darren.bane@emdalo.com>2020-08-04 12:30:56 +0100
committerDarren Bane <darren.bane@emdalo.com>2020-08-04 12:30:56 +0100
commit1167e1207e3c0928f04aa3ed51fc315fb5b8729a (patch)
treeaa7d0bb009a5495f4ba524cfcbd4e36704c0d9eb /cpprint.lisp
parent546c54613a397996e3faa04173bfa73a08a6ee47 (diff)
downloadlsp-1167e1207e3c0928f04aa3ed51fc315fb5b8729a.tar.gz
Flip-flop back to CL.
Diffstat (limited to 'cpprint.lisp')
-rw-r--r--cpprint.lisp83
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))))