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

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Module protocol definition
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensible 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 ;;; Module environment.
  30
  31 (defvar *module-bindings-alist* nil
  32   "An alist of (SYMBOL . THUNK) pairs.
  33
  34    During module construction, each SYMBOL is special-bound to the value
  35    returned by the corresponding THUNK.")
  36
  37 (export 'add-module-binding)
  38 (defun add-module-binding (symbol thunk)
  39   "Add a new module variable binding.
  40
  41    During module construction, SYMBOL will be special-bound to the value
  42    returned by THUNK.  If you can, use `define-module-var' instead."
  43   (aif (assoc symbol *module-bindings-alist*)
  44        (setf (cdr it) thunk)
  45        (asetf *module-bindings-alist* (acons symbol thunk it))))
  46
  47 (export 'define-module-var)
  48 (defmacro define-module-var (name value-form &optional documentation)
  49   "Add a new module variable binding.
  50
  51    During module construction, NAME will be special-bound to the value of
  52    VALUE-FORM.  The NAME is proclaimed special, but is initially left
  53    unbound."
  54   `(progn
  55      (defvar ,name)
  56      ,@(and documentation
  57             `((setf (documentation ',name 'variable) ,documentation)))
  58      (add-module-binding ',name (lambda () ,value-form))))
  59
  60 (export 'with-module-environment)
  61 (defmacro with-module-environment ((&optional (module '*module*)) &body body)
  62   "Evaluate the BODY with MODULE's variable bindings in scope."
  63   `(call-with-module-environment (lambda () ,@body) ,module))
  64
  65 ;;;--------------------------------------------------------------------------
  66 ;;; The reset switch.
  67
  68 (defvar *clear-the-decks-alist* nil
  69   "List tracking functions to be called by `clear-the-decks'.")
  70
  71 (export 'add-clear-the-decks-function)
  72 (defun add-clear-the-decks-function (symbol thunk)
  73   "Add a function to the `clear-the-decks' list.
  74
  75    If a function tagged by SYMBOL already exists on the list, then that
  76    function is replaced; otherwise a new function is added."
  77   (aif (assoc symbol *clear-the-decks-alist*)
  78        (setf (cdr it) thunk)
  79        (asetf *clear-the-decks-alist* (acons symbol thunk it))))
  80
  81 (export 'define-clear-the-decks)
  82 (defmacro define-clear-the-decks (name &body body)
  83   "Add behaviour to `clear-the-decks'.
  84
  85    When `clear-the-decks' is called, the BODY will be evaluated as a progn.
  86    The relative order of `clear-the-decks' operations is unspecified."
  87   (multiple-value-bind (docs decls body) (parse-body body)
  88     `(add-clear-the-decks-function ',name (lambda ()
  89                                             ,@docs ,@decls
  90                                             (block ,name ,@body)))))
  91
  92 (export 'clear-the-decks)
  93 (defun clear-the-decks ()
  94   "Invoke a sequence of functions to reset the world."
  95   (dolist (item *clear-the-decks-alist*)
  96     (funcall (cdr item))))
  97
  98 ;;;--------------------------------------------------------------------------
  99 ;;; Module construction protocol.
 100
 101 (export '*module*)
 102 (defparameter *module* nil
 103   "The current module under construction.
 104
 105    During module construction, this is always an instance of `module'.  Once
 106    we've finished constructing it, we'll call `change-class' to turn it into
 107    an instance of whatever type is requested in the module's `:module-class'
 108    property.")
 109
 110 (export 'module-import)
 111 (defgeneric module-import (object)
 112   (:documentation
 113    "Import definitions into the current environment.
 114
 115    Instructs the OBJECT to import its definitions into the current
 116    environment.  Modules pass the request on to their constituents.  There's
 117    a default method which does nothing at all.
 118
 119    It's not usual to modify the current module.  Inserting things into the
 120    `*module-type-map*' is a good plan.")
 121   (:method (object)
 122     (declare (ignore object))
 123     nil))
 124
 125 (export 'add-to-module)
 126 (defgeneric add-to-module (module item)
 127   (:documentation
 128    "Add ITEM to the MODULE's list of accumulated items.
 129
 130    The module items participate in the `module-import' and `hook-output'
 131    protocols."))
 132
 133 (export 'finalize-module)
 134 (defgeneric finalize-module (module)
 135   (:documentation
 136    "Finalizes a module, setting everything which needs setting.
 137
 138    This isn't necessary if you made the module by hand.  If you've
 139    constructed it incrementally, then it might be a good plan.  In
 140    particular, it will change the class (using `change-class') of the module
 141    according to the class choice set in the module's `:module-class'
 142    property.  This has the side effects of calling `shared-initialize',
 143    setting the module's state to `t', and checking for unrecognized
 144    properties.  (Therefore subclasses should add a method to `shared-
 145    initialize' taking care of looking at interesting properties, just to make
 146    sure they're ticked off.)"))
 147
 148 ;;;--------------------------------------------------------------------------
 149 ;;; Module objects.
 150
 151 (export '(module module-name module-pset module-errors
 152           module-items module-files module-dependencies module-state))
 153 (defclass module ()
 154   ((name :initarg :name :type pathname :reader module-name)
 155    (%pset :initarg :pset :initform (make-pset)
 156           :type pset :reader module-pset)
 157    (errors :initarg :errors :initform 0 :type fixnum :reader module-errors)
 158    (items :initarg :items :initform nil :type list :accessor module-items)
 159    (files :initarg :files :initform nil :type list :accessor module-files)
 160    (dependencies :initarg :dependencies :initform nil
 161                  :type list :accessor module-dependencies)
 162    (variables :initarg :variables :type list :accessor module-variables
 163               :initform (mapcar (compose #'cdr #'funcall)
 164                                 *module-bindings-alist*))
 165    (state :initarg :state :initform nil :accessor module-state))
 166   (:documentation
 167    "A module is a container for the definitions made in a source file.
 168
 169    Modules are the fundamental units of translation.  The main job of a
 170    module is to remember which definitions it contains, so that they can be
 171    translated and written to output files.  The module contains the following
 172    handy bits of information:
 173
 174      * A (path) name, which is the filename we used to find it.  The default
 175        output filenames are derived from this.  (We use the file's truename
 176        as the hash key to prevent multiple inclusion, and that's a different
 177        thing.)
 178
 179      * A property list containing other useful things.
 180
 181      * A list of items which the module contains.
 182
 183      * A list of other modules that this one depends on.
 184
 185      * A list of other files this module has read.
 186
 187      * A list of module-variable values, in the order in which they're named
 188        in `*module-bindings-alist*'.
 189
 190    Modules are usually constructed by the `read-module' function, though
 191    there's nothing to stop fancy extensions building modules
 192    programmatically."))
 193
 194 (export 'define-module)
 195 (defmacro define-module
 196     ((name &key (truename nil truenamep) (location nil locationp))
 197      &body body)
 198   "Define and return a new module.
 199
 200    The module will be called NAME; it will be included in the `*module-map*'
 201    only if it has a TRUENAME (which defaults to the truename of NAME, or nil
 202    if there is no file with that name).  The module is populated by
 203    evaluating the BODY in a dynamic environment where `*module*' is bound to
 204    the module under construction, and any other module variables are bound to
 205    appropriate initial values -- see `*module-bindings-alist*' and
 206    `define-module-var'.
 207
 208    If a module with the same NAME is already known, then it is returned
 209    unchanged: the BODY is not evaluated.
 210
 211    The LOCATION may be any printable value other than `t' (though
 212    `file-location' objects are most usual) indicating what provoked this
 213    module definition: it gets reported to the user if an import cycle is
 214    detected.  This check is made only if a TRUENAME is supplied.
 215
 216    Evaluation order irregularity: the TRUENAME and LOCATION arguments are
 217    always evaluated in that order, regardless of their order in the macro
 218    call site (which this macro can't detect)."
 219
 220   `(build-module ,name
 221                  (lambda () ,@body)
 222                  ,@(and truenamep `(:truename ,truename))
 223                  ,@(and locationp `(:location ,location))))
 224
 225 (export 'with-temporary-module)
 226 (defmacro with-temporary-module ((&key) &body body)
 227   "Evaluate BODY within the context of a temporary module."
 228   `(call-with-temporary-module (lambda () ,@body)))
 229
 230 ;;;--------------------------------------------------------------------------
 231 ;;; Code fragments.
 232
 233 (export '(c-fragment c-fragment-text))
 234 (defclass c-fragment ()
 235   ((location :initarg :location :type file-location :reader file-location)
 236    (text :initarg :text :type string :reader c-fragment-text))
 237   (:documentation
 238    "Represents a fragment of C code to be written to an output file.
 239
 240    A C fragment is aware of its original location, and will bear proper
 241    `#line' markers when written out."))
 242
 243 ;;;----- That's all, folks --------------------------------------------------