Chez Scheme and rktboot: adapt to work with latest nanopass
This commit doesn't update nanopass itself, but adapts `rktboot` so it can be used with the main Chez Scheme bbranch. It also adjust "cpnanopass.ss" to avoid different behavior between the old and newer versions of nanopass.
This commit is contained in:
parent
60e6989620
commit
ba5cbaf2e2
|
@ -100,10 +100,18 @@
|
|||
|
||||
(reset-toplevels)
|
||||
|
||||
(define (load-if-exists/cd path)
|
||||
(when (file-exists? path)
|
||||
(load/cd path)))
|
||||
|
||||
(status "Load nanopass")
|
||||
(define (load-nanopass)
|
||||
(load/cd (build-path nano-dir "nanopass/helpers.ss"))
|
||||
(load/cd (build-path nano-dir "nanopass/syntaxconvert.ss"))
|
||||
(load-if-exists/cd (build-path nano-dir "nanopass/records.ss"))
|
||||
(load-if-exists/cd (build-path nano-dir "nanopass/nano-syntax-dispatch.ss"))
|
||||
(load-if-exists/cd (build-path nano-dir "nanopass/parser.ss"))
|
||||
(load-if-exists/cd (build-path nano-dir "nanopass/unparser.ss"))
|
||||
(load/cd (build-path nano-dir "nanopass/records.ss"))
|
||||
(load/cd (build-path nano-dir "nanopass/meta-syntax-dispatch.ss"))
|
||||
(load/cd (build-path nano-dir "nanopass/meta-parser.ss"))
|
||||
|
@ -117,6 +125,7 @@
|
|||
(load/cd (build-path nano-dir "nanopass.ss")))
|
||||
(parameterize ([current-namespace ns]
|
||||
[current-readtable r6rs-readtable])
|
||||
(load-if-exists/cd (build-path nano-dir "nanopass/syntactic-property.sls"))
|
||||
(load/cd (build-path nano-dir "nanopass/implementation-helpers.ikarus.ss"))
|
||||
(load-nanopass))
|
||||
|
||||
|
|
|
@ -142,7 +142,9 @@
|
|||
bytevector-u64-native-ref
|
||||
call-with-bytevector-output-port
|
||||
make-compile-time-value
|
||||
optimize-level)
|
||||
optimize-level
|
||||
symbol-value
|
||||
set-symbol-value!)
|
||||
|
||||
(module+ ikarus
|
||||
(provide print-gensym
|
||||
|
@ -811,3 +813,7 @@
|
|||
(define (make-compile-time-value v) v)
|
||||
|
||||
(define optimize-level (make-parameter optimize-level-init))
|
||||
|
||||
;; For "implementation-helpers.ikarus.ss":
|
||||
(define (symbol-value s) (namespace-variable-value s #f))
|
||||
(define (set-symbol-value! s v) (namespace-set-variable-value! s v #f))
|
||||
|
|
|
@ -3386,7 +3386,8 @@
|
|||
(values new-e unboxed?))))]
|
||||
[(mvcall ,info ,e1 ,e2) (values `(mvcall ,info ,(Expr1 e1) ,(Expr1 e2)) #f)]
|
||||
[(mvlet ,e ((,x** ...) ,interface* ,body*) ...)
|
||||
(values `(mvlet ,(Expr1 e) ((,x** ...) ,interface* ,(map Expr1 body*)) ...) #f)])
|
||||
(values `(mvlet ,(Expr1 e) ((,x** ...) ,interface* ,(map Expr1 body*)) ...) #f)]
|
||||
[,lvalue (Lvalue lvalue can-unbox-fp?)])
|
||||
(Lvalue : Lvalue (ir [unboxed-fp? #f]) -> Lvalue (#f)
|
||||
[(mref ,e1 ,e2 ,imm ,type)
|
||||
(let ([e `(mref ,(Expr1 e1) ,(Expr1 e2) ,imm ,type)])
|
||||
|
|
Loading…
Reference in New Issue
Block a user