(defpackage #:cpprint (:use #:common-lisp) (:export pp-line)) (in-package #:cpprint) (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 )) (convert (num expr) )) (defmethod ppl (pr (expr )) (var expr)) (defmethod ppl (pr (expr )) (string-append "\"" (str expr) "\"")) (defmethod ppl (pr (expr )) (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 )) (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 )) (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 )) (ppl pr expr)) (defmethod ppr (pr (expr )) (ppl pr expr)) (defmethod ppr (pr (expr )) (ppl pr expr)) (defmethod ppr (pr (expr )) (ppl pr expr)) (defun pp-expression (expr) (ppl 0 expr)) (defgeneric pp-command (cmd)) (defmethod pp-command ((cmd )) (string-append "REM " (str cmd))) (defmethod pp-command ((cmd )) (string-append "GOTO " (convert (num cmd) ))) (defmethod pp-command ((cmd )) (string-append "PRINT " (pp-expression (expr cmd)))) (defmethod pp-command ((cmd )) (string-append "INPUT " (var cmd))) (defmethod pp-command ((cmd )) (string-append "IF " (pp-expression (expr cmd)) " THEN " (convert (num cmd) ))) (defmethod pp-command ((cmd )) (string-append "LET " (var cmd) " = " (pp-expression (expr cmd)))) (defun pp-line (l) (string-append (convert (car l) ) " " (pp-command (cdr l)))) (provide "cpprint")