Unlike when we built the first compiler (most in Java - do you know just how many lines of code it took just to get to the old one?), it was intended to get us working. And it did, but with a lot of things not working. For 6 years we've being patching it. Any of you that have been around a bit understand the result. So, now we have enough Lisp to build a real compiler.
This time we're starting with the environment as the first component. Building a lot of DEFSTRUCTs is always a good way to understand your system (everyone remember your old data structures class?). Here's a look at the current data structures. It will likely have some changes as we go, but it gets us off in a good footing. You'll also a parameter-printer macro. It generates the printers for the structs.
I should have a good set of functions that use these structs before the end of the year. After that comes the structural analysis part...
Happy Thanksgiving!
BTW, Blogger will insert gratuitous para breaks between lines. Or it may just be Safari.
-------------
;;; Here is where all of the environment starts.
;;; There are a set of substructs that
;;; extend the general environment. The basic environment are made up of
;;; LAMBDA, LET, FLET, LABELS and any parameters from
;;; LAMBDA, LET, FLET, and LABELS
;;; Note: this environment uses the lambda calculus definition of functions:
;;; one or one parameter
(defstruct (environment (:print-object print-environment))
; range is LAMBDA, LET, FLET, LABELS, :PARAMETER, :BLOCK, :TAGBODY, :SYMBOL
(kind :environment :read-only t)
(parent nil :read-only t :type environment)
(children nil :type list))
(parameter-printer environment (kind) (children))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;; SYMBOL-BINDING ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This struct is holds common facets of named environment
(defstruct (named-binding (:include environment
(kind :named-binding))
(:print-object print-named-binding))
(name nil :type symbol :read-only t))
(parameter-printer named-binding (kind name) (children))
;;; This struct handles the binding of the value part of the symbol. It works
;;; with parameters (LAMBDA), and LET forms.
(defstruct (symbol-binding (:include named-binding
(kind :symbol-binding))
(:print-object print-symbol-binding))
(scope :local) ;; :local, :closure, :special, :reference (accessing a closure)
(type t)
(init-form nil)
(allocation nil))
(parameter-printer symbol-binding (kind name scope type init-form allocation) (children))
;;; This struct handles the binding of the function part of the symbol. It works
;;; with FLET and LABELS forms.
(defstruct (function-binding (:include named-binding )
(:print-object print-function-binding))
(ftype :function :read-only t :type function-type)) ; or :macro
(parameter-printer function-binding (kind name ftype) (children))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;; PARAMETER STRUCTURES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This section deals with making structures for the various parameter types
;;; This is the core of every parameter type in CL
(defstruct (parameter-env (:include symbol-binding (kind :parameter))
(:print-object print-parameter-env))
(usage nil :read-only t) ;; making a parameter must include the usage
(ignore nil :type boolean)
(ignorable nil :type boolean))
(parameter-printer parameter-env
(kind name scope type init-form allocation usage ignore ignorable)
(children))
;;; This is an intermediate structure that extends the init form to
;;; handle supplied-p
(defstruct (supplied-p-parameter (:include parameter-env (kind :supplied-p))
(:print-object print-supplied-p-parameter))
(value nil :read-only t :type boolean))
(parameter-printer supplied-p-parameter
(kind name scope type init-form allocation usage ignore ignorable value)
(children))
;;; REQUIRED - uses only the basic PARAMETER struct
(defstruct (required-parameter (:include parameter-env (kind :required))
(:print-object print-required-parameter)))
(parameter-printer required-parameter
(kind name scope type init-form allocation usage ignore ignorable) (children))
;;; OPTIONAL - adds the init-form and supplied-p slots
(defstruct (optional-parameter (:include supplied-p-parameter (kind :optional))))
(parameter-printer optional-parameter
(kind name scope type init-form allocation usage ignore ignorable) (children))
;;; REST or fake rest parameter made for handling &keys
(defstruct (rest-parameter (:include parameter-env (kind :rest))))
(parameter-printer rest-parameter
(kind name scope type init-form allocation usage ignore ignorable) (children))
;;; KEY - adds the init-form, supplied-p and keyword-name
(defstruct (key-parameter (:include supplied-p-parameter (kind :key)))
(keyword-name nil :read-only t :type symbol))
(parameter-printer key-parameter
(kind name scope type init-form allocation usage ignore ignorable keyword-name)
(children))
;;; ALLOW-OTHER-KEYS - this is a cypher found in the lambda list
(defstruct (allow-other-keys-parameter) )
;;; AUX - uses the init-form parameter
(defstruct (aux-parameter (:include parameter-env (kind :aux)) ))
(parameter-printer aux-parameter
(kind name scope type init-form allocation usage ignore ignorable) (children))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;; STRUCTURES THAT MAKE UP THE ENVIRONMENT ;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defstruct (let-env (:include environment (kind :let)))
;; the code that makes this has to set the environment type to :LET
(symbol-bindings nil :type list)) ; this is a list of symbol-binding
(parameter-printer let-env (kind name) (symbol-bindings children))
(defstruct (lambda-env (:include named-binding (kind :lambda))
(:print-object print-lambda-env))
;; the code that makes this has to set the environment type to :LAMBDA
(parameter-bindings nil :type list))
(parameter-printer lambda-env (kind name) (parameter-bindings children))
(defstruct (macro-env (:include lambda-env (kind :macro))))
;; the code that makes this has to set the environment type to :MACRO
(defstruct (labels-env (:include lambda-env (kind :labels)))
;; the code that makes this has to set the environment type to :LABELS
(fn-bindings nil :type list))
(parameter-printer lambda-env (kind name) (fn-bindings children))
(defstruct (flet-env (:include lambda-env (kind :flet)))
;; the code that makes this has to set the environment type to :FLET
(fn-bindings nil :type list))
(parameter-printer lambda-env (kind name) (fn-bindings children))
(defstruct (block-env (:include named-binding (kind :block))
(:print-object print-block-env)) )
(parameter-printer block-env (kind name) (children))
(defstruct (tagbody-env (:include environment (kind :tagbody))
(:print-object print-tagbody-env))
(tags nil :type list))
(parameter-printer tagbody-env (kind) (tags children))
(defstruct (tagbody-across-lambda (:include tagbody-env
(kind :tagbody-across-lambda))
(:print-object print-tagbody-across-lambda))
(boundary nil :type environment :read-only nil))
(parameter-printer tagbody-across-lambda (kind name boundary) (tags children))
#|
(defstruct (macrolet-env (:include lambda-env))
;; the code that makes this has to set the environment type to :LAMBDA
TBD
)
|#
(defstruct (expression-info (:include environment (kind :expression))
(:print-object print-lambda-env))
(type nil :type t)) ;; the declared type by the THE
(parameter-printer expression-info (kind type) (children))
-------------
;;; Here's a first stab about a macro for building the environment
(defmacro with-new-environment (kind (&rest args) &body body)
(let ((the-function
(case kind
(:LAMBDA 'make-lambda-env) ; this has a chain of parameters
(:LET 'make-let-env) ; this has a list of variables at
; the same level
(:FLET 'make-flet-env)
(:LABELS 'make-labels-env)
(:REQUIRED 'make-required-env)
(:OPTIONAL 'make-optional-env)
(:REST 'make-rest-env)
(:KEY 'make-key-env)
(:AUX 'make-aux-env)
(:BLOCK 'make-block-env)
(:TAGBODY 'make-tagbody-env))))
(:MACRO 'make-macro-env)
(:MACROLET 'make-macrolet-env)
(:SYMBOL-MACRO 'make-symbol-macro-env)
(:LOCALLY 'make-locally-env)
(:THE 'make-the-env)
`(let ((*current-environment*
(,the-function :kind ,kind :parent *current-environment* ,@args)))
(add-child-env-to-parent
*current-environment* (environment-parent *current-environment*))
,@body)))
-------------
