John Lorentzson
928cdfd318
It ingests tokens via a "token stream", and feeds out a node tree. It's a mostly handwritten recursive descent parser with the occasional Lisp macros for convenience.
113 lines
3.7 KiB
Common Lisp
113 lines
3.7 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
;;; S-Printer (the S stood for S-expression, but that's no longer true).
|
|
;;; It reprints a valid program out of a syntax tree. Start it by passing
|
|
;;; S-PRINT a NODE-PROGRAM and a stream. Otherwise, be sure to properly bind
|
|
;;; the dynamic variables.
|
|
|
|
(defparameter *s-print-indent-size* 4)
|
|
(defvar *s-print-indent* 0)
|
|
(defvar *s-print-indent-p* nil)
|
|
|
|
(defun s-indent (stream)
|
|
(when *s-print-indent-p*
|
|
(loop :repeat (* *s-print-indent* *s-print-indent-size*)
|
|
:do (write-char #\Space stream))))
|
|
|
|
(defgeneric s-print (node stream))
|
|
|
|
(defmethod s-print ((node null) stream)
|
|
(format stream "~%~%END OF FILE~%"))
|
|
|
|
(defmethod s-print ((node node) stream)
|
|
(s-print (normal-next node)))
|
|
|
|
(defmethod s-print :around (node (stream symbol))
|
|
(cond ((eql stream t) (s-print node *standard-output*))
|
|
((eql stream nil) (with-output-to-string (s)
|
|
(s-print node s)))
|
|
(t (error "~A is not a valid stream. Must be T, NIL, or a STREAM."
|
|
stream))))
|
|
|
|
(defmethod s-print ((node node-expr-grouping) stream)
|
|
(format stream "(~A)" (s-print (expression node) nil)))
|
|
|
|
(defmethod s-print ((node node-expr) stream)
|
|
(let ((operator (car (rassoc (class-name (class-of (operator-token node)))
|
|
*operator-token-classes*
|
|
:key #'car))))
|
|
(assert (= (length (operands node)) 2))
|
|
(format stream "~A ~A ~A"
|
|
(s-print (first (operands node)) nil)
|
|
operator
|
|
(s-print (second (operands node)) nil))))
|
|
|
|
(defmethod s-print ((node node-assignment) stream)
|
|
(s-indent stream)
|
|
(format stream "~A = ~A~%"
|
|
(s-print (dst-variable node) nil)
|
|
(s-print (value node) nil)))
|
|
|
|
(defmethod s-print ((node node-conditional) stream)
|
|
(s-indent stream)
|
|
(format stream "IF ~A THEN~%~A"
|
|
(s-print (test-node node) nil)
|
|
(prog2
|
|
(incf *s-print-indent*)
|
|
(s-print (then-node node) nil)
|
|
(decf *s-print-indent*)))
|
|
(s-indent stream)
|
|
(if (null (else-node node))
|
|
(format stream "END~%")
|
|
(progn
|
|
(format stream "ELSE~%~A"
|
|
(prog2
|
|
(incf *s-print-indent*)
|
|
(s-print (else-node node) nil)
|
|
(decf *s-print-indent*)))
|
|
(s-indent stream)
|
|
(format stream "END~%"))))
|
|
|
|
(defmethod s-print ((node reference-variable) stream)
|
|
(write-string (name node) stream))
|
|
|
|
(defmethod s-print ((node reference-constant) stream)
|
|
(format stream "~D" (ref-value node)))
|
|
|
|
(defmethod s-print ((node node-dotimes) stream)
|
|
(s-indent stream)
|
|
(format stream "FOR ~A DO ~A TIMES~%"
|
|
(s-print (counter-ref node) nil)
|
|
(s-print (stop-ref node) nil))
|
|
(incf *s-print-indent*)
|
|
(s-print (loopee-node node) stream)
|
|
(decf *s-print-indent*)
|
|
(s-indent stream)
|
|
(format stream "END~%"))
|
|
|
|
(defmethod s-print ((node token-name) stream)
|
|
(format stream "~A" (name node)))
|
|
|
|
(defmethod s-print ((node token-number) stream)
|
|
(format stream "~A" (value node)))
|
|
|
|
(defmethod s-print ((node node-block) stream)
|
|
(dolist (s (statements node))
|
|
(s-print s stream)))
|
|
|
|
(defmethod s-print ((node node-program) stream)
|
|
(let ((*s-print-indent* 0)
|
|
(*s-print-indent-p* t))
|
|
(dolist (s (statements node))
|
|
(s-print s stream))))
|
|
|
|
(defmethod s-print ((node node-call) stream)
|
|
(s-indent stream)
|
|
(format stream "~A(~A~{, ~A~})~%"
|
|
(s-print (callee node) nil)
|
|
(s-print (first (arguments node)) nil)
|
|
(mapcar (lambda (a) (s-print a nil))
|
|
(rest (arguments node)))))
|
|
|
|
(defmethod s-print ((node asm-function) stream)
|
|
(format stream "~A" (string-upcase (name node))))
|