X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/239fa5bd3dff0b38b0cebdd3438311f21c24ba4f..f458e64e36509fa8c204f1dbcafff1d3dc059619:/src/module-proto.lisp diff --git a/src/module-proto.lisp b/src/module-proto.lisp index 93b4f68..7e42a5b 100644 --- a/src/module-proto.lisp +++ b/src/module-proto.lisp @@ -7,7 +7,7 @@ ;;;----- Licensing notice --------------------------------------------------- ;;; -;;; This file is part of the Sensble Object Design, an object system for C. +;;; This file is part of the Sensible Object Design, an object system for C. ;;; ;;; SOD is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -57,13 +57,10 @@ `((setf (documentation ',name 'variable) ,documentation))) (add-module-binding ',name (lambda () ,value-form)))) -(export 'call-with-module-environment) -(defun call-with-module-environment (thunk) - "Invoke THUNK with a new collection of bindings for the module variables." - (progv - (mapcar #'car *module-bindings-alist*) - (mapcar (compose #'cdr #'funcall) *module-bindings-alist*) - (funcall thunk))) +(export 'with-module-environment) +(defmacro with-module-environment ((&optional (module '*module*)) &body body) + "Evaluate the BODY with MODULE's variable bindings in scope." + `(call-with-module-environment (lambda () ,@body) ,module)) ;;;-------------------------------------------------------------------------- ;;; The reset switch. @@ -87,7 +84,10 @@ When `clear-the-decks' is called, the BODY will be evaluated as a progn. The relative order of `clear-the-decks' operations is unspecified." - `(add-clear-the-decks-function ',name (lambda () ,@body))) + (multiple-value-bind (docs decls body) (parse-body body) + `(add-clear-the-decks-function ',name (lambda () + ,@docs ,@decls + (block ,name ,@body))))) (export 'clear-the-decks) (defun clear-the-decks () @@ -104,7 +104,7 @@ During module construction, this is always an instance of `module'. Once we've finished constructing it, we'll call `change-class' to turn it into - an instance of whatever type is requested in the module's `:lisp-class' + an instance of whatever type is requested in the module's `:module-class' property.") (export 'module-import) @@ -118,14 +118,16 @@ It's not usual to modify the current module. Inserting things into the `*module-type-map*' is a good plan.") - (:method (object) nil)) + (:method (object) + (declare (ignore object)) + nil)) (export 'add-to-module) (defgeneric add-to-module (module item) (:documentation "Add ITEM to the MODULE's list of accumulated items. - The module items participate in the `module-import' and `add-output-hooks' + The module items participate in the `module-import' and `hook-output' protocols.")) (export 'finalize-module) @@ -136,9 +138,9 @@ This isn't necessary if you made the module by hand. If you've constructed it incrementally, then it might be a good plan. In particular, it will change the class (using `change-class') of the module - according to the class choice set in the module's `:lisp-class' property. - This has the side effects of calling `shared-initialize', setting the - module's state to `t', and checking for unrecognized + according to the class choice set in the module's `:module-class' + property. This has the side effects of calling `shared-initialize', + setting the module's state to `t', and checking for unrecognized properties. (Therefore subclasses should add a method to `shared-initialize' taking care of looking at interesting properties, just to make sure they're ticked off.)")) @@ -146,13 +148,19 @@ ;;;-------------------------------------------------------------------------- ;;; Module objects. -(export '(module module-name module-pset module-items module-dependencies)) +(export '(module module-name module-pset module-errors + module-items module-dependencies)) (defclass module () ((name :initarg :name :type pathname :reader module-name) - (pset :initarg :pset :initform (make-pset) :type pset :reader module-pset) + (%pset :initarg :pset :initform (make-pset) + :type pset :reader module-pset) + (errors :initarg :errors :initform 0 :type fixnum :reader module-errors) (items :initarg :items :initform nil :type list :accessor module-items) (dependencies :initarg :dependencies :initform nil :type list :accessor module-dependencies) + (variables :initarg :variables :type list :accessor module-variables + :initform (mapcar (compose #'cdr #'funcall) + *module-bindings-alist*)) (state :initarg :state :initform nil :accessor module-state)) (:documentation "A module is a container for the definitions made in a source file. @@ -173,6 +181,9 @@ * A list of other modules that this one depends on. + * A list of module-variable values, in the order in which they're named + in `*module-bindings-alist*'. + Modules are usually constructed by the `read-module' function, though there's nothing to stop fancy extensions building modules programmatically."))