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:
Matthew Flatt 2020-08-31 12:47:11 -06:00
parent 60e6989620
commit ba5cbaf2e2
3 changed files with 18 additions and 2 deletions

View File

@ -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))

View File

@ -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))

View File

@ -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)])