From 418752c55a29e2380d6d1aef767b7cfba02cf4be Mon Sep 17 00:00:00 2001 Message-Id: <418752c55a29e2380d6d1aef767b7cfba02cf4be.1718462115.git.mdw@distorted.org.uk> From: Mark Wooding Date: Sun, 30 Aug 2015 10:58:38 +0100 Subject: [PATCH] src/codegen-{proto,impl}.lisp: Have `definst' optionally export symbols. Organization: Straylight/Edgeware From: Mark Wooding The enormous export lists are annoying to maintain. --- src/codegen-impl.lisp | 26 +++++++------------------- src/codegen-proto.lisp | 32 ++++++++++++++++---------------- 2 files changed, 23 insertions(+), 35 deletions(-) diff --git a/src/codegen-impl.lisp b/src/codegen-impl.lisp index 2b23661..3790d9d 100644 --- a/src/codegen-impl.lisp +++ b/src/codegen-impl.lisp @@ -66,48 +66,36 @@ (defmethod print-object ((var temporary-name) stream) ;; Compound statements. -(export '(if-inst make-if-inst - while-inst make-while-inst - do-inst make-do-inst - inst-condition inst-consequent inst-alternative inst-body)) - -(definst if (stream) (condition consequent alternative) +(definst if (stream :export t) (condition consequent alternative) (format-compound-statement (stream consequent alternative) (format stream "if (~A)" condition)) (when alternative (format-compound-statement (stream alternative) (write-string "else" stream)))) -(definst while (stream) (condition body) +(definst while (stream :export t) (condition body) (format-compound-statement (stream body) (format stream "while (~A)" condition))) -(definst do-while (stream) (body condition) +(definst do-while (stream :export t) (body condition) (format-compound-statement (stream body :space) (write-string "do" stream)) (format stream "while (~A);" condition)) ;; Special varargs hacks. -(export '(va-start-inst make-va-start-inst - va-copy-inst make-va-copy-inst - va-end-inst make-va-end-inst - inst-ap inst-arg inst-to inst-from)) - -(definst va-start (stream) (ap arg) +(definst va-start (stream :export t) (ap arg) (format stream "va_start(~@<~A, ~_~A~:>);" ap arg)) -(definst va-copy (stream) (to from) +(definst va-copy (stream :export t) (to from) (format stream "va_copy(~@<~A, ~_~A~:>);" to from)) -(definst va-end (stream) (ap) +(definst va-end (stream :export t) (ap) (format stream "va_end(~A);" ap)) ;; Expressions. -(export '(call-inst make-call-inst inst-func inst-args)) - -(definst call (stream) (func args) +(definst call (stream :export t) (func args) (format stream "~A(~@<~{~A~^, ~_~}~:>)" func args)) ;;;-------------------------------------------------------------------------- diff --git a/src/codegen-proto.lisp b/src/codegen-proto.lisp index b8206fa..29ff35b 100644 --- a/src/codegen-proto.lisp +++ b/src/codegen-proto.lisp @@ -120,7 +120,7 @@ (defgeneric inst-metric (inst) ;; Instruction definition. (export 'definst) -(defmacro definst (code (streamvar) args &body body) +(defmacro definst (code (streamvar &key export) args &body body) "Define an instruction type and describe how to output it. An `inst' can represent any structured piece of output syntax: a @@ -138,10 +138,14 @@ (defmacro definst (code (streamvar) args &body body) * A print method, which prints a diagnostic dump if `*print-escape*' is set, or invokes the BODY (with STREAMVAR bound to the output stream) otherwise. The BODY is expected to produce target code at this - point." + point. + + If EXPORT is non-nil, then export the `CODE-inst' and `make-CODE-inst' + symbols." (let ((inst-var (gensym "INST")) (class-name (symbolicate code '-inst)) + (constructor-name (symbolicate 'make- code '-inst)) (keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword)) args))) `(progn @@ -149,7 +153,7 @@ (defclass ,class-name (inst) ,(mapcar (lambda (arg key) `(,arg :initarg ,key :reader ,(symbolicate 'inst- arg))) args keys)) - (defun ,(symbolicate 'make- code '-inst) (,@args) + (defun ,constructor-name (,@args) (make-instance ',class-name ,@(mappend #'list keys args))) (defmethod inst-metric ((,inst-var ,class-name)) (with-slots (,@args) ,inst-var @@ -160,30 +164,26 @@ (defmethod print-object ((,inst-var ,class-name) ,streamvar) (print-unreadable-object (,inst-var ,streamvar :type t) (format stream "~@<~@{~S ~@_~S~^ ~_~}~:>" ,@(mappend #'list keys args))) - (progn ,@body))))))) + (progn ,@body)))) + ,@(and export `((export '(,class-name ,constructor-name)))) + ',code))) ;; Important instruction classes. -(export '(block-inst make-block-inst var-inst make-var-inst - function-inst make-function-inst set-inst make-set-inst - return-inst make-return-inst expr-inst make-expr-inst - inst-decls inst-body inst-name inst-type inst-init inst-var - inst-expr)) - -(definst var (stream) (name type init) +(definst var (stream :export t) (name type init) (pprint-c-type type stream name) (when init (format stream " = ~A" init))) -(definst set (stream) (var expr) +(definst set (stream :export t) (var expr) (format stream "~@<~A = ~@_~2I~A;~:>" var expr)) -(definst return (stream) (expr) +(definst return (stream :export t) (expr) (format stream "return~@[ (~A)~];" expr)) -(definst expr (stream) (expr) +(definst expr (stream :export t) (expr) (format stream "~A;" expr)) -(definst block (stream) (decls body) +(definst block (stream :export t) (decls body) (format stream "{~:@_~@< ~2I~@[~{~A;~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}" decls body)) -(definst function (stream) (name type body) +(definst function (stream :export t) (name type body) (pprint-logical-block (stream nil) (princ "static " stream) (pprint-c-type type stream name) -- [mdw]