From bff387a6f9cc7e4927845d0a269d03b9ec15d238 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Tue, 1 Mar 2011 16:21:24 -0500 Subject: [PATCH] compile time environments can have placeholders for space --- compile.rkt | 3 +++ expression-structs.rkt | 14 +++++++++----- lexical-env.rkt | 36 +++++++++++++++++++++++++----------- lexical-structs.rkt | 9 +++++++-- parse.rkt | 9 +++------ runtime.js | 4 ++++ typed-parse.rkt | 4 ++-- 7 files changed, 53 insertions(+), 26 deletions(-) diff --git a/compile.rkt b/compile.rkt index b51a0b0..d088e76 100644 --- a/compile.rkt +++ b/compile.rkt @@ -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)] diff --git a/expression-structs.rkt b/expression-structs.rkt index df8a6f2..dd5963d 100644 --- a/expression-structs.rkt +++ b/expression-structs.rkt @@ -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)) \ No newline at end of file +(define (rest-exps seq) (cdr seq)) + + + + +(define-struct: Assign ([variable : Symbol] + [value : Expression]) #:transparent) +(define-type Expression (U ExpressionCore #;Assign)) diff --git a/lexical-env.rkt b/lexical-env.rkt index 8c635fa..241b037 100644 --- a/lexical-env.rkt +++ b/lexical-env.rkt @@ -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. diff --git a/lexical-structs.rkt b/lexical-structs.rkt index 173d8d8..59a5026 100644 --- a/lexical-structs.rkt +++ b/lexical-structs.rkt @@ -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)) diff --git a/parse.rkt b/parse.rkt index 8f89e92..05ff75d 100644 --- a/parse.rkt +++ b/parse.rkt @@ -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)))] diff --git a/runtime.js b/runtime.js index 7ef11f5..35a4287 100644 --- a/runtime.js +++ b/runtime.js @@ -23,6 +23,10 @@ var Primitives = { MACHINE.params.currentDisplayer("\n"); }, + 'pi' : Math.PI, + + 'e' : Math.E, + '=': function(argl) { return argl[0] === argl[1][0]; }, diff --git a/typed-parse.rkt b/typed-parse.rkt index 363d9e0..e35eb97 100644 --- a/typed-parse.rkt +++ b/typed-parse.rkt @@ -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) \ No newline at end of file