suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

trying to add positional names to lambdas

Browse Source
This commit is contained in:
Danny Yoo 2011-05-08 19:22:13 -04:00
parent 4a8413cfc8
commit c192989e55
6 changed files with 55 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
assemble-helpers.rkt
View File

@ -1,6 +1,7 @@
#lang typed/racket/base #lang typed/racket/base
(require "il-structs.rkt" (require "il-structs.rkt"
"expression-structs.rkt"
"lexical-structs.rkt" "lexical-structs.rkt"
racket/list) racket/list)
@ -238,13 +239,14 @@
(: assemble-display-name ((U Symbol False) -> String)) (: assemble-display-name ((U Symbol LamPositionalName) -> String))
(define (assemble-display-name symbol-or-string) (define (assemble-display-name name)
(if (symbol? symbol-or-string) (cond
(format "~s" (symbol->string symbol-or-string)) [(symbol? name)
"false")) (format "~s" (symbol->string name))]
[(LamPositionalName? name)
;; FIXME: record more interesting information here.
(format "~s" (symbol->string (LamPositionalName-name name)))]))

9
il-structs.rkt
View File

@ -1,7 +1,8 @@
#lang typed/racket/base #lang typed/racket/base
(provide (all-defined-out)) (provide (all-defined-out))
(require "lexical-structs.rkt" (require "expression-structs.rkt"
"lexical-structs.rkt"
"kernel-primitives.rkt") "kernel-primitives.rkt")
@ -219,7 +220,7 @@
(define-struct: MakeCompiledProcedure ([label : Symbol] (define-struct: MakeCompiledProcedure ([label : Symbol]
[arity : Arity] [arity : Arity]
[closed-vals : (Listof Natural)] [closed-vals : (Listof Natural)]
[display-name : (U Symbol False)]) [display-name : (U Symbol LamPositionalName)])
#:transparent) #:transparent)
@ -227,7 +228,7 @@
;; bother with trying to capture the free variables. ;; bother with trying to capture the free variables.
(define-struct: MakeCompiledProcedureShell ([label : Symbol] (define-struct: MakeCompiledProcedureShell ([label : Symbol]
[arity : Arity] [arity : Arity]
[display-name : (U Symbol False)]) [display-name : (U Symbol LamPositionalName)])
#:transparent) #:transparent)
@ -423,7 +424,7 @@
;; We try to keep at compile time a mapping from environment positions to ;; We try to keep at compile time a mapping from environment positions to
;; statically known things, to generate better code. ;; statically known things, to generate better code.
(define-struct: StaticallyKnownLam ([name : (U Symbol False)] (define-struct: StaticallyKnownLam ([name : (U Symbol LamPositionalName)]
[entry-point : Symbol] [entry-point : Symbol]
[arity : Arity]) #:transparent) [arity : Arity]) #:transparent)

5
parameters.rkt
View File

@ -1,6 +1,7 @@
#lang typed/racket/base #lang typed/racket/base
(require "expression-structs.rkt")
(provide current-defined-name) (provide current-defined-name)
(: current-defined-name (Parameterof (U Symbol False))) (: current-defined-name (Parameterof (U Symbol LamPositionalName)))
(define current-defined-name (make-parameter #f)) (define current-defined-name (make-parameter 'unknown))

5
simulator-structs.rkt
View File

@ -3,6 +3,7 @@
(provide (all-defined-out)) (provide (all-defined-out))
(require "il-structs.rkt" (require "il-structs.rkt"
"expression-structs.rkt"
"lexical-structs.rkt") "lexical-structs.rkt")
@ -146,7 +147,7 @@
;; Primitive procedure wrapper ;; Primitive procedure wrapper
(define-struct: primitive-proc ([f : (machine PrimitiveValue * -> PrimitiveValue)] (define-struct: primitive-proc ([f : (machine PrimitiveValue * -> PrimitiveValue)]
[arity : Arity] [arity : Arity]
[display-name : (U Symbol False)]) [display-name : (U Symbol LamPositionalName)])
#:transparent) #:transparent)
@ -156,7 +157,7 @@
(define-struct: closure ([label : Symbol] (define-struct: closure ([label : Symbol]
[arity : Arity] [arity : Arity]
[vals : (Listof SlotValue)] [vals : (Listof SlotValue)]
[display-name : (U Symbol False)]) [display-name : (U Symbol LamPositionalName)])
#:transparent #:transparent
#:mutable) #:mutable)

1
simulator.rkt
View File

@ -10,6 +10,7 @@
"simulator-structs.rkt" "simulator-structs.rkt"
"bootstrapped-primitives.rkt" "bootstrapped-primitives.rkt"
"kernel-primitives.rkt" "kernel-primitives.rkt"
"expression-structs.rkt"
racket/list racket/list
racket/match racket/match
(for-syntax racket/base)) (for-syntax racket/base))

68
test-parse.rkt
View File

@ -89,50 +89,50 @@
(test (parse '(lambda () x)) (test (parse '(lambda () x))
(make-Top (make-Prefix '(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))) '(0) 'lamEntry1)))
(test (parse '(lambda args args)) (test (parse '(lambda args args))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-Lam #f 0 #t (make-LocalRef 0 #f) (make-Lam 'unknown 0 #t (make-LocalRef 0 #f)
'() 'lamEntry1))) '() 'lamEntry1)))
(test (parse '(lambda (x y . z) x)) (test (parse '(lambda (x y . z) x))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-Lam #f 2 #t (make-Lam 'unknown 2 #t
(make-LocalRef 0 #f) (make-LocalRef 0 #f)
'() 'lamEntry1))) '() 'lamEntry1)))
(test (parse '(lambda (x y . z) y)) (test (parse '(lambda (x y . z) y))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-Lam #f 2 #t (make-Lam 'unknown 2 #t
(make-LocalRef 1 #f) (make-LocalRef 1 #f)
'() 'lamEntry1))) '() 'lamEntry1)))
(test (parse '(lambda (x y . z) z)) (test (parse '(lambda (x y . z) z))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-Lam #f 2 #t (make-Lam 'unknown 2 #t
(make-LocalRef 2 #f) (make-LocalRef 2 #f)
'() 'lamEntry1))) '() 'lamEntry1)))
(test (parse '(lambda (x y z) x)) (test (parse '(lambda (x y z) x))
(make-Top (make-Prefix '()) (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)) (test (parse '(lambda (x y z) y))
(make-Top (make-Prefix '()) (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)) (test (parse '(lambda (x y z) z))
(make-Top (make-Prefix '()) (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)) (test (parse '(lambda (x y z) x y z))
(make-Top (make-Prefix '()) (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 1 #f)
(make-LocalRef 2 #f))) (make-LocalRef 2 #f)))
'() '()
@ -140,7 +140,7 @@
(test (parse '(lambda (x y z) k)) (test (parse '(lambda (x y z) k))
(make-Top (make-Prefix '(k)) (make-Top (make-Prefix '(k))
(make-Lam #f (make-Lam 'unknown
3 3
#f #f
(make-ToplevelRef 0 0 ) (make-ToplevelRef 0 0 )
@ -149,7 +149,7 @@
(test (parse '(lambda (x y z) k x y z)) (test (parse '(lambda (x y z) k x y z))
(make-Top (make-Prefix '(k)) (make-Top (make-Prefix '(k))
(make-Lam #f (make-Lam 'unknown
3 3
#f #f
(make-Seq (list (make-ToplevelRef 0 0 ) (make-Seq (list (make-ToplevelRef 0 0 )
@ -167,9 +167,9 @@
z z
w)))) w))))
(make-Top (make-Prefix '(w)) (make-Top (make-Prefix '(w))
(make-Lam #f 1 #f (make-Lam 'unknown 1 #f
(make-Lam #f 1 #f (make-Lam 'unknown 1 #f
(make-Lam #f 1 #f (make-Lam 'unknown 1 #f
(make-Seq (list (make-Seq (list
(make-LocalRef 1 #f) (make-LocalRef 1 #f)
(make-LocalRef 2 #f) (make-LocalRef 2 #f)
@ -187,8 +187,8 @@
(lambda (y) (lambda (y)
x))) x)))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-Lam #f 1 #f (make-Lam 'unknown 1 #f
(make-Lam #f 1 #f (make-Lam 'unknown 1 #f
(make-LocalRef 0 #f) (make-LocalRef 0 #f)
'(0) '(0)
'lamEntry1) 'lamEntry1)
@ -199,8 +199,8 @@
(lambda (y) (lambda (y)
y))) y)))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-Lam #f 1 #f (make-Lam 'unknown 1 #f
(make-Lam #f 1 #f (make-Lam 'unknown 1 #f
(make-LocalRef 0 #f) (make-LocalRef 0 #f)
(list) (list)
'lamEntry1) 'lamEntry1)
@ -217,7 +217,7 @@
(test (parse '(lambda (x) (+ x x))) (test (parse '(lambda (x) (+ x x)))
(make-Top (make-Prefix `(,(make-ModuleVariable '+ '#%kernel))) (make-Top (make-Prefix `(,(make-ModuleVariable '+ '#%kernel)))
(make-Lam #f 1 #f (make-Lam 'unknown 1 #f
(make-App (make-ToplevelRef 2 0) (make-App (make-ToplevelRef 2 0)
(list (make-LocalRef 3 #f) (list (make-LocalRef 3 #f)
(make-LocalRef 3 #f))) (make-LocalRef 3 #f)))
@ -228,7 +228,7 @@
(+ (* x x) x))) (+ (* x x) x)))
(make-Top (make-Prefix `(,(make-ModuleVariable '* '#%kernel) (make-Top (make-Prefix `(,(make-ModuleVariable '* '#%kernel)
,(make-ModuleVariable '+ '#%kernel))) ,(make-ModuleVariable '+ '#%kernel)))
(make-Lam #f 1 #f (make-Lam 'unknown 1 #f
;; stack layout: [???, ???, prefix, x] ;; stack layout: [???, ???, prefix, x]
(make-App (make-ToplevelRef 2 1) (make-App (make-ToplevelRef 2 1)
(list (list
@ -414,7 +414,7 @@
(make-Top (make-Prefix `(,(make-ModuleVariable 'add1 '#%kernel))) (make-Top (make-Prefix `(,(make-ModuleVariable 'add1 '#%kernel)))
(make-Let1 (make-Constant 0) (make-Let1 (make-Constant 0)
(make-BoxEnv 0 (make-BoxEnv 0
(make-Lam #f 0 #f (make-Lam 'unknown 0 #f
(make-Seq (list (make-InstallValue (make-Seq (list (make-InstallValue
1 1 1 1
(make-App (make-ToplevelRef 1 0) (make-App (make-ToplevelRef 1 0)
@ -435,7 +435,7 @@
(make-Seq (list (make-Seq (list
(make-InstallValue 1 0 (make-Constant 0) #t) (make-InstallValue 1 0 (make-Constant 0) #t)
(make-InstallValue 1 1 (make-Constant 1) #t) (make-InstallValue 1 1 (make-Constant 1) #t)
(make-Lam #f 0 #f (make-Lam 'unknown 0 #f
(make-Seq (make-Seq
(list (make-InstallValue (list (make-InstallValue
1 1 1 1
@ -524,14 +524,14 @@
;; CaseLam ;; CaseLam
(test (parse '(case-lambda)) (test (parse '(case-lambda))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-CaseLam #f (list) 'lamEntry1))) (make-CaseLam 'unknown (list) 'lamEntry1)))
(test (parse '(case-lambda [(x) x])) (test (parse '(case-lambda [(x) x]))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-CaseLam (make-CaseLam
#f 'unknown
(list (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)) (list (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) '() 'lamEntry2))
'lamEntry1))) 'lamEntry1)))
@ -539,18 +539,18 @@
[(x y) x])) [(x y) x]))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-CaseLam (make-CaseLam
#f 'unknown
(list (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry2) (list (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)
(make-Lam #f 2 #f (make-LocalRef 0 #f) '() 'lamEntry3)) (make-Lam 'unknown 2 #f (make-LocalRef 0 #f) '() 'lamEntry3))
'lamEntry1))) 'lamEntry1)))
(test (parse '(case-lambda [(x) x] (test (parse '(case-lambda [(x) x]
[(x y) y])) [(x y) y]))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-CaseLam (make-CaseLam
#f 'unknown
(list (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry2) (list (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)
(make-Lam #f 2 #f (make-LocalRef 1 #f) '() 'lamEntry3)) (make-Lam 'unknown 2 #f (make-LocalRef 1 #f) '() 'lamEntry3))
'lamEntry1))) 'lamEntry1)))
@ -558,8 +558,8 @@
[(x) x])) [(x) x]))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-CaseLam (make-CaseLam
#f 'unknown
(list (make-Lam #f 2 #f (make-LocalRef 1 #f) '() 'lamEntry2) (list (make-Lam 'unknown 2 #f (make-LocalRef 1 #f) '() 'lamEntry2)
(make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry3)) (make-Lam 'unknown 1 #f (make-LocalRef 0 #f) '() 'lamEntry3))
'lamEntry1))) 'lamEntry1)))