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

about to write the unsplicing code.

Browse Source
This commit is contained in:
Danny Yoo 2011-04-11 15:26:10 -04:00
parent f76bec0d13
commit c67fe8ab31
3 changed files with 102 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
compile.rkt
View File

@ -116,9 +116,10 @@
(append (map (lambda: ([d : Natural]) (append (map (lambda: ([d : Natural])
(list-ref cenv d)) (list-ref cenv d))
(Lam-closure-map lam)) (Lam-closure-map lam))
(build-list (Lam-num-parameters lam) (lambda: ([i : Natural]) '?)))) (build-list (if (Lam-rest? lam)
(add1 (Lam-num-parameters lam))
(Lam-num-parameters lam))
(lambda: ([i : Natural]) '?))))
@ -338,7 +339,9 @@
`(,(make-AssignPrimOpStatement `(,(make-AssignPrimOpStatement
target target
(make-MakeCompiledProcedure (Lam-entry-label exp) (make-MakeCompiledProcedure (Lam-entry-label exp)
(Lam-num-parameters exp) (if (Lam-rest? exp)
(make-ArityAtLeast (Lam-num-parameters exp))
(Lam-num-parameters exp))
(Lam-closure-map exp) (Lam-closure-map exp)
(Lam-name exp))))))) (Lam-name exp)))))))
@ -354,7 +357,9 @@
`(,(make-AssignPrimOpStatement `(,(make-AssignPrimOpStatement
target target
(make-MakeCompiledProcedureShell (Lam-entry-label exp) (make-MakeCompiledProcedureShell (Lam-entry-label exp)
(Lam-num-parameters exp) (if (Lam-rest? exp)
(make-ArityAtLeast (Lam-num-parameters exp))
(Lam-num-parameters exp))
(Lam-name exp))))))) (Lam-name exp)))))))
@ -362,22 +367,29 @@
;; Compiles the body of the lambda in the appropriate environment. ;; Compiles the body of the lambda in the appropriate environment.
;; Closures will target their value to the 'val register, and use return linkage. ;; Closures will target their value to the 'val register, and use return linkage.
(define (compile-lambda-body exp cenv) (define (compile-lambda-body exp cenv)
(append-instruction-sequences (let: ([maybe-unsplice-rest-argument : InstructionSequence
(if (Lam-rest? exp)
(make-instruction-sequence ;; FIXME: we may need to unsplice the rest argument if this lambda is a rest
`(,(Lam-entry-label exp))) (error 'fixme)
empty-instruction-sequence)]
(if (not (empty? (Lam-closure-map exp))) [maybe-install-closure-values : InstructionSequence
(make-instruction-sequence `(,(make-PerformStatement (make-InstallClosureValues!)))) (if (not (empty? (Lam-closure-map exp)))
empty-instruction-sequence) (make-instruction-sequence
`(,(make-PerformStatement (make-InstallClosureValues!))))
(compile (Lam-body exp) empty-instruction-sequence)]
(append (map (lambda: ([d : Natural]) [lam-body-code : InstructionSequence
(list-ref cenv d)) (compile (Lam-body exp)
(Lam-closure-map exp)) (extract-lambda-cenv exp cenv)
(build-list (Lam-num-parameters exp) (lambda: ([i : Natural]) '?))) 'val
'val return-linkage)])
return-linkage)))
(append-instruction-sequences
(make-instruction-sequence
`(,(Lam-entry-label exp)))
maybe-unsplice-rest-argument
maybe-install-closure-values
lam-body-code)))

46
parse.rkt
View File

@ -183,12 +183,20 @@
(parse b body-cenv #f)) (parse b body-cenv #f))
(lambda-body exp))) (lambda-body exp)))
mutated-parameters)]) mutated-parameters)])
(make-Lam (current-defined-name) (cond [(lambda-has-rest-parameter? exp)
(length (lambda-parameters exp)) (make-Lam (current-defined-name)
#f (sub1 (length (lambda-parameters exp)))
lam-body #t
(map env-reference-depth closure-references) lam-body
(fresh-lam-label))))) (map env-reference-depth closure-references)
(fresh-lam-label))]
[else
(make-Lam (current-defined-name)
(length (lambda-parameters exp))
#f
lam-body
(map env-reference-depth closure-references)
(fresh-lam-label))]))))
(define lam-label-counter 0) (define lam-label-counter 0)
@ -378,7 +386,31 @@
(define (lambda? exp) (define (lambda? exp)
(tagged-list? exp 'lambda)) (tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
;; lambda-parameters: lambda-expression -> (listof identifier)
(define (lambda-parameters exp)
(let loop ([params (cadr exp)])
(cond
[(null? params)
empty]
[(pair? params)
(cons (car params)
(loop (cdr params)))]
[else
(list params)])))
;; Produces true if the lambda's last parameter is a rest parameter.
(define (lambda-has-rest-parameter? exp)
(let loop ([params (cadr exp)])
(cond
[(null? params)
#f]
[(pair? params)
(loop (cdr params))]
[else
#t])))
(define (lambda-body exp) (cddr exp)) (define (lambda-body exp) (cddr exp))
(define (make-lambda parameters body) (define (make-lambda parameters body)

30
test-parse.rkt
View File

@ -87,6 +87,36 @@
(make-ToplevelRef 0 1) (make-ToplevelRef 0 1)
(make-Constant "ok")))) (make-Constant "ok"))))
(test (parse '(lambda () x))
(make-Top (make-Prefix '(x))
(make-Lam #f 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)
'() 'lamEntry1)))
(test (parse '(lambda (x y . z) x))
(make-Top (make-Prefix '())
(make-Lam #f 2 #t
(make-LocalRef 0 #f)
'() 'lamEntry1)))
(test (parse '(lambda (x y . z) y))
(make-Top (make-Prefix '())
(make-Lam #f 2 #t
(make-LocalRef 1 #f)
'() 'lamEntry1)))
(test (parse '(lambda (x y . z) z))
(make-Top (make-Prefix '())
(make-Lam #f 2 #t
(make-LocalRef 2 #f)
'() '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 #f 3 #f (make-LocalRef 0 #f) '() 'lamEntry1)))