From c192989e550d68bfdf16ab5fd85215c4e641ec10 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Sun, 8 May 2011 19:22:13 -0400 Subject: [PATCH] trying to add positional names to lambdas --- assemble-helpers.rkt | 16 +++++----- il-structs.rkt | 9 +++--- parameters.rkt | 5 ++-- simulator-structs.rkt | 5 ++-- simulator.rkt | 1 + test-parse.rkt | 68 +++++++++++++++++++++---------------------- 6 files changed, 55 insertions(+), 49 deletions(-) diff --git a/assemble-helpers.rkt b/assemble-helpers.rkt index ae2bb36..c8b7cc7 100644 --- a/assemble-helpers.rkt +++ b/assemble-helpers.rkt @@ -1,6 +1,7 @@ #lang typed/racket/base (require "il-structs.rkt" + "expression-structs.rkt" "lexical-structs.rkt" racket/list) @@ -238,13 +239,14 @@ -(: assemble-display-name ((U Symbol False) -> String)) -(define (assemble-display-name symbol-or-string) - (if (symbol? symbol-or-string) - (format "~s" (symbol->string symbol-or-string)) - "false")) - - +(: assemble-display-name ((U Symbol LamPositionalName) -> String)) +(define (assemble-display-name name) + (cond + [(symbol? name) + (format "~s" (symbol->string name))] + [(LamPositionalName? name) + ;; FIXME: record more interesting information here. + (format "~s" (symbol->string (LamPositionalName-name name)))])) diff --git a/il-structs.rkt b/il-structs.rkt index e93839e..42ec5bc 100644 --- a/il-structs.rkt +++ b/il-structs.rkt @@ -1,7 +1,8 @@ #lang typed/racket/base (provide (all-defined-out)) -(require "lexical-structs.rkt" +(require "expression-structs.rkt" + "lexical-structs.rkt" "kernel-primitives.rkt") @@ -219,7 +220,7 @@ (define-struct: MakeCompiledProcedure ([label : Symbol] [arity : Arity] [closed-vals : (Listof Natural)] - [display-name : (U Symbol False)]) + [display-name : (U Symbol LamPositionalName)]) #:transparent) @@ -227,7 +228,7 @@ ;; bother with trying to capture the free variables. (define-struct: MakeCompiledProcedureShell ([label : Symbol] [arity : Arity] - [display-name : (U Symbol False)]) + [display-name : (U Symbol LamPositionalName)]) #:transparent) @@ -423,7 +424,7 @@ ;; We try to keep at compile time a mapping from environment positions to ;; statically known things, to generate better code. -(define-struct: StaticallyKnownLam ([name : (U Symbol False)] +(define-struct: StaticallyKnownLam ([name : (U Symbol LamPositionalName)] [entry-point : Symbol] [arity : Arity]) #:transparent) diff --git a/parameters.rkt b/parameters.rkt index 9308e2f..4d3747a 100644 --- a/parameters.rkt +++ b/parameters.rkt @@ -1,6 +1,7 @@ #lang typed/racket/base +(require "expression-structs.rkt") (provide current-defined-name) -(: current-defined-name (Parameterof (U Symbol False))) -(define current-defined-name (make-parameter #f)) \ No newline at end of file +(: current-defined-name (Parameterof (U Symbol LamPositionalName))) +(define current-defined-name (make-parameter 'unknown)) \ No newline at end of file diff --git a/simulator-structs.rkt b/simulator-structs.rkt index 026966e..e61a866 100644 --- a/simulator-structs.rkt +++ b/simulator-structs.rkt @@ -3,6 +3,7 @@ (provide (all-defined-out)) (require "il-structs.rkt" + "expression-structs.rkt" "lexical-structs.rkt") @@ -146,7 +147,7 @@ ;; Primitive procedure wrapper (define-struct: primitive-proc ([f : (machine PrimitiveValue * -> PrimitiveValue)] [arity : Arity] - [display-name : (U Symbol False)]) + [display-name : (U Symbol LamPositionalName)]) #:transparent) @@ -156,7 +157,7 @@ (define-struct: closure ([label : Symbol] [arity : Arity] [vals : (Listof SlotValue)] - [display-name : (U Symbol False)]) + [display-name : (U Symbol LamPositionalName)]) #:transparent #:mutable) diff --git a/simulator.rkt b/simulator.rkt index 92d8e8d..a6a13a8 100644 --- a/simulator.rkt +++ b/simulator.rkt @@ -10,6 +10,7 @@ "simulator-structs.rkt" "bootstrapped-primitives.rkt" "kernel-primitives.rkt" + "expression-structs.rkt" racket/list racket/match (for-syntax racket/base)) diff --git a/test-parse.rkt b/test-parse.rkt index 17b5314..8e64d65 100644 --- a/test-parse.rkt +++ b/test-parse.rkt @@ -89,50 +89,50 @@ (test (parse '(lambda () x)) (make-Top (make-Prefix '(x)) - (make-Lam #f 0 #f (make-ToplevelRef 0 0) + (make-Lam 'unknown 0 #f (make-ToplevelRef 0 0) '(0) 'lamEntry1))) (test (parse '(lambda args args)) (make-Top (make-Prefix '()) - (make-Lam #f 0 #t (make-LocalRef 0 #f) + (make-Lam 'unknown 0 #t (make-LocalRef 0 #f) '() 'lamEntry1))) (test (parse '(lambda (x y . z) x)) (make-Top (make-Prefix '()) - (make-Lam #f 2 #t + (make-Lam 'unknown 2 #t (make-LocalRef 0 #f) '() 'lamEntry1))) (test (parse '(lambda (x y . z) y)) (make-Top (make-Prefix '()) - (make-Lam #f 2 #t + (make-Lam 'unknown 2 #t (make-LocalRef 1 #f) '() 'lamEntry1))) (test (parse '(lambda (x y . z) z)) (make-Top (make-Prefix '()) - (make-Lam #f 2 #t + (make-Lam 'unknown 2 #t (make-LocalRef 2 #f) '() 'lamEntry1))) (test (parse '(lambda (x y z) x)) (make-Top (make-Prefix '()) - (make-Lam #f 3 #f (make-LocalRef 0 #f) '() 'lamEntry1))) + (make-Lam 'unknown 3 #f (make-LocalRef 0 #f) '() 'lamEntry1))) (test (parse '(lambda (x y z) y)) (make-Top (make-Prefix '()) - (make-Lam #f 3 #f (make-LocalRef 1 #f) '() 'lamEntry1))) + (make-Lam 'unknown 3 #f (make-LocalRef 1 #f) '() 'lamEntry1))) (test (parse '(lambda (x y z) z)) (make-Top (make-Prefix '()) - (make-Lam #f 3 #f (make-LocalRef 2 #f) '() 'lamEntry1))) + (make-Lam 'unknown 3 #f (make-LocalRef 2 #f) '() 'lamEntry1))) (test (parse '(lambda (x y z) x y z)) (make-Top (make-Prefix '()) - (make-Lam #f 3 #f (make-Seq (list (make-LocalRef 0 #f) + (make-Lam 'unknown 3 #f (make-Seq (list (make-LocalRef 0 #f) (make-LocalRef 1 #f) (make-LocalRef 2 #f))) '() @@ -140,7 +140,7 @@ (test (parse '(lambda (x y z) k)) (make-Top (make-Prefix '(k)) - (make-Lam #f + (make-Lam 'unknown 3 #f (make-ToplevelRef 0 0 ) @@ -149,7 +149,7 @@ (test (parse '(lambda (x y z) k x y z)) (make-Top (make-Prefix '(k)) - (make-Lam #f + (make-Lam 'unknown 3 #f (make-Seq (list (make-ToplevelRef 0 0 ) @@ -167,9 +167,9 @@ z w)))) (make-Top (make-Prefix '(w)) - (make-Lam #f 1 #f - (make-Lam #f 1 #f - (make-Lam #f 1 #f + (make-Lam 'unknown 1 #f + (make-Lam 'unknown 1 #f + (make-Lam 'unknown 1 #f (make-Seq (list (make-LocalRef 1 #f) (make-LocalRef 2 #f) @@ -187,8 +187,8 @@ (lambda (y) x))) (make-Top (make-Prefix '()) - (make-Lam #f 1 #f - (make-Lam #f 1 #f + (make-Lam 'unknown 1 #f + (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) '(0) 'lamEntry1) @@ -199,8 +199,8 @@ (lambda (y) y))) (make-Top (make-Prefix '()) - (make-Lam #f 1 #f - (make-Lam #f 1 #f + (make-Lam 'unknown 1 #f + (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) (list) 'lamEntry1) @@ -217,7 +217,7 @@ (test (parse '(lambda (x) (+ x x))) (make-Top (make-Prefix `(,(make-ModuleVariable '+ '#%kernel))) - (make-Lam #f 1 #f + (make-Lam 'unknown 1 #f (make-App (make-ToplevelRef 2 0) (list (make-LocalRef 3 #f) (make-LocalRef 3 #f))) @@ -228,7 +228,7 @@ (+ (* x x) x))) (make-Top (make-Prefix `(,(make-ModuleVariable '* '#%kernel) ,(make-ModuleVariable '+ '#%kernel))) - (make-Lam #f 1 #f + (make-Lam 'unknown 1 #f ;; stack layout: [???, ???, prefix, x] (make-App (make-ToplevelRef 2 1) (list @@ -414,7 +414,7 @@ (make-Top (make-Prefix `(,(make-ModuleVariable 'add1 '#%kernel))) (make-Let1 (make-Constant 0) (make-BoxEnv 0 - (make-Lam #f 0 #f + (make-Lam 'unknown 0 #f (make-Seq (list (make-InstallValue 1 1 (make-App (make-ToplevelRef 1 0) @@ -435,7 +435,7 @@ (make-Seq (list (make-InstallValue 1 0 (make-Constant 0) #t) (make-InstallValue 1 1 (make-Constant 1) #t) - (make-Lam #f 0 #f + (make-Lam 'unknown 0 #f (make-Seq (list (make-InstallValue 1 1 @@ -524,14 +524,14 @@ ;; CaseLam (test (parse '(case-lambda)) (make-Top (make-Prefix '()) - (make-CaseLam #f (list) 'lamEntry1))) + (make-CaseLam 'unknown (list) 'lamEntry1))) (test (parse '(case-lambda [(x) x])) (make-Top (make-Prefix '()) (make-CaseLam - #f - (list (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)) + 'unknown + (list (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)) 'lamEntry1))) @@ -539,18 +539,18 @@ [(x y) x])) (make-Top (make-Prefix '()) (make-CaseLam - #f - (list (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry2) - (make-Lam #f 2 #f (make-LocalRef 0 #f) '() 'lamEntry3)) + 'unknown + (list (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) '() 'lamEntry2) + (make-Lam 'unknown 2 #f (make-LocalRef 0 #f) '() 'lamEntry3)) 'lamEntry1))) (test (parse '(case-lambda [(x) x] [(x y) y])) (make-Top (make-Prefix '()) (make-CaseLam - #f - (list (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry2) - (make-Lam #f 2 #f (make-LocalRef 1 #f) '() 'lamEntry3)) + 'unknown + (list (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) '() 'lamEntry2) + (make-Lam 'unknown 2 #f (make-LocalRef 1 #f) '() 'lamEntry3)) 'lamEntry1))) @@ -558,8 +558,8 @@ [(x) x])) (make-Top (make-Prefix '()) (make-CaseLam - #f - (list (make-Lam #f 2 #f (make-LocalRef 1 #f) '() 'lamEntry2) - (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry3)) + 'unknown + (list (make-Lam 'unknown 2 #f (make-LocalRef 1 #f) '() 'lamEntry2) + (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) '() 'lamEntry3)) 'lamEntry1)))