(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)])))