2021-06-04 13:56:03 +00:00
|
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
2022-01-16 08:48:18 +00:00
|
|
|
;;; SPDX-FileCopyrightText: Copyright © 2015-2022 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
2021-06-01 15:19:24 +00:00
|
|
|
|
2018-03-21 08:16:54 +00:00
|
|
|
#lang racket/base
|
|
|
|
|
2021-06-02 10:37:36 +00:00
|
|
|
(provide (for-syntax preserves-pattern-registry
|
|
|
|
register-preserves-pattern!
|
|
|
|
analyse-pattern
|
2021-06-10 14:21:30 +00:00
|
|
|
analyse-pattern-bindings
|
|
|
|
analyse-match-pattern)
|
2021-06-02 10:37:36 +00:00
|
|
|
define-preserves-pattern
|
2021-06-02 10:50:21 +00:00
|
|
|
:pattern
|
2021-06-10 14:21:30 +00:00
|
|
|
:parse
|
2021-06-03 13:58:48 +00:00
|
|
|
|
|
|
|
pattern->constant-values
|
|
|
|
pattern->constant-paths
|
|
|
|
pattern->capture-paths
|
|
|
|
|
2021-06-03 21:23:48 +00:00
|
|
|
!dump-registered-preserves-patterns!
|
|
|
|
|
2021-07-01 07:40:52 +00:00
|
|
|
(all-from-out "schemas/dataspacePatterns.rkt"))
|
2018-04-08 10:44:32 +00:00
|
|
|
|
|
|
|
(require (for-syntax racket/base))
|
|
|
|
(require (for-syntax racket/match))
|
2021-06-02 10:37:36 +00:00
|
|
|
(require (for-syntax racket/list))
|
2018-04-08 10:44:32 +00:00
|
|
|
(require (for-syntax racket/struct-info))
|
2021-06-02 10:50:21 +00:00
|
|
|
(require (for-syntax racket/syntax))
|
2021-06-02 10:37:36 +00:00
|
|
|
(require (for-syntax syntax/id-table))
|
2018-04-08 10:44:32 +00:00
|
|
|
(require (for-syntax syntax/stx))
|
2021-06-02 10:37:36 +00:00
|
|
|
|
2021-06-17 11:38:30 +00:00
|
|
|
(require preserves)
|
2021-06-08 13:38:24 +00:00
|
|
|
(require preserves-schema)
|
2021-06-03 13:58:48 +00:00
|
|
|
(require racket/match)
|
|
|
|
(require racket/list)
|
2018-05-04 16:52:16 +00:00
|
|
|
(require "pattern-expander.rkt")
|
2021-06-18 15:02:56 +00:00
|
|
|
(require "smart-pattern.rkt")
|
2021-07-01 07:40:52 +00:00
|
|
|
(require "schemas/dataspacePatterns.rkt")
|
2021-06-02 10:37:36 +00:00
|
|
|
|
|
|
|
;;---------------------------------------------------------------------------
|
2018-03-21 08:16:54 +00:00
|
|
|
|
2021-06-02 10:37:36 +00:00
|
|
|
(define-for-syntax preserves-pattern-registry (make-free-id-table))
|
|
|
|
|
|
|
|
(define-for-syntax (register-preserves-pattern! id-stx transformer)
|
|
|
|
(free-id-table-set! preserves-pattern-registry id-stx transformer))
|
|
|
|
|
|
|
|
(define-syntax (define-preserves-pattern stx)
|
|
|
|
(syntax-case stx ()
|
2021-06-10 14:21:30 +00:00
|
|
|
[(_ top-type-name parser-name (ctor-stx field-stxs ...) pattern-stx bindings-stx)
|
2021-06-02 10:50:21 +00:00
|
|
|
#`(begin (begin-for-syntax
|
2021-06-02 10:37:36 +00:00
|
|
|
(register-preserves-pattern!
|
|
|
|
#'ctor-stx
|
|
|
|
(lambda (mode s)
|
|
|
|
(match mode
|
|
|
|
['pattern
|
|
|
|
(syntax-case s ()
|
|
|
|
[(_ field-stxs ...) pattern-stx]
|
2021-06-18 12:57:05 +00:00
|
|
|
[_ (raise-syntax-error 'ctor-stx "Invalid pattern" s)])]
|
2021-06-10 14:21:30 +00:00
|
|
|
['match-pattern
|
|
|
|
(syntax-case s ()
|
|
|
|
[(_ field-stxs ...) #`(app parser-name (ctor-stx field-stxs ...))]
|
2021-06-18 12:57:05 +00:00
|
|
|
[_ (raise-syntax-error 'ctor-stx "Invalid match-pattern" s)])]
|
2021-06-02 10:37:36 +00:00
|
|
|
['bindings
|
|
|
|
(syntax-case s ()
|
|
|
|
[(_ field-stxs ...) bindings-stx]
|
2021-06-18 12:57:05 +00:00
|
|
|
[_ (raise-syntax-error 'ctor-stx "Invalid binding-pattern" s)])]))))
|
2021-06-02 10:37:36 +00:00
|
|
|
(void))]))
|
2018-03-21 08:16:54 +00:00
|
|
|
|
|
|
|
;;---------------------------------------------------------------------------
|
|
|
|
|
2018-05-04 16:52:16 +00:00
|
|
|
(define-for-syntax orig-insp
|
|
|
|
(variable-reference->module-declaration-inspector (#%variable-reference)))
|
|
|
|
|
2018-04-08 10:44:32 +00:00
|
|
|
(begin-for-syntax
|
|
|
|
(define (dollar-id? stx)
|
|
|
|
(and (identifier? stx)
|
|
|
|
(char=? (string-ref (symbol->string (syntax-e stx)) 0) #\$)))
|
|
|
|
|
|
|
|
(define (undollar stx)
|
|
|
|
(and (dollar-id? stx)
|
|
|
|
(datum->syntax stx (string->symbol (substring (symbol->string (syntax-e stx)) 1)))))
|
|
|
|
|
2021-06-18 15:02:56 +00:00
|
|
|
(define (id=? expected stx)
|
2018-04-08 10:44:32 +00:00
|
|
|
(and (identifier? stx)
|
2021-06-18 15:02:56 +00:00
|
|
|
(free-identifier=? expected stx)))
|
2018-04-08 10:44:32 +00:00
|
|
|
|
|
|
|
(define (id-value stx)
|
|
|
|
(and (identifier? stx)
|
|
|
|
(syntax-local-value stx (lambda () #f))))
|
|
|
|
|
2021-06-18 15:02:56 +00:00
|
|
|
(define (discard-id? stx) (id=? #'_ stx))
|
|
|
|
(define (list-id? stx) (id=? #'list stx))
|
|
|
|
(define (hash-or-hasheqv-id? stx) (or (id=? #'hash stx) (id=? #'hasheqv stx)))
|
2021-06-03 20:42:42 +00:00
|
|
|
|
2021-06-02 10:37:36 +00:00
|
|
|
(define (constructor-registered? stx)
|
|
|
|
(free-id-table-ref preserves-pattern-registry stx #f))
|
|
|
|
|
2022-01-16 23:18:57 +00:00
|
|
|
(define (struct-label/arity-check id-stx actual-count)
|
2021-06-02 10:37:36 +00:00
|
|
|
(match-define (list _type-stx ctor-stx pred-stx accessor-stxs _mutator-stxs _super)
|
|
|
|
(extract-struct-info (id-value id-stx)))
|
|
|
|
(define expected-count (length accessor-stxs))
|
|
|
|
(when (not (= expected-count actual-count))
|
|
|
|
(raise-syntax-error ':pattern
|
|
|
|
(format "Expected ~a arguments to ~v, but got ~a"
|
|
|
|
expected-count
|
|
|
|
ctor-stx
|
|
|
|
actual-count)))
|
2022-01-16 23:18:57 +00:00
|
|
|
(syntax-e ctor-stx))
|
2018-05-01 19:57:22 +00:00
|
|
|
|
2021-06-03 20:42:42 +00:00
|
|
|
(define (append-map-pairs f xs)
|
|
|
|
(match xs
|
|
|
|
['() '()]
|
|
|
|
[(list _) (raise-syntax-error #f "Odd number of elements in hash-like pattern")]
|
|
|
|
[(list* k v more) (append (f k v) (append-map-pairs f more))]))
|
|
|
|
|
2021-06-10 11:32:39 +00:00
|
|
|
(define (analyse-pattern stx
|
|
|
|
[check-destructuring (lambda (stx) stx)]
|
|
|
|
[wrap-literal (lambda (stx) stx)])
|
2021-06-18 15:02:56 +00:00
|
|
|
(define (walk-hash pieces-stx)
|
2022-01-16 23:18:57 +00:00
|
|
|
(append-map-pairs (lambda (key-stx pat-stx)
|
|
|
|
(list key-stx (analyse-pattern pat-stx check-destructuring wrap-literal)))
|
|
|
|
(syntax->list pieces-stx)))
|
2021-06-10 11:32:39 +00:00
|
|
|
(let walk ((stx stx))
|
|
|
|
(define disarmed-stx (syntax-disarm stx orig-insp))
|
|
|
|
(syntax-case disarmed-stx ($ quasiquote unquote quote)
|
|
|
|
[(expander args ...)
|
|
|
|
(pattern-expander-id? #'expander)
|
|
|
|
(pattern-expander-transform disarmed-stx
|
2021-06-10 14:21:30 +00:00
|
|
|
(lambda (result) (walk (syntax-rearm result stx))))]
|
2021-06-10 11:32:39 +00:00
|
|
|
|
2021-06-18 12:57:21 +00:00
|
|
|
[(ctor args ...)
|
|
|
|
(constructor-registered? #'ctor)
|
2022-01-16 23:18:57 +00:00
|
|
|
((free-id-table-ref preserves-pattern-registry #'ctor) 'pattern disarmed-stx)]
|
2021-06-18 12:57:21 +00:00
|
|
|
|
2021-06-10 11:32:39 +00:00
|
|
|
;; Extremely limited support for quasiquoting and quoting
|
|
|
|
[(quasiquote (unquote p)) (walk #'p)]
|
|
|
|
[(quasiquote (p ...)) (walk #'(list (quasiquote p) ...))]
|
2022-01-16 23:18:57 +00:00
|
|
|
[(quasiquote p) #`(literal->literal-pattern #,(wrap-literal #''p))]
|
|
|
|
[(quote p) #`(literal->literal-pattern #,(wrap-literal #''p))]
|
2021-06-10 11:32:39 +00:00
|
|
|
|
|
|
|
[(unquote p) #'p]
|
|
|
|
|
|
|
|
[(ctor piece ...)
|
|
|
|
(struct-info? (id-value #'ctor))
|
2022-01-16 23:18:57 +00:00
|
|
|
(let ((label (struct-label/arity-check #'ctor (length (syntax->list #'(piece ...))))))
|
|
|
|
(check-destructuring #`(rec '#,label (list #,@(map walk (syntax->list #'(piece ...)))))))]
|
2021-06-10 11:32:39 +00:00
|
|
|
|
|
|
|
[(list-stx piece ...)
|
|
|
|
(list-id? #'list-stx)
|
2022-01-16 23:18:57 +00:00
|
|
|
(check-destructuring #`(arr (list #,@(map walk (syntax->list #'(piece ...))))))]
|
2021-06-10 11:32:39 +00:00
|
|
|
|
|
|
|
[(hash-stx piece ...)
|
|
|
|
(hash-or-hasheqv-id? #'hash-stx)
|
2022-01-16 23:18:57 +00:00
|
|
|
(check-destructuring #`(dict (hash #,@(walk-hash #'(piece ...)))))]
|
2021-06-10 11:32:39 +00:00
|
|
|
|
|
|
|
[id
|
|
|
|
(dollar-id? #'id)
|
2021-08-11 19:52:01 +00:00
|
|
|
#`(Pattern-DBind (DBind (Pattern-DDiscard (DDiscard))))]
|
2021-06-10 11:32:39 +00:00
|
|
|
|
|
|
|
[($ (unquote bp) p)
|
2021-08-11 19:52:01 +00:00
|
|
|
#`(Pattern-DBind (DBind #,(walk #'p)))]
|
2021-06-10 11:32:39 +00:00
|
|
|
|
|
|
|
[($ id p)
|
2021-08-11 19:52:01 +00:00
|
|
|
#`(Pattern-DBind (DBind #,(walk #'p)))]
|
2021-06-10 11:32:39 +00:00
|
|
|
|
|
|
|
[id
|
|
|
|
(discard-id? #'id)
|
|
|
|
#`(Pattern-DDiscard (DDiscard))]
|
|
|
|
|
2022-01-16 23:18:57 +00:00
|
|
|
[(c l (list-stx piece ...))
|
|
|
|
(and (id=? #'rec #'c)
|
|
|
|
(list-id? #'list-stx))
|
|
|
|
#`(rec* l (list #,@(map walk (syntax->list #'(piece ...)))))]
|
2021-06-18 15:02:56 +00:00
|
|
|
|
2022-01-16 23:18:57 +00:00
|
|
|
[(c (list-stx piece ...))
|
|
|
|
(and (id=? #'arr #'c)
|
|
|
|
(list-id? #'list-stx))
|
|
|
|
#`(arr* (list #,@(map walk (syntax->list #'(piece ...)))))]
|
2021-06-18 15:02:56 +00:00
|
|
|
|
|
|
|
[(c (hash-stx piece ...))
|
2022-01-16 23:18:57 +00:00
|
|
|
(and (id=? #'dict #'c)
|
2021-06-18 15:02:56 +00:00
|
|
|
(hash-or-hasheqv-id? #'hash-stx))
|
2022-01-16 23:18:57 +00:00
|
|
|
#`(dict* (hash-stx #,@(walk-hash #'(piece ...))))]
|
2021-06-18 15:02:56 +00:00
|
|
|
|
2022-01-16 23:18:57 +00:00
|
|
|
[other #`(literal->literal-pattern #,(wrap-literal #'other))])))
|
2018-04-22 20:07:35 +00:00
|
|
|
|
2021-06-02 10:37:36 +00:00
|
|
|
(define (analyse-pattern-bindings stx)
|
2021-06-08 07:30:29 +00:00
|
|
|
(let walk ((stx stx))
|
|
|
|
(define disarmed-stx (syntax-disarm stx orig-insp))
|
|
|
|
(syntax-case disarmed-stx ($ quasiquote unquote quote)
|
|
|
|
[(expander args ...)
|
|
|
|
(pattern-expander-id? #'expander)
|
|
|
|
(pattern-expander-transform disarmed-stx
|
|
|
|
(lambda (result) (walk (syntax-rearm result stx))))]
|
|
|
|
|
2021-06-18 12:57:21 +00:00
|
|
|
[(ctor args ...)
|
|
|
|
(constructor-registered? #'ctor)
|
|
|
|
((free-id-table-ref preserves-pattern-registry #'ctor) 'bindings disarmed-stx)]
|
|
|
|
|
2021-06-08 07:30:29 +00:00
|
|
|
;; Extremely limited support for quasiquoting and quoting
|
|
|
|
[(quasiquote (unquote p)) (walk #'p)]
|
|
|
|
[(quasiquote (p ...)) (walk #'(list (quasiquote p) ...))]
|
|
|
|
[(quasiquote _p) '()]
|
|
|
|
[(quote _p) '()]
|
|
|
|
|
|
|
|
[(ctor piece ...)
|
|
|
|
(struct-info? (id-value #'ctor))
|
|
|
|
(append-map walk (syntax->list #'(piece ...)))]
|
|
|
|
|
|
|
|
[(list-stx piece ...)
|
|
|
|
(list-id? #'list-stx)
|
|
|
|
(append-map walk (syntax->list #'(piece ...)))]
|
|
|
|
|
|
|
|
[(hash-stx piece ...)
|
|
|
|
(hash-or-hasheqv-id? #'hash-stx)
|
|
|
|
(append-map-pairs (lambda (_k v) (walk v)) (syntax->list #'(piece ...)))]
|
|
|
|
|
|
|
|
[id
|
|
|
|
(dollar-id? #'id)
|
|
|
|
(list (undollar #'id))]
|
|
|
|
|
|
|
|
[($ id p)
|
|
|
|
(cons #'id (walk #'p))]
|
|
|
|
|
|
|
|
[id
|
|
|
|
(discard-id? #'id)
|
|
|
|
'()]
|
|
|
|
|
2022-01-16 23:18:57 +00:00
|
|
|
[(c l (list-stx piece ...))
|
|
|
|
(and (id=? #'rec #'c)
|
|
|
|
(list-id? #'list-stx))
|
|
|
|
(append-map walk (syntax->list #'(piece ...)))]
|
2021-06-18 15:02:56 +00:00
|
|
|
|
2022-01-16 23:18:57 +00:00
|
|
|
[(c (list-stx piece ...))
|
|
|
|
(and (id=? #'arr #'c)
|
|
|
|
(list-id? #'list-stx))
|
|
|
|
(append-map walk (syntax->list #'(piece ...)))]
|
2021-06-18 15:02:56 +00:00
|
|
|
|
|
|
|
[(c (hash-stx piece ...))
|
2022-01-16 23:18:57 +00:00
|
|
|
(and (id=? #'dict #'c)
|
2021-06-18 15:02:56 +00:00
|
|
|
(hash-or-hasheqv-id? #'hash-stx))
|
|
|
|
(append-map-pairs (lambda (_k v) (walk v)) (syntax->list #'(piece ...)))]
|
|
|
|
|
2022-01-16 23:18:57 +00:00
|
|
|
[other '()])))
|
2021-06-02 10:37:36 +00:00
|
|
|
|
2021-06-10 14:21:30 +00:00
|
|
|
(define (analyse-match-pattern stx)
|
|
|
|
(let walk ((stx stx))
|
|
|
|
(define disarmed-stx (syntax-disarm stx orig-insp))
|
|
|
|
(syntax-case disarmed-stx ($ quasiquote unquote quote)
|
|
|
|
[(expander args ...)
|
|
|
|
(pattern-expander-id? #'expander)
|
|
|
|
(pattern-expander-transform disarmed-stx
|
|
|
|
(lambda (result) (walk (syntax-rearm result stx))))]
|
|
|
|
|
2021-06-18 12:57:21 +00:00
|
|
|
[(ctor args ...)
|
|
|
|
(constructor-registered? #'ctor)
|
|
|
|
((free-id-table-ref preserves-pattern-registry #'ctor) 'match-pattern disarmed-stx)]
|
|
|
|
|
2021-06-10 14:21:30 +00:00
|
|
|
;; Extremely limited support for quasiquoting and quoting
|
|
|
|
[(quasiquote (unquote p)) (walk #'p)]
|
|
|
|
[(quasiquote (p ...)) (walk #'(list (quasiquote p) ...))]
|
|
|
|
[(quasiquote p) #''p]
|
|
|
|
[(quote p) #''p]
|
|
|
|
|
|
|
|
[(unquote p) (raise-syntax-error #f "Out-of-place unquote in match-pattern")]
|
|
|
|
|
|
|
|
[(ctor piece ...)
|
|
|
|
(struct-info? (id-value #'ctor))
|
|
|
|
#`(ctor (:parse piece) ...)]
|
|
|
|
|
|
|
|
[(list-stx piece ...)
|
|
|
|
(list-id? #'list-stx)
|
|
|
|
#`(list-stx (:parse piece) ...)]
|
|
|
|
|
|
|
|
[(hash-stx piece ...)
|
|
|
|
(hash-or-hasheqv-id? #'hash-stx)
|
|
|
|
#`(hash-table #,@(let loop ((pieces (syntax->list #'(piece ...))))
|
|
|
|
(match pieces
|
|
|
|
['() '()]
|
|
|
|
[(list* k v more) (list* k #`(:parse #,v) (loop more))]))
|
|
|
|
[_ _] ___)]
|
|
|
|
|
|
|
|
[(or-stx piece ...)
|
|
|
|
(and (identifier? #'or-stx) (free-identifier=? #'or #'or-stx))
|
|
|
|
#`(or (:parse piece) ...)]
|
|
|
|
|
|
|
|
[(and-stx piece ...)
|
|
|
|
(and (identifier? #'and-stx) (free-identifier=? #'and #'and-stx))
|
|
|
|
#`(and (:parse piece) ...)]
|
|
|
|
|
|
|
|
[other
|
|
|
|
#`other])))
|
|
|
|
|
2021-06-10 11:32:39 +00:00
|
|
|
(define (expand-:pattern stx)
|
2021-06-03 20:44:18 +00:00
|
|
|
(syntax-case stx ()
|
2021-06-10 11:32:39 +00:00
|
|
|
[(_ pat-stx atomic-literal-transformer)
|
|
|
|
(analyse-pattern #'pat-stx
|
|
|
|
(lambda (stx) (raise-syntax-error #f "Attempt to destructure known-atomic"))
|
|
|
|
(lambda (stx) #`(atomic-literal-transformer #,stx)))]
|
2021-06-03 20:44:18 +00:00
|
|
|
[(_ pat-stx)
|
|
|
|
(analyse-pattern #'pat-stx)])))
|
2021-06-02 10:37:36 +00:00
|
|
|
|
2021-06-10 11:32:39 +00:00
|
|
|
(define-pattern-expander :pattern
|
|
|
|
(lambda (stx)
|
|
|
|
;; This effectively quasiquotes the pattern; a naked unquote in
|
|
|
|
;; the pattern returns to the "outer" context. This is useful for
|
|
|
|
;; observing observers:
|
|
|
|
;;
|
|
|
|
;; (Observe (:pattern (some-pattern ...)) _)
|
|
|
|
;;
|
|
|
|
(expand-:pattern stx))
|
|
|
|
(lambda (stx)
|
|
|
|
(expand-:pattern stx)))
|
|
|
|
|
2021-06-10 14:21:30 +00:00
|
|
|
(define-match-expander :parse
|
|
|
|
(lambda (stx)
|
|
|
|
(syntax-case stx ()
|
|
|
|
[(_ pat-stx) (analyse-match-pattern #'pat-stx)])))
|
|
|
|
|
2021-06-03 13:58:48 +00:00
|
|
|
;;---------------------------------------------------------------------------
|
|
|
|
|
|
|
|
(define (select-pattern-leaves desc capture-fn lit-fn)
|
|
|
|
(let walk-node ((key-rev '()) (desc desc))
|
|
|
|
(match desc
|
2022-01-16 23:18:57 +00:00
|
|
|
[(Pattern-DCompound (or (DCompound-rec _ fields)
|
|
|
|
(DCompound-arr fields)))
|
|
|
|
(append* (for/list [(key (in-naturals)) (subdesc (in-list fields))]
|
|
|
|
(walk-node (cons key key-rev) subdesc)))]
|
|
|
|
[(Pattern-DCompound (DCompound-dict entries))
|
|
|
|
(append* (for/list [((key subdesc) (in-hash entries))]
|
2021-06-03 13:58:48 +00:00
|
|
|
(walk-node (cons key key-rev) subdesc)))]
|
2021-08-11 19:52:01 +00:00
|
|
|
[(Pattern-DBind (DBind subdesc))
|
|
|
|
(append (capture-fn key-rev) (walk-node key-rev subdesc))]
|
2021-06-03 13:58:48 +00:00
|
|
|
[(Pattern-DDiscard (DDiscard))
|
|
|
|
'()]
|
|
|
|
[(Pattern-DLit (DLit value))
|
2022-01-16 23:18:57 +00:00
|
|
|
(lit-fn key-rev (->preserve value))])))
|
2021-06-03 13:58:48 +00:00
|
|
|
|
|
|
|
(define (pattern->constant-values desc)
|
|
|
|
(select-pattern-leaves desc
|
2021-08-11 19:52:01 +00:00
|
|
|
(lambda (key-rev) (list))
|
2021-06-03 13:58:48 +00:00
|
|
|
(lambda (key-rev value) (list value))))
|
|
|
|
|
|
|
|
(define (pattern->constant-paths desc)
|
|
|
|
(select-pattern-leaves desc
|
2021-08-11 19:52:01 +00:00
|
|
|
(lambda (key-rev) (list))
|
2021-06-03 13:58:48 +00:00
|
|
|
(lambda (key-rev value) (list (reverse key-rev)))))
|
|
|
|
|
|
|
|
(define (pattern->capture-paths desc)
|
|
|
|
(select-pattern-leaves desc
|
2021-08-11 19:52:01 +00:00
|
|
|
(lambda (key-rev) (list (reverse key-rev)))
|
2021-06-03 13:58:48 +00:00
|
|
|
(lambda (key-rev value) (list))))
|
|
|
|
|
2021-06-03 21:23:48 +00:00
|
|
|
(define-syntax (!dump-registered-preserves-patterns! stx)
|
|
|
|
(syntax-case stx ()
|
|
|
|
[(_)
|
|
|
|
(let ()
|
|
|
|
(local-require racket/pretty)
|
|
|
|
(for [(k (in-list (free-id-table-keys preserves-pattern-registry)))]
|
|
|
|
(printf " - ~v\n" k))
|
|
|
|
#'(void))]))
|