+(export 'format-banner-comment)
+(defun format-banner-comment (stream control &rest args)
+ (format stream "~@</~@<* ~@;~?~:>~_ */~:>" control args))
+
+;; Important instruction classes.
+
+;; HACK: Some of the slot names we'd like to use are external symbols in our
+;; package or the `common-lisp' package. Use gensyms for these slot names to
+;; prevent them from leaking.
+
+(definst var (stream :export t) (name #1=#:type &optional init)
+ (pprint-c-type #1# stream name)
+ (when init
+ (format stream " = ~A" init))
+ (write-char #\; stream))
+
+(definst function (stream :export t)
+ (name #1=#:type body &optional #2=#:banner &rest banner-args)
+ (pprint-logical-block (stream nil)
+ (when #2#
+ (apply #'format-banner-comment stream #2# banner-args)
+ (pprint-newline :mandatory stream))
+ (princ "static " stream)
+ (pprint-c-type #1# stream name)
+ (format stream "~:@_~A~:@_~:@_" body)))
+
+;; Expression statements.
+(definst expr (stream :export t) (#1=#:expr)
+ (format stream "~A;" #1#))
+(definst set (stream :export t) (var #1=#:expr)
+ (format stream "~@<~A = ~@_~2I~A;~:>" var #1#))
+(definst update (stream :export t) (var op #1=#:expr)
+ (format stream "~@<~A ~A= ~@_~2I~A;~:>" var op #1#))
+
+;; Special kinds of expressions.
+(definst call (stream :export t) (#1=#:func &rest args)
+ (format stream "~A(~@<~{~A~^, ~_~}~:>)" #1# args))
+(definst cond (stream :export t) (#1=#:cond conseq alt)
+ (format stream "~@<~A ~2I~@_~@<? ~A ~_: ~A~:>~:>" #1# conseq alt))
+
+;; Simple statements.
+(definst return (stream :export t) (#1=#:expr)
+ (format stream "return~@[ (~A)~];" #1#))
+(definst break (stream :export t) ()
+ (format stream "break;"))
+(definst continue (stream :export t) ()
+ (format stream "continue;"))
+
+;; Compound statements.
+
+(defvar *first-statement-p* t
+ "True if this is the first statement in a block.
+
+ This is used to communicate between `block-inst' and `banner-inst' so that
+ they get the formatting right between them.")
+
+(definst banner (stream :export t) (control &rest args)
+ (pprint-logical-block (stream nil)
+ (unless *first-statement-p* (pprint-newline :mandatory stream))
+ (apply #'format-banner-comment stream control args)))
+
+(export 'emit-banner)
+(defun emit-banner (codegen control &rest args)
+ (emit-inst codegen (apply #'make-banner-inst control args)))
+
+(definst block (stream :export t) (decls body)
+ (write-char #\{ stream)
+ (pprint-newline :mandatory stream)
+ (pprint-logical-block (stream nil)
+ (let ((newlinep nil))
+ (flet ((newline ()
+ (if newlinep
+ (pprint-newline :mandatory stream)
+ (setf newlinep t))))
+ (pprint-indent :block 2 stream)
+ (write-string " " stream)
+ (when decls
+ (dolist (decl decls)
+ (newline)
+ (write decl :stream stream))
+ (when body (newline)))
+ (let ((*first-statement-p* t))
+ (dolist (inst body)
+ (newline)
+ (write inst :stream stream)
+ (setf *first-statement-p* nil))))))
+ (pprint-newline :mandatory stream)
+ (write-char #\} stream))
+
+(definst if (stream :export t) (#1=#:cond conseq &optional alt)
+ (let ((stmt "if"))
+ (loop (format-compound-statement (stream conseq (if alt t nil))
+ (format stream "~A (~A)" stmt #1#))
+ (typecase alt
+ (null (return))
+ (if-inst (setf stmt "else if"
+ #1# (inst-cond alt)
+ conseq (inst-conseq alt)
+ alt (inst-alt alt)))
+ (t (format-compound-statement (stream alt)
+ (format stream "else"))
+ (return))))))
+
+(definst while (stream :export t) (#1=#:cond body)
+ (format-compound-statement (stream body)
+ (format stream "while (~A)" #1#)))
+
+(definst do-while (stream :export t) (body #1=#:cond)
+ (format-compound-statement (stream body :space)
+ (write-string "do" stream))
+ (format stream "while (~A);" #1#))
+
+(definst for (stream :export t) (init #1=#:cond update body)
+ (format-compound-statement (stream body)
+ (format stream "for (~@<~@[~A~];~@[ ~_~A~];~@[ ~_~A~]~:>)"
+ init #1# update)))
+
~mdw / sod / blobdiff