[phylum]<3-LISP>documentation>3-lamping-processor.bravo!1

This verison of the implementation processor achieves its simplicity by remaining two levels away from the action instead of one. As a result, all of the worries about the implementation falling off its parentheses or encountering a reflective continuation are taken care of by the reflective processor running one level down. A second feature of this implementation processor is that it is not written in continuation-passing style — it could have been, but this way has the benefit of making it impossible to confuse the object level’s continuations with those of the implementation’s.

————————————————————————————————————————————

(define *NORMALISE
(lambda simple [exp env]
(cond [(normal exp) exp]
[(atom exp) (binding exp env)]
[(rail exp) (*normalise-rail exp env)]
[(pair exp) (*reduce (car exp) (cdr exp) env)])))

(define *NORMALISE-RAIL
(lambda simple [rail env]
(if (empty rail)
(rcons)
(prep (*normalise (1st rail) env)
(*normalise-rail (rest rail) env)))))

(define *REDUCE
(lambda simple [proc args env]
(let [[proc! (*normalise proc env)]]
(*c-proc!-or-climb proc! proc args env))))

If the procedure that we are about to reduce is not safe then we will shift up one level (i.e., reduce this call to C-PROC! instead of doing *C-PROC!).

(define *C-PROC!-OR-CLIMB
(lambda simple [proc! proc args env]
(if (or (safe proc!) (special-reflect proc!))
(*c-proc! proc! args env)
(expand-closure ↑(make-c-proc! proc args env (shift-up)) ↑[proc!])))))

(define *C-PROC!
(lambda simple [proc! args env]
(if (special-reflective proc!)
(execute-reflective proc! args env)
(*c-args! proc! (*normalise args env)))))

(define *C-ARGS!
(lambda simple [proc! args!]
(if (special-simple proc!)
(execute-simple proc! args!)
(expand-closure-or-drop proc! args!))))

Whenever we are about to expand a closure we look to see if the processor one level down is about to enter C-ARGS! with a safe procedure as an argument. If this is the case we will shift down one level and perform the reduction.

(define EXPAND-CLOSURE-OR-DROP
(lambda simple [proc! args!]
(if (c-match proc! @sample-c-args!)
(let [[args!-one-level-down (1st ↑args!)]
[proc!-one-level-down ↑(binding ’proc! (environment proc!))]
[cont-one-level-down ↑(binding ’cont (environment proc!))]]
(if (safe proc!-one-level-down)
(block (shift-down cont-one-level-down)
(*c-args! proc!-one-level-down
args!-one-level-down))
(expand-closure proc! args!)))
(expand-closure proc! args!))))

(define EXPAND-CLOSURE
(lambda simple [proc! args!]
(*normalise (body proc!)
(bind (pattern proc!)
args!
(environment proc!)))))

(define EXECUTE-REFLECT
(lambda simple [proc! args env]
(select proc!
[↑if
(if ↑(*normalise (1st args) env)
(*normalise (2nd args) env)
(*normalise (3rd args) env))]
[↑lambda
(let [[kind! (*normalise (1st args) env)]]
(select kind!
[↑simple (ccons ’simple ↑env (2nd args) (3rd args))]
[↑reflect (ccond ’reflect ↑env (2nd args) (3rd args))]))]
[↑block
(if (unit args)
(*normalize (1st args) env)
(block (*normalize (1st args) env)
(execute-reflect proc! (rest args) env)))])))

The set of simple procedure that are treated specially must include all of the primitives, but may also contain most of the simple kernel procedures. However, non-kernel procedure, kernel procedures that take functional arguments (e.g. MAP), and the PPPs are definitely excluded from this set.

(define SPECIAL-SIMPLE
(lambda simple [proc!]
(or (primitive proc!)
(member proc! [↑normal ↑normal-rail ↑simple ↑bind ↑binding ↑rebind
↑reflect ↑de-reflect ↑reflective
↑1st ↑2nd ↑3rd ↑4th ↑rest ↑vector ↑atom ...]))))

