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))
(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))]
[checked-operands : (Listof String)
(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)]
[expected-operand-types : (Listof OperandDomain)]

6
parse.rkt
View File

@ -629,7 +629,7 @@
(append (find-mutated-names body)
(apply append (map find-mutated-names rhss))))))
(let ([new-cenv (extend-lexical-environment/names cenv
(reverse vars)
vars
(build-list n (lambda (i) #f)))])
;; 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
@ -642,12 +642,12 @@
(parse `(begin ,@body) new-cenv #f))
#f))]
[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)
(seq (append
(map (lambda (var rhs index)
(make-InstallValue 1
(- n 1 index)
index
(parameterize ([current-defined-name var])
(parse rhs new-cenv #f))
#t))

16
test-parse.rkt
View File

@ -333,9 +333,9 @@
(make-Top (make-Prefix '())
(make-LetVoid 3
(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 'c 0 #f (make-App (make-LocalRef 0 #f) '()) '(2) 'lamEntry3))
(make-App (make-LocalRef 2 #f) '()))
(make-Lam 'b 0 #f (make-App (make-LocalRef 0 #f) '()) '(2) 'lamEntry2)
(make-Lam 'c 0 #f (make-App (make-LocalRef 0 #f) '()) '(0) 'lamEntry3))
(make-App (make-LocalRef 0 #f) '()))
#f)))
@ -348,17 +348,17 @@
(make-LetVoid 2
(make-Seq
(list
(make-InstallValue 1 1
(make-InstallValue 1 0
(make-Lam 'x 1 #f (make-LocalRef 0 #f) '() 'lamEntry1)
#t)
(make-InstallValue 1 0
(make-InstallValue 1 1
(make-Lam 'y 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)
#t)
;; 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-App (make-LocalRef 2 #t)
(list (make-LocalRef 1 #t)))))))
(make-App (make-LocalRef 1 #t)
(list (make-LocalRef 2 #t)))))))
#t)))