toplevelref remembers if it's a constant or not
This commit is contained in:
Danny Yoo
parent
875f270aa6
commit
b573d0b762
|
|
@ -13,6 +13,8 @@
|
|||
racket/match
|
||||
racket/bool
|
||||
racket/list)
|
||||
(require/typed "../logger.rkt"
|
||||
[log-debug (String -> Void)])
|
||||
|
||||
(provide (rename-out [-compile compile])
|
||||
compile-general-procedure-call
|
||||
|
|
@ -1678,6 +1680,8 @@
|
|||
entry)]
|
||||
|
||||
[(ToplevelRef? exp)
|
||||
(when (ToplevelRef-constant? exp)
|
||||
(log-debug (format "toplevel reference ~a should be known constant" exp)))
|
||||
(let: ([name : (U Symbol False GlobalBucket ModuleVariable)
|
||||
(list-ref (Prefix-names (ensure-prefix (list-ref cenv (ToplevelRef-depth exp))))
|
||||
(ToplevelRef-pos exp))])
|
||||
|
|
@ -2202,6 +2206,7 @@
|
|||
exp
|
||||
(make-ToplevelRef (ensure-natural (- (ToplevelRef-depth exp) n))
|
||||
(ToplevelRef-pos exp)
|
||||
(ToplevelRef-constant? exp)
|
||||
(ToplevelRef-check-defined? exp)))]
|
||||
|
||||
[(LocalRef? exp)
|
||||
|
|
|
|||
|
|
@ -56,6 +56,7 @@
|
|||
|
||||
(define-struct: ToplevelRef ([depth : Natural]
|
||||
[pos : Natural]
|
||||
[constant? : Boolean]
|
||||
[check-defined? : Boolean]) #:transparent)
|
||||
|
||||
(define-struct: LocalRef ([depth : Natural]
|
||||
|
|
|
|||
|
|
@ -428,6 +428,7 @@
|
|||
(make-VariableReference
|
||||
(make-ToplevelRef (ensure-natural (+ n (ToplevelRef-depth t)))
|
||||
(ToplevelRef-pos t)
|
||||
(ToplevelRef-constant? t)
|
||||
(ToplevelRef-check-defined? t))))]))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -88,6 +88,7 @@
|
|||
[(EnvPrefixReference? address)
|
||||
(make-ToplevelRef (EnvPrefixReference-depth address)
|
||||
(EnvPrefixReference-pos address)
|
||||
#f
|
||||
#t)]))]
|
||||
|
||||
[(define-values? exp)
|
||||
|
|
|
|||
|
|
@ -661,10 +661,10 @@
|
|||
;; FIXME: we should also keep track of const? and ready? to produce better code, and to
|
||||
;; do the required runtime checks when necessary (const?=#f, ready?=#f)
|
||||
[(struct toplevel (depth pos const? ready?))
|
||||
(make-ToplevelRef depth pos (if (and (not const?)
|
||||
(not ready?))
|
||||
#t
|
||||
#f))]))
|
||||
(make-ToplevelRef depth pos const?
|
||||
(if (and (not const?) (not ready?))
|
||||
#t
|
||||
#f))]))
|
||||
|
||||
|
||||
(define (parse-topsyntax expr)
|
||||
|
|
|
|||
|
|
@ -663,10 +663,12 @@
|
|||
;; FIXME: we should also keep track of const? and ready? to produce better code, and to
|
||||
;; do the required runtime checks when necessary (const?=#f, ready?=#f)
|
||||
[(struct toplevel (depth pos const? ready?))
|
||||
(make-ToplevelRef depth pos (if (and (not const?)
|
||||
(not ready?))
|
||||
#t
|
||||
#f))]))
|
||||
(make-ToplevelRef depth
|
||||
pos
|
||||
const?
|
||||
(if (and (not const?) (not ready?))
|
||||
#t
|
||||
#f))]))
|
||||
|
||||
|
||||
(define (parse-topsyntax expr)
|
||||
|
|
|
|||
|
|
@ -65,16 +65,16 @@
|
|||
;; global variables
|
||||
(check-equal? (run-my-parse #'x)
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'x)))
|
||||
(make-ToplevelRef 0 0 #t)))
|
||||
(make-ToplevelRef 0 0 #f #t)))
|
||||
|
||||
|
||||
|
||||
(check-equal? (run-my-parse #'(begin (define x 3)
|
||||
x))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'x)))
|
||||
(make-Splice (list (make-DefValues (list (make-ToplevelRef 0 0 #t))
|
||||
(make-Splice (list (make-DefValues (list (make-ToplevelRef 0 0 #f #t))
|
||||
(make-Constant 3))
|
||||
(make-ToplevelRef 0 0 #t)))))
|
||||
(make-ToplevelRef 0 0 #f #t)))))
|
||||
|
||||
|
||||
;; Lambdas
|
||||
|
|
@ -119,15 +119,15 @@
|
|||
(check-equal? (run-my-parse #'(let ([y (f)])
|
||||
'ok))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'f)))
|
||||
(make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 1 0 #f #t) (list))
|
||||
(make-Constant 'ok))))
|
||||
|
||||
(check-equal? (run-my-parse #'(let ([y (f)]
|
||||
[z (g)])
|
||||
'ok))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-GlobalBucket 'g)))
|
||||
(make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 2 1 #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 1 0 #f #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 2 1 #f #t) (list))
|
||||
(make-Constant 'ok)))))
|
||||
|
||||
(check-equal? (run-my-parse #'(let* ([y (f)]
|
||||
|
|
@ -135,8 +135,8 @@
|
|||
y
|
||||
z))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-GlobalBucket 'g)))
|
||||
(make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 2 1 #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 1 0 #f #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 2 1 #f #t) (list))
|
||||
;; racket's compiler optimizes away the sequence and lookup to y.
|
||||
#;(make-Seq (list (make-LocalRef 1 #f)
|
||||
(make-LocalRef 0 #f)))
|
||||
|
|
@ -149,8 +149,8 @@
|
|||
y
|
||||
z))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-GlobalBucket 'g)))
|
||||
(make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 2 1 #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 1 0 #f #t) (list))
|
||||
(make-Let1 (make-App (make-ToplevelRef 2 1 #f #t) (list))
|
||||
(make-LocalRef 0 #f)))))
|
||||
|
||||
|
||||
|
|
@ -161,15 +161,15 @@
|
|||
(make-Top (make-Prefix (list (make-GlobalBucket 'f)
|
||||
(make-GlobalBucket 'g)
|
||||
(make-GlobalBucket 'h)))
|
||||
(make-Branch (make-App (make-ToplevelRef 0 0 #t) '())
|
||||
(make-App (make-ToplevelRef 0 1 #t) '())
|
||||
(make-App (make-ToplevelRef 0 2 #t) '()))))
|
||||
(make-Branch (make-App (make-ToplevelRef 0 0 #f #t) '())
|
||||
(make-App (make-ToplevelRef 0 1 #f #t) '())
|
||||
(make-App (make-ToplevelRef 0 2 #f #t) '()))))
|
||||
|
||||
|
||||
;; Another example where Racket's compiler is helping: constant propagation, dead code removal.
|
||||
(check-equal? (run-my-parse #'(if 3 (g) (h)))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'g)))
|
||||
(make-App (make-ToplevelRef 0 0 #t) '())))
|
||||
(make-App (make-ToplevelRef 0 0 #f #t) '())))
|
||||
|
||||
|
||||
|
||||
|
|
@ -178,9 +178,9 @@
|
|||
(make-Top (make-Prefix (list (make-GlobalBucket 'x)
|
||||
(make-GlobalBucket 'y)
|
||||
(make-GlobalBucket 'z)))
|
||||
(make-Branch (make-ToplevelRef 0 0 #t)
|
||||
(make-Branch (make-ToplevelRef 0 1 #t)
|
||||
(make-ToplevelRef 0 2 #t)
|
||||
(make-Branch (make-ToplevelRef 0 0 #f #t)
|
||||
(make-Branch (make-ToplevelRef 0 1 #f #t)
|
||||
(make-ToplevelRef 0 2 #f #t)
|
||||
(make-Constant 1))
|
||||
(make-Constant #t))))
|
||||
|
||||
|
|
@ -188,8 +188,8 @@
|
|||
(check-equal? (run-my-parse #'(cond [x y]))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'x)
|
||||
(make-GlobalBucket 'y)))
|
||||
(make-Branch (make-ToplevelRef 0 0 #t)
|
||||
(make-ToplevelRef 0 1 #t)
|
||||
(make-Branch (make-ToplevelRef 0 0 #f #t)
|
||||
(make-ToplevelRef 0 1 #f #t)
|
||||
(make-Constant (void)))))
|
||||
|
||||
|
||||
|
|
@ -204,9 +204,9 @@
|
|||
(make-Top (make-Prefix (list (make-GlobalBucket 'x)))
|
||||
(make-App (make-PrimitiveKernelValue '+)
|
||||
(list (make-App (make-PrimitiveKernelValue '*)
|
||||
(list (make-ToplevelRef 4 0 #t)
|
||||
(make-ToplevelRef 4 0 #t)))
|
||||
(make-ToplevelRef 2 0 #t)))))
|
||||
(list (make-ToplevelRef 4 0 #f #t)
|
||||
(make-ToplevelRef 4 0 #f #t)))
|
||||
(make-ToplevelRef 2 0 #f #t)))))
|
||||
|
||||
(check-equal? (run-my-parse #'list)
|
||||
(make-Top (make-Prefix (list))
|
||||
|
|
@ -219,7 +219,7 @@
|
|||
|
||||
(check-equal? (run-my-parse #'(let () x))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'x)))
|
||||
(make-ToplevelRef 0 0 #t)))
|
||||
(make-ToplevelRef 0 0 #f #t)))
|
||||
|
||||
|
||||
|
||||
|
|
@ -276,8 +276,8 @@
|
|||
(check-equal? (run-my-parse #'(call-with-values (lambda () (f)) g))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'f)
|
||||
(make-GlobalBucket 'g)))
|
||||
(make-ApplyValues (make-ToplevelRef 0 1 #t)
|
||||
(make-App (make-ToplevelRef 0 0 #t) '()))))
|
||||
(make-ApplyValues (make-ToplevelRef 0 1 #f #t)
|
||||
(make-App (make-ToplevelRef 0 0 #f #t) '()))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -325,13 +325,13 @@
|
|||
|
||||
(check-equal? (run-my-parse #'(begin0 (f)))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'f)))
|
||||
(make-App (make-ToplevelRef 0 0 #t) '())))
|
||||
(make-App (make-ToplevelRef 0 0 #f #t) '())))
|
||||
|
||||
(check-equal? (run-my-parse #'(begin0 (f) (g)))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'f)
|
||||
(make-GlobalBucket 'g)))
|
||||
(make-Begin0 (list (make-App (make-ToplevelRef 0 0 #t) '())
|
||||
(make-App (make-ToplevelRef 0 1 #t) '())))))
|
||||
(make-Begin0 (list (make-App (make-ToplevelRef 0 0 #f #t) '())
|
||||
(make-App (make-ToplevelRef 0 1 #f #t) '())))))
|
||||
|
||||
|
||||
;; Compiling modules
|
||||
|
|
@ -345,7 +345,7 @@
|
|||
_ ;; requires
|
||||
_ ;; provides
|
||||
(struct Splice ((list (struct ApplyValues
|
||||
((struct ToplevelRef ('0 '0 _)) (struct Constant ('42)))))))))))
|
||||
((struct ToplevelRef ('0 '0 _ _)) (struct Constant ('42)))))))))))
|
||||
#t]))
|
||||
|
||||
|
||||
|
|
@ -360,7 +360,7 @@
|
|||
_ ;; requires
|
||||
_ ;; provides
|
||||
(struct Splice ((list (struct DefValues
|
||||
((list (struct ToplevelRef ('0 '0 _)))
|
||||
((list (struct ToplevelRef ('0 '0 _ _)))
|
||||
(struct Constant ("x")))))))))))
|
||||
#t]))
|
||||
|
||||
|
|
@ -370,7 +370,7 @@
|
|||
;; Variable reference
|
||||
(check-equal? (run-my-parse #'(#%variable-reference x))
|
||||
(make-Top (make-Prefix (list (make-GlobalBucket 'x)))
|
||||
(make-VariableReference (make-ToplevelRef 0 0 #t))))
|
||||
(make-VariableReference (make-ToplevelRef 0 0 #f #t))))
|
||||
|
||||
;; todo: see what it would take to run a typed/racket/base language.
|
||||
(void
|
||||
|
|
@ -441,7 +441,7 @@
|
|||
(struct Prefix ((list 'f)))
|
||||
(list (struct ModuleLocator ('#%kernel '#%kernel)))
|
||||
_
|
||||
(struct Splice ((list (struct DefValues ((list (struct ToplevelRef (0 0 #t)))
|
||||
(struct Splice ((list (struct DefValues ((list (struct ToplevelRef (0 0 _ #t)))
|
||||
(struct Constant ('ok)))))))))))
|
||||
'#t]))
|
||||
|
||||
|
|
|
|||
|
|
@ -41,58 +41,58 @@
|
|||
|
||||
(test (parse 'hello)
|
||||
(make-Top (make-Prefix '(hello))
|
||||
(make-ToplevelRef 0 0 #t)))
|
||||
(make-ToplevelRef 0 0 #f #t)))
|
||||
|
||||
(test (parse '(begin hello world))
|
||||
(make-Top (make-Prefix '(hello world))
|
||||
(make-Splice (list (make-ToplevelRef 0 0 #t)
|
||||
(make-ToplevelRef 0 1 #t)))))
|
||||
(make-Splice (list (make-ToplevelRef 0 0 #f #t)
|
||||
(make-ToplevelRef 0 1 #f #t)))))
|
||||
|
||||
(test (parse '(define x y))
|
||||
(make-Top (make-Prefix '(x y))
|
||||
(make-ToplevelSet 0 0 (make-ToplevelRef 0 1 #t))))
|
||||
(make-ToplevelSet 0 0 (make-ToplevelRef 0 1 #f #t))))
|
||||
|
||||
(test (parse '(begin (define x 42)
|
||||
(define y x)))
|
||||
(make-Top (make-Prefix '(x y))
|
||||
(make-Splice (list (make-ToplevelSet 0 0 (make-Constant 42))
|
||||
(make-ToplevelSet 0 1 (make-ToplevelRef 0 0 #t))))))
|
||||
(make-ToplevelSet 0 1 (make-ToplevelRef 0 0 #f #t))))))
|
||||
|
||||
(test (parse '(if x y z))
|
||||
(make-Top (make-Prefix '(x y z))
|
||||
(make-Branch (make-ToplevelRef 0 0 #t)
|
||||
(make-ToplevelRef 0 1 #t)
|
||||
(make-ToplevelRef 0 2 #t))))
|
||||
(make-Branch (make-ToplevelRef 0 0 #f #t)
|
||||
(make-ToplevelRef 0 1 #f #t)
|
||||
(make-ToplevelRef 0 2 #f #t))))
|
||||
|
||||
(test (parse '(if x (if y z 1) #t))
|
||||
(make-Top (make-Prefix '(x y z))
|
||||
(make-Branch (make-ToplevelRef 0 0 #t)
|
||||
(make-Branch (make-ToplevelRef 0 1 #t)
|
||||
(make-ToplevelRef 0 2 #t)
|
||||
(make-Branch (make-ToplevelRef 0 0 #f #t)
|
||||
(make-Branch (make-ToplevelRef 0 1 #f #t)
|
||||
(make-ToplevelRef 0 2 #f #t)
|
||||
(make-Constant 1))
|
||||
(make-Constant #t))))
|
||||
|
||||
(test (parse '(if x y))
|
||||
(make-Top (make-Prefix '(x y))
|
||||
(make-Branch (make-ToplevelRef 0 0 #t)
|
||||
(make-ToplevelRef 0 1 #t)
|
||||
(make-Branch (make-ToplevelRef 0 0 #f #t)
|
||||
(make-ToplevelRef 0 1 #f #t)
|
||||
(make-Constant (void)))))
|
||||
|
||||
(test (parse '(cond [x y]))
|
||||
(make-Top (make-Prefix '(x y))
|
||||
(make-Branch (make-ToplevelRef 0 0 #t)
|
||||
(make-ToplevelRef 0 1 #t)
|
||||
(make-Branch (make-ToplevelRef 0 0 #f #t)
|
||||
(make-ToplevelRef 0 1 #f #t)
|
||||
(make-Constant (void)))))
|
||||
|
||||
(test (parse '(cond [x y] [else "ok"]))
|
||||
(make-Top (make-Prefix '(x y))
|
||||
(make-Branch (make-ToplevelRef 0 0 #t)
|
||||
(make-ToplevelRef 0 1 #t)
|
||||
(make-Branch (make-ToplevelRef 0 0 #f #t)
|
||||
(make-ToplevelRef 0 1 #f #t)
|
||||
(make-Constant "ok"))))
|
||||
|
||||
(test (parse '(lambda () x))
|
||||
(make-Top (make-Prefix '(x))
|
||||
(make-Lam 'unknown 0 #f (make-ToplevelRef 0 0 #t)
|
||||
(make-Lam 'unknown 0 #f (make-ToplevelRef 0 0 #f #t)
|
||||
'(0) 'lamEntry1)))
|
||||
|
||||
(test (parse '(lambda args args))
|
||||
|
|
@ -146,7 +146,7 @@
|
|||
(make-Lam 'unknown
|
||||
3
|
||||
#f
|
||||
(make-ToplevelRef 0 0 #t)
|
||||
(make-ToplevelRef 0 0 #f #t)
|
||||
'(0)
|
||||
'lamEntry1)))
|
||||
|
||||
|
|
@ -155,7 +155,7 @@
|
|||
(make-Lam 'unknown
|
||||
3
|
||||
#f
|
||||
(make-Seq (list (make-ToplevelRef 0 0 #t)
|
||||
(make-Seq (list (make-ToplevelRef 0 0 #f #t)
|
||||
(make-LocalRef 1 #f)
|
||||
(make-LocalRef 2 #f)
|
||||
(make-LocalRef 3 #f)))
|
||||
|
|
@ -177,7 +177,7 @@
|
|||
(make-LocalRef 1 #f)
|
||||
(make-LocalRef 2 #f)
|
||||
(make-LocalRef 3 #f)
|
||||
(make-ToplevelRef 0 0 #t)))
|
||||
(make-ToplevelRef 0 0 #f #t)))
|
||||
'(0 1 2) ;; w x y
|
||||
'lamEntry1)
|
||||
|
||||
|
|
@ -213,15 +213,15 @@
|
|||
(test (parse '(+ x x))
|
||||
(make-Top (make-Prefix `(,(make-ModuleVariable '+ (make-ModuleLocator '#%kernel '#%kernel))
|
||||
x))
|
||||
(make-App (make-ToplevelRef 2 0 #t)
|
||||
(list (make-ToplevelRef 2 1 #t)
|
||||
(make-ToplevelRef 2 1 #t)))))
|
||||
(make-App (make-ToplevelRef 2 0 #f #t)
|
||||
(list (make-ToplevelRef 2 1 #f #t)
|
||||
(make-ToplevelRef 2 1 #f #t)))))
|
||||
|
||||
|
||||
(test (parse '(lambda (x) (+ x x)))
|
||||
(make-Top (make-Prefix `(,(make-ModuleVariable '+ (make-ModuleLocator '#%kernel '#%kernel))))
|
||||
(make-Lam 'unknown 1 #f
|
||||
(make-App (make-ToplevelRef 2 0 #t)
|
||||
(make-App (make-ToplevelRef 2 0 #f #t)
|
||||
(list (make-LocalRef 3 #f)
|
||||
(make-LocalRef 3 #f)))
|
||||
'(0)
|
||||
|
|
@ -233,10 +233,10 @@
|
|||
,(make-ModuleVariable '+ (make-ModuleLocator '#%kernel '#%kernel))))
|
||||
(make-Lam 'unknown 1 #f
|
||||
;; stack layout: [???, ???, prefix, x]
|
||||
(make-App (make-ToplevelRef 2 1 #t)
|
||||
(make-App (make-ToplevelRef 2 1 #f #t)
|
||||
(list
|
||||
;; stack layout: [???, ???, ???, ???, prefix, x]
|
||||
(make-App (make-ToplevelRef 4 0 #t)
|
||||
(make-App (make-ToplevelRef 4 0 #f #t)
|
||||
(list (make-LocalRef 5 #f)
|
||||
(make-LocalRef 5 #f)))
|
||||
(make-LocalRef 3 #f)))
|
||||
|
|
@ -246,7 +246,7 @@
|
|||
(test (parse '(let ()
|
||||
x))
|
||||
(make-Top (make-Prefix '(x))
|
||||
(make-ToplevelRef 0 0 #t)))
|
||||
(make-ToplevelRef 0 0 #f #t)))
|
||||
|
||||
(test (parse '(let ([x 3])
|
||||
x))
|
||||
|
|
@ -304,10 +304,10 @@
|
|||
(make-App
|
||||
|
||||
;; stack layout: [???, ???, x_0, prefix]
|
||||
(make-ToplevelRef 3 0 #t) (list (make-LocalRef 2 #f)))
|
||||
(make-ToplevelRef 3 0 #f #t) (list (make-LocalRef 2 #f)))
|
||||
|
||||
;; stack layout [???, x_1, x_0, prefix]
|
||||
(make-App (make-ToplevelRef 3 0 #t)
|
||||
(make-App (make-ToplevelRef 3 0 #f #t)
|
||||
(list (make-LocalRef 1 #f)))))))
|
||||
|
||||
|
||||
|
|
@ -424,7 +424,7 @@
|
|||
(make-Lam 'unknown 0 #f
|
||||
(make-Seq (list (make-InstallValue
|
||||
1 1
|
||||
(make-App (make-ToplevelRef 1 0 #t)
|
||||
(make-App (make-ToplevelRef 1 0 #f #t)
|
||||
(list (make-LocalRef 2 #t)))
|
||||
#t)
|
||||
(make-Constant (void))))
|
||||
|
|
@ -446,7 +446,7 @@
|
|||
(make-Seq
|
||||
(list (make-InstallValue
|
||||
1 1
|
||||
(make-App (make-ToplevelRef 1 0 #t)
|
||||
(make-App (make-ToplevelRef 1 0 #f #t)
|
||||
(list (make-LocalRef 2 #t)))
|
||||
#t)
|
||||
(make-Constant (void))))
|
||||
|
|
@ -483,42 +483,42 @@
|
|||
(make-Seq (list (make-ToplevelSet 0 1 (make-Constant '())) (make-Constant (void))))))
|
||||
'(0)
|
||||
'lamEntry1))
|
||||
(make-App (make-ToplevelRef 0 3 #t) '())
|
||||
(make-App (make-ToplevelRef 2 2 #t) (list (make-ToplevelRef 2 0 #t) (make-ToplevelRef 2 1 #t)))))))
|
||||
(make-App (make-ToplevelRef 0 3 #f #t) '())
|
||||
(make-App (make-ToplevelRef 2 2 #f #t) (list (make-ToplevelRef 2 0 #f #t) (make-ToplevelRef 2 1 #f #t)))))))
|
||||
|
||||
|
||||
|
||||
(test (parse '(with-continuation-mark x y z))
|
||||
(make-Top (make-Prefix '(x y z))
|
||||
(make-WithContMark (make-ToplevelRef 0 0 #t)
|
||||
(make-ToplevelRef 0 1 #t)
|
||||
(make-ToplevelRef 0 2 #t))))
|
||||
(make-WithContMark (make-ToplevelRef 0 0 #f #t)
|
||||
(make-ToplevelRef 0 1 #f #t)
|
||||
(make-ToplevelRef 0 2 #f #t))))
|
||||
|
||||
|
||||
|
||||
(test (parse '(call-with-values x y))
|
||||
(make-Top (make-Prefix '(x y))
|
||||
(make-ApplyValues (make-ToplevelRef 0 1 #t)
|
||||
(make-App (make-ToplevelRef 0 0 #t) (list)))))
|
||||
(make-ApplyValues (make-ToplevelRef 0 1 #f #t)
|
||||
(make-App (make-ToplevelRef 0 0 #f #t) (list)))))
|
||||
|
||||
(test (parse '(call-with-values (lambda () x) y))
|
||||
(make-Top (make-Prefix '(x y))
|
||||
(make-ApplyValues (make-ToplevelRef 0 1 #t)
|
||||
(make-ToplevelRef 0 0 #t))))
|
||||
(make-ApplyValues (make-ToplevelRef 0 1 #f #t)
|
||||
(make-ToplevelRef 0 0 #f #t))))
|
||||
|
||||
|
||||
|
||||
(test (parse '(define-values () (values)))
|
||||
(make-Top (make-Prefix '(values))
|
||||
(make-DefValues '()
|
||||
(make-App (make-ToplevelRef 0 0 #t) '()))))
|
||||
(make-App (make-ToplevelRef 0 0 #f #t) '()))))
|
||||
|
||||
(test (parse '(define-values (x y z) (values 'hello 'world 'testing)))
|
||||
(make-Top (make-Prefix '(values x y z))
|
||||
(make-DefValues (list (make-ToplevelRef 0 1 #t)
|
||||
(make-ToplevelRef 0 2 #t)
|
||||
(make-ToplevelRef 0 3 #t))
|
||||
(make-App (make-ToplevelRef 3 0 #t)
|
||||
(make-DefValues (list (make-ToplevelRef 0 1 #f #t)
|
||||
(make-ToplevelRef 0 2 #f #t)
|
||||
(make-ToplevelRef 0 3 #f #t))
|
||||
(make-App (make-ToplevelRef 3 0 #f #t)
|
||||
(list (make-Constant 'hello)
|
||||
(make-Constant 'world)
|
||||
(make-Constant 'testing))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user