+(export 'format-banner-comment)
+(defun format-banner-comment (stream control &rest args)
+ (format stream "~@</~@<* ~@;~?~:>~_ */~:>" control args))
+
+;; Important instruction classes.
+
+(definst var (stream :export t) (name %type &optional init)
+ (pprint-logical-block (stream nil)
+ (pprint-c-type type stream name)
+ (when init
+ (format stream " = ~2I~_~A" init))
+ (write-char #\; stream)))
+
+(definst function (stream :export t)
+ (name %type body &optional %banner &rest banner-args)
+ (pprint-logical-block (stream nil)
+ (when banner
+ (apply #'format-banner-comment stream banner banner-args)
+ (pprint-newline :mandatory stream))
+ (princ "static " stream)
+ (pprint-c-type type stream name)
+ (format stream "~:@_~A~:@_~:@_" body)))
+
+;; Expression statements.
+(definst expr (stream :export t) (%expr)
+ (format stream "~A;" expr))
+(definst set (stream :export t) (var %expr)
+ (format stream "~@<~A = ~2I~_~A;~:>" var expr))
+(definst update (stream :export t) (var op %expr)
+ (format stream "~@<~A ~A= ~2I~_~A;~:>" var op expr))
+
+;; Special kinds of expressions.
+(definst call (stream :export t) (%func &rest args)
+ (format stream "~@<~A~4I~_(~@<~{~A~^, ~_~}~:>)~:>" func args))
+(definst cond (stream :export t) (%cond conseq alt)
+ (format stream "~@<~A ~2I~@_~@<? ~A ~_: ~A~:>~:>" cond conseq alt))
+
+;; Simple statements.
+(definst return (stream :export t) (%expr)
+ (format stream "return~@[ (~A)~];" expr))
+(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) (%cond conseq &optional alt)
+ (let ((stmt "if"))
+ (loop (format-compound-statement (stream conseq (if alt t nil))
+ (format stream "~A (~A)" stmt cond))
+ (typecase alt
+ (null (return))
+ (if-inst (setf stmt "else if"
+ cond (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) (%cond body)
+ (format-compound-statement (stream body)
+ (format stream "while (~A)" cond)))
+
+(definst do-while (stream :export t) (body %cond)
+ (format-compound-statement (stream body :space)
+ (write-string "do" stream))
+ (format stream "while (~A);" cond))
+
+(definst for (stream :export t) (init %cond update body)
+ (format-compound-statement (stream body)
+ (format stream "for (~@<~@[~A~];~@[ ~_~A~];~@[ ~_~A~]~:>)"
+ init cond update)))
+