[plt-scheme] Some more syntax-handling fun --- trying to extract all the definitions in an arbitrary file

> >   ;; mappend: (X -> (listof Y)) (listof X) -> (listof Y)
> >   ;;
> >   ;; mapping append.
> >   (define (mappend f l)
> >     (apply append (map f l)))
> >
>
> As a side note, there is already an append-map in srfi1. :)


Hi Paulo,

Ah, thank you!  I also found "mappend!" in swindle's "misc.ss".  The
problem with having such an abundance of libraries is that it takes more
effort to learn about them.


I did some more work and got something more reasonable now --- here's a
module that does try to do its best to grab all defined names in a module:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module get-defined-names mzscheme

  ;; Looks for the names of all defined values and syntaxes in a file.
  ;; Note: doesn't look at any of the provided values, just the defined
  ;; ones.  Also, this appears to only work reliably on modules at the
  ;; moment.

  (require (lib "contract.ss"))
  (require (lib "stx.ss" "syntax"))
  (require (lib "file.ss"))
  (require (only (lib "list.ss") empty))
  (require (only (lib "misc.ss" "swindle") mappend))


  (provide/contract (get-defined-names/path (-> path-string? (listof
syntax?))))


  ;; get-defined-names/path: path -> (listof syntax)
  ;;
  ;; Given a filename, opens it up and tries to extract out all the
  ;; Scheme definition symbols
  (define (get-defined-names/path path)
    (let-values (((base name must-be-dir?) (split-path
(path->complete-path path))))
      (parameterize
          [(current-directory base)
           (current-load-relative-directory base)]
        (call-with-input-file*
            name
          (lambda (ip)
            (let ((stx (expand (read-syntax path ip))))
              (extract-defined-from-top-level stx)))))))


  ;; extract-defined-from-top-level: syntax -> (listof syntax)
  ;;
  ;; Given a top-level-expression syntax, tries to return all
  ;; the toplevel defined symbol syntaxes.
  (define (extract-defined-from-top-level stx)
    (syntax-case* stx (module begin %#plain-module-begin)
module-or-top-identifier=?
      [(module m-name lang (#%plain-module-begin module-level-expr ...))
       (mappend extract-defined-from-module-level
                 (syntax->list (syntax (module-level-expr ...))))]
      [(begin top-level-expr ...)
       (mappend extract-defined-from-top-level
                 (syntax->list (syntax (top-level-expr ...))))]
      [else
       (extract-defined-from-general-top-level stx)]))


  ;; extract-defined-from-module-level: syntax -> (listof syntax)
  (define (extract-defined-from-module-level stx)
    (syntax-case* stx (provide begin) module-or-top-identifier=?
      [(provide provide-spec ...) empty]
      [(begin module-level-expr ...)
       (mappend extract-defined-from-module-level
                (syntax->list (syntax (module-level-expr ...))))]
      [else (extract-defined-from-general-top-level stx)]))


  ;; extract-defined-from-general-top-level: syntax -> (listof syntax)
  (define (extract-defined-from-general-top-level stx)
    (syntax-case* stx (define-values define-syntaxes
define-values-for-syntax
                        require require-for-syntax require-for-template)
                      module-or-top-identifier=?
      [(define-values (identifier ...) expr) (syntax->list (syntax
(identifier ...)))]
      [(define-syntaxes (identifier ...) expr) (syntax->list (syntax
(identifier ...)))]
      [(define-values-for-syntax (variable ...) expr) empty]
      [(require require-spec ...) empty]
      [(require-for-syntax require-spec ...) empty]
      [(require-for-template require-spec ...) empty]
      [else (extract-defined-from-expr stx)]))


  ;; extract-defined-from-expr: syntax -> (listof syntax)
  (define (extract-defined-from-expr stx)
    (syntax-case* stx (lambda case-lambda if begin begin0
                        let-values letrec-values set!
                        quote quote-syntax with-continuation-mark
                        #%app #%datum #%top #%variable-reference)
                      module-or-top-identifier=?
      [variable (identifier? (syntax variable)) empty]
      [(lambda formals expr ...) empty]
      [(case-lambda (formals expr ...) ...) empty]
      [(if test-expr true-expr) empty]
      [(if test-expr true-expr false-expr) empty]
      [(begin expr ...) empty]
      [(begin0 first-expr expr ...) empty]
      [(let-values (((variables ...) values) ...) body ...) empty]
      [(letrec-values (((variables ...) values) ...) body ...) empty]
      [(set! variable expr) empty]
      [(quote datum) empty]
      [(with-continutation-mark key-expr mark-expr body-expr) empty]
      [(#%app expr ...) empty]
      [(#%datum . datum) empty]
      [(#%top . variable) empty]
      [(#%variable-reference (#%top . variable)) empty]
      [(#%variable-reference variable) empty]
      [else (raise-syntax-error #f "extract-defined-from-expr: couldn't
match" stx)])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



For example:

;;;;;;
> (require (lib "file.ss"))
> (map syntax-e
       (get-defined-names/path (find-library "fold.ss" "srfi" "1")))
(unfold-right
  unfold
  fold
  fold-right
  pair-fold-right
  pair-fold
  reduce
  reduce-right
  append-map
  append-map!
  really-append-map
  pair-for-each
  map!
  filter-map
  map-in-order
  my-map
  my-for-each)
;;;;;;


This is so cool!  *grin*  Thanks again for everyone's help!