Syntax-based implementation for saved values, finally working.

collects/tests/xrepl/xrepl.rkt

@@ -74,8 +74,12 @@
 
 (provide test-xrepl)
 (define test-xrepl @make-xrepl-test{
+  -> «^»
+  ; ^: no saved values, yet [,bt for context]
   -> «(- 2 1)»
   1
+  -> «^^»
+  ; ^^: no 2 saved values, yet [,bt for context]
   -> «(values 2 3)»
   2
   3
@@ -100,7 +104,13 @@
   -> «,switch foo»
   ; *** Initializing a new `foo' namespace with "racket/init.rkt" ***
   ; *** Switching to the `foo' namespace ***
-  foo::-> «,switch *»
+  foo::-> «,switch typed/racket»
+  ; *** Initializing a new `typed/racket' namespace with typed/racket ***
+  ; *** Switching to the `typed/racket' namespace ***
+  typed/racket::-> «^»                  ⇒ works in TR too
+  - : Positive-Byte
+  123
+  typed/racket::-> «,switch *»
   ; *** Switching to the `*' namespace ***
   -> «bleh»
   ; reference to undefined identifier: bleh [,bt for context]

collects/xrepl/saved-values.rkt

@@ -0,0 +1,56 @@
+#lang racket/base
+
+;; This module is used for saved values bindings.  This would have been
+;; a very simple use case for an identifier macro, but this fail in one
+;; important aspect: in some languages we can't rely on bindings that
+;; we'll expand to to behave as usual.  Specifically, such an expansion
+;; makes using saved values impossible in TR, since the expansion would
+;; eventually be something that has no type (and even if we do some
+;; specific hack and add a type, it would be a useless `Any').
+;;
+;; The solution is a pile of hair...  We define here a syntax-level
+;; variable that holds the saved values parameter, and provide a macro
+;; that sets it.  Then, xrepl calls us with the parameter values
+;; injected directly into the syntax (=> 3d code), which is used to set
+;; the variable.  (The syntax level gets instantiated multiple times, so
+;; this way they all share the same parameter from xrepl.)  Finally, a
+;; reference expands to a `quote' expression with the value injected
+;; 3d-ly, and TR will be happy to see just a literal value as its
+;; expansion.  (Well, mostly happily -- it makes using functions
+;; impossible since TR will infer an `Any' type for them, but that case
+;; is hopeless anyway.)
+
+(require (for-syntax racket/base))
+
+(define-for-syntax saved-values-param #f)
+
+(provide set-saved-values-param!)
+(define-syntax (set-saved-values-param! stx)
+  (syntax-case stx ()
+    [(_ p) (parameter? (syntax-e #'p))
+           (begin (set! saved-values-param (syntax-e #'p))
+                  (datum->syntax #'here (void)))]
+    [_ (raise-syntax-error 'set-saved-values-param! "internal error")]))
+
+(provide saved-value-ref)
+(define-syntax (saved-value-ref stx)
+  (define (ref id)
+    (define (err fmt . args)
+      (raise-syntax-error (syntax-e id) (apply format fmt args)))
+    (unless (parameter? saved-values-param)
+      (err "internal error: no saved-values"))
+    (define saved (saved-values-param))
+    (unless (list? saved) (err "internal error: saved-values isn't a list"))
+    (define str (symbol->string (syntax-e id)))
+    (define n
+      (cond [(regexp-match? #rx"^([^0-9])+$" str) (string-length str)]
+            [(regexp-match #rx"[0-9]+$" str)
+             => (λ (m) (string->number (car m)))]
+            [else (err "unknown name pattern for a saved-value reference")]))
+    (unless (pair? saved)          (err "no saved values, yet"))
+    (when (n . > . (length saved)) (err "no ~a saved values, yet" n))
+    #`'#,(list-ref saved (sub1 n)))
+  (syntax-case stx (set!)
+    [(set! id . xs) (raise-syntax-error 'set! "cannot set history reference")]
+    [(id . xs) (datum->syntax stx (cons (ref #'id) #'xs) stx)]
+    [id (identifier? #'id) (ref #'id)]))

collects/xrepl/xrepl.rkt

@@ -18,6 +18,8 @@
 
 (define home-dir (find-system-path 'home-dir))
 
+(define (here-namespace) (namespace-anchor->namespace anchor))
+
 ;; autoloads: avoid loading a ton of stuff to minimize startup penalty
 (define autoloaded-specs (make-hasheq))
 (define (autoloaded? sym) (hash-ref autoloaded-specs sym #f))
@@ -38,7 +40,6 @@
 
 ;; similar, but just for identifiers
 (define-namespace-anchor anchor)
-(define (here-namespace) (namespace-anchor->namespace anchor))
 (define hidden-namespace (make-base-namespace))
 (define initial-namespace (current-namespace))
 ;; when `racket/enter' initializes, it grabs the `current-namespace' to get
@@ -1194,7 +1195,7 @@
 ;; ----------------------------------------------------------------------------
 ;; eval hook that keep track of recent evaluation results
 
-;; saved interaction values
+;; saved interaction values (can be #f to disable saving)
 (define saved-values (make-parameter '()))
 (define (save-values! xs)
   (let ([xs (filter (λ (x) (not (void? x))) xs)]) ; don't save void values
@@ -1219,39 +1220,34 @@
       (last-saved-names+state (list new cur-num cur-char))
       new)))
 
-;; make saved values available through bindings, but do this in a way that
-;; doesn't interfere with users using these binders in some way -- set only ids
-;; that were void, and restore them to void afterwards
-(define (with-saved-values thunk)
-  (define saved-names (get-saved-names))
-  (define vals (for/list ([id (in-list saved-names)])
-                 (box (namespace-variable-value id #f void))))
-  (define res #f)
-  (dynamic-wind
-    (λ ()
-      (for ([id    (in-list saved-names)]
-            [saved (in-list (saved-values))]
-            [v     (in-list vals)])
-        ;; set only ids that are void, and remember these values
-        (if (void? (unbox v))
-          (begin (namespace-set-variable-value! id saved)
-                 (set-box! v saved))
-          (set-box! v (void)))))
-    (λ () (call-with-values thunk (λ vs (set! res vs) (apply values vs))))
-    (λ ()
-      (for ([id (in-list saved-names)] [v (in-list vals)])
-        ;; restore the names to void so we can set them next time
-        (when (and (not (void? (unbox v))) ; restore if we set this id above
-                   (eq? (unbox v) ; and if it didn't change
-                        (namespace-variable-value id #f void)))
-          (namespace-set-variable-value! id (void))))
-      (when res (save-values! res)))))
+;; see comment at the top of this module for the below hair
+(require xrepl/saved-values)
 
+;; make saved values available through bindings, but avoid names that
+;; already exist in the namespace (possibly from a previous initialization)
+(define (initialize-namespace)
+  ;; We might run into circularity problems, give up silently in that case
+  (when (with-handlers ([exn? (λ (_) #f)])
+          (namespace-attach-module (here-namespace) 'xrepl/saved-values)
+          (dynamic-require 'xrepl/saved-values (void))
+          #t)
+    ;; Hack: wire in our parameter for expansions (see comment in saved-values)
+    (eval-sexpr-for-user `(,#'set-saved-values-param! ,saved-values))
+    (for ([sym (in-list (get-saved-names))])
+      (define id (namespace-symbol->identifier sym))
+      (unless (identifier-binding id)
+        (eval-sexpr-for-user
+         `(,#'require (,#'only-in ,#'xrepl/saved-values
+                                  [,#'saved-value-ref ,id])))))))
+
+(require (for-syntax racket/base))
 (define ((make-xrepl-evaluator orig) expr)
   ;; not useful: catches only escape continuations
   ;;   (with-handlers ([exn:break? (λ (e) (last-break-exn e) (raise e))]) ...)
   (if (saved-values)
-    (with-saved-values (λ () (orig expr)))
+    (let ([results (call-with-values (λ () (orig expr)) list)])
+      (save-values! results)
+      (apply values results))
     (orig expr)))
 
 ;; ----------------------------------------------------------------------------
@@ -1290,6 +1286,7 @@
       (unless (and (equal? (current-namespace) last-namespace)
                    (equal? curdir last-directory))
         (report-directory-change)
+        (initialize-namespace)
         (set! prefix
               (with-handlers
                   ([exn? (λ (e)