In this chapter, we present a meta-evaluator for towers of the form described in this thesis. There are two implementations of the meta-evaluator, the earlier of these two being written in C, and the other in Lisp. They are presented in the other order, however, since the Lisp one is more important, and has superseded the C version.
The Lisp implementation has two versions, the second being derived from the first by moving common code from several procedures into a separate procedure, which is the kernel of this form of the meta-evaluator.
In section pl89sect we look at Platypus89, the Lisp implementation of Platypus, which is written for conciseness, readability and programming aesthetics. A full listing of Platypus89 is given as Appendix A of this thesis.
In section 11.7, we look briefly at C-Platypus, the C implementation of Platypus. This is written for efficiency. Although this line of development was abandoned in favour of the Lisp-based approach, some of the ideas explored in this version may be useful in future developments of reflective interpreters, and so are still presented.
The meta-evaluator of Platypus89 is a Lisp function looking much like the standard interpreter. The listing given here is produced directly from the real sources (using a mixed-language style of LaTeX and Lisp!). As with other listings from the real source code, the Lisp syntax has been modified to allow labelling of points in the code with text in square brackets.
The general tower meta-evaluator function is very similar in structure to the standard evaluator, but it must also perform level shifting when required.
(defun evaluate-anything (anything background-level)
"Evaluate ANYTHING in the context of LEVEL."
(let* ((cont (level-current-closure background-level))
(evaluator (closure-evaluator cont)))
[is-on-standard-evaluator?]
(if (not (eq (closure-original evaluator)
(tower-standard-evaluator-closure
(level-tower background-level))))
[interpret-evaluator]
(let ((evaluator-interpretation-level
(make-interpretation-level
background-level
evaluator)))
(evaluate-anything evaluator-interpretation-level
evaluator-interpretation-level))
[evaluator]
(let ((inside-tower-type-eval
(env-lookup (type-of anything)
(closure-type-evaluators cont))))
(if inside-tower-type-eval
(let ((outside-tower-type-eval
[type-shadow-lookup] (env-lookup (closure-original
inside-tower-type-eval)
(tower-type-shadow-map
(level-tower
background-level)))))
(if outside-tower-type-eval
[shadowed-type] (funcall
outside-tower-type-eval
anything background-level cont)
[nonshadowed-type]
(let ((type-interpretation-level
(make-interpretation-level
background-level
inside-tower-type-eval)))
(evaluate-anything
type-interpretation-level
type-interpretation-level))))
[type-unknown]
anything)))))
The first decision to make in the meta evaluation of a level is
whether the the level can be interpreted directly by the meta
evaluator, or whether the level s evaluator must be interpreted. The
rule for this, as explained in section extintalgor, is that the level
can be interpreted directly if its evaluator is the standard
evaluator, and otherwise its evaluator must be interpreted by the
meta-evaluator. This decision is taken at
is-on-standard-evaluator?. If the level cannot be evaluated
directly, the meta-evaluator recurses to run it, at
interpret-evaluator. This realizes (see section unroll-circular-tower)
a level of the tower, which previously existed abstractly but had no
separate representation in the implementation. The realization is done
in make-interpretation-level, which allocates a new level
and fills it in such that when interpreted it will interpret the given
evaluator with the original level as the evaluator's argument.
If
the level can be evaluated directly, this is done at
evaluator, a point which has a direct equivalent in the
standard evaluator. The type of the evaluand is looked up in
the type-evaluators environment of the level to find a
closure to instantiate and apply to evaluate that kind of evaluand. If
no way of evaluating it is found, the evaluand is returned unchanged,
at type-unknown. Otherwise, the original of
the type-evaluator is looked up in the type-shadow-map of
the tower, at type-shadow-lookup. As explained in section unrollmech, the
original field may be used to determine whether a closure
is an instantiation of a particular closure (usually a shadowed
one). If a closure is modified (other than in the values list), its
original field---not accessible to be changed
independently---is changed automatically to point to the closure
itself, rather than that of which is was an instantiation, and so it
will not be treated as an instantiation of that one any longer. If the
type evaluator is shadowed, the shadow is called, at
shadowed-type. Otherwise the type evaluator must be
interpreted, in a modified copy of this levl, made and evaluated at
non-shadowed-type. For a system with a one-dimensioned
tower, the shadow procedure is in the substrate language, Common
Lisp. It will be one of the procedures presented below.
The list evaluator is like that within towers
(including the all-too-Lisp-specific part for handling
nil!), but must also look for the shadow of an
operator, and, if it has one, use that, otherwise
realizes (see section 4.4) a new
level to interpret the operator definition, and
interprets that level using the current
evaluator---this is done using the Platypus form
(or Common Lisp macro) evaluate-by-evaluator-of-level
(presented in section 11.4) rather than as a direct call, so
that this procedure may be called from places other
than evaluate-anything:
(defun meta-eval-list (list background-level curr-cont)
"Evaluate LIST in the context of BACKGROUND-LEVEL.
CURR-CONT is the current continuation closure, which the caller has
already extracted and so might as well pass along."
(if (null list)
nil
(let* ((operator-name (expression-operator list))
(operator (env-lookup operator-name
(closure-language curr-cont))))
(if (null operator)
[funcall]
(with-changed-level
background-level
(:continuation-expression (cons 'funcall list))
(evaluate-anything background-level
background-level))
[operator]
(let ((shadow-definition
[shadow-lookup] (shadow-lookup
operator
(level-tower background-level))))
(if (null shadow-definition)
[non-shadowed-op]
(let ((operator-interpretation-level
(make-interpretation-level
background-level
operator)))
(evaluate-anything
operator-interpretation-level
operator-interpretation-level))
[shadowed-op]
(funcall shadow-definition
list
background-level
curr-cont)))))))
Extraction of the expression, operator and operator definition of the current continuation closure of the level are just as in the standard evaluator, as is the automatic conversion of unknown operators into procedure calls.
Once an operator has been found, the action is
similar to that of the standard evaluator, but
with the addition of code to handle shadowing of
some operators by primitive definitions. The split
between shadowed and non-shadowed operators is, in
terms of the standard evaluator, entirely within
the (funcall op anything) at
operator. In principle, the standard
evaluator and the meta-evaluator could be
produced from the same source code, using an
operator/procedure which could be described as
shadowable-funcall; within the tower, this
would be a normal funcall, but in the meta-evaluator,
would have the extra rôle of
finding and using the shadow versions of callee
procedures that have shadows.
At shadow-lookup, the shadow map for the tower is looked up. This shadow map must match the tower's meta-evaluator, and describes which operators the meta-evaluator has shadows for. Ideally, it should be a field of the value stored in the meta-evaluator field of the tower.
If there is no shadow for that operator, the meta-evaluator recurses to interpret the interpretable definition of the operator. This is done at non-shadowed-op.
If a shadow has been found, it is called directly
(that is, to run at the level of the meta-evaluator),
at shadowed-op. This is written as a macro
partly to give it a more descriptive name, and partly
to hide even more optionally compiled tracing code! It
is, in the underlying Common Lisp, simply a
funcall.
Symbol evaluation is very similar---there is no shadowing to do here either!
The code below is simplified slightly from what a
real system should do, in that if nil is
returned by the first lookup, the second lookup is
performed. This should really be done using a
multiple-value return [Steele 84][Section 7.9] with
the first value being the result of the lookup and
the second value being the success code. However,
there is another approach to this, using a
distinct return value (which the next meta-level
might not make available for general use at this
level). This is described in section 11.2.
Like Common Lisp, our dialect of Lisp provides
keywords---symbols which always evaluate to
themselves---and they are handled at
keyword. (Keywords are printed with a
colon preceding the symbol name.) They are
generally useful as simple token values; for
example, in the list of changes given to
with-changed-level, they are used to name the
parts of the level to change.
(defun meta-eval-symbol (symbol background-level curr-cont)
"Evaluate SYMBOL in BACKGROUND-LEVEL."
(cond ((eq symbol t) t)
[keyword] ((keywordp (the symbol symbol))
symbol)
(t
(let
((dynamically-found
(env-lookup symbol
(closure-fluid-environment
curr-cont))))
(if dynamically-found
dynamically-found
(env-lookup symbol
(level-lexical-environment
background-level)))))))
Evaluation of local variable indices (string
characters) is just as in the evaluator inside the
tower. Since the listings here present the working code
of the system, they use for efficiency a Common Lisp
feature that does not affect the semantics of the
program: the declaration the, which allows the
compiler to make assumptions about the types of
expressions' results. A fixnum is a number which
is an integer and which need not have heap memory
allocated for it---that it is, it is not a double and
not a bignum (a number stored as a string of
digits). (This requires it to be small enough to fit,
along with its tag bits, into one machine word.)
Telling the compiler explicitly that values are of this
type permits the use of efficient number handling
code, with, for example, addition instructions
that are compiled in-line, instead of tests on the
types of the arguments, and calls to a
general-purpose addition procedure to deal with
any cases that the in-line code cannot handle
directly itself.
(In addition to this, some parts of the system are
compiled with an implementation-specific
proclamation, (fixnum-safety 0), which tells
the compiler that all arithmetic is to be
performed with fixnum operations (which are
typically inlined) rather than calling general
arithmetic functions.)
(defun meta-eval-stringchar (char background-level curr-cont)
"Evaluate CHAR in the context of BACKGROUND-LEVEL.
CURR-CONT is the current continuation closure,
which the caller has already extracted and so might
as well pass along."
(declare (ignore background-level))
(nth-value (the fixnum (char-int char))
(closure-values curr-cont)))
Local variable reference structures also involve no shadowing:
(defun meta-eval-lvr (lvr background-level curr-cont)
"Evaluate LVR in BACKGROUND-LEVEL."
(declare (ignore background-level))
(nth-value (the fixnum
(local-variable-reference-slot-number lvr))
(closure-values curr-cont)))
Levels are handled exactly as inside the tower (perhaps a little surprising, considering their close involvement with the model of reflective evaluation):
(defun meta-eval-level (arglevel background-level curr-cont)
"Evaluate ARGLEVEL in BACKGROUND-LEVEL."
(declare (ignore background-level curr-cont))
(evaluate-anything (level-current-expression arglevel)
arglevel))
The same goes for closure evaluation:
(defun meta-eval-closure (closure background-level)
"Evaluate CLOSURE in BACKGROUND-LEVEL."
(with-changed-level background-level
(:evaluator
(closure-evaluator closure)
:language
(closure-language closure)
:procedure-expression
(closure-procedure-expression closure)
:continuation-expression
(closure-continuation-expression closure))
(call-meta-evaluator background-level)))
The macro with-changed-level is explained in
section 11.4.
The other evaluators just pass the arguments straight through: (defun meta-eval-string (string background-level curr-cont) "Evaluate STRING in BACKGROUND-LEVEL." string) (defun meta-eval-integer (integer background-level curr-cont) "Evaluate INTEGER in BACKGROUND-LEVEL." integer) (defun meta-eval-nil (the-nil background-level curr-cont) "Evaluate THE-NIL in BACKGROUND-LEVEL." the-nil) This is all of the significant code of the meta-evaluator. Much of the rest of Platypus89 is made up of the operators and their shadows.
In the small amount of code presented above are all the semantically significant parts of a mixed-language meta-tower-based evaluator---and perhaps more than is strictly necessary for that function. The apparently complex goal turned out to have an essentially simple solution, refined to be just what is required for the generalization of what it is for something to be an evaluator for procedural and functional languages.
Is it possible to refine this further, to derive a function which describes the essence of tower-reflective interpretation in the context of a mixed-language system?
Several parts of this are directly equivalent to parts of the standard evaluator, and the explanations given in section 7.3 apply precisely to these points too. These include those marked as funcall, operator, and evaluator.
Just as it is possible to refine the standard evaluator to a form in which several parts of the evaluator are calls to a suitably parameterized function, it is also possible to do this with the standard meta-evaluator.
This parameterized function, the snark, is this:
;;;; Is this the ultimate Lisp function?
(defun snark (thing
level selector
env-selector shadow-selector
cont)
"Parameterized meta-tower evaluator kernel
for mixed languages."
(funcall (lookup (lookup (funcall selector
thing)
(funcall env-selector
level))
(funcall shadow-selector
level))
thing level cont))
It is very similar to boojum, but with a
second selection and lookup. It is an optimized
form of a boojum-boojum function:
(defun boojum-boojum (thing
level selector
env-selector meaning-selector
shadow-selector)
"Parameterized meta-tower evaluator kernel
for mixed languages."
(funcall (lookup (funcall meaning-selector
(lookup (funcall selector
thing)
(funcall env-selector
level)))
(funcall shadow-selector
level))
thing level))
the optimization being that meaning-selector
is always the identity function.
The snark function is used in the following
procedures to make the new version of the meta-evaluator.
This is a replacement for the code presented in
section 11.1, but it uses
snark for each of the appropriate parts of the
evaluator, instead of the ad-hoc evaluation
functions there shown. It may be instructive to
compare this with the code presented
here, to see the similarity
between snark and the last part of that
version of evaluate-anything.
The general tower meta-evaluator function is very similar in structure to the standard evaluator presented here, but it must also perform level shifting when required.
In this case, snark is used to do the
switching on the argument type, and the level
shift is performed conditionally, to get the type
evaluator either interpreted or mimicked as
appropriate.
(defun evaluate-anything (anything background-level)
"Evaluate ANYTHING in the context of LEVEL."
(let* ((cont (level-current-closure background-level))
(evaluator (closure-evaluator cont)))
(if (not (eq (closure-original evaluator)
(tower-standard-evaluator-closure
(level-tower background-level))))
(let ((evaluator-interpretation-level
[non-shadowed-eval] (make-interpretation-level
background-level
evaluator)))
(evaluate-anything evaluator-interpretation-level
evaluator-interpretation-level))
[shadowed-eval]
(snark anything
background-level
#'type-of
#'level-type-evaluators-function
#'level-type-shadow-map-function
cont))))
It would be possible to simplify this evaluator
further, with added flexibility, but at the
expense of speed, by using another map to go from
the evaluator in the tower to its shadow, the
meta-evaluator. In such a system, this new map
(which replaces the if in the code presented
above) would map the standard evaluator to a
procedure which calls snark to switch on the
evaluand type, as at shadowed-eval, and
anything else (via the map environment's
unbound value) to a procedure which makes a new
level in which to interpret the evaluation, as at
non-shadowed-eval. The use of the extra
map would, naturally, be implemented by another
call to snark. The further flexibility that
this brings is that it would then be possible for
more than one possible evaluator to be shadowed by
more than one meta-evaluator.
The expression evaluator uses snark to
dispatch on the operator name and to do the level
shift, if necessary, to get the operator
definition interpreted or mimicked as appropriate.
In this version of the expression evaluator, there
is no code to convert unknown operators to
function calls. This may be done by having the
unbound pseudo-binding in the language
environment bind unknown operators to a procedure
which converts them to function calls and tries
again.
(defun meta-eval-list (list background-level curr-cont)
"Evaluate LIST in the context of BACKGROUND-LEVEL.
CURR-CONT is the current continuation closure, which
the caller has already extracted and so might as well
pass along."
(if (null list)
nil
(snark list
background-level
#'expression-operator-function
#'level-language-function
#'level-operator-shadow-map-function
curr-cont)))
The symbol evaluator could use snark with
the identity function as the key selector for use
on symbols, and have the unbound binding in
the lexical environment bind to a function that
looks the name up in the dynamic environment.
Then, as snark always evaluates the result
of its lookups, this inheritance between the two
environments is provided---at the cost of each
binding being of a procedure that returns the
intended value of the binding---rather like a
continuation-passing style of environment
implementation.
(defun meta-eval-symbol (symbol background-level curr-cont)
"Evaluate SYMBOL in BACKGROUND-LEVEL."
(cond ((eq symbol t) t)
[keyword] ((keywordp (the symbol symbol))
symbol)
(t
(let
((dynamically-found
(env-lookup symbol
(closure-fluid-environment
curr-cont))))
(if dynamically-found
dynamically-found
(env-lookup symbol
(level-lexical-environment
background-level)))))))
The remaining functions are as in the other
version of the evaluator, as they have no
particular use for calling snark.
This is all of the significant code of the compact meta-evaluator, occupying only 83 lines of openly formatted Lisp, in 11 procedures---perhaps rather shorter than an ad-hoc versions of such a function would be!
This is shorter than I originally expected such a program to be, and is quite a small part of the overall system. An analysis of the size of the system is presented in section 12.4.
Is it possible to refine this function further? There is one thing that can be done: to pun on the names of structure components, making an isomorphism between the union of all possible evaluands (or their types) and the structural field wherein they exist and are evaluated. Doing this, the key selector and the environment selector take on the same names for each pair. Are there any parallels to this in other programming systems? It is similar in some ways to instances and classes in object-oriented system such as SmallTalk-80 and CLOS.
Structural punning apart, the boojum/snark appears to be the most refined form of evaluator that can be derived along these lines. Seen in more general terms than Computer Science, it does seem to make sense as a description of performing an action according to instructions: use some key aspect of the situation and some key aspect of the context to find an action, and perform that action, possibly moving to the plane of abstraction necessary for handling that action.
How does this fit in with general models for action, for example the deliberation model of Doyle [Doyle], as re-presented in [Batali 83]? This is examined further in reflchap.
In Platypus89, the data stack is represented as a single extensible vector, the values list, which is shared between all closures that refer to it. Its division into stack frames is an abstraction visible only in the operators of languages, and a language may treat it as an open stack, as does PostScript, for example.
There are several advantages to this form of stack, which I consider to be a correct choice of stack design here.
&rest, and for PostScript's
array operator, and its overloaded transformation
operators such as rotate.
&rest working compatibly between them and
other languages.
The only drawback with this ordering is that if
arguments to a function are to be evaluated left to
right, as Common Lisp and many other languages require,
the results cannot be pushed onto the stack in the
order in which they are evaluated. The solution to
this is to access the value list as an indexable array
rather than as a stack while doing this. The auxiliary
function for funcall, funcall-helper, which is
presented on here in
section 11.5, uses the following macro
to evaluate the argument sub-expressions from left to
right but to push their results right to left:
(defmacro eval-and-push-sub-exprs (expr level)
"Evaluate each sub-expr (except the first) of EXPR in
the context of LEVEL. If optional extra argument START
is given, that specifies where to start in the sub-expr
list, with 1 being the usual place, that is, it is how
many initial sub-exprs not to evaluate. The results are
pushed onto the stack of LEVEL."
`(with-values-of-level
,level
(let* ((the-exprs ,expr)
(the-length (length the-exprs)))
(when (>= (+ the-length (the-value-list-last))
(the-value-list-max))
(extend-value-list (the-value-list) the-length))
(do* ((x the-exprs (cdr x))
(n (- the-length) (1+ n)))
((endp x))
(setf (the-nth-value n)
(evaluate-by-evaluator-of-level
(car x) ,level)))
(incf (the-value-list-last) the-length))
nil))
It would, in principle, be possible to use the same stack mechanism to implement the stack of saved closures in each level (the return stack, in conventional terms) and also to implement the stack of levels that, along with the shadowing system, makes up each tower. This would reduce the amount of code needed, not only to implement the tower, but also in programs that use reified data.
The central procedure of the meta-evaluator is similar to that of the standard evaluator, and there are other parts that are analogous to some in the standard evaluator. These include the operators, and procedures called by the operators for common purposes such as the evaluation of arguments.
As well as the parts that do have analogues in the standard evaluator, there are those that handle the tower manipulation---constructing levels and shifting between them.
The Platypus operator (or Lisp macro, in the
meta-evaluator) evaluate-by-evaluator-of-level
calls the evaluator of the current level, or, if that
evaluator is the standard evaluator, calls the
meta-evaluator directly.
It is used where procedures called by the evaluator
need to call the evaluator. Going via the evaluator of
the current closure of the current level is preferable
to calling standard-evaluator or
evaluate-anything directly, as it allows such
procedures to be called from places other than the
standard evaluator and meta-evaluator. The code of
evaluate-by-evaluator-
of-level is is
follows:
(defmacro evaluate-by-evaluator-of-level (thing level)
"Evaluate THING in the tower of LEVEL
using the evaluator of that tower."
`(let* ((our-level ,level)
(evaluator (level-evaluator our-level)))
(with-changed-level
our-level
(:continuation-expression ,thing)
(if (= standard-evaluator-closure-number
(closure-number evaluator))
(evaluate-anything ,thing our-level)
(call-meta-evaluator our-level)))))
The procedures presented here create and maintain towers and the levels that make up the towers. They are in two groups, those handling whole towers and those handling levels.
The following procedures set up and start towers. Starting a tower means applying its meta-evaluator to it; starting a tower in the real evaluator (of which these routines are part) means applying something one stage further away than the meta-evaluator, as all levels of meta-tower that support that tower must also be started at the same time.
A tower is a complex data structure with many
cycles of references; new-tower and
funcall-shadow, and many of the procedures
presented further below, are used in the
maintenance of this structure.
Much of the manipulation of the tower is done in
the core of the meta-evaluator, but it can also be
done by operators, including some that might not
normally be regarded as reflective. For example,
funcall-shadow is unusual in being an
operator that manipulates the tower structure
explicitly (in the form of adding a call
record to the call record chain of a
level)---although this may be done by any
procedure in the system, whether or not it is an
operator, and whether or not it is shadowed, as
these actions are simply the manipulation of a
data structure.
Some structure access operators, for manipulating
fields of tower components, may sometimes be in
effect reflective, if the components that they alter
are parts of a live tower, as reifier results
are---reifiers in Platypus do not take a copy
(snapshot) of the tower, but return references to
parts of the real tower. When this is the case,
operators such as set-closure-evaluator are
jumpy reflectors. As described in
section 9.4, the shadow versions of
such operators take special actions to ensure that
shadowed procedures are never altered---a copy is
always taken at the appropriate place and it is
that copy that is altered.
Towers are created by the function
new-tower, which takes as its arguments the
meta-evaluator, the base level program, and the
standard procedure. The tower that it sets up has
the base level already realized, complete with a
reference back to the tower. If there are already
some evaluator levels attached to the base level,
they are retained, and these levels are given
references back to the tower just as the base
level is.
(defun new-tower (meta-eval base stand-proc)
"Make a new tower, with META-EVAL as its
meta-evaluator, BASE as the program it is to run at its
base level, and STAND-PROC the evaluator it is to use
as its standard evaluator. Any evaluators BASE may
already have are kept, and STAND-PROC is put above them
all."
(let ((the-tower
(make-tower
:meta-evaluator meta-eval
:base-level base
:standard-evaluator-closure stand-proc)))
(do* ((this-one base
next-one)
(next-one (closure-evaluator
(level-current-closure
this-one))
(closure-evaluator
(level-current-closure
this-one))))
((eq next-one stand-proc) nil)
(when (null next-one)
(setf next-one
stand-proc
(closure-evaluator
(level-current-closure
this-one))
stand-proc)))
the-tower))
new-tower creates a tower with a given
meta-evaluator, application program, and standard
evaluator. This tower is suitable for passing to
run-tower.
(defun run-tower (tower)
"Evaluate TOWER."
(begin-define-in-tower tower)
(prog1
(call-meta-evaluator (tower-base-level tower))
(end-define-in-tower tower)))
run-tower is the real substrate language
procedure that starts the evaluation of a tower.
It sets the definition context (for such things as
defun) to be that tower, and then passes
control to the tower's meta-evaluator, and, after
setting the definition context back to what it
was, returns the result from the meta-evaluator.
These macros and procedures are for creating (or realizing---see section 4.4) new levels. They are used in the meta-evaluator when it has to do level shifts when a evaluator, type-evaluator or operator must be interpreted.
(defmacro make-interpretation-level (level evaluator)
"Make a level with the context from LEVEL
to evaluate an instance of EVALUATOR with an
argument of LEVEL. EVALUATOR is a closure."
`(new-level
,level ; level
,evaluator ; closure
(list ,level ,level))) ; arguments
new-level is the central routine for
creating new levels ready for parts of the
evaluator to shift the evaluation into them.
It takes as arguments:
level, from which a tower is found. The
new level is put into the same tower as this
argument level. This level also provides the
template closure used to fill in parts of the
instantiated closure that the level will start
running.
closure to instantiate, providing the
expression that the new level is to run. The rest
of the instantiated closure (apart from the
argument list, that is, the initial value list) is
made from the template closure which is part of
the level supplied as the first argument.
argument list which is used to fill in the
initial contents of the value list of the current
closure of the new level.
new-level creates two linked structures, a
level and the current closure for that level, and
completes the cycle of references between them.
The code of new-level is as follows:
(defun new-level (level closure args)
"Construct a level to go in the tower of LEVEL
made by instantiating CLOSURE with ARGS for its
arguments."
(let* ((tower (level-tower level))
(template (level-template-closure level))
(the-new-closure
(make-closure
:evaluator
(closure-evaluator template)
:language
(closure-language template)
:type-evaluators
(closure-type-evaluators template)
:procedure-expression
(closure-procedure-expression closure)
:continuation-expression
(closure-continuation-expression closure)
:values
(convert-to-value-list args)
:lexical-environment
(closure-lexical-environment template)
:fluid-environment
(closure-fluid-environment template)
:level
nil ; filled in later to complete a circle
:original
(closure-original closure)
:number
(incf closure-counter)))
(the-new-level
(make-level
:call-record-stack
(list the-new-closure)
:tower tower
:template-closure (closure-original closure))))
(setf (closure-level the-new-closure) ; complete the circle
the-new-level)
the-new-level))
The macro with-changed-level is used in a
variety of ways. It modifies its argument level
as specified by a list of changes, evaluates its
body forms, and undoes the changes it made to the
level, before returning the result of the last of
the body forms.
In effect, this is a rebinding of some fields of the level, the scope of the rebinding being the body arguments of this macro. However, the rebinding is not done within the level being modified, but in the meta-evaluator handling that level---in this case, in the stack of the substrate system.
This is important not only for intuitively correct evaluation of the interpretive tower, but also for its efficient evaluation. It is correct, because some of this work is done behind the scenes by the meta-evaluator, and is hidden from the tower being worked on; it is efficient, because it avoids creating temporary tower levels and throwing them away after use---the original level is re-used, and the temporary storage is on the substrate system's stack.
The coincidence of correctness and efficiency goes further than that, too: were temporary levels to be made for use in the evaluation, changes made to those levels through the use of reflection would be discarded unless copied back into the levels from which the temporary levels were copied.
The disputable point here is not whether this technique should be used, but where the saved data should be stored, in the version that runs on the substrate system. (Obviously enough, when run on an ordinary meta-evaluator, the saved data may be kept on that evaluator's stack.)
The expansion of with-changed-level can be
quite complex; its macro-expander procedure calls
the following procedure, make-change-savers,
to generate pieces of the code to return. It
takes a list of change descriptions, each of which
consists of a list containing a keyword indicating
what to change, and a form indicating what to
change it to. It returns a list of lists, each of
which contains (in order):
setf [Steele 84][section 7.2]).
The elements of these lists are built into the
result of the with-changed-level expander.
(defun make-change-savers (change-list)
"Shadow function for expanding with-changed-level."
(let ((the-savers nil))
(let ((evaluator-value
(member :evaluator change-list
:test #'eq)))
(when evaluator-value
(push
`(old-evaluator new-evaluator
,(second evaluator-value)
(closure-evaluator the-cont-clo))
the-savers)))
(let ((language-value
(member :language change-list
:test #'eq)))
(when language-value
(push
`(old-language new-language
,(second language-value)
(closure-language the-cont-clo))
the-savers)))
(let ((type-evaluators-value
(member :type-evaluators change-list
:test #'eq)))
(when type-evaluators-value
(push
`(old-type-evaluators new-type-evaluators
,(second type-evaluators-value)
(closure-type-evaluators the-cont-clo))
the-savers)))
(let ((procedure-expression-value
(member :procedure-expression change-list
:test #'eq)))
(when procedure-expression-value
(push
`(old-procedure-expression new-procedure-expression
,(second procedure-expression-value)
(closure-procedure-expression the-cont-clo))
the-savers)))
(let ((continuation-expression-value
(member :continuation-expression change-list :test #'eq)))
(when continuation-expression-value
(push
`(old-continuation-expression new-continuation-expression
,(second continuation-expression-value)
(closure-continuation-expression the-cont-clo))
the-savers)))
(let ((values-value
(member :values change-list :test #'eq)))
(when values-value
(push
`(old-values new-values
,(second values-value) (closure-values the-cont-clo))
the-savers)))
(let ((lexical-environment-value
(member :lexical-environment change-list :test #'eq)))
(when lexical-environment-value
(push
`(old-lexical-environment new-lexical-environment
,(second lexical-environment-value)
(closure-lexical-environment the-cont-clo))
the-savers)))
(let ((fluid-environment-value
(member :fluid-environment change-list :test #'eq)))
(when fluid-environment-value
(push
`(old-fluid-environment new-fluid-environment
,(second fluid-environment-value)
(closure-fluid-environment the-cont-clo))
the-savers)))
the-savers))
with-changed-level
has a macro expansion in which the subject level
and the parts involved in the change are bound to
variables, using let*. Within the body of
the let*, the modifications are made, the
argument body evaluated, and the modifications
reversed, before returning the result of the last
of the argument body forms.
(defmacro with-changed-level (level changes &body body)
"Modify LEVEL as specified by the keyword arguments in CHANGES, and
run BODY. Then change the changed parts back."
(let ((change-savers (make-change-savers changes)))
`(let* ((the-level ,level)
(the-cont-clo (car (level-call-record-stack the-level)))
,@(map 'list #'(lambda (saver)
`(,(first saver) ,(fourth saver)))
change-savers)
,@(map 'list #'(lambda (saver)
`(,(second saver) ,(third saver)))
change-savers))
,@(map 'list #'(lambda (saver)
`(setf ,(fourth saver)
,(second saver)))
change-savers)
(let ((result (progn ,@body)))
,@(map 'list #'(lambda (saver)
`(setf ,(fourth saver)
,(first saver)))
change-savers)
result))))
Examples of the use of with-changed-level
may be found in several places in the code
presented in this thesis, including at
section 11.1.
Each operator of the base language (as described
in baselanguage) is shadowed by a
procedure in the meta-evaluator. These could
in principle be compiled from the corresponding
definitions within the tower, but (for historical
reasons) most of them are written separately. They
are largely generated by Lisp macros, as there is
an appreciable amount of standard code at the
start of each, to pick apart the level that is
passed in as an argument, and, in the case of
operators that evaluate all their arguments (such
as arithmetic operators, cons, etc), to
perform the argument evaluation.
There are one or two parts to the definition of each shadowed operator:
An example of the kind with a separate Lisp
function is the primitive if operator, which
has the Lisp helper function:
(defun if-helper (expr level cont)
"Interpret a LEVEL that wants to do an if-then-else."
(let* ((condition (second expr))
(if-case (third expr))
(else-case (fourth expr)))
(if (evaluate-by-evaluator-of-level condition level)
(evaluate-by-evaluator-of-level if-case level)
(evaluate-by-evaluator-of-level else-case level))))
and the definition in the tower:
(platypus-def-control-prim
if ; name
if-helper ; helper function to use
(condition then else) ; argument names for definer
; macro to generate for use
; in procedure body
;; procedure body (to run in tower for non-shadowed
;; interpretation)
(if (eval-in-level condition int-level)
(eval-in-level then int-level)
(eval-in-level else int-level)))
Platypus89 operators that are very like existing Lisp functions, and need all their arguments evaluated anyway, may be defined in one piece, as follows:
(platypus-def-lispy-prim cons ; name within tower cons ; name of primitive Lisp function to call (a d) ; argument list (cons a d)) ; code to run inside or outside the tower
The operator + is one of those defined to
evaluate all its arguments. Its definition is as
follows:
(platypus-def-lispy-prim + + (a b)
(+ a b))
In section 9.4 it is mentioned that reflectors and structure accessors that might return data consisting of closures higher in the tower must check that what they are returning is not the standard processor---in which case they must make and return a copy of it instead. They use the following procedure to do this:
(defun unroll-closure (closure)
"We take a copy of the evaluator if it would be the
standard evaluator, so that the user program can't get
at the standard evaluator to modify it. Otherwise we
return the closure as it is."
(if (eq closure standard-evaluator)
(let ((the-closure (copy-closure closure)))
(setf (closure-number the-closure)
(incf closure-counter))
the-closure)
closure))
It is used in the structure accessor that definitely returns data from further up a tower:
(defun closure-evaluator-function (closure) "Return the evaluator of CLOSURE." (unroll-closure (closure-evaluator closure)))
and in anything that might modify a closure (accessed through some other means, such as as a component of a language) in case that closure is the standard evaluator:
(defun closure-type-evaluators-setter-function (closure type-evaluators)
"Set the type-evaluators of CLOSURE to TYPE-EVALUATORS"
(let ((modifiable-closure (unroll-closure closure)))
(setf (closure-type-evaluators modifiable-closure)
type-evaluators
(closure-original modifiable-closure)
modifiable-closure)
modifiable-closure))
funcall is a
particularly important operator, as it is part of
the general evaluation mechanism. It evaluates its
arguments, and creates a new closure by
instantiating the closure held in its first
argument. The remaining evaluated arguments are
placed on the end of the values list (pushed as
onto a stack) and the closure placed on the end of
the list of closures run at that level (that is,
pushed onto the return stack). The current
meta-evaluator is called to evaluate the new
closure---that is, to continue evaluation with the
new closure as the current evaluation point.
Note that since many languages require their arguments to be evaluated from left to right, but pushing them in order of evaluation leaves them in the wrong order on the stack, we must in effect collect the evaluated arguments into a list which we reverse before pushing its contents onto the value list. In practice, this is done more efficiently by moving to the new end position of the stack, and filling the values in in reverse order, as explained here.
Here is the code of funcall-helper:
(defun funcall-helper (expr level cont)
"Interpret a LEVEL that wants to do a funcall."
(let* ((values (closure-values cont))
(nvalues (value-list-length values))
(callee-name (second expr))
(callee (evaluate-by-evaluator-of-level
callee-name
level))
(instantiated-callee
(if (not (closure-p callee))
(error
"funcall-helper: Platypus function ~S ~
(derived from functor ~S in level ~S) ~
is not a closure~
callee callee-name level)
(copy-closure callee)))
)
(setf (closure-number instantiated-callee)
(incf closure-counter))
(eval-and-push-sub-exprs (cdr (expression-tail expr))
level)
(let ((nvalues-incl-args (value-list-length values)))
(setf (closure-values instantiated-callee)
values)
(setf (closure-fluid-environment instantiated-callee)
(closure-fluid-environment cont))
(setf (closure-evaluator instantiated-callee)
(closure-evaluator cont))
;; Put the new call record onto the stack of the
;; current level
(push instantiated-callee
(level-call-record-stack level))
;; Let the underlying evaluator continue
;; evaluating. This is like handing the new
;; code-vector address over to the program
;; counter to be run, in a conventional machine.
(let ((funcall-result (call-meta-evaluator level)))
;; put the activation stack back to normal
(pop (level-call-record-stack level))
;; pop the args
(pop-below values nvalues-incl-args nvalues)
funcall-result))))
Since procedure calling is so central to the
system, for efficiency another operator,
funcall1, is provided that does a funcall
an extra level lower down the tower. This is
suitable for use as the entire body of the
in-tower definition of funcall. It evaluates
its arguments to get to the level need, to pass
them on to funcall-helper, which it then
calls. Its implementation is as follows:
(defun funcall1-helper (expr level cont)
"Interpret a LEVEL that wants to do a funcall1, that is, to
interpret the interpretation of a funcall. funcall1 is provided for
use by interpreters only, really."
(let* ((res nil)
(cont-values (closure-values cont))
(cont-value-1 (nth-value 1 cont-values)))
(let* ((lcc (level-current-closure cont-value-1))
(lcx (closure-continuation-expression lcc)))
(setq res (funcall-helper
lcx
cont-value-1
lcc))
res)))
and its use in the in-tower definitions is this:
(platypus-defprim funcall funcall-helper (fun &body args)
(funcall1 fun args))
Another use of this procedure is that made by the
standard evaluator and the meta-evaluator to
convert unknown operators into funcalls:
(platypus-defprim
:default
convert-missing-op-to-funcall-helper
(fun &body args)
(funcall1 fun args))
The stack-based operators are defined in the same way
as other operators, but use in their helper procedures
the macros with-popped-args, push-results
and with-popped-args-push-results, which are
explained here. Here are some
examples; not that they are similar to their Lisp-style
counterparts, but simpler in that they do not evaluate
their arguments but just take what is provided for them
on the stack:
(defun ps-add-helper (expr level cont)
"Interpret a level that wants to do a PostScript add."
(with-popped-args-push-results
level
(a1 a2) ; the args
((+ a1 a2)) ; the results
; arbitrary body follows, may be empty
))
The if procedure, which has no ``else''
clause in PostScript:
(defun ps-if-helper (expr level cont) "Interpret a level that wants to do a PostScript if." (with-popped-args level (condition proc) (if condition (with-level-interpret-ps-block level (cdr proc)))))
Almost all of the stack-style operators may be defined in this manner, making their definitions generally succinct. It would, naturally, be possible to define them in terms of stack-like operators, as is done in the PostScript-in-PostScript implementation described in [Hopkins 89].
The operators and their shadows are defined using the macros and procedures presented in the following pages.
We need to make each definition in the context of a particular tower, to get various bits of background for definitions.
(defvar *platypus-definition-towers* nil "A list of towers open for defining things in. New definitions go in the topmost one of these. This is a pushy equivalent to CL's jumpy in-package system.") (defmacro current-definition-tower () "Return the current definition tower." '(car *platypus-definition-towers*))
In Platypus' closures' expressions, local variables are
referred to not by a name (in the sense of a Lisp
symbol) but by a number which is stored either as a
Lisp character value (as described in
section 7.3) or, if it will not fit in the
range of numeric values denotable by characters, in a
local-variable-reference structure. The procedure
lisp-to-platypus-expression takes in a lambda
expression with formal parameter names, in which Lisp
let* constructs may be used, and converts formal
parameter and local variable references into the
character or structure form.
Whenever a let* form is found, it is
converted into a let-local, which does
whatever its operator definition in the language
at run-time provides: it should evaluate its
subexpressions, and append (push) them onto the
value list. The let*ted variable names are
then added to the read-time local variables and formal
parameters list to be passed to recursive calls of
lisp-to-platypus-expression---this list is
started with the formal parameter list on the
outermost call to lisp-to-platypus-expression.
This may be used for languages other than Lisp, as long
as their parsers produce locally scoped variable
declarations in the same form as Lisp's let*s.
(defun lisp-to-platypus-expression (the-args the-body)
"Convert lambda-body-like expression with args
THE-ARGS and body THE-BODY from Lisp format to Platypus
format."
(typecase
the-body
(list
(if (eq (car the-body) 'quote)
the-body
(if (eq (car the-body) 'let*)
(let* ((bindings-list
(without-fluids (cadr the-body)))
(new-body (cddr the-body))
(all-the-args the-args)
(bind-exprs (map 'list
#'(lambda (binding)
(progn
(push (car binding)
all-the-args)
(lisp-to-platypus-expression
all-the-args
(cadr binding))))
bindings-list)))
(let ((new-expr (cons 'let-local
(cons bind-exprs
(lisp-to-platypus-expression
all-the-args new-body)))))
new-expr))
(map 'list #'(lambda (x)
(lisp-to-platypus-expression the-args x))
the-body))))
(symbol
(if (member the-body the-args)
(as-local-variable-index the-body the-args)
the-body))
(t
the-body)))
The procedure make-closure-with-expression takes
an expression, in the form produced by
lisp-to-platypus-expression, and a tower, and returns
a closure ready to run that expression and suitable for
instantiation in that tower. Each tower includes a
template closure, from which new closures by default
inherit components that are not specified explicitly
when the closure is created. The template closure
normally must have as its evaluator the
standard-evaluator that is used in that tower, so that
closures instantiated in the initial context of the
tower will be shadowed by the meta-evaluator
of that tower.
(defun make-closure-with-expression
(expr &optional (tower (current-definition-tower)))
"Make a closure for the current definition tower or
for a specified tower, with EXPR as its expression, and
the TOWER (if not the default one) as the second
argument."
(let* ((template (tower-template tower))
(closure (make-closure
:evaluator (closure-evaluator template)
:type-evaluators (closure-type-evaluators template)
:language (closure-language template)
:continuation-expression expr
:procedure-expression expr
:values nil
:lexical-environment (closure-lexical-environment
template)
:fluid-environment (closure-fluid-environment
template)
:level (closure-level template)
:original nil
:number (incf closure-counter)
)))
(setf (closure-original closure)
closure)
closure))
The fact that this closure is a static closure (see
section 3.4) is indicated by its
closure-original field being eq to this closure
itself.
Closures produced by instantiating this closure will
have this closure as their
closure-original field.
Platypus provides several defining forms in the syntax
of its Lisp-like base language, corresponding
approximately to defun in Common Lisp. There are
variants for defining ordinary functions, operators,
and primitives---that is, shadowed operators. There are
several ways of defining shadowed operators, according
to whether they require all their arguments to be
evaluated automatically before their provided code body
is entered, and according to whether a named existing
Lisp procedure is to be used as the procedure to wrap
into the whole shadow code body, or whether the shadow
code is to be generated automatically directly from the
code that
it shadows.
There is much in common between all these kinds of
defining forms, such as the need to translate
parameter and local variable references to the
form described in section 6.3, and they
are implemented as macros which call the procedure
platypus-defun1 to do the common parts of
their work.
There are two optional (keyed) arguments to this
macro, which indicate whether the form being
defined is to be shadowed (primitive), and
whether it is to be bound in the language (
define-as-operator) or in the environment (as a
callable procedure). The callers of
platypus-defun1 use various combinations of these
arguments, the only combination not used in
practice being a shadowed callable procedure---all
shadowed procedures are normally run directly from
the evaluator, as operators, rather than being
called through the funcall operator.
(defun platypus-defun1 (fun-name fun-args fun-body
&key primitive define-as-operator)
"Define a platypus function, called FUN-NAME, with
args FUN-ARGS and body FUN-BODY. Keyword argument
PRIMITIVE, if specified, specifies a lisp function with
which to implement this function. This is mapped in the
shadow map of the current definition tower."
(let* ((the-body (if (and (> (length fun-body) 1)
(stringp (car fun-body)))
(cdr fun-body) ; throw away docstring
fun-body))
(the-name (if (listp fun-name)
(cadr fun-name)
fun-name))
(the-env (if (listp fun-name)
(car fun-name)
(if define-as-operator
(tower-language
(current-definition-tower))
(tower-environment
(current-definition-tower)))))
(closure (make-closure-with-expression
(lisp-to-platypus-expression fun-args the-body))))
(when *print-platypus-defuns*
(format t "Setting defun in env: ~A~"
the-env))
(platypus-set-environment-variable the-env the-name
closure)
(when (not (null primitive))
(when *print-platypus-defuns*
(format t "Setting primitive~A"
(platypus-set-environment-variable
(tower-operator-shadow-map
(current-definition-tower))
closure primitive))
nil)) ; value to return from macro
This is the simplest use of platypus-defun1.
At this stage in the definition process, the
procedure body must be a single form, rather than
an implicit progn.
(defmacro platypus-defun (fun-name fun-args
;;&body
fun-body)
"Define a platypus function, called FUN-NAME, with
args FUN-ARGS and body FUN-BODY."
`(platypus-defun1 ',fun-name ',fun-args ',fun-body))
platypus-defop is similar to platypus-defun, but it makes the definition in the
language of the initial context of the tower, rather
than
in its general environment.
(defmacro platypus-defop (op-name op-args
;;&body
op-body)
"Define a platypus operator, called OP-NAME, with
args OP-ARGS and body OP-BODY."
`(platypus-defun1 ',op-name
',op-args
',op-body
:define-as-operator
t))
platypus-defprim is the simplest way to define
a shadowed primitive. It is similar to platypus-defun, with
the addition of the prim-name argument, which is the
name of the shadow procedure to run when interpreting this
procedure and finding that it is eligible for
shadowing (see sections shadowint and metaevaluator).
(defmacro platypus-defprim (fun-name prim-name fun-args
;; &body
fun-body)
"Define a platypus function, called FUN-NAME, and
implemented by the lisp function called PRIM-NAME, with
args FUN-ARGS and body FUN-BODY. The primitive named by
PRIM-NAME is called with one argument, the level to
interpret."
`(platypus-defun1 ',fun-name ',fun-args ',fun-body
:define-as-operator t
:primitive ',prim-name))
The following function is for use in a
macro-expander, platypus-def-control-prim,
which is presented after it. It takes an
expression template, which is a list of names for
successive sub-expressions of the expression, and
produces a let-binding list for binding
those names to those parts of the expression. If
do-eval is true, the code returned has the
sub-expressions evaluated in the context of the
level, accessible in the context in which this
binding code is run, under the name given by
level-name, and the results of those evaluations
are bound; otherwise the un-evaluated
sub-expressions are bound throughout.
For example, the description of the arguments for
if, (condition then else),
given the name expr for the expression will
produce the list:
((condition (nth 1 expr)) (then (nth 2 expr)) (else (nth 3 expr)))
whereas the description of the arguments for
cons, which needs its arguments evaluated for it,
will expand to:
((a (eval-in-level (nth 2 expr) level)) (b (eval-in-level (nth 3 expr) level)))
where level is passed in as the name of the
level in which to evaluate the arguments.
(defun make-control-arg-splitter (level-name
expr-name
arg-names
do-eval)
"Make a let-binding-list, in which the argument expr
bound to EXPR-NAME is split into its successive part
and bound, part by part, to the names in ARG-NAMES. If
the third argument, DO-EVAL, is non-nil, each argument
expr is wrapped in a call to eval."
(do* ((args arg-names (cdr args))
(arg (car args) (car args))
(arg-index 1 (1+ arg-index))
(let-list nil))
((endp args) (nreverse let-list))
(if (eq arg '&body)
(progn
(setq args (cdr args))
(setq arg (car args))
(push (if do-eval
`(,arg (eval-in-level
(nthcdr ,arg-index ,expr-name)
,level-name))
`(,arg (nthcdr ,arg-index ,expr-name)))
let-list))
(push
(if do-eval
`(,arg (eval-in-level
(nth ,arg-index ,expr-name)
,level-name))
`(,arg (nth ,arg-index ,expr-name)))
let-list))))
The results of make-control-arg-splitter are used
in the following macro-expander:
(defmacro platypus-def-control-prim (fun-name prim-name fun-args
&body fun-body)
"Define a platypus function, called FUN-NAME, and
implemented by the lisp function called PRIM-NAME, with
args FUN-ARGS and body FUN-BODY. The primitive named by
PRIM-NAME is called with one argument, the level to
interpret. If interpreted, the body has the parts of
the expression of the current continuation closure of
the argument level split out into the appropriate named
variables as specified by fun-args."
`(platypus-defun1 ',fun-name '(int-expr int-level int-cont)
'(let* (,@(make-control-arg-splitter
'int-level
'int-expr
fun-args
nil))
,@fun-body)
:define-as-operator t
:primitive ',prim-name))
The Lisp-like primitives are those that require all of their arguments
to be evaluated before entering the provided code body.
The evaluation of the arguments is done by some
code which the following macro wraps around the
provided code body. The extra code calls
eval-sub-exprs, which works it way along the
argument sub-expressions evaluating each one and
returning a list made from the results of these
evaluations. eval-sub-exprs is presented in
section 7.7. This is used for the version
that runs inside the tower. For the shadow
version, the argument evaluation is done inside
the code fragments returned by
make-control-arg-splitters, which arranges this
argument evaluation when called with its
do-eval argument non-nil.
(defmacro platypus-def-lispy-prim (fun-name prim-name fun-args
&body
fun-body)
"Define a lispy platypus function, called FUN-NAME,
and with an implementation based on the lisp function
called PRIM-NAME, with args FUN-ARGS and body FUN-BODY.
The arguments for the call are evaluated by the wrapper
provided by this macro, and given to the function named
by PRIM-NAME."
(let ((shadow-name (intern (concatenate 'string
"frame-"
(symbol-name prim-name)))))
`(progn
(compile
',shadow-name
`(lambda (expr level cont)
(let ((the-expr expr))
(apply #',',prim-name
(eval-sub-exprs the-expr level)))))
(platypus-defun1 ',fun-name
;; ',fun-args ',fun-body
'(int-expr int-level int-cont)
'(let* (,@(make-control-arg-splitter
'int-level
'int-expr
fun-args
t))
,@fun-body)
:define-as-operator t
:primitive ',shadow-name))))
These primitives, like those defined by platypus-def-lispy-prim,
have their arguments evaluated before running the given code body, but
whereas those call a Lisp function that exists anyway, this macro
platypus-def-lispy-expr-prim also create the Lisp function from the
expression provided, and compiles it.
(defmacro platypus-def-lispy-expr-prim (fun-name fun-args
;; &body
fun-body)
"Define a lispy platypus function, called FUN-NAME,
and with an implementation based on the lisp expression
given as the function body, below, with args FUN-ARGS
and body FUN-BODY. The arguments for the call are
evaluated by the wrapper produced by this macro, and
given to the function supplied as FUN-BODY."
(let ((shadow-name
(intern
(concatenate 'string
"frame-"
(symbol-name fun-name)))))
`(progn
(compile
',shadow-name
`(lambda (expr level cont)
(let ((the-expr expr))
(apply #','(lambda ,fun-args ,fun-body)
(eval-sub-exprs the-expr level)))))
(platypus-defun1 ',fun-name
'(int-expr int-level int-cont)
'(let*
(,@(make-control-arg-splitter
'int-level
'int-expr
fun-args
t))
,@fun-body)
:define-as-operator t
:primitive ',shadow-name))))
As described in section 3.4,
closures are used to represent procedures
available for calling. These are not true
closures, as they do not have all of the fields
filled in---they are completed in the copy made
when instantiating the closure. When a closure is
instantiated (by funcall-shadow, for
example), it is copied and completed. The
closure-original field of the copy points to the
original from which it was copied, and this is
used to determine whether the closure is
shadowed.
(defmacro def-unclosure (name args
;;&body
body)
"Set NAME to a new closure with ARGS for its
arguments and BODY for its expression and the rest made
to distinguished nonsense values. This may then be
copied into towers having the rest of the slots filled
in as appropriate for that tower. It is used for
defining things that are useful in many towers. BODY
may have a docstring, which is thrown away."
#| (when (and (stringp (car body)) (not (endp (cdr body))))
(setq body (cdr body))) |#
`(let ((expr (lisp-to-platypus-expression
',args ',body)))
(setf ,name (make-closure
:evaluator nil ; :no-evaluator
:language :no-language
:type-evaluators
:no-type-evaluators
:procedure-expression expr
:continuation-expression expr
:values :no-values
:lexical-environment :no-lexical-environment
:fluid-environment :no-fluid-environment
:original nil
:level nil
:number (incf closure-counter)
))
Procedure and operator definitions are placed in the appropriate
part---language or environment---of a tower. The tower they go in is
the current-definition-tower, which is the top of a stack of
such towers. To change the tower into which definitions are placed,
the procedures begin-define-in-tower and
end-define-in-tower are provided.
(defun tell-current-definition-tower ()
"Say which the current definition tower is."
(format t "Definitions now go into tower ~S~"
(current-definition-tower)))
(defun begin-define-in-tower (tower)
"Make TOWER the current tower for definitions."
(setq *platypus-definition-towers*
(cons tower *platypus-definition-towers*))
(tell-current-definition-tower))
(defun end-define-in-tower (&optional tower)
"Revert to the previous tower for definitions. TOWER
is used to check the nesting of definitions, unless it
is nil."
(unless (or (null tower)
(eq tower (car *platypus-definition-towers*)))
(error "Closing towers for definition in the wrong order."))
(setq *platypus-definition-towers*
(cdr *platypus-definition-towers*))
(tell-current-definition-tower))
In defining the helper
functions for stack-style operators (as used in
PostScript and FORTH) the macros
with-popped-args, push-results and
with-popped-args-push-results are useful. They
take values from the end of a level's value list
and bind them to Lisp names, and push result of
Lisp expressions onto the value list. Their
definitions involve many obscure macros, but, with
some of the internal macros expanded out, look
like this:
(defmacro with-values (some-vl &body some-body)
"Using the values list SOME-VL, run SOME-BODY."
`(let* ((.values-list. ,some-vl)
(.values-last. (value-list-last .values-list.))
(.values-max. (value-list-max .values-list.))
(.values-data. (value-list-data .values-list.))
)
(declare (type fixnum .values-last. .values-max.)
(type values-list .values-list.)
(type simple-vector .values-data.))
(let ((the-with-values-result
(progn
,@some-body)))
;; assume only this has changed:
(setf (value-list-last .values-list.)
.values-last.)
the-with-values-result)))
with-values makes a particular value list into the
current value list, as used by the macros
the-value-list-last, the-value-list-max,
the-value-list-data, and the-nth-value.
(defmacro with-values-of-level (some-level &body some-body)
"Using the values list of SOME-LEVEL, run SOME-BODY."
`(with-values (level-values ,some-level)
,@some-body))
with-values-of-level builds on with-values,
for the commonest use of it.
The expander for the macro with-the-popped-args
needs an auxiliary procedure which returns a let
binding list:
(defun make-popping-arg-list (args)
"Make a let binding list for ARGS,
with the current value list."
(let ((i (length args)))
(map 'list #'(lambda (arg)
(decf i)
`(,arg (the-nth-value ,i)))
args)))
This macro packages the above on into its most useful form:
(defmacro with-popped-args (level args &body body)
"Using LEVEL to supply the arguments,
pop the args needed to fill ARGS, and run BODY."
`(with-values-of-level ,level
(with-the-popped-args ,args
,@body)))
The following definitions are the complement of the preceding ones---pushing results back onto the stack. The results are specified as a list of arbitrary Lisp expressions. The following procedure is used by the macro expander after it:
(defun make-result-placer-pushers (forms n)
"Return a list of code to put FORMS into the
current value list; for efficiency, we are told
that there are N forms."
(let ((i n))
(map 'list #'(lambda (form)
(decf i)
`(setf (the-nth-value ,i)
,form))
forms)))
This packages it into its most useful form:
(defmacro push-results (level &rest results)
"Into LEVEL push &REST RESULTS."
`(with-values-of-level ,level
(push-the-results
,@results)))
The following macro combines the two stack facilities above, and may be used as the outermost part of each stack-based operator shadow body:
(defmacro with-popped-args-push-results (level
args
results
&body body)
"Using LEVEL to supply the arguments, pop the args
needed to fill ARGS, and run BODY, finally pushing
RESULTS onto the stack of LEVEL."
`(with-values-of-level ,level
(with-the-popped-args
,args
,@body
(push-the-results ,@results))))
The C implementation of Platypus is a complete system implementation, not relying on another language's support system and library for memory management and other facilities. Because of this, it is fairly large and complex, and contains much code not directly relevant to the research.
C-Platypus keeps the entire tower system within a storage heap. The meta-evaluator is not visible from the tower, and is a C program, which is not contained within the heap. All values in the heap are tagged with their type; to allow as much flexibility as possible, the tags are whole machine words (making each C-Platypus word two machine words), and point to the type descriptors concerned. Each object in the heap has a header, consisting of two C-Platypus words: the length and the type. (The type of the type points to the type descriptor for the whole object, and the value of the type is the object itself---a redundant reference that turned out very useful for debugging.) This type system makes all types first-class [Lang and Pearlmutter 88]. There is no distinction between predefined system types and user-defined types.
The garbage-collector is a stop-and-copy one. It is complicated by the need to update the shadowing tables in the meta-evaluator. As an interesting reflection curiosity, the heap is also an object that contains itself.
The shadowing tables use a perfect hashing scheme from addresses within the heap to addresses in the meta-evaluator. The hash code is the low few bits of the address in the heap, and the size of the hash table is a power of two. In the initialization of the heap with the shadowed objects, and when the garbage collector moves them, when a shadowed object is about to be allocated, if its address has the same hash code as one that has already been marked in the shadow map, words of memory are thrown away until one with a free hash code is found. This typically wasted 22 words at any one time, and seems a small overhead to pay for such a fast hashing scheme. However, it is not so suitable for a system using many more mapping tables (environments) as the wastage would go up, as would the amount of special treatment of objects done by the garbage collector.
The meta-evaluator is similar to the one
written in Lisp for Platypus89, but is written in
as a loop, instead of using the compiler's tail-recursion
removal. It does not use a level-type-evaluators
environment mechanism for evaluating things of
different types, but has it built in to a
switch statement.
The shadow operators are implemented in a similar way to those in Platypus89, but the C code that defines them must be pre-processed before compilation, to insert some of the standard helper code for taking apart levels and closures, and for evaluating arguments for operators that simply want all their arguments evaluated.
Platypus is a trial implementation of a reflective tower-based evaluation system in which data representations inside and outside the tower are the same. It has been through two broadly similar implementation generations, one in C and one in Common Lisp.
Dynamic typing is used throughout the system, both inside and outside the tower. All objects in the tower are kept in a storage heap; in the C implementation this is scavenged by a stop-and-copy garbage collector, which must pay attention to updating variables of the meta-evaluator as it moves the things to which they point.
While several meta-evaluator variables point into the heap, it is not possible for a program in the tower to find from an object in the heap what it corresponds to in the meta-evaluator (although a meta-evaluator that makes this information available could be written).
The meta-interpreter must contain:
The meta-evaluator may be reduced to a very concise form built around one function, which is appropriately very similar to the corresponding function for the concise form of the standard internal evaluator for a tower. This function consists of four procedure calls and two environment lookups.
The code for all the shadow operator definitions has much in common; in particular, all operators that must evaluate all their arguments independently share an argument evaluator mechanism. Such operators are built around primitive procedures in the implementation language, by a macro-preprocessor, that takes functions in the implementation language, and produces wrapper functions for use as the shadow operators.
For the snark was a boojum, you see.
The Hunting Of The Snark