Primitives are considered to be safe because they can be done in one shot without fear of reflection. Most of the kernel procedures (e.g. NORMAL, ATOM) are safe because all of the steps involved to doing them are themselves safe. The PPPs are safe because they are written in (partial) continuation-passing style in which all potentially unsafe steps are done strictly tail-recursively.

(define PPP
(lambda simple [proc!]
(or (member proc! [↑normalise ↑reduce ↑normalise-rail])
(c-match proc! @sample-c-proc!)
(c-match proc! @sample-c-args!)
(c-match proc! @sample-c-first!)
(c-match proc! @sample-c-rest!))))

————————————————————————————————————————————

(define C-MATCH
(lambda simple [closure template]
(and (= (body closure) (body template))
(= (pattern closure) (pattern template))
(= (procedure-type closure) ’simple)
(match-env (environment-designator closure) (environment-designator template)))))

(define MATCH-ENV
(lambda simple [candidate master]
(cond [(= candidate master) $T]
[(= master ↑global) $F]
[(empty candidate) $F]
[(= (1st (1st candidate)) (1st (1st master)))
(match-env (rest candidate) (rest master))]
[$T $F])))

————————————————————————————————————————————

(define MAKE-C-PROC!
(lambda simple [proc args env cont]
(simple ↑(bind (pattern ↑reduce)
↑[proc args env cont]
(environment ↑reduce))
(pattern @sample-c-proc!)
(body @sample-c-proc!))))

————————————————————————————————————————————

SHIFT-UP pretends that we are now playing reflective processor at one level higher that we were just a moment ago, and adjusts the continuation stack so that it accurately reflects our new stance. Similarly, SHIFT-DOWN pretends that we are going to play reflective processor at one level lower than we were a moment ago, and saves the continuation for our level we are moving to on the continuation stack (cf. other implementation processor).

(define SHIFT-UP
(lambda simple []
(block (set @current-level (1+ @current-level))
(if (empty @continuation-stack)
(new-top-level-continuation @current-level)
(pop @continuation-stack)))))

(define SHIFT-DOWN
(lambda simple [cont]
(block (set @current-level (1- @current-level))
(push cont @continuation-stack))))

————————————————————————————————————————————

GENESIS starts things off at level 2 with an empty continuation stack. The reflective processor one level down will be normalising a read-normalize-print redex.

(define GENESIS
(lambda simple []
(let [[throw-out-cont (lambda reflect [[] e c] ↑↑c)]]
(block (set @sample-c-first! (catch [(throw-out-cont)]))
(set @sample-c-proc! (catch ((throw-out-cont))))
(set @sample-c-args! (catch (id* . (throw-out-cont))))
(set @sample-c-rest!
(catch [’? ((lambda reflect [[] e c]
↑(binding ’cont (environment ↑c))))]))
(set @sample-c-block (catch (block (throw-out-cont) ’?)))
(set @continuation-stack (scons))
(set @current-level 2)
(expand-closure ↑normalise
↑[’(read-normalise-print 1 global) global])))))

————————————————————————————————————————————

This means that the great flurry of activity at level 1 is supposedly driven by the call to NORMALISE inside READ-NORMALISE-PRINT, whose definition is:

(define READ-NORMALISE-PRINT
(lambda simple [level env]
(block (prompt level)
(normalise (read) env print)
(read-normalise-print level env))))

(define NEW-TOP-LEVEL-CONTINUATION
(let [[rnp-code-fragment (rest (cdr (body ↑read-normalise-print)))]
[rnp-environment (environment ↑read-normalise-print)]
[rnp-pattern (pattern ↑read-normalise-print)]]
(lambda simple [level]
(make-c-block rnp-code-fragment
(bind rnp-pattern ↑[level global] rnp-environment)
print))))

(define MAKE-C-BLOCK
(lambda simple [clauses env cont]
(simple ↑(bind (pattern ↑block-helper)
↑[clauses env cont]
(environment ↑block-helper))
(pattern @sample-c-block)
(body @sample-c-block))))

————————————————————————————————————————————