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

passing test cases again

Browse Source
This commit is contained in:
Danny Yoo 2011-05-12 15:43:01 -04:00
parent d7d4abec59
commit 5132e3dbc2
4 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
assemble-open-coded.rkt
View File

@ -13,7 +13,7 @@
(: open-code-kernel-primitive-procedure (CallKernelPrimitiveProcedure -> String)) (: open-code-kernel-primitive-procedure (CallKernelPrimitiveProcedure -> String))
(define (open-code-kernel-primitive-procedure op) (define (open-code-kernel-primitive-procedure op)
(let*: ([operator : KernelPrimitiveName (CallKernelPrimitiveProcedure-operator op)] (let*: ([operator : KernelPrimitiveName/Inline (CallKernelPrimitiveProcedure-operator op)]
[operands : (Listof String) (map assemble-oparg (CallKernelPrimitiveProcedure-operands op))] [operands : (Listof String) (map assemble-oparg (CallKernelPrimitiveProcedure-operands op))]
[checked-operands : (Listof String) [checked-operands : (Listof String)
(map (lambda: ([dom : OperandDomain] (map (lambda: ([dom : OperandDomain]

2
il-structs.rkt
View File

@ -252,7 +252,7 @@
(define-struct: CallKernelPrimitiveProcedure ([operator : KernelPrimitiveName] (define-struct: CallKernelPrimitiveProcedure ([operator : KernelPrimitiveName/Inline]
[operands : (Listof OpArg)] [operands : (Listof OpArg)]
[expected-operand-types : (Listof OperandDomain)] [expected-operand-types : (Listof OperandDomain)]

6
parse.rkt
View File

@ -629,7 +629,7 @@
(append (find-mutated-names body) (append (find-mutated-names body)
(apply append (map find-mutated-names rhss)))))) (apply append (map find-mutated-names rhss))))))
(let ([new-cenv (extend-lexical-environment/names cenv (let ([new-cenv (extend-lexical-environment/names cenv
(reverse vars) vars
(build-list n (lambda (i) #f)))]) (build-list n (lambda (i) #f)))])
;; Semantics: allocate a closure shell for each lambda form in procs. ;; Semantics: allocate a closure shell for each lambda form in procs.
;; Install them in reverse order, so that the closure shell for the last element ;; Install them in reverse order, so that the closure shell for the last element
@ -642,12 +642,12 @@
(parse `(begin ,@body) new-cenv #f)) (parse `(begin ,@body) new-cenv #f))
#f))] #f))]
[else [else
(let ([new-cenv (extend-lexical-environment/boxed-names cenv (reverse vars))]) (let ([new-cenv (extend-lexical-environment/boxed-names cenv vars)])
(make-LetVoid (length vars) (make-LetVoid (length vars)
(seq (append (seq (append
(map (lambda (var rhs index) (map (lambda (var rhs index)
(make-InstallValue 1 (make-InstallValue 1
(- n 1 index) index
(parameterize ([current-defined-name var]) (parameterize ([current-defined-name var])
(parse rhs new-cenv #f)) (parse rhs new-cenv #f))
#t)) #t))

16
test-parse.rkt
View File

@ -333,9 +333,9 @@
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-LetVoid 3 (make-LetVoid 3
(make-LetRec (list (make-Lam 'a 0 #f (make-App (make-LocalRef 0 #f) '()) '(1) 'lamEntry1) (make-LetRec (list (make-Lam 'a 0 #f (make-App (make-LocalRef 0 #f) '()) '(1) 'lamEntry1)
(make-Lam 'b 0 #f (make-App (make-LocalRef 0 #f) '()) '(0) 'lamEntry2) (make-Lam 'b 0 #f (make-App (make-LocalRef 0 #f) '()) '(2) 'lamEntry2)
(make-Lam 'c 0 #f (make-App (make-LocalRef 0 #f) '()) '(2) 'lamEntry3)) (make-Lam 'c 0 #f (make-App (make-LocalRef 0 #f) '()) '(0) 'lamEntry3))
(make-App (make-LocalRef 2 #f) '())) (make-App (make-LocalRef 0 #f) '()))
#f))) #f)))
@ -348,17 +348,17 @@
(make-LetVoid 2 (make-LetVoid 2
(make-Seq (make-Seq
(list (list
(make-InstallValue 1 1 (make-InstallValue 1 0
(make-Lam 'x 1 #f (make-LocalRef 0 #f) '() 'lamEntry1) (make-Lam 'x 1 #f (make-LocalRef 0 #f) '() 'lamEntry1)
#t) #t)
(make-InstallValue 1 0 (make-InstallValue 1 1
(make-Lam 'y 1 #f (make-LocalRef 0 #f) '() 'lamEntry2) (make-Lam 'y 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)
#t) #t)
;; stack layout: ??? x y ;; stack layout: ??? x y
(make-Seq (list (make-Seq (list (make-InstallValue 1 1 (make-LocalRef 1 #t) #t) (make-Seq (list (make-Seq (list (make-InstallValue 1 0 (make-LocalRef 0 #t) #t)
(make-Constant (void)))) (make-Constant (void))))
(make-App (make-LocalRef 2 #t) (make-App (make-LocalRef 1 #t)
(list (make-LocalRef 1 #t))))))) (list (make-LocalRef 2 #t)))))))
#t))) #t)))