chiark - git - mdw - sod/blob - src/codegen-proto.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Code generation protocol
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensble Object Design, an object system for C.
  11 ;;;
  12 ;;; SOD is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; SOD is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with SOD; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 (cl:in-package #:sod)
  27
  28 ;;;--------------------------------------------------------------------------
  29 ;;; Temporary names.
  30
  31 ;; Protocol.
  32
  33 (export 'format-temporary-name)
  34 (defgeneric format-temporary-name (var stream)
  35   (:documentation
  36    "Write the name of a temporary variable VAR to STREAM."))
  37
  38 (export 'var-in-use-p)
  39 (defgeneric var-in-use-p (var)
  40   (:documentation
  41    "Answer whether VAR is currently being used.  See `with-temporary-var'.")
  42   (:method (var)
  43     "Non-temporary variables are always in use."
  44     t))
  45 (defgeneric (setf var-in-use-p) (value var)
  46   (:documentation
  47    "Record whether VAR is currently being used.  See `with-temporary-var'."))
  48
  49 ;; Root class.
  50
  51 (export 'temporary-name)
  52 (defclass temporary-name ()
  53   ((tag :initarg :tag :reader temp-tag))
  54   (:documentation
  55    "Base class for temporary variable and argument names."))
  56
  57 ;; Important variables.
  58
  59 (defparameter *temporary-index* 0
  60   "Index for temporary name generation.
  61
  62    This is automatically reset to zero before the output functions are
  63    invoked to write a file.  This way, we can ensure that the same output
  64    file is always produced from the same input."
  65   ;; FIXME: this is currently a lie.  Need some protocol to ensure that this
  66   ;; happens.
  67 )
  68
  69 ;; Important temporary names.
  70
  71 (export '(*sod-ap* *sod-master-ap*))
  72 (defparameter *sod-ap*
  73   (make-instance 'temporary-name :tag "sod__ap"))
  74 (defparameter *sod-master-ap*
  75   (make-instance 'temporary-name :tag "sod__master_ap"))
  76
  77 ;;;--------------------------------------------------------------------------
  78 ;;; Instructions.
  79
  80 ;; Classes.
  81
  82 (export 'inst)
  83 (defclass inst () ()
  84   (:documentation
  85    "A base class for instructions.
  86
  87    An `instruction' is anything which might be useful to string into a code
  88    generator.  Both statements and expressions map can be represented by
  89    trees of instructions.  The `definst' macro is a convenient way of
  90    defining new instructions.
  91
  92    The only important protocol for instructions is output, which is achieved
  93    by calling `print-object' with `*print-escape*' nil.
  94
  95    This doesn't really do very much, but it acts as a handy marker for
  96    instruction subclasses."))
  97
  98 (export 'inst-metric)
  99 (defgeneric inst-metric (inst)
 100   (:documentation
 101    "Returns a `metric' describing how complicated INST is.
 102
 103    The default metric of an inst node is simply 1; `inst' subclasses
 104    generated by `definst' (q.v.) have an automatically generated method which
 105    returns one plus the sum of the metrics of the node's children.
 106
 107    This isn't intended to be a particularly rigorous definition.  Its purpose
 108    is to allow code generators to make decisions about inlining or calling
 109    code fairly simply.")
 110   (:method (inst) 1))
 111
 112 ;; Instruction definition.
 113
 114 (export 'definst)
 115 (defmacro definst (code (streamvar) args &body body)
 116   "Define an instruction type and describe how to output it.
 117
 118    An `inst' can represent any structured piece of output syntax: a
 119    statement, expression or declaration, for example.  This macro defines the
 120    following things:
 121
 122      * A class `CODE-inst' to represent the instruction.
 123
 124      * Instance slots named after the ARGS, with matching keyword initargs,
 125        and `inst-ARG' readers.
 126
 127      * A constructor `make-CODE-inst' which accepts the ARGS (in order, not
 128        with keywords) as arguments and returns a fresh instance.
 129
 130      * A print method, which prints a diagnostic dump if `*print-escape*' is
 131        set, or invokes the BODY (with STREAMVAR bound to the output stream)
 132        otherwise.  The BODY is expected to produce target code at this
 133        point."
 134
 135   (let ((inst-var (gensym "INST"))
 136         (class-name (symbolicate code '-inst))
 137         (keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
 138                       args)))
 139     `(progn
 140        (defclass ,class-name (inst)
 141          ,(mapcar (lambda (arg key)
 142                     `(,arg :initarg ,key :reader ,(symbolicate 'inst- arg)))
 143                   args keys))
 144        (defun ,(symbolicate 'make- code '-inst) (,@args)
 145          (make-instance ',class-name ,@(mappend #'list keys args)))
 146        (defmethod inst-metric ((,inst-var ,class-name))
 147          (with-slots (,@args) ,inst-var
 148            (+ 1 ,@(mapcar (lambda (arg) `(inst-metric ,arg)) args))))
 149        (defmethod print-object ((,inst-var ,class-name) ,streamvar)
 150          (with-slots (,@args) ,inst-var
 151            (if *print-escape*
 152                (print-unreadable-object (,inst-var ,streamvar :type t)
 153                  (format stream "~@<~@{~S ~@_~S~^ ~_~}~:>"
 154                          ,@(mappend #'list keys args)))
 155                (progn ,@body)))))))
 156
 157 ;; Important instruction classes.
 158
 159 (export '(block-inst make-block-inst var-inst make-var-inst
 160           function-inst make-function-inst set-inst make-set-inst
 161           return-inst make-return-inst expr-inst make-expr-inst
 162           inst-decls inst-body inst-name inst-type inst-init inst-var
 163           inst-expr))
 164
 165 (definst var (stream) (name type init)
 166   (pprint-c-type type stream name)
 167   (when init
 168     (format stream " = ~A" init)))
 169 (definst set (stream) (var expr)
 170   (format stream "~@<~A = ~@_~2I~A;~:>" var expr))
 171 (definst return (stream) (expr)
 172   (format stream "return~@[ (~A)~];" expr))
 173 (definst expr (stream) (expr)
 174   (format stream "~A;" expr))
 175 (definst block (stream) (decls body)
 176   (format stream "{~:@_~@<  ~2I~@[~{~A;~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}"
 177           decls body))
 178 (definst function (stream) (name type body)
 179   (pprint-logical-block (stream nil)
 180     (princ "static " stream)
 181     (pprint-c-type type stream name)
 182     (format stream "~:@_~A~:@_~:@_" body)))
 183
 184 ;; Formatting utilities.
 185
 186 (defun format-compound-statement* (stream child morep thunk)
 187   "Underlying function for `format-compound-statement'."
 188   (cond ((typep child 'block-inst)
 189          (funcall thunk stream)
 190          (write-char #\space stream)
 191          (princ child stream)
 192          (when morep (write-char #\space stream)))
 193         (t
 194          (pprint-logical-block (stream nil)
 195            (funcall thunk stream)
 196            (write-char #\space stream)
 197            (pprint-indent :block 2 stream)
 198            (pprint-newline :linear stream)
 199            (princ child stream)
 200            (pprint-indent :block 0 stream)
 201            (case morep
 202              (:space
 203               (write-char #\space stream)
 204               (pprint-newline :linear stream))
 205              ((t)
 206               (pprint-newline :mandatory stream)))))))
 207
 208 (export 'format-compound-statement)
 209 (defmacro format-compound-statement
 210     ((stream child &optional morep) &body body)
 211   "Format a compound statement to STREAM.
 212
 213    The introductory material is printed by BODY.  The CHILD is formatted
 214    properly according to whether it's a `block-inst'.  If MOREP is true, then
 215    allow for more stuff following the child."
 216   `(format-compound-statement* ,stream ,child ,morep
 217                                (lambda (,stream) ,@body)))
 218
 219 ;;;--------------------------------------------------------------------------
 220 ;;; Code generation.
 221
 222 ;; Accessors.
 223
 224 (export 'codegen-functions)
 225 (defgeneric codegen-functions (codegen)
 226   (:documentation
 227    "Return the list of `function-inst's of completed functions."))
 228
 229 (export 'ensure-var)
 230 (defgeneric ensure-var (codegen name type &optional init)
 231   (:documentation
 232    "Add a variable to CODEGEN's list.
 233
 234    The variable is called NAME (which should be comparable using `equal' and
 235    print to an identifier) and has the given TYPE.  If INIT is present and
 236    non-nil it is an expression `inst' used to provide the variable with an
 237    initial value."))
 238
 239 (export '(emit-inst emit-insts))
 240 (defgeneric emit-inst (codegen inst)
 241   (:documentation
 242    "Add INST to the end of CODEGEN's list of instructions."))
 243 (defgeneric emit-insts (codegen insts)
 244   (:documentation
 245    "Add a list of INSTS to the end of CODEGEN's list of instructions.")
 246   (:method (codegen insts)
 247     (dolist (inst insts) (emit-inst codegen inst))))
 248
 249 (export 'codegen-push)
 250 (defgeneric codegen-push (codegen)
 251   (:documentation
 252    "Pushes the current code generation state onto a stack.
 253
 254    The state consists of the accumulated variables and instructions."))
 255
 256 (export 'codegen-pop)
 257 (defgeneric codegen-pop (codegen)
 258   (:documentation
 259    "Pops a saved state off of the CODEGEN's stack.
 260
 261    Returns the newly accumulated variables and instructions as lists, as
 262    separate values."))
 263
 264 (export 'codegen-add-function)
 265 (defgeneric codegen-add-function (codegen function)
 266   (:documentation
 267    "Adds a function to CODEGEN's list.
 268
 269    Actually, we're not picky: FUNCTION can be any kind of object that you're
 270    willing to find in the list returned by `codegen-functions'."))
 271
 272 (export 'temporary-var)
 273 (defgeneric temporary-var (codegen type)
 274   (:documentation
 275    "Return the name of a temporary variable.
 276
 277    The temporary variable will have the given TYPE, and will be marked
 278    in-use.  You should clear the in-use flag explicitly when you've finished
 279    with the variable -- or, better, use `with-temporary-var' to do the
 280    cleanup automatically."))
 281
 282 (export 'codegen-build-function)
 283 (defun codegen-build-function (codegen name type vars insts)
 284   "Build a function and add it to CODEGEN's list.
 285
 286    Returns the function's name."
 287   (codegen-add-function codegen
 288                         (make-function-inst name type
 289                                             (make-block-inst vars insts)))
 290   name)
 291
 292 (export 'codegen-pop-block)
 293 (defgeneric codegen-pop-block (codegen)
 294   (:documentation
 295    "Makes a block (`block-inst') out of the completed code in CODEGEN.")
 296   (:method (codegen)
 297     (multiple-value-bind (vars insts) (codegen-pop codegen)
 298       (make-block-inst vars insts))))
 299
 300 (export 'codegen-pop-function)
 301 (defgeneric codegen-pop-function (codegen name type)
 302   (:documentation
 303    "Makes a function out of the completed code in CODEGEN.
 304
 305    The NAME can be any object you like.  The TYPE should be a function type
 306    object which includes argument names.  The return value is the NAME.")
 307   (:method (codegen name type)
 308     (multiple-value-bind (vars insts) (codegen-pop codegen)
 309       (codegen-build-function codegen name type vars insts))))
 310
 311 (export 'with-temporary-var)
 312 (defmacro with-temporary-var ((codegen var type) &body body)
 313   "Evaluate BODY with VAR bound to a temporary variable name.
 314
 315    During BODY, VAR will be marked in-use; when BODY ends, VAR will be marked
 316   available for re-use."
 317   `(let ((,var (temporary-var ,codegen ,type)))
 318      (unwind-protect
 319           (progn ,@body)
 320        (setf (var-in-use-p ,var) nil))))
 321
 322 ;;;--------------------------------------------------------------------------
 323 ;;; Code generation idioms.
 324
 325 (export 'deliver-expr)
 326 (defun deliver-expr (codegen target expr)
 327   "Emit code to deliver the value of EXPR to the TARGET.
 328
 329    The TARGET may be one of the following.
 330
 331      * `:void', indicating that the value is to be discarded.  The expression
 332        will still be evaluated.
 333
 334      * `:void-return', indicating that the value is to be discarded (as for
 335        `:void') and furthermore a `return' from the current function should
 336        be forced after computing the value.
 337
 338      * `:return', indicating that the value is to be returned from the
 339        current function.
 340
 341      * A variable name, indicating that the value is to be stored in the
 342        variable.
 343
 344    In the cases of `:return', `:void' and `:void-return' targets, it is valid
 345    for EXPR to be nil; this signifies that no computation needs to be
 346    performed.  Variable-name targets require an expression."
 347
 348   (case target
 349     (:return (emit-inst codegen (make-return-inst expr)))
 350     (:void (when expr (emit-inst codegen (make-expr-inst expr))))
 351     (:void-return (when expr (emit-inst codegen (make-expr-inst expr)))
 352                   (emit-inst codegen (make-return-inst nil)))
 353     (t (emit-inst codegen (make-set-inst target expr)))))
 354
 355 (export 'convert-stmts)
 356 (defun convert-stmts (codegen target type func)
 357   "Invoke FUNC to deliver a value to a non-`:return' target.
 358
 359    FUNC is a function which accepts a single argument, a non-`:return'
 360    target, and generates statements which deliver a value (see
 361    `deliver-expr') of the specified TYPE to this target.  In general, the
 362    generated code will have the form
 363
 364      setup instructions...
 365      (deliver-expr CODEGEN TARGET (compute value...))
 366      cleanup instructions...
 367
 368    where the cleanup instructions are essential to the proper working of the
 369    generated program.
 370
 371    The `convert-stmts' function will call FUNC to generate code, and arrange
 372    that its value is correctly delivered to TARGET, regardless of what the
 373    TARGET is -- i.e., it lifts the restriction to non-`:return' targets.  It
 374    does this by inventing a new temporary variable."
 375
 376   (case target
 377     (:return (with-temporary-var (codegen var type)
 378                (funcall func var)
 379                (deliver-expr codegen target var)))
 380     (:void-return (funcall func :void)
 381                   (emit-inst codegen (make-return-inst nil)))
 382     (t (funcall func target))))
 383
 384 ;;;----- That's all, folks --------------------------------------------------