about summary refs log blame commit diff stats
path: root/cpprint.lisp
blob: 82dec08c82f90575a3e7fd71333a814c798c170f (plain) (tree)
1
2
3
4
5




                      
















                        


                  

                      
                            


                                    
                                
                                    
             
                                    
                                       
                                    






                                                  
                                    





                                                                                           


                                    





                                                                                           
                                    
                
                                    
                
                                    
                
                                    
                

                           
               


                                       
                                   
                                        
                                                       
                                         
                                                      
                                         
                                     
                                      
                                                                                         
                                       
                                                                    

                  

                                                                       
(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 <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 "PRINT " (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))))
(provide "cpprint")