X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/167524b5890cdbf4a832b1766a328f6d8a1f8f04..6c3c2dd3e236da72ce43b923e4eeac7d33eb5cbd:/src/codegen-proto.lisp diff --git a/src/codegen-proto.lisp b/src/codegen-proto.lisp index 4bfaeca..856e44e 100644 --- a/src/codegen-proto.lisp +++ b/src/codegen-proto.lisp @@ -66,6 +66,13 @@ (make-instance 'temporary-name :tag "sod__tmp_ap")) (defparameter *sod-tmp-val* (make-instance 'temporary-name :tag "sod__t")) +(defparameter *sod-keywords* + (make-instance 'temporary-name :tag "sod__kw")) +(defparameter *sod-key-pointer* + (make-instance 'temporary-name :tag "sod__keys")) + +(export '*null-pointer*) +(defparameter *null-pointer* "NULL") ;;;-------------------------------------------------------------------------- ;;; Instructions. @@ -188,13 +195,13 @@ (pprint-indent :block 2 stream) (pprint-newline :linear stream) (princ child stream) - (pprint-indent :block 0 stream) - (case morep - (:space - (write-char #\space stream) - (pprint-newline :linear stream)) - ((t) - (pprint-newline :mandatory stream))))))) + (pprint-indent :block 0 stream)) + (case morep + (:space + (write-char #\space stream) + (pprint-newline :linear stream)) + ((t) + (pprint-newline :mandatory stream)))))) (export 'format-compound-statement) (defmacro format-compound-statement @@ -207,6 +214,10 @@ `(format-compound-statement* ,stream ,child ,morep (lambda (,stream) ,@body))) +(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 @@ -214,13 +225,18 @@ ;; 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)) + (pprint-logical-block (stream nil) + (pprint-c-type #1# stream name) + (when init + (format stream " = ~2I~_~A" init)) + (write-char #\; stream))) -(definst function (stream :export t) (name #1=#:type body) +(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))) @@ -229,13 +245,15 @@ (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#)) + (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#)) + (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)) + (format stream "~@<~A~4I~_(~@<~{~A~^, ~_~}~:>)~:>" #1# args)) +(definst cond (stream :export t) (#1=#:cond conseq alt) + (format stream "~@<~A ~2I~@_~@~:>" #1# conseq alt)) ;; Simple statements. (definst return (stream :export t) (#1=#:expr) @@ -247,16 +265,58 @@ ;; 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) - (format stream "{~:@_~@< ~2I~@[~{~A~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}" - 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) - (format-compound-statement (stream conseq alt) - (format stream "if (~A)" #1#)) - (when alt - (format-compound-statement (stream alt) - (write-string "else" stream)))) + (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) @@ -267,6 +327,11 @@ (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))) + ;;;-------------------------------------------------------------------------- ;;; Code generation. @@ -339,13 +404,15 @@ cleanup automatically.")) (export 'codegen-build-function) -(defun codegen-build-function (codegen name type vars insts) +(defun codegen-build-function + (codegen name type vars insts &optional banner &rest banner-args) "Build a function and add it to CODEGEN's list. Returns the function's name." (codegen-add-function codegen - (make-function-inst name type - (make-block-inst vars insts))) + (apply #'make-function-inst name type + (make-block-inst vars insts) + banner banner-args)) name) (export 'codegen-pop-block) @@ -357,15 +424,17 @@ (make-block-inst vars insts)))) (export 'codegen-pop-function) -(defgeneric codegen-pop-function (codegen name type) +(defgeneric codegen-pop-function + (codegen name type &optional banner &rest banner-args) (:documentation "Makes a function out of the completed code in CODEGEN. The NAME can be any object you like. The TYPE should be a function type object which includes argument names. The return value is the NAME.") - (:method (codegen name type) + (:method (codegen name type &optional banner &rest banner-args) (multiple-value-bind (vars insts) (codegen-pop codegen) - (codegen-build-function codegen name type vars insts)))) + (apply #'codegen-build-function codegen name type vars insts + banner banner-args)))) (export 'with-temporary-var) (defmacro with-temporary-var ((codegen var type) &body body)