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

toplevel refs remember if they need to be checked

Browse Source
This commit is contained in:
Danny Yoo 2011-07-22 11:06:25 -04:00
parent f32f8e2f1d
commit e445c61ed2
7 changed files with 58 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/compiler.rkt
View File

@ -505,16 +505,17 @@
(end-with-linkage linkage (end-with-linkage linkage
cenv cenv
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence
`(,(make-Comment (format "Checking the prefix of length ~s" (if (ToplevelRef-check-defined? exp)
(length (Prefix-names (ensure-prefix (list-ref cenv (ToplevelRef-depth exp))))))) (make-PerformStatement (make-CheckToplevelBound!
,(make-PerformStatement (make-CheckToplevelBound!
(ToplevelRef-depth exp) (ToplevelRef-depth exp)
(ToplevelRef-pos exp))) (ToplevelRef-pos exp)))
,(make-AssignImmediateStatement empty-instruction-sequence)
(make-AssignImmediateStatement
target target
(make-EnvPrefixReference (ToplevelRef-depth exp) (make-EnvPrefixReference (ToplevelRef-depth exp)
(ToplevelRef-pos exp))))) (ToplevelRef-pos exp)))
singular-context-check)))) singular-context-check))))
@ -2200,7 +2201,8 @@
(if (< (ToplevelRef-depth exp) skip) (if (< (ToplevelRef-depth exp) skip)
exp exp
(make-ToplevelRef (ensure-natural (- (ToplevelRef-depth exp) n)) (make-ToplevelRef (ensure-natural (- (ToplevelRef-depth exp) n))
(ToplevelRef-pos exp)))] (ToplevelRef-pos exp)
(ToplevelRef-check-defined? exp)))]
[(LocalRef? exp) [(LocalRef? exp)
(if (< (LocalRef-depth exp) skip) (if (< (LocalRef-depth exp) skip)

3
compiler/expression-structs.rkt
View File

@ -55,7 +55,8 @@
(define-struct: Constant ([v : Any]) #:transparent) (define-struct: Constant ([v : Any]) #:transparent)
(define-struct: ToplevelRef ([depth : Natural] (define-struct: ToplevelRef ([depth : Natural]
[pos : Natural]) #:transparent) [pos : Natural]
[check-defined? : Boolean]) #:transparent)
(define-struct: LocalRef ([depth : Natural] (define-struct: LocalRef ([depth : Natural]
[unbox? : Boolean]) #:transparent) [unbox? : Boolean]) #:transparent)

3
compiler/optimize-il.rkt
View File

@ -154,7 +154,8 @@
(let ([t (VariableReference-toplevel oparg)]) (let ([t (VariableReference-toplevel oparg)])
(make-VariableReference (make-VariableReference
(make-ToplevelRef (ensure-natural (+ n (ToplevelRef-depth t))) (make-ToplevelRef (ensure-natural (+ n (ToplevelRef-depth t)))
(ToplevelRef-pos t))))])) (ToplevelRef-pos t)
(ToplevelRef-check-defined? t))))]))
(define-predicate natural? Natural) (define-predicate natural? Natural)

3
parser/baby-parser.rkt
View File

@ -87,7 +87,8 @@
(EnvLexicalReference-unbox? address))] (EnvLexicalReference-unbox? address))]
[(EnvPrefixReference? address) [(EnvPrefixReference? address)
(make-ToplevelRef (EnvPrefixReference-depth address) (make-ToplevelRef (EnvPrefixReference-depth address)
(EnvPrefixReference-pos address))]))] (EnvPrefixReference-pos address)
#t)]))]
[(define-values? exp) [(define-values? exp)
(make-DefValues (map (lambda (id) (make-DefValues (map (lambda (id)

5
parser/parse-bytecode-5.1.1.rkt
View File

@ -661,7 +661,10 @@
;; FIXME: we should also keep track of const? and ready? to produce better code, and to ;; 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) ;; do the required runtime checks when necessary (const?=#f, ready?=#f)
[(struct toplevel (depth pos const? ready?)) [(struct toplevel (depth pos const? ready?))
(make-ToplevelRef depth pos)])) (make-ToplevelRef depth pos (if (and (not const?)
(not ready?))
#t
#f))]))
(define (parse-topsyntax expr) (define (parse-topsyntax expr)

3
parser/parse-bytecode.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require "../version-case/version-case.rkt" (require "../version-case/version-case.rkt"
"../logger.rkt"
racket/file racket/file
(prefix-in whalesong: "../version.rkt") (prefix-in whalesong: "../version.rkt")
(for-syntax racket/base)) (for-syntax racket/base))
@ -8,11 +9,13 @@
[(and (version<= "5.1.1" (version)) [(and (version<= "5.1.1" (version))
(version< (version) "5.1.2")) (version< (version) "5.1.2"))
(begin (begin
(log-debug "Using 5.1.1 bytecode parser")
(require "parse-bytecode-5.1.1.rkt") (require "parse-bytecode-5.1.1.rkt")
(provide (except-out (all-from-out "parse-bytecode-5.1.1.rkt") (provide (except-out (all-from-out "parse-bytecode-5.1.1.rkt")
parse-bytecode)))] parse-bytecode)))]
[(version<= "5.1.2" (version)) [(version<= "5.1.2" (version))
(begin (begin
(log-debug "Using 5.1.2 bytecode parser")
(require "parse-bytecode-5.1.2.rkt") (require "parse-bytecode-5.1.2.rkt")
(provide (except-out (all-from-out "parse-bytecode-5.1.1.rkt") (provide (except-out (all-from-out "parse-bytecode-5.1.1.rkt")
parse-bytecode)))] parse-bytecode)))]

66
tests/test-parse-bytecode.rkt
View File

@ -65,16 +65,16 @@
;; global variables ;; global variables
(check-equal? (run-my-parse #'x) (check-equal? (run-my-parse #'x)
(make-Top (make-Prefix (list (make-GlobalBucket 'x))) (make-Top (make-Prefix (list (make-GlobalBucket 'x)))
(make-ToplevelRef 0 0))) (make-ToplevelRef 0 0 #t)))
(check-equal? (run-my-parse #'(begin (define x 3) (check-equal? (run-my-parse #'(begin (define x 3)
x)) x))
(make-Top (make-Prefix (list (make-GlobalBucket 'x))) (make-Top (make-Prefix (list (make-GlobalBucket 'x)))
(make-Splice (list (make-DefValues (list (make-ToplevelRef 0 0)) (make-Splice (list (make-DefValues (list (make-ToplevelRef 0 0 #t))
(make-Constant 3)) (make-Constant 3))
(make-ToplevelRef 0 0))))) (make-ToplevelRef 0 0 #t)))))
;; Lambdas ;; Lambdas
@ -119,15 +119,15 @@
(check-equal? (run-my-parse #'(let ([y (f)]) (check-equal? (run-my-parse #'(let ([y (f)])
'ok)) 'ok))
(make-Top (make-Prefix (list (make-GlobalBucket 'f))) (make-Top (make-Prefix (list (make-GlobalBucket 'f)))
(make-Let1 (make-App (make-ToplevelRef 1 0) (list)) (make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
(make-Constant 'ok)))) (make-Constant 'ok))))
(check-equal? (run-my-parse #'(let ([y (f)] (check-equal? (run-my-parse #'(let ([y (f)]
[z (g)]) [z (g)])
'ok)) 'ok))
(make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-GlobalBucket 'g))) (make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-GlobalBucket 'g)))
(make-Let1 (make-App (make-ToplevelRef 1 0) (list)) (make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
(make-Let1 (make-App (make-ToplevelRef 2 1) (list)) (make-Let1 (make-App (make-ToplevelRef 2 1 #t) (list))
(make-Constant 'ok))))) (make-Constant 'ok)))))
(check-equal? (run-my-parse #'(let* ([y (f)] (check-equal? (run-my-parse #'(let* ([y (f)]
@ -135,8 +135,8 @@
y y
z)) z))
(make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-GlobalBucket 'g))) (make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-GlobalBucket 'g)))
(make-Let1 (make-App (make-ToplevelRef 1 0) (list)) (make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
(make-Let1 (make-App (make-ToplevelRef 2 1) (list)) (make-Let1 (make-App (make-ToplevelRef 2 1 #t) (list))
;; racket's compiler optimizes away the sequence and lookup to y. ;; racket's compiler optimizes away the sequence and lookup to y.
#;(make-Seq (list (make-LocalRef 1 #f) #;(make-Seq (list (make-LocalRef 1 #f)
(make-LocalRef 0 #f))) (make-LocalRef 0 #f)))
@ -149,8 +149,8 @@
y y
z)) z))
(make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-GlobalBucket 'g))) (make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-GlobalBucket 'g)))
(make-Let1 (make-App (make-ToplevelRef 1 0) (list)) (make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
(make-Let1 (make-App (make-ToplevelRef 2 1) (list)) (make-Let1 (make-App (make-ToplevelRef 2 1 #t) (list))
(make-LocalRef 0 #f))))) (make-LocalRef 0 #f)))))
@ -161,15 +161,15 @@
(make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-Top (make-Prefix (list (make-GlobalBucket 'f)
(make-GlobalBucket 'g) (make-GlobalBucket 'g)
(make-GlobalBucket 'h))) (make-GlobalBucket 'h)))
(make-Branch (make-App (make-ToplevelRef 0 0) '()) (make-Branch (make-App (make-ToplevelRef 0 0 #t) '())
(make-App (make-ToplevelRef 0 1) '()) (make-App (make-ToplevelRef 0 1 #t) '())
(make-App (make-ToplevelRef 0 2) '())))) (make-App (make-ToplevelRef 0 2 #t) '()))))
;; Another example where Racket's compiler is helping: constant propagation, dead code removal. ;; Another example where Racket's compiler is helping: constant propagation, dead code removal.
(check-equal? (run-my-parse #'(if 3 (g) (h))) (check-equal? (run-my-parse #'(if 3 (g) (h)))
(make-Top (make-Prefix (list (make-GlobalBucket 'g))) (make-Top (make-Prefix (list (make-GlobalBucket 'g)))
(make-App (make-ToplevelRef 0 0) '()))) (make-App (make-ToplevelRef 0 0 #t) '())))
@ -178,9 +178,9 @@
(make-Top (make-Prefix (list (make-GlobalBucket 'x) (make-Top (make-Prefix (list (make-GlobalBucket 'x)
(make-GlobalBucket 'y) (make-GlobalBucket 'y)
(make-GlobalBucket 'z))) (make-GlobalBucket 'z)))
(make-Branch (make-ToplevelRef 0 0) (make-Branch (make-ToplevelRef 0 0 #t)
(make-Branch (make-ToplevelRef 0 1) (make-Branch (make-ToplevelRef 0 1 #t)
(make-ToplevelRef 0 2) (make-ToplevelRef 0 2 #t)
(make-Constant 1)) (make-Constant 1))
(make-Constant #t)))) (make-Constant #t))))
@ -188,8 +188,8 @@
(check-equal? (run-my-parse #'(cond [x y])) (check-equal? (run-my-parse #'(cond [x y]))
(make-Top (make-Prefix (list (make-GlobalBucket 'x) (make-Top (make-Prefix (list (make-GlobalBucket 'x)
(make-GlobalBucket 'y))) (make-GlobalBucket 'y)))
(make-Branch (make-ToplevelRef 0 0) (make-Branch (make-ToplevelRef 0 0 #t)
(make-ToplevelRef 0 1) (make-ToplevelRef 0 1 #t)
(make-Constant (void))))) (make-Constant (void)))))
@ -204,9 +204,9 @@
(make-Top (make-Prefix (list (make-GlobalBucket 'x))) (make-Top (make-Prefix (list (make-GlobalBucket 'x)))
(make-App (make-PrimitiveKernelValue '+) (make-App (make-PrimitiveKernelValue '+)
(list (make-App (make-PrimitiveKernelValue '*) (list (make-App (make-PrimitiveKernelValue '*)
(list (make-ToplevelRef 4 0) (list (make-ToplevelRef 4 0 #t)
(make-ToplevelRef 4 0))) (make-ToplevelRef 4 0 #t)))
(make-ToplevelRef 2 0))))) (make-ToplevelRef 2 0 #t)))))
(check-equal? (run-my-parse #'list) (check-equal? (run-my-parse #'list)
(make-Top (make-Prefix (list)) (make-Top (make-Prefix (list))
@ -219,7 +219,7 @@
(check-equal? (run-my-parse #'(let () x)) (check-equal? (run-my-parse #'(let () x))
(make-Top (make-Prefix (list (make-GlobalBucket 'x))) (make-Top (make-Prefix (list (make-GlobalBucket 'x)))
(make-ToplevelRef 0 0))) (make-ToplevelRef 0 0 #t)))
@ -276,8 +276,8 @@
(check-equal? (run-my-parse #'(call-with-values (lambda () (f)) g)) (check-equal? (run-my-parse #'(call-with-values (lambda () (f)) g))
(make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-Top (make-Prefix (list (make-GlobalBucket 'f)
(make-GlobalBucket 'g))) (make-GlobalBucket 'g)))
(make-ApplyValues (make-ToplevelRef 0 1) (make-ApplyValues (make-ToplevelRef 0 1 #t)
(make-App (make-ToplevelRef 0 0) '())))) (make-App (make-ToplevelRef 0 0 #t) '()))))
@ -325,13 +325,13 @@
(check-equal? (run-my-parse #'(begin0 (f))) (check-equal? (run-my-parse #'(begin0 (f)))
(make-Top (make-Prefix (list (make-GlobalBucket 'f))) (make-Top (make-Prefix (list (make-GlobalBucket 'f)))
(make-App (make-ToplevelRef 0 0) '()))) (make-App (make-ToplevelRef 0 0 #t) '())))
(check-equal? (run-my-parse #'(begin0 (f) (g))) (check-equal? (run-my-parse #'(begin0 (f) (g)))
(make-Top (make-Prefix (list (make-GlobalBucket 'f) (make-Top (make-Prefix (list (make-GlobalBucket 'f)
(make-GlobalBucket 'g))) (make-GlobalBucket 'g)))
(make-Begin0 (list (make-App (make-ToplevelRef 0 0) '()) (make-Begin0 (list (make-App (make-ToplevelRef 0 0 #t) '())
(make-App (make-ToplevelRef 0 1) '()))))) (make-App (make-ToplevelRef 0 1 #t) '())))))
;; Compiling modules ;; Compiling modules
@ -345,7 +345,7 @@
_ ;; requires _ ;; requires
_ ;; provides _ ;; provides
(struct Splice ((list (struct ApplyValues (struct Splice ((list (struct ApplyValues
((struct ToplevelRef ('0 '0)) (struct Constant ('42))))))))))) ((struct ToplevelRef ('0 '0 '#t)) (struct Constant ('42)))))))))))
#t])) #t]))
@ -360,7 +360,7 @@
_ ;; requires _ ;; requires
_ ;; provides _ ;; provides
(struct Splice ((list (struct DefValues (struct Splice ((list (struct DefValues
((list (struct ToplevelRef ('0 '0))) ((list (struct ToplevelRef ('0 '0 '#t)))
(struct Constant ("x"))))))))))) (struct Constant ("x")))))))))))
#t])) #t]))
@ -370,7 +370,7 @@
;; Variable reference ;; Variable reference
(check-equal? (run-my-parse #'(#%variable-reference x)) (check-equal? (run-my-parse #'(#%variable-reference x))
(make-Top (make-Prefix (list (make-GlobalBucket 'x))) (make-Top (make-Prefix (list (make-GlobalBucket 'x)))
(make-VariableReference (make-ToplevelRef 0 0)))) (make-VariableReference (make-ToplevelRef 0 0 #t))))
;; todo: see what it would take to run a typed/racket/base language. ;; todo: see what it would take to run a typed/racket/base language.
(void (void
@ -405,7 +405,7 @@
(#%provide f)))) (#%provide f))))
(parameterize ([current-root-path this-test-path] #;(parameterize ([current-root-path this-test-path]
[current-module-path (build-path this-test-path "foo.rkt")]) [current-module-path (build-path this-test-path "foo.rkt")])
(check-true (check-true
(match (run-my-parse #'(module foo racket/base)) (match (run-my-parse #'(module foo racket/base))
@ -441,7 +441,7 @@
(struct Prefix ((list 'f))) (struct Prefix ((list 'f)))
(list (struct ModuleLocator ('#%kernel '#%kernel))) (list (struct ModuleLocator ('#%kernel '#%kernel)))
_ _
(struct Splice ((list (struct DefValues ((list (struct ToplevelRef (0 0))) (struct Splice ((list (struct DefValues ((list (struct ToplevelRef (0 0 #t)))
(struct Constant ('ok))))))))))) (struct Constant ('ok)))))))))))
'#t])) '#t]))