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

9
il-structs.rkt
View File

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

5
parameters.rkt
View File

@ -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))
(: current-defined-name (Parameterof (U Symbol LamPositionalName)))
(define current-defined-name (make-parameter 'unknown))

5
simulator-structs.rkt
View File

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

1
simulator.rkt
View File

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

68
test-parse.rkt
View File

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