doing the typechecking on consts up front, to avoid the weirdness in dealing with Any later on.

This commit is contained in:
Danny Yoo 2011-08-30 01:34:16 -04:00
parent 12dfe2caa0
commit ce48679f73
4 changed files with 68 additions and 8 deletions

View File

@ -0,0 +1,38 @@
#lang racket/base
(provide ensure-const-value)
(define (ensure-const-value x)
(cond
[(symbol? x)
x]
[(boolean? x)
x]
[(string? x)
x]
[(number? x)
x]
[(void? x)
x]
[(null? x)
x]
[(char? x)
x]
[(bytes? x)
x]
[(path? x)
x]
[(pair? x)
(begin (ensure-const-value (car x))
(ensure-const-value (cdr x))
x)]
[(vector? x)
(begin (for-each ensure-const-value (vector->list x)))
x]
[(box? x)
(ensure-const-value (unbox x))
x]
[else
(error 'ensure-const-value "Not a const value: ~s\n" x)]))

View File

@ -13,9 +13,13 @@
racket/bool
racket/list
racket/match)
(require/typed "../logger.rkt"
[log-debug (String -> Void)])
(require/typed "compiler-helper.rkt"
[ensure-const-value (Any -> const-value)])
(provide (rename-out [-compile compile])
compile-general-procedure-call
append-instruction-sequences)
@ -450,7 +454,8 @@
(end-with-linkage linkage
cenv
(append-instruction-sequences
(make-AssignImmediateStatement target (make-Const (Constant-v exp)))
(make-AssignImmediateStatement target (make-Const
(ensure-const-value (Constant-v exp))))
singular-context-check))))
@ -1208,7 +1213,7 @@
(map (lambda: ([e : Expression])
(cond
[(Constant? e)
(make-Const (Constant-v e))]
(make-Const (ensure-const-value (Constant-v e)))]
[(LocalRef? e)
(make-EnvLexicalReference (LocalRef-depth e)
(LocalRef-unbox? e))]
@ -1655,7 +1660,7 @@
'?]))]
[(Constant? exp)
(make-Const (Constant-v exp))]
(make-Const (ensure-const-value (Constant-v exp)))]
[(PrimitiveKernelValue? exp)
exp]

View File

@ -64,12 +64,27 @@
#:transparent)
(define-type const-value
(Rec C
(U Symbol
String
Number
Boolean
Void
Null
Char
Bytes
Path
(Pairof C C)
(Vectorof C)
(Boxof C))))
(define-struct: Label ([name : Symbol])
#:transparent)
(define-struct: Reg ([name : AtomicRegisterSymbol])
#:transparent)
(define-struct: Const ([const : Any])
(define-struct: Const ([const : const-value])
#:transparent)
;; Limited arithmetic on OpArgs

View File

@ -109,7 +109,7 @@
;; fixme: use js->string
(: assemble-const (Const -> String))
(define (assemble-const stmt)
(let: loop : String ([val : Any (Const-const stmt)])
(let: loop : String ([val : const-value (Const-const stmt)])
(cond [(symbol? val)
(format "RUNTIME.makeSymbol(~s)" (symbol->string val))]
[(pair? val)
@ -136,13 +136,15 @@
[(path? val)
(format "RUNTIME.makePath(~s)"
(path->string val))]
#;[(vector? val)
[(vector? val)
(format "RUNTIME.makeVector(~s)"
(string-join (for/list ([elt (vector->list val)])
(loop elt))
","))]
[else
(error 'assemble-const "Unsupported datum ~s" val)])))
[(box? val)
(format "RUNTIME.makeBox(~s)"
(loop (unbox val)))])))
(: assemble-listof-assembled-values ((Listof String) -> String))