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)))