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

20
compiler/compiler.rkt
View File

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

3
compiler/expression-structs.rkt
View File

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

3
compiler/optimize-il.rkt
View File

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

3
parser/baby-parser.rkt
View File

@ -87,7 +87,8 @@
(EnvLexicalReference-unbox? address))]
[(EnvPrefixReference? address)
(make-ToplevelRef (EnvPrefixReference-depth address)
(EnvPrefixReference-pos address))]))]
(EnvPrefixReference-pos address)
#t)]))]
[(define-values? exp)
(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
;; do the required runtime checks when necessary (const?=#f, ready?=#f)
[(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)

5
parser/parse-bytecode.rkt
View File

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

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

@ -65,16 +65,16 @@
;; global variables
(check-equal? (run-my-parse #'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)
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-ToplevelRef 0 0)))))
(make-ToplevelRef 0 0 #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) (list))
(make-Let1 (make-App (make-ToplevelRef 1 0 #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) (list))
(make-Let1 (make-App (make-ToplevelRef 2 1) (list))
(make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
(make-Let1 (make-App (make-ToplevelRef 2 1 #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) (list))
(make-Let1 (make-App (make-ToplevelRef 2 1) (list))
(make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
(make-Let1 (make-App (make-ToplevelRef 2 1 #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) (list))
(make-Let1 (make-App (make-ToplevelRef 2 1) (list))
(make-Let1 (make-App (make-ToplevelRef 1 0 #t) (list))
(make-Let1 (make-App (make-ToplevelRef 2 1 #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) '())
(make-App (make-ToplevelRef 0 1) '())
(make-App (make-ToplevelRef 0 2) '()))))
(make-Branch (make-App (make-ToplevelRef 0 0 #t) '())
(make-App (make-ToplevelRef 0 1 #t) '())
(make-App (make-ToplevelRef 0 2 #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) '())))
(make-App (make-ToplevelRef 0 0 #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)
(make-Branch (make-ToplevelRef 0 1)
(make-ToplevelRef 0 2)
(make-Branch (make-ToplevelRef 0 0 #t)
(make-Branch (make-ToplevelRef 0 1 #t)
(make-ToplevelRef 0 2 #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)
(make-ToplevelRef 0 1)
(make-Branch (make-ToplevelRef 0 0 #t)
(make-ToplevelRef 0 1 #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)
(make-ToplevelRef 4 0)))
(make-ToplevelRef 2 0)))))
(list (make-ToplevelRef 4 0 #t)
(make-ToplevelRef 4 0 #t)))
(make-ToplevelRef 2 0 #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)))
(make-ToplevelRef 0 0 #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)
(make-App (make-ToplevelRef 0 0) '()))))
(make-ApplyValues (make-ToplevelRef 0 1 #t)
(make-App (make-ToplevelRef 0 0 #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) '())))
(make-App (make-ToplevelRef 0 0 #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) '())
(make-App (make-ToplevelRef 0 1) '())))))
(make-Begin0 (list (make-App (make-ToplevelRef 0 0 #t) '())
(make-App (make-ToplevelRef 0 1 #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 '#t)) (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 '#t)))
(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))))
(make-VariableReference (make-ToplevelRef 0 0 #t))))
;; todo: see what it would take to run a typed/racket/base language.
(void
@ -405,7 +405,7 @@
(#%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")])
(check-true
(match (run-my-parse #'(module foo racket/base))
@ -441,7 +441,7 @@
(struct Prefix ((list 'f)))
(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)))))))))))
'#t]))