utils.rkt: Copy over extract-symbols.

scribblings/utils.scrbl

@@ -2,7 +2,7 @@
 @(require scribble/example racket/sandbox
 	  (for-label racket graph "../utils.rkt"
 	  	     (only-in typed/racket/base
-		     	      Any AnyValues)))
+		     	      Any AnyValues Listof)))
 
 @title[#:tag "utils"]{dds/utils: Various Utilities}
 
@@ -107,6 +107,17 @@ Note that only one expression can be supplied in the body.
 
 @section{Analysis of quoted expressions}
 
+@defproc[(extract-symbols [form Any]) (Listof Symbol)]{
+
+Produces a list of symbols appearing in the quoted expression
+passed in the first argument.
+
+@examples[#:eval utils-evaluator
+(extract-symbols '(1 (2 3) x (y z 3)))
+]
+
+}
+
 @section{Org-mode interoperability}
 
 Org-mode supports laying out the output of code blocks as tables, which is very

utils-untyped.rkt

@@ -10,8 +10,7 @@
 
 (provide
  ;; Functions
- (contract-out [extract-symbols (-> any/c list?)]
-               [any->string (-> any/c string?)]
+ (contract-out [any->string (-> any/c string?)]
                [stringify-variable-mapping (-> variable-mapping? string-variable-mapping?)]
                [string->any (-> string? any/c)]
                [read-org-sexp (-> string? (listof any/c))]

utils.rkt

@@ -4,6 +4,7 @@
 
 (provide Symbol VariableMapping
          eval-with eval1-with
+         extract-symbols
          ;; Syntax
          auto-hash-ref/explicit auto-hash-ref/:)
 
@@ -99,3 +100,27 @@
     (define ht2 #hash((a . 1) (b . 2)))
     (check-equal? (auto-hash-ref/: ht2 (+ :a (* 2 :b)))
                   5)))
+
+;;; ==============================
+;;; 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)
+  (: extract-rec (-> Any (Listof Any)))
+  (define (extract-rec form)
+    (match form
+      [(? symbol?) (list form)]
+      [(? list?)
+       (flatten (for/list : (Listof Any)
+                    ([x form])
+                  (extract-symbols x)))]
+      [else '()]))
+  (cast (extract-rec form) (Listof Symbol)))
+
+(module+ test
+  (test-case "extract-symbols"
+    (check-equal? (extract-symbols '(1 (2 3) x (y z 3)))
+                  '(x y z))))