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