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

trying to deal with cycles by eliminating them from our representation.

Browse Source
This commit is contained in:
Danny Yoo 2011-05-09 16:06:20 -04:00
parent 7aad5e2b33
commit e6968a596b
4 changed files with 137 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
compiler.rkt
View File

@ -33,7 +33,7 @@
;; Layout the lambda bodies...
(make-instruction-sequence
`(,(make-GotoStatement (make-Label after-lam-bodies))))
(compile-lambda-bodies (collect-all-lams exp))
(compile-lambda-bodies (collect-all-lambdas-with-bodies exp))
after-lam-bodies
;; Begin a prompted evaluation:
@ -55,9 +55,9 @@
(: collect-all-lams (Expression -> (Listof lam+cenv)))
(: collect-all-lambdas-with-bodies (Expression -> (Listof lam+cenv)))
;; Finds all the lambdas in the expression.
(define (collect-all-lams exp)
(define (collect-all-lambdas-with-bodies exp)
(let: loop : (Listof lam+cenv)
([exp : Expression exp]
[cenv : CompileTimeEnvironment '()])
@ -87,6 +87,9 @@
(loop lam cenv))
(CaseLam-clauses exp))))]
[(EmptyClosureReference? exp)
'()]
[(Seq? exp)
(apply append (map (lambda: ([e : Expression]) (loop e cenv))
(Seq-actions exp)))]
@ -173,6 +176,8 @@
(compile-lambda exp cenv target linkage)]
[(CaseLam? exp)
(compile-case-lambda exp cenv target linkage)]
[(EmptyClosureReference? exp)
(compile-empty-closure-reference exp cenv target linkage)]
[(Seq? exp)
(compile-sequence (Seq-actions exp)
cenv
@ -470,6 +475,25 @@
(Lam-name exp)))))
singular-context-check))))
(: compile-empty-closure-reference (EmptyClosureReference CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-empty-closure-reference exp cenv target linkage)
(let ([singular-context-check (emit-singular-context linkage)])
(end-with-linkage
linkage
cenv
(append-instruction-sequences
(make-instruction-sequence
`(,(make-AssignPrimOpStatement
target
(make-MakeCompiledProcedure (EmptyClosureReference-entry-label exp)
(EmptyClosureReference-arity exp)
empty
(EmptyClosureReference-name exp)))))
singular-context-check))))
(: compile-case-lambda (CaseLam CompileTimeEnvironment Target Linkage -> InstructionSequence))
;; Similar to compile-lambda.
(define (compile-case-lambda exp cenv target linkage)
@ -523,6 +547,15 @@
(Lam-num-parameters lam)))
(: EmptyClosureReference-arity (EmptyClosureReference -> Arity))
(define (EmptyClosureReference-arity lam)
(if (EmptyClosureReference-rest? lam)
(make-ArityAtLeast (EmptyClosureReference-num-parameters lam))
(EmptyClosureReference-num-parameters lam)))
(: shift-closure-map ((Listof Natural) Natural -> (Listof Natural)))
(define (shift-closure-map closure-map n)
(map (lambda: ([i : Natural]) (+ i n))
@ -1860,6 +1893,9 @@
(CaseLam-clauses exp))
(CaseLam-entry-label exp))]
[(EmptyClosureReference? exp)
exp]
[(Seq? exp)
(make-Seq (map (lambda: ([action : Expression])
(adjust-expression-depth action n skip))

12
expression-structs.rkt
View File

@ -12,8 +12,9 @@
LocalRef
ToplevelSet
Branch
CaseLam
Lam
CaseLam
EmptyClosureReference
Seq
Splice
App
@ -73,6 +74,15 @@
[closure-map : (Listof Natural)]
[entry-label : Symbol]) #:transparent)
;; An EmptyClosureReference has enough information to create the lambda value,
;; assuming that the lambda's body has already been compiled. The entry-label needs
;; to have been shared with an existing Lam, and the closure must be empty.
(define-struct: EmptyClosureReference ([name : (U Symbol LamPositionalName)]
[num-parameters : Natural]
[rest? : Boolean]
[entry-label : Symbol]) #:transparent)
;; We may have more information about the lambda's name. This will show it.
(define-struct: LamPositionalName ([name : Symbol]

113
parse-bytecode-5.1.1.rkt
View File

@ -30,14 +30,17 @@
(error 'current-module-path-index-resolver))))
;; seen-lambdas:
(define seen-lambdas (make-parameter (make-hasheq)))
;; seen-closures: (hashof symbol -> symbol)
;; As we're parsing, we watch for closure cycles. On any subsequent time where
;; we see a closure cycle, we break the cycle by generating an EmptyClosureReference.
;; The map is from the gen-id to the entry-point label of the lambda.
(define seen-closures (make-parameter (make-hasheq)))
;; parse-bytecode: Input-Port -> Expression
(define (parse-bytecode in)
(parameterize ([seen-lambdas (make-hasheq)])
(parameterize ([seen-closures (make-hasheq)])
(let ([compilation-top (zo-parse in)])
(parse-top compilation-top))))
@ -239,7 +242,7 @@
(define (parse-expr expr)
(cond
[(lam? expr)
(parse-lam expr)]
(parse-lam expr (make-label 'lamEntry))]
[(closure? expr)
(parse-closure expr)]
[(case-lam? expr)
@ -277,37 +280,16 @@
[(primval? expr)
(parse-primval expr)]))
(define (parse-lam expr)
(define (parse-lam expr entry-point-label)
(match expr
[(struct lam (name flags num-params param-types rest? closure-map closure-types max-let-depth body))
(let ([lam-name (cond
[(symbol? name)
name]
[(vector? name)
(match name
[(vector (and (? symbol?) sym)
(and (? path?) path)
(and (? number?) line)
(and (? number?) column)
(and (? number?) offset)
(and (? number?) span)
_)
(make-LamPositionalName sym
(path->string path)
line
column
offset
span)]
[else
(string->symbol (format "~s" name))])]
[else
(error "lam name neither symbol nor vector: ~e" name)])])
(let ([lam-name (extract-lam-name name)])
(make-Lam lam-name
num-params
rest?
(parse-lam-body body)
(vector->list closure-map)
(make-label 'lamEntry)))]))
entry-point-label))]))
(define (parse-lam-body body)
(cond
@ -319,12 +301,54 @@
(make-Constant body)]))
;; parse-closure: closure -> Expression
;; Either parses as a regular lambda, or if we come across the same closure twice,
;; breaks the cycle by creating an EmptyClosureReference with the pre-existing lambda
;; entry point.
(define (parse-closure expr)
(match expr
[(struct closure (code gen-id))
;; Fixme: we must handle cycles here.
(parse-lam code)]))
(let ([seen (seen-closures)])
(cond
[(hash-has-key? seen gen-id)
(match code
[(struct lam (name flags num-params param-types rest? closure-map closure-types max-let-depth body))
(let ([lam-name (extract-lam-name name)])
(make-EmptyClosureReference lam-name
num-params
rest?
(hash-ref seen gen-id)))])]
[else
(let ([fresh-entry-point (make-label 'lamEntry)])
(hash-set! seen gen-id fresh-entry-point)
(parse-lam code fresh-entry-point))]))]))
;; extract-lam-name: (U Symbol Vector) -> (U Symbol LamPositionalName)
(define (extract-lam-name name)
(cond
[(symbol? name)
name]
[(vector? name)
(match name
[(vector (and (? symbol?) sym)
(and (? path?) path)
(and (? number?) line)
(and (? number?) column)
(and (? number?) offset)
(and (? number?) span)
_)
(make-LamPositionalName sym
(path->string path)
line
column
offset
span)]
[else
(string->symbol (format "~s" name))])]
[else
(error "lam name neither symbol nor vector: ~e" name)]))
(define (parse-case-lam exp)
@ -363,8 +387,33 @@
(define (parse-topsyntax expr)
(error 'fixme))
(define (parse-application expr)
(error 'fixme))
(match expr
[(struct application (rator rands))
(make-App (parse-application-rator rator)
(map parse-application-rand rands))]))
(define (parse-application-rator rator)
(cond
[(expr? rator)
(parse-expr rator)]
[(seq? rator)
(parse-seq rator)]
[else
(make-Constant rator)]))
(define (parse-application-rand rand)
(cond
[(expr? rand)
(parse-expr rand)]
[(seq? rand)
(parse-seq rand)]
[else
(make-Constant rand)]))
(define (parse-branch expr)
(error 'fixme))

7
test-parse-bytecode-5.1.1.rkt
View File

@ -93,9 +93,14 @@
;; infinite loop
;; make sure we don't see an infinite loop
#;(run-zo-parse #'(letrec ([g (lambda () (g))])
(g)))
(void (run-my-parse #'(letrec ([g (lambda () (g))])
(g))))
#;(run-zo-parse #'(letrec ([g (lambda () (h))]
[h (lambda () (g))])
(g)))