utils: Add extract-symbols.
This commit is contained in:
parent
1a174ad8e0
commit
9cbfcfca4b
2 changed files with 24 additions and 1 deletions
|
@ -29,3 +29,7 @@
|
||||||
(check-equal? (let ([ht #hash((a . 1) (b . 1))])
|
(check-equal? (let ([ht #hash((a . 1) (b . 1))])
|
||||||
(eval-with1 ht '(+ b a 1)))
|
(eval-with1 ht '(+ b a 1)))
|
||||||
3)))
|
3)))
|
||||||
|
|
||||||
|
(test-case "Analysis of quoted expressions"
|
||||||
|
(check-equal? (extract-symbols '(1 (2 3) x (y z 3)))
|
||||||
|
'(x y z)))
|
||||||
|
|
21
utils.rkt
21
utils.rkt
|
@ -7,7 +7,8 @@
|
||||||
(require (for-syntax syntax/parse)
|
(require (for-syntax syntax/parse)
|
||||||
(for-syntax racket/list))
|
(for-syntax racket/list))
|
||||||
|
|
||||||
(provide auto-hash-ref/explicit auto-hash-ref/: eval-with eval-with1)
|
(provide auto-hash-ref/explicit auto-hash-ref/: eval-with eval-with1
|
||||||
|
extract-symbols)
|
||||||
|
|
||||||
;;; ===================
|
;;; ===================
|
||||||
;;; HashTable Injection
|
;;; HashTable Injection
|
||||||
|
@ -109,3 +110,21 @@
|
||||||
(let ([vals (call-with-values (λ () (eval-with ht expr))
|
(let ([vals (call-with-values (λ () (eval-with ht expr))
|
||||||
(λ vals vals))])
|
(λ vals vals))])
|
||||||
(car vals)))
|
(car vals)))
|
||||||
|
|
||||||
|
|
||||||
|
;;; ==============================
|
||||||
|
;;; Analysis of quoted expressions
|
||||||
|
;;; ==============================
|
||||||
|
|
||||||
|
;;; Produces a list of symbols appearing in the quoted expression
|
||||||
|
;;; passed in the first argument.
|
||||||
|
(: extract-symbols (-> Any (Listof Symbol)))
|
||||||
|
(define (extract-symbols form)
|
||||||
|
(cond
|
||||||
|
[(symbol? form)
|
||||||
|
(list (cast form Symbol))]
|
||||||
|
[(list? form)
|
||||||
|
(cast (flatten (for/list : (Listof (Listof Symbol))
|
||||||
|
([x (cast form (Listof Any))])
|
||||||
|
(extract-symbols x))) (Listof Symbol))]
|
||||||
|
[else '()]))
|
||||||
|
|
Loading…
Reference in a new issue