62 lines
2.8 KiB
Racket
62 lines
2.8 KiB
Racket
#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))
|
|
;; the values are either `#f', or a weak box holding the value
|
|
(define r
|
|
(let ([b (list-ref saved (sub1 n))])
|
|
(and b (or (weak-box-value b)
|
|
(err "saved value #~a was garbage-collected" n)))))
|
|
#`'#,r)
|
|
(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)]))
|