From ba5cbaf2e2a01bcb068c7d7763a2aceece49f8c8 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 31 Aug 2020 12:47:11 -0600
Subject: [PATCH] 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.
---
 racket/src/ChezScheme/rktboot/make-boot.rkt | 9 +++++++++
 racket/src/ChezScheme/rktboot/r6rs-lang.rkt | 8 +++++++-
 racket/src/ChezScheme/s/cpnanopass.ss       | 3 ++-
 3 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/racket/src/ChezScheme/rktboot/make-boot.rkt b/racket/src/ChezScheme/rktboot/make-boot.rkt
index f1aa0368af..9385e734b0 100644
--- a/racket/src/ChezScheme/rktboot/make-boot.rkt
+++ b/racket/src/ChezScheme/rktboot/make-boot.rkt
@@ -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))
 
diff --git a/racket/src/ChezScheme/rktboot/r6rs-lang.rkt b/racket/src/ChezScheme/rktboot/r6rs-lang.rkt
index fbe8025931..89861e11f0 100644
--- a/racket/src/ChezScheme/rktboot/r6rs-lang.rkt
+++ b/racket/src/ChezScheme/rktboot/r6rs-lang.rkt
@@ -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))
diff --git a/racket/src/ChezScheme/s/cpnanopass.ss b/racket/src/ChezScheme/s/cpnanopass.ss
index 8bd5b0d329..ba0bcd7313 100644
--- a/racket/src/ChezScheme/s/cpnanopass.ss
+++ b/racket/src/ChezScheme/s/cpnanopass.ss
@@ -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)])