compile time environments can have placeholders for space

This commit is contained in:
Danny Yoo 2011-03-01 16:21:24 -05:00
parent bbde3cdeaa
commit bff387a6f9
7 changed files with 53 additions and 26 deletions

View File

@ -161,6 +161,7 @@
(: compile-sequence ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-sequence seq cenv target linkage)
;; All but the last will use 'next linkage.
(if (last-exp? seq)
(compile (first-exp seq) cenv target linkage)
(append-instruction-sequences (compile (first-exp seq) cenv target 'next)
@ -168,6 +169,8 @@
(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
;; Write out code for lambda expressions.
;; The lambda will close over the free variables.
(define (compile-lambda exp cenv target linkage)
(let*: ([proc-entry : Symbol (make-label 'entry)]
[after-lambda : Symbol (make-label 'afterLambda)]

View File

@ -5,15 +5,12 @@
;; Expressions
(define-type ExpressionCore (U Top Constant Var Branch Def Lam Seq #;App))
(define-type Expression (U ExpressionCore #;Assign))
(define-type ExpressionCore (U Top Constant Var Branch Def Lam Seq App))
(define-struct: Top ([prefix : Prefix]
[code : ExpressionCore]) #:transparent)
(define-struct: Constant ([v : Any]) #:transparent)
(define-struct: Var ([id : Symbol]) #:transparent)
(define-struct: Assign ([variable : Symbol]
[value : Expression]) #:transparent)
(define-struct: Branch ([predicate : Expression]
[consequent : Expression]
[alternative : Expression]) #:transparent)
@ -33,4 +30,11 @@
(define (first-exp seq) (car seq))
(: rest-exps ((Listof Expression) -> (Listof Expression)))
(define (rest-exps seq) (cdr seq))
(define (rest-exps seq) (cdr seq))
(define-struct: Assign ([variable : Symbol]
[value : Expression]) #:transparent)
(define-type Expression (U ExpressionCore #;Assign))

View File

@ -6,6 +6,7 @@
"sets.rkt")
(provide find-variable
extend-lexical-environment
extend-lexical-environment/placeholders
lexical-environment-pop-depth
collect-lexical-references
lexical-references->compile-time-environment)
@ -26,17 +27,22 @@
[depth : Natural 0])
(cond [(empty? cenv)
(error 'find-variable "Unable to find ~s in the environment" name)]
[(Prefix? (first cenv))
(cond [(member name (Prefix-names (first cenv)))
(make-PrefixAddress depth (find-pos name (Prefix-names (first cenv))) name)]
[else
(loop (rest cenv) (add1 depth))])]
[(symbol? (first cenv))
(cond
[(eq? name (first cenv))
(make-LocalAddress depth)]
[else
(loop (rest cenv) (add1 depth))])])))
[else
(let: ([elt : CompileTimeEnvironmentEntry (first cenv)])
(cond
[(eq? #f elt)
(loop (rest cenv) (add1 depth))]
[(Prefix? elt)
(cond [(member name (Prefix-names elt))
(make-PrefixAddress depth (find-pos name (Prefix-names elt)) name)]
[else
(loop (rest cenv) (add1 depth))])]
[(symbol? elt)
(cond
[(eq? name elt)
(make-LocalAddress depth)]
[else
(loop (rest cenv) (add1 depth))])]))])))
@ -49,6 +55,14 @@
(append names cenv)]))
(: extend-lexical-environment/placeholders (CompileTimeEnvironment Natural -> CompileTimeEnvironment))
;; Add placeholders to the lexical environment (This represents what happens during procedure application.)
(define (extend-lexical-environment/placeholders cenv n)
(cond [(= n 0)
cenv]
[else
(extend-lexical-environment/placeholders (cons #f cenv) (sub1 n))]))
(: lexical-environment-pop-depth (CompileTimeEnvironment -> Natural))
;; Computes how many environments we need to pop till we clear the procedure arguments.

View File

@ -10,10 +10,15 @@
(define-struct: Prefix ([names : (Listof Symbol)])
#:transparent)
(define-type CompileTimeEnvironmentEntry (U False ;; placeholder for temporary space
Symbol ;; lexically bound local identiifer
Prefix ;; a prefix
))
;; A compile-time environment is a (listof (listof symbol)).
;; A lexical address is either a 2-tuple (depth pos), or 'not-found.
(define-type CompileTimeEnvironment (Listof (U Symbol
Prefix)))
(define-type CompileTimeEnvironment (Listof CompileTimeEnvironmentEntry))
;; A lexical address is a reference to an value in the environment stack.
(define-type LexicalAddress (U LocalAddress PrefixAddress))

View File

@ -1,5 +1,5 @@
#lang racket/base
(require "typed-structs.rkt")
(require "expression-structs.rkt")
(provide parse)
(define (parse exp)
@ -7,12 +7,9 @@
[(self-evaluating? exp)
(make-Constant exp)]
[(quoted? exp)
(make-Quote (text-of-quotation exp))]
(make-Constant (text-of-quotation exp))]
[(variable? exp)
(make-Var exp)]
[(assignment? exp)
(make-Assign (assignment-variable exp)
(parse (assignment-value exp)))]
[(definition? exp)
(make-Def (definition-variable exp)
(parse (definition-value exp)))]
@ -22,7 +19,7 @@
(parse (if-alternative exp)))]
[(lambda? exp)
(make-Lam (lambda-parameters exp)
(map parse (lambda-body exp)))]
(make-Seq (map parse (lambda-body exp))))]
[(begin? exp)
(make-Seq (map parse (begin-actions exp)))]

View File

@ -23,6 +23,10 @@ var Primitives = {
MACHINE.params.currentDisplayer("\n");
},
'pi' : Math.PI,
'e' : Math.E,
'=': function(argl) {
return argl[0] === argl[1][0];
},

View File

@ -1,6 +1,6 @@
#lang typed/racket/base
(require "typed-structs.rkt")
(require "expression-structs.rkt")
(require/typed "parse.rkt"
[parse (Any -> Expression)])
[parse (Any -> ExpressionCore)])
(provide parse)