commit 1f2a9eaebb1cf2e6ed4f533b6fee740c3997263b
parent f1ede1dd4db8481b8546bf25f41f36563371bfac
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Thu, 26 Jan 2017 04:15:03 +0100
Changed subtemplate to use current-pvars+unique
Diffstat:
5 files changed, 314 insertions(+), 194 deletions(-)
diff --git a/main.rkt b/main.rkt
@@ -1,15 +1,15 @@
#lang racket
+
(require racket/require
phc-toolkit/untyped
racket/stxparam
- syntax/parse
- backport-template-pr1514/experimental/template
- ;syntax/parse/experimental/template
- ;syntax/parse/experimental/private/substitute
+ stxparse-info/parse
+ stxparse-info/current-pvars
+ stxparse-info/parse/experimental/template
syntax/id-table
racket/syntax
- (for-syntax "patch-arrows.rkt"
- syntax/parse
+ (for-syntax phc-graph/patch-arrows
+ stxparse-info/parse
racket/private/sc
racket/syntax
racket/list
@@ -21,82 +21,27 @@
syntax/contract
racket/contract))
-(provide (rename-out [new-syntax-parse syntax-parse]
- [new-syntax-parser syntax-parser]
- [new-syntax-case syntax-case])
- ;define-unhygienic-template-metafunction
- subtemplate
+(provide subtemplate
quasisubtemplate)
-(begin-for-syntax (struct derived ()))
-(define-syntax-parameter maybe-syntax-pattern-variable-ids '())
-(define empty-pvar-values '())
-(define-syntax-parameter pvar-values-id (make-rename-transformer
- #'empty-pvar-values))
-
-(begin-for-syntax
- (define/contract (split-colon sym)
- (-> symbol? (cons/c symbol? (listof symbol?)))
- (cons sym
- (map string->symbol
- (string-split (symbol->string sym)
- ":")))))
-
-(define-for-syntax (new-scope rest lctx)
- ;(wrap-expr/c
- ;#'(listof (cons/c identifier? (listof symbol?)))
- #`(cons (cons (quote-syntax #,(syntax-local-get-shadower
- (datum->syntax lctx
- 'outer-lctx))
- #:local)
- '#,(~> (syntax->datum rest)
- flatten
- (filter symbol? _)
- (append-map split-colon _)
- (remove-duplicates)))
- (syntax-parameter-value
- #'maybe-syntax-pattern-variable-ids)));)
+(define derived-valvar-cache (make-weak-hash))
(begin-for-syntax
- (define/contract (wrap-with-parameterize lctx new-whole-form rest)
- (-> identifier? syntax? syntax? syntax?)
- (quasisyntax/top-loc lctx
- (let ()
- #,(patch-arrows
- ;; HERE insert a hash table, to cache the uses of derived pvars.
- ;; Lifting the define-temp-ids is not likely to work, as they
- ;; need to define syntax pattern variables so that other macros
- ;; can recognize them. Instead, we only lift the values, but still
- ;; do the bindings around the subtemplate.
- #`(let ([the-pvar-values (cons (make-hash) pvar-values-id)])
- (syntax-parameterize ([maybe-syntax-pattern-variable-ids
- #,(new-scope rest lctx)]
- [pvar-values-id (make-rename-transformer
- #'the-pvar-values)])
- #,new-whole-form)))))))
+ ;; Act like a syntax transformer, but which is recognizable via the
+ ;; derived-pattern-variable? predicate.
+ (struct derived-valvar (valvar)
+ #:property prop:procedure
+ (λ (self stx)
+ #`(#%expression #,(derived-valvar-valvar self))))
-(begin-for-syntax
- (define/contract (simple-wrap-with-parameterize new-form-id)
- (-> identifier? (-> syntax? syntax?))
- (λ/syntax-case (self . rest) ()
- (wrap-with-parameterize #'self #`(#,new-form-id . rest) #'rest))))
+ (define (id-is-derived-valvar? id)
+ (define mapping (syntax-local-value id (thunk #f)))
+ (and mapping ;; … defined as syntax
+ (syntax-pattern-variable? mapping) ;; and is a syntax pattern variable
+ (derived-valvar? ;; and the pvar's valvar is derived
+ (syntax-local-value (syntax-mapping-valvar mapping)
+ (thunk #f)))))
-(define-syntax new-syntax-parse
- (simple-wrap-with-parameterize #'syntax-parse))
-
-(define-syntax new-syntax-case
- (simple-wrap-with-parameterize #'syntax-case))
-
-(define-syntax (new-syntax-parser stx)
- (syntax-case stx ()
- [(self . rest)
- (quasisyntax/top-loc #'self
- (λ (stx2)
- #,(wrap-with-parameterize #'self
- #'((syntax-parser . rest) stx2)
- #'rest)))]))
-
-(begin-for-syntax
(define/contract (string-suffix a b)
(-> string? string? string?)
(define suffix-length (string-suffix-length a b))
@@ -135,180 +80,223 @@
(string-length sub)))])
(datum->syntax id (string->symbol new-str) id id)))
- (define/contract (find-subscript-binder2a lctx scopes bound scope-depth)
- (-> identifier?
- (listof (cons/c identifier? (listof symbol?)))
- identifier?
- exact-nonnegative-integer?
- (listof (list/c identifier? exact-nonnegative-integer?)))
- (if (null? scopes)
- '()
- (let ()
- (define outer-lctx (caar scopes))
- (define syms (cdar scopes))
- (define recur-found (find-subscript-binder2a outer-lctx
- (cdr scopes)
- bound
- (add1 scope-depth)))
- (define found-here
- (for*/list ([binder-sym (in-list syms)]
- [binder (in-value (datum->syntax lctx binder-sym #f))]
- #:when (syntax-pattern-variable?
- (syntax-local-value binder (thunk #f)))
- #:when (not (derived?
- (syntax-local-value
- (format-id binder
- " is-derived-~a "
- binder)
- (thunk #f))))
- [subscripts (in-value (subscript-equal? bound
- binder))]
- #:when subscripts)
- (list binder scope-depth)))
- (if (null? found-here)
- recur-found
- (append found-here recur-found)))))
-
- (define/contract (find-subscript-binder2 bound)
- (-> identifier?
- (or/c #f (list/c identifier? ;; bound
- (syntax/c (listof identifier?)) ;; binders
- (syntax/c (listof identifier?)) ;; max-binders
- exact-nonnegative-integer? ;; ellipsis-depth
- exact-nonnegative-integer? ;; scope-depth
- syntax?))) ;; check-ellipsis-count
- (define scopes (syntax-parameter-value #'maybe-syntax-pattern-variable-ids))
- (define/with-syntax ([binder scope-depth] …)
- (find-subscript-binder2a bound ;; TODO: check this is okay (should be).
- scopes
- bound
- 0))
- (if (stx-null? #'(binder …))
- #f
- (let ()
- (define depths
- (stx-map (∘ syntax-mapping-depth syntax-local-value) #'(binder …)))
- (unless (or (< (length depths) 2) (apply = depths))
- (raise-syntax-error 'subtemplate
- (format "inconsistent depths: ~a"
- (syntax->list #'(binder …)))
- bound))
- ;; generate code to check that the bindings have all the same
- ;; ellipsis count
- (define/with-syntax check-ellipsis-count-ddd
- (nest-ellipses #'(binder …) (car depths)))
- (define max-scope-depth (apply max (syntax->datum #'(scope-depth …))))
- (define max-binders
- (sort (map car
- (filter (λ (bs) (= (syntax-e (cdr bs)) max-scope-depth))
- (stx-map syntax-e #'([binder . scope-depth] …))))
- symbol<?
- #:key syntax-e))
- (list bound
- #'(binder …)
- #`#,max-binders
- (car depths)
- max-scope-depth
- #'check-ellipsis-count-ddd))))
-
(define/contract (nest-ellipses stx n)
(-> syntax? exact-nonnegative-integer? syntax?)
(if (= n 0)
stx
#`(#,(nest-ellipses stx (sub1 n))
- (… …)))))
+ (… …))))
+
+ (define/contract (find-subscript-binder bound)
+ (-> identifier?
+ (or/c #f (list/c identifier? ; bound
+ (syntax/c (listof identifier?)) ; binders
+ (syntax/c (listof identifier?)) ; unique-at-runtime ids
+ exact-nonnegative-integer? ; ellipsis-depth
+ syntax?))) ; check-ellipsis-count
+ (let/cc return
+ ;; EARLY RETURN (already a pattern variable)
+ (when (syntax-pattern-variable?
+ (syntax-local-value bound (thunk #f)))
+ (return #f))
+
+ (define/with-syntax ([binder . unique-at-runtime-id] …)
+ (filter (compose (conjoin identifier?
+ (negate id-is-derived-valvar?)
+ (λ~> (syntax-local-value _ (thunk #f))
+ syntax-pattern-variable?)
+ ;; force call syntax-local-value to prevent
+ ;; ambiguous bindings, as syntax-local-value
+ ;; triggers an error for those.
+ ;; Must be done before the free-identifier=?
+ ;; which just returns #false
+ (λ~> (datum->syntax _ (syntax-e bound))
+ (syntax-local-value _ (thunk #f))
+ (thunk* #t)) ;; ok if no error.
+ (λ~> (datum->syntax _ (syntax-e bound))
+ (free-identifier=? _ bound))
+ (λ~> (subscript-equal? bound _)))
+ car)
+ (current-pvars+unique)))
+
+ ;; Or write it as:
+
+ #;(define/with-syntax ([binder . unique-at-runtime] …)
+ (for/list ([binder (current-pvars)]
+ #:when (identifier? (car binder))
+ #:unless (id-is-derived-pvar? (car binder))
+ #:when (syntax-pattern-variable?
+ (syntax-local-value (car binder) (thunk #f)))
+ ;; force call syntax-local-value to prevent ambiguous
+ ;; bindings, as syntax-local-value triggers an error for
+ ;; those.
+ ;; Must be done before the free-identifier=? which just
+ ;; returns #false
+ #:when (begin
+ (syntax-local-value
+ (datum->syntax _ (syntax-e bound))
+ (thunk #f))
+ #t) ;; ok if no error.
+ #:when (free-identifier=? (datum->syntax (car binder)
+ (syntax-e bound))
+ bound)
+ #:when (subscript-equal? bound (car binder)))
+ binder))
+
+ ;; EARLY RETURN (no candidate binders found)
+ (when (stx-null? #'(binder …))
+ (return #f))
+
+ (define depths
+ (stx-map (∘ syntax-mapping-depth syntax-local-value) #'(binder …)))
+
+ ;; EARLY ERROR (inconsistent depths)
+ (unless (or (< (length depths) 2) (apply = depths))
+ (car depths)
+ (raise-syntax-error 'subtemplate
+ (format "inconsistent depths: ~a"
+ (syntax->list #'(binder …)))
+ bound))
+
+ ;; generate code to check that the bindings have all the same
+ ;; ellipsis count, by simply generating a dummy syntax object, with
+ ;; all the given binders nested under the right number of ellipses.
+ (define/with-syntax check-ellipsis-count-ddd
+ (nest-ellipses #'(binder …) (car depths)))
+
+ ;; FINAL RETURN (list of same-depth binders + their depth)
+ (list bound
+ #'(binder …)
+ #'(unique-at-runtime-id …)
+ (car depths)
+ #'check-ellipsis-count-ddd))))
(define-for-syntax/case-args ((sub*template tmpl-form) (self . tmpl))
(define acc '())
+
+ ;; Finds identifiers of the form zᵢ, and return a list of existing xᵢ bindings
(define (fold-process stx rec)
(syntax-case stx ()
[(id . _) (and (identifier? #'id)
(free-identifier=? #'id #'unsyntax))
stx]
[id (identifier? #'id)
- (let ([binders+info (find-subscript-binder2 #'id)])
+ (let ([binders+info (find-subscript-binder #'id)])
(when binders+info
(set! acc (cons binders+info acc)))
#'id)]
[other (rec #'other)]))
- ;; process the syntax, extract the derived bindings into acc
+ ;; Process the syntax, extract the derived bindings into acc
+ ;; Does not take zᵢ identifiers generated by template metafunctions into
+ ;; account for now.
(fold-syntax fold-process #'tmpl)
+
;; define the result, which looks like (template . tmpl) or
;; like (quasitemplate . tmpl)
(define result
(quasisyntax/top-loc #'self
- (#,tmpl-form
- . tmpl)))
+ (#,tmpl-form . tmpl)))
;; Make sure that we remove duplicates, otherwise we'll get errors if we
;; define the same derived id twice.
- (define/with-syntax ([bound binders
- max-binders
- depth
- scope-depth
- check-ellipsis-count] …)
+ (define/with-syntax ([bound
+ binders
+ unique-at-runtime-ids
+ ellipsis-depth
+ check-ellipsis-count]
+ …)
(remove-duplicates acc #:key car))
#`(let ()
- (derive bound binders max-binders depth scope-depth)
+ (derive bound binders unique-at-runtime-ids ellipsis-depth)
…
(let ()
;; no-op, just to raise an error when they are incompatible
- #'(check-ellipsis-count …)
+ #'(check-ellipsis-count …) ;; TODO: allow #f values for ~optional in syntax/parse ;;;;;;;;;;;;;;
;; actually call template or quasitemplate
#,result)))
(define-syntax subtemplate (sub*template #'template))
(define-syntax quasisubtemplate (sub*template #'quasitemplate))
+(define/contract (multi-hash-ref! h keys to-set)
+ ;; This assumes that the hash does not get mutated during the execution of
+ ;; this function.
+ (-> (and/c (hash/c symbol? any/c #:immutable #f) hash-weak?)
+ (listof symbol?)
+ any/c
+ any/c)
+ (define val (or (for/or ([k (in-list keys)]) (hash-ref h k #f))
+ to-set))
+ (for ([k (in-list keys)]) (hash-ref! h k val))
+ val)
+
+(define/contract ((stx-list*+stx/c depth) l)
+ (-> exact-nonnegative-integer? (-> any/c boolean?))
+ (if (= depth 0)
+ (syntax? l)
+ (and (syntax? l)
+ (syntax->list l)
+ (andmap (λ (lᵢ) ((stx-list*+stx/c (sub1 depth)) lᵢ))
+ (syntax->list l)))))
+(define/contract ((list*+stx/c depth) l)
+ (-> exact-nonnegative-integer? (-> any/c boolean?))
+ (if (= depth 0)
+ (syntax? l)
+ (and (list? l)
+ (andmap (λ (lᵢ) ((list*+stx/c (sub1 depth)) lᵢ))
+ l))))
-(define-syntax/case (derive bound binders max-binders stx-depth stx-scope-depth)
- ()
- ;; TODO: shouldn't it be called in the first place?
- (if (syntax-pattern-variable? (syntax-local-value #'bound (thunk #f)))
- #'(begin)
- #'(derive2 bound binders max-binders stx-depth stx-scope-depth)))
+(define/contract (destructure-stx-list* l depth)
+ (->i ([l (depth) (stx-list*+stx/c depth)]
+ [depth exact-nonnegative-integer?])
+ [range (depth) (list*+stx/c depth)])
+ (if (= depth 0)
+ l
+ (stx-map (λ (lᵢ) (destructure-stx-list* lᵢ (sub1 depth)))
+ l)))
-(define-syntax/case (derive2 bound
- binders
- (max-binder0 . max-binders)
- stx-depth
- stx-scope-depth) ()
- (define depth (syntax-e #'stx-depth))
+(define-syntax/case (derive bound
+ (binder₀ binderᵢ …)
+ (unique-at-runtime-idᵢ …)
+ ellipsis-depth) ()
+ (define depth (syntax-e #'ellipsis-depth))
(define/with-syntax bound-ddd (nest-ellipses #'bound depth))
(define/with-syntax tmp-id
- (format-id #'here "~a/~a" #'max-binder0 (drop-subscripts #'bound)))
+ (format-id #'here "~a/~a" #'binder₀ (drop-subscripts #'bound)))
(define/with-syntax tmp-str
(datum->syntax #'tmp-id
(symbol->string
(syntax-e
(format-id #'here "~~a/~a" (drop-subscripts #'bound))))))
(define/with-syntax tmp-ddd (nest-ellipses #'tmp-id depth))
- (define/with-syntax binder-ddd (nest-ellipses #'max-binder0 depth))
+ (define/with-syntax binder-ddd (nest-ellipses #'binder₀ depth))
;; Draw arrows in DrRacket.
(with-arrows
- (define subscripts (subscript-equal? #'bound #'max-binder0))
+ (define subscripts (subscript-equal? #'bound #'binder₀))
(define bound-id-str (identifier->string #'bound))
- (for ([max-binder (in-list (syntax->list #'(max-binder0 . max-binders)))])
- (define binder-id-str (identifier->string max-binder))
+ (for ([binder (in-list (syntax->list #'(binder₀ binderᵢ …)))])
+ (define binder-id-str (identifier->string binder))
(record-sub-range-binders! (vector #'bound
(- (string-length bound-id-str)
(string-length subscripts))
(string-length subscripts)
- max-binder
+ binder
(- (string-length binder-id-str)
(string-length subscripts))
(string-length subscripts))))
- #;(define binder0-id-str (identifier->string #'max-binder0))
+ #;(define binder0-id-str (identifier->string #'binder0))
#;(record-sub-range-binders! (vector #'bound
(- (string-length bound-id-str)
(string-length subscripts))
(string-length subscripts)
- #'max-binder0
+ #'binder0
(- (string-length binder0-id-str)
(string-length subscripts))
(string-length subscripts)))
+ (define/with-syntax temp-derived (generate-temporary #'bound))
+ (define/with-syntax temp-cached (generate-temporary #'bound))
;; HERE: cache the define-temp-ids in the free-id-table, and make sure
;; that we retrieve the cached ones, so that two subtemplate within the same
;; syntax-case or syntax-parse clause use the same derived ids.
@@ -322,11 +310,16 @@
;; zᵢ …))])
;; the test above is not exactly right (zᵢ will still have the correct
;; binding), but it gives the general idea.
- #`(begin (define-temp-ids tmp-str binder-ddd)
- (define cached (hash-ref! (list-ref pvar-values-id
- stx-scope-depth)
- 'bound
- #'tmp-ddd))
- (define/with-syntax bound-ddd cached)
- (define-syntax #,(format-id #'bound " is-derived-~a " #'bound)
- (derived)))))
+ #`(begin (define-temp-ids #:concise tmp-str binder-ddd)
+ (define temp-cached
+ (free-id-table-ref! (multi-hash-ref! derived-valvar-cache
+ '(unique-at-runtime-idᵢ …)
+ (make-free-id-table))
+ (quote-syntax bound)
+ (destructure-stx-list* #'tmp-ddd
+ 'ellipsis-depth)))
+ (define-syntax temp-derived
+ (derived-valvar (quote-syntax temp-cached)))
+ (define-syntax bound
+ (make-syntax-mapping 'ellipsis-depth (quote-syntax temp-derived)))
+ (define-pvars bound))))
+\ No newline at end of file
diff --git a/test/assumption-free-identifier-equal.rkt b/test/assumption-free-identifier-equal.rkt
@@ -0,0 +1,20 @@
+#lang racket
+(define-for-syntax outer #f)
+(define-for-syntax inner #f)
+(let ([x 1])
+ (define-syntax (capture1 stx)
+ (set! outer #'x)
+ #'(void))
+ (capture1)
+ (let ([x 2])
+ (define-syntax (capture2 stx)
+ (set! inner #'x)
+ #'(void))
+ (capture2)
+ (let ([y 3])
+ (define-syntax (compare stx)
+ (define candidate (datum->syntax #'y 'x))
+ (displayln (free-identifier=? candidate inner))
+ (displayln (free-identifier=? candidate outer))
+ #'(void))
+ (compare))))
+\ No newline at end of file
diff --git a/test/assumption-weak-hash.rkt b/test/assumption-weak-hash.rkt
@@ -0,0 +1,24 @@
+#lang racket
+
+(require (for-syntax racket/private/sc))
+
+(define h (make-weak-hasheq))
+
+(define (all-eq? l)
+ (foldl (λ (x acc)
+ (and (eq? x acc) acc))
+ (car l)
+ (cdr l)))
+
+(for/list ([range-a (in-range 100)])
+ (with-syntax ([(xᵢ ...) #'(1 2 3)])
+ (define-syntax (hh stx)
+ #`(hash-ref! h
+ #,(syntax-mapping-valvar (syntax-local-value #'xᵢ))
+ (gensym)))
+ (displayln (hash->list h))
+ (all-eq? (for/list ([range-b (in-range 5)])
+ ;(collect-garbage)
+ ;(collect-garbage)
+ ;(collect-garbage)
+ (hh)))))
+\ No newline at end of file
diff --git a/test/test-subtemplate.rkt b/test/test-subtemplate.rkt
@@ -1,5 +1,7 @@
#lang racket
-(require "../subtemplate.rkt"
+(require subtemplate
+ stxparse-info/parse
+ stxparse-info/case
phc-toolkit/untyped
rackunit)
@@ -22,11 +24,70 @@
|#
+
(check-equal? (syntax->datum (syntax-parse #'(a b c d)
[(_ xⱼ zᵢ …)
(subtemplate foo)]))
'foo)
+(check-equal? (syntax->datum (syntax-case #'(a b c d) ()
+ [(_ xⱼ zᵢ …)
+ (subtemplate foo)]))
+ 'foo)
+
+(check-equal? (syntax->datum (syntax-parse #'(a b c d)
+ [(_ xⱼ zᵢ …)
+ (subtemplate xⱼ)]))
+ 'b)
+
+(check-equal? (syntax->datum (syntax-case #'(a b c d) ()
+ [(_ xⱼ zᵢ …)
+ (subtemplate xⱼ)]))
+ 'b)
+
+(check-equal? (syntax->datum (syntax-parse #'(a b c d)
+ [(_ xⱼ zᵢ …)
+ (subtemplate (zᵢ …))]))
+ '(c d))
+
+(check-equal? (syntax->datum (syntax-case #'(a b c d) ()
+ [(_ xⱼ zᵢ …)
+ (subtemplate (zᵢ …))]))
+ '(c d))
+
+(check-equal? (syntax->datum (syntax-parse #'(a b c d)
+ [(_ xⱼ zᵢ …)
+ (subtemplate (wᵢ …))]))
+ '(c/w d/w))
+
+(check-equal? (syntax->datum (syntax-case #'(a b c d) ()
+ [(_ xⱼ zᵢ …)
+ (subtemplate (wᵢ …))]))
+ '(c/w d/w))
+
+(check-equal? (syntax->datum (syntax-parse #'(a b c d)
+ [(_ xⱼ zᵢ …)
+ (subtemplate (kⱼ wᵢ …))]))
+ '(b/k c/w d/w))
+
+(check-equal? (syntax->datum (syntax-case #'(a b c d) ()
+ [(_ xⱼ zᵢ …)
+ (subtemplate (kⱼ wᵢ …))]))
+ '(b/k c/w d/w))
+
+(check-equal? (syntax->datum (syntax-parse #'(a b c d)
+ [(_ xⱼ zᵢ …)
+ (subtemplate (xⱼ kⱼ (zᵢ wᵢ) …))]))
+ '(b b/k (c c/w) (d d/w)))
+
+(check-equal? (syntax->datum (syntax-case #'(a b c d) ()
+ [(_ xⱼ zᵢ …)
+ (subtemplate (xⱼ kⱼ (wᵢ zᵢ) …))]))
+ '(b b/k (c/w c) (d/w d)))
+
+
+
+
#;(let ()
(syntax-parse #'a #;(syntax-parse #'(a b c d)
[(_ xⱼ zᵢ …)
@@ -427,7 +488,7 @@
(check free-identifier=? #'zz2 #'b)
(check free-identifier=? #'x1 #'x2)
- (check (∘ not free-identifier=?) #'w1 #'w2) ;; yes above, no here.
+ (check (∘ not bound-identifier=?) #'w1 #'w2) ;; yes above, no here.
(check free-identifier=? #'foo1 #'foo2)
(check free-identifier=? #'z1 #'z2)
(check free-identifier=? #'p1 #'p2)
diff --git a/test/wrong-assumption-with-syntax-eq.rkt b/test/wrong-assumption-with-syntax-eq.rkt
@@ -0,0 +1,18 @@
+#lang racket
+(require (for-syntax racket/private/sc))
+
+(define old #f)
+
+(for/list ([range-a (in-range 100)])
+ ;; The contents of the valvar is eq? when using a literal syntax object
+ ;; #'(1 2 3), but not with (datum->syntax #'here '(1 2 3)).
+ ;; I expected the result to always be different at each execution of the
+ ;; with-syntax, but it turns out the syntax object is kept as-is.
+ (with-syntax ([(xᵢ ...) #'(1 2 3) #;(datum->syntax #'here '(1 2 3))])
+ (define-syntax (hh stx)
+ #`#,(syntax-mapping-valvar (syntax-local-value #'xᵢ)))
+ (unless old
+ (displayln "initial set!")
+ (set! old (hh)))
+ (andmap identity (for/list ([range-b (in-range 5)])
+ (eq? old hh)))))
+\ No newline at end of file
