From 97b2982a1d318ccc0d351d010b9e3242ce6a6cc5 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 29 Jun 2019 08:30:08 -0600
Subject: [PATCH] schemify: update demo

---
 racket/src/schemify/schemify-demo.rkt | 56 ++++++++++++++++++---------
 1 file changed, 38 insertions(+), 18 deletions(-)

diff --git a/racket/src/schemify/schemify-demo.rkt b/racket/src/schemify/schemify-demo.rkt
index 5cba40774e..21d18ca006 100644
--- a/racket/src/schemify/schemify-demo.rkt
+++ b/racket/src/schemify/schemify-demo.rkt
@@ -1,5 +1,9 @@
 #lang racket/base
 (require racket/pretty
+         (only-in racket/linklet
+                  datum->correlated
+                  correlated?
+                  correlated-e)
          "schemify.rkt"
          "known.rkt")
 
@@ -13,23 +17,35 @@
     (for/hasheq ([s (in-list (namespace-mapped-symbols ns))]
                  #:when (with-handlers ([exn:fail? (lambda (x) #f)])
                           (procedure? (eval s ns))))
-      (values s a-known-procedure))))
+      (values s (known-procedure (procedure-arity-mask (eval s ns)))))))
 
-(define (wrap-everywhere p)
+(define (wrap p)
   (cond
-   [(pair? p)
-    (datum->syntax #f (cons (wrap-everywhere (car p))
-                            (wrap-everywhere (cdr p))))]
-   [else
-    (datum->syntax #f p)]))
+    [(and (pair? p)
+          (eq? (car p) 'define-values))
+     ;; expander doesn't use a correalted for id list, so avoid
+     ;; adding one here
+     (list (car p) (map wrap (cadr p)) (map wrap (cddr p)))]
+    [(list? p)
+     (datum->correlated (map wrap p))]
+    [(pair? p)
+     (cons (wrap (car p)) (wrap (cdr p)))]
+    [else
+     (datum->correlated p)]))
 
-(define-values (schemified importss-abi exports-info)
+(define (unwrap p)
+  (cond
+    [(correlated? p) (unwrap (correlated-e p))]
+    [(pair? p) (cons (unwrap (car p)) (unwrap (cdr p)))]
+    [else p]))
+
+(define-values (schemified importss exports import-keys imports-abis exports-info)
   (schemify-linklet `(linklet 
                       ()
-                      (x ,#'y [,#'z ,#'ext-z])
-                      .
+                      (x y [z ext-z])
+                       .
                       ,(map
-                        wrap-everywhere
+                        wrap
                         '((define-values (struct:s make-s s? s-ref s-set!)
                             (make-struct-type 's #f 2 0 #f))
                           (define-values (y) (make-s (lambda () x) 5))
@@ -41,14 +57,18 @@
                           (define-values (done) (z)))))
                     #;
                     (call-with-input-file "regexp.rktl" read)
-                    (lambda (old-v new-v)
-                      (if (syntax? old-v)
-                          (datum->syntax #f new-v old-v)
-                          new-v))
-                    (lambda (old-v) (syntax->datum (datum->syntax #f old-v)))
+                    #t ; serializable
+                    #t ; datum-intern?
+                    #f ; for-jitify?
+                    #f ; allow-set!-undefined?
+                    #f ; unsafe-mode?
+                    #t ; enforce-constant?
+                    #t ; allow-inline?
+                    #f ; no-prompt?
                     prim-knowns
-                    (lambda args #hasheq())))
+                    #f
+                    #f))
 
-(pretty-print schemified)
+(pretty-print (unwrap schemified))
 (pretty-print exports-info)