From b573d0b76204d64d8de4d43bb603a5e45fa57f3f Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Sat, 30 Jul 2011 20:12:11 -0400 Subject: [PATCH] toplevelref remembers if it's a constant or not --- compiler/compiler.rkt | 7 ++- compiler/expression-structs.rkt | 1 + compiler/optimize-il.rkt | 1 + parser/baby-parser.rkt | 1 + parser/parse-bytecode-5.1.1.rkt | 8 +-- parser/parse-bytecode-5.1.2.rkt | 10 ++-- tests/test-parse-bytecode.rkt | 64 +++++++++++------------ tests/test-parse.rkt | 92 ++++++++++++++++----------------- 8 files changed, 97 insertions(+), 87 deletions(-) diff --git a/compiler/compiler.rkt b/compiler/compiler.rkt index 256c722..870484f 100644 --- a/compiler/compiler.rkt +++ b/compiler/compiler.rkt @@ -13,7 +13,9 @@ racket/match racket/bool racket/list) - +(require/typed "../logger.rkt" + [log-debug (String -> Void)]) + (provide (rename-out [-compile compile]) compile-general-procedure-call append-instruction-sequences) @@ -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) diff --git a/compiler/expression-structs.rkt b/compiler/expression-structs.rkt index 6002e31..d38ffe3 100644 --- a/compiler/expression-structs.rkt +++ b/compiler/expression-structs.rkt @@ -56,6 +56,7 @@ (define-struct: ToplevelRef ([depth : Natural] [pos : Natural] + [constant? : Boolean] [check-defined? : Boolean]) #:transparent) (define-struct: LocalRef ([depth : Natural] diff --git a/compiler/optimize-il.rkt b/compiler/optimize-il.rkt index 21307e0..c8cf883 100644 --- a/compiler/optimize-il.rkt +++ b/compiler/optimize-il.rkt @@ -428,6 +428,7 @@ (make-VariableReference (make-ToplevelRef (ensure-natural (+ n (ToplevelRef-depth t))) (ToplevelRef-pos t) + (ToplevelRef-constant? t) (ToplevelRef-check-defined? t))))])) diff --git a/parser/baby-parser.rkt b/parser/baby-parser.rkt index 40ad7e2..37c9473 100644 --- a/parser/baby-parser.rkt +++ b/parser/baby-parser.rkt @@ -88,6 +88,7 @@ [(EnvPrefixReference? address) (make-ToplevelRef (EnvPrefixReference-depth address) (EnvPrefixReference-pos address) + #f #t)]))] [(define-values? exp) diff --git a/parser/parse-bytecode-5.1.1.rkt b/parser/parse-bytecode-5.1.1.rkt index 03cf9d8..1714518 100644 --- a/parser/parse-bytecode-5.1.1.rkt +++ b/parser/parse-bytecode-5.1.1.rkt @@ -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) diff --git a/parser/parse-bytecode-5.1.2.rkt b/parser/parse-bytecode-5.1.2.rkt index 7c297e1..36addd3 100644 --- a/parser/parse-bytecode-5.1.2.rkt +++ b/parser/parse-bytecode-5.1.2.rkt @@ -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) diff --git a/tests/test-parse-bytecode.rkt b/tests/test-parse-bytecode.rkt index ae1ed93..01498c0 100644 --- a/tests/test-parse-bytecode.rkt +++ b/tests/test-parse-bytecode.rkt @@ -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])) diff --git a/tests/test-parse.rkt b/tests/test-parse.rkt index e69954d..210e8ad 100644 --- a/tests/test-parse.rkt +++ b/tests/test-parse.rkt @@ -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))))))