[plt-scheme] Re: Emacs tags for MzScheme modules

Sun Nov 2 22:25:38 EST 2003

On Sun, 2 Nov 2003, Eli Barzilay wrote:

>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
> On Nov  2, Bill Clementson wrote:
> >
> > > What you want is the ability to find functions where you can only
> > > see their name, but don't know where they are -- a la M-. of
> > > etags.
> >
> > Yes, what I'm struggling with is finding a mechanism for locating
> > the definitions of individual functions, macros, etc. In C, Java,
> > and CL, I have tools for doing this. I'm just trying to find the
> > equivalent tools to use when I'm working with MzScheme.
>
> OK, this bothered me since it *should* be possible to do a much better
> job than tools like the ones you use for Java/C/CL etc.

Well, it bugged me too, so I wrote my own as well. I actually took the
time to reverse engineering the TAGS file format. As a result, the output
of my script is directly usable by Emacs.

Like Eli's script, I call expand on the target file and traverse the
resulting syntax. Unlike Eli's, I exclusively look for 'define-values' and
'define-syntaxes'. There is no space in a TAGS file where to record all
the provide and require information.

The script attached to the email runs on the command line, like this:

   gmarceau at canuk ~/src/plt/collects $ find -name \*.ss | xargs etags.ss

You might have to mangle the first line of the script to point to your
mzscheme installation. It will generate a TAGS file for the entire plt
distribution. It takes about two minutes on my machine.

I am also attaching a tag file for plt-205 to this email. It's a wooping 17k!

Enjoy.

-- 
"The thing I remember most about America is that it's silly.
 That can be quite a relief at times."  -- Thom Yorke, Radiohead

- Guillaume

-------------- next part --------------
#!/home/gmarceau/bin/mzscheme -r

(require (lib "list.ss")
         (lib "etc.ss")
         (lib "file.ss")
         (lib "string.ss"))

(define target-tag-file (open-output-file "TAGS" 'replace))

(define scheme-files (make-hash-table 'equal))

(define (string-chop str)
  (substring str 0 (- (string-length str) 1)))

(define (hash-table-mem? hash item) 
  (let/cc k (begin (hash-table-get hash item (lambda () (k false))) true)))

(define (hash-table-gad! hash key val-fn)
  (if (not (hash-table-mem? hash key)) 
      (begin (let ((v (val-fn)))
               (hash-table-put! hash key v)
               v))
      (hash-table-get hash key)))

(define (process-stx stx)
  ;(display (syntax-object->datum (expand stx)))
  (let ([strs
         (let loop ([substx (expand stx)])
           ;(display (format "loop ~a\n\n" (syntax-object->datum stx)))
           (syntax-case substx (define-values)
             [(define-values (name-pt ...) body ...)
              (let loop ([lst (syntax->list (syntax (name-pt ...)))]
                         [result empty])
                (cond [(empty? lst) result]
                      [(or (not (syntax-source (first lst)))
                           (not (syntax-position (first lst))))
                       (loop (rest lst) result)]
                      [else 
                       (let* ([name-stx (first lst)]
                              [name-sym (syntax-e name-stx)]
                              [s (syntax-source name-stx)]
                              [p (syntax-position name-stx)]
                              [file (hash-table-gad! scheme-files s (lambda () (open-input-file s)))]
                              [lead-in (open-output-string)])

                         (let loop ([p p])
                           (when (>= p 0)
                             (file-position file p)
                             (unless (eq? (read-char file) #\newline)
                               (loop (- p 1)))))

                         (let* ([matched (regexp-match (regexp (format "^[^\n]*~a[ \t\n]" name-sym))
                                                       file 0 false lead-in)])
                           (if matched
                               (let ([text 
                                      (format "~a~a~a~a,~a\n" 
                                              (get-output-string lead-in)
                                              (string-chop (first matched))
                                              name-sym
                                              (syntax-line name-stx) (syntax-position name-stx))])
                                 (loop (rest lst) (cons text result)))
                               (loop (rest lst) result))))]))]
             [(i ...)  
              (apply append (map loop (syntax->list (syntax (i ...)))))]

             [_ empty]))])
    (apply string-append (reverse strs))))

(define (process-files files)
  (let loopOnFiles ([files files])
    (read-case-sensitive true)
    (when (not (empty? files))
      (let* ([source-file (first files)]
             [source-port (open-input-file source-file)]
             [_ (port-count-lines! source-port)]
             [strs 
              (with-handlers
                  ([not-break-exn?
                    (lambda (exn) (display (format "Error while processing ~a:\n~a\n\n" 
                                              source-file (exn-message exn)))
                       empty)])
                (let ([file-dir (path-only (normalize-path source-file))])
                  (current-load-relative-directory file-dir)
                  (let loopOnLines ([result empty])
                    (let ([cur (read-syntax source-file source-port (list 0 0 0))])
                      (if (eof-object? cur) result
                          (loopOnLines (cons (process-stx cur) result)))))))]

             [section (apply string-append (reverse strs))])
        (display (format "\n~a,~a\n~a"
                         source-file (string-length section) section)
                 target-tag-file))
      (loopOnFiles (rest files)))))

(with-handlers
    ([exn:break? (lambda (exn) (void))])
  (process-files (vector->list argv)))

-------------- next part --------------

./stepper/info.ss,128
  (define namename2,51
  (define toolstools3,77
  (define tool-namestool-names6,163
  (define tool-iconstool-icons9,237

./stepper/stepper-tool.ss,212
  (define (stepper-print-convertstepper-print-convert21,723
  (define-syntax string-constant-liststring-constant-list28,915
  (define stepper-works-forstepper-works-for35,1185
  (define tool@tool@45,1391

./string-constants/private/only-once.ss,95
  (define alreaalready-printed?4,73
  (define (maybe-print-messagemaybe-print-message6,108

./string-constants/danish-string-constants.ss,0

./string-constants/dutch-string-constants.ss,0

./string-constants/english-string-constants.ss,0

./string-constants/french-string-constants.ss,0

./string-constants/german-string-constants.ss,0

./string-constants/info.ss,26
   (define namename2,52

./string-constants/italian-string-constants.ss,0

./string-constants/spanish-string-constants.ss,0

./string-constants/string-constant-lang.ss,56
  (define-syntax (-#%module-begin-#%module-begin5,131

./string-constants/string-constant.ss,396
  (define (set-language-prefset-language-pref20,800
  (define language (get-preference 'plt:human-languagelanguage24,930
  (define-syntax-set (string-constantstring-constant26,1023
  (define-syntax-set (string-constant string-constantsstring-constants26,1039
  (define-syntax-set (string-constant string-constants this-languagethis-language26,1056
  (define-syntaall-languages26,1070

./syntax/private/doctable.ss,144
  (define htht5,78
  (define (register-documentationregister-documentation7,119
  (define (lookup-documentationlookup-documentation19,525

./syntax/boundmap.ss,738
  (define-strucstruct:bound-identifier-mapping6,97
  (define-strucmake-bound-identifier-mapping6,97
  (define-struct bound-identifier-mappingbound-identifier-mapping?6,97
  (define-strucbound-identifier-mapping-ht6,97
  (define-strucset-bound-identifier-mapping-ht!6,97
  (define-struct bound-identifier-mappingbound-identifier-mapping6,97
  (define mk-bound-identifier-mappingmk-bound-identifier-mapping8,139
  (define bound-identifier-mapping-getbound-identifier-mapping-get15,338
  (define bound-identifier-mapping-put!bound-identifier-mapping-put!28,706
  (define bound-identifier-mapping-for-eachbound-identifier-mapping-for-each44,1131
  (define bound-identifier-mapping-mapbound-identifier-mapping-map52,1350

./syntax/context.ss,106
  (define (build-expand-contextbuild-expand-context6,101
  (define (genegenerate-expand-context12,244

./syntax/docprovide.ss,177
  (define-syntaxes (provide-and-documentprovide-and-document5,96
  (define-syntaprovide-and-document/wrap5,117
  (define (lookup-documentationlookup-documentation252,7161

./syntax/info.ss,25
  (define namename3,52

./syntax/kerncase.ss,134
  (define-syntax kernel-syntax-casekernel-syntax-case4,46
  (define (kernel-form-identifier-listkernel-form-identifier-list24,596

./syntax/moddep.ss,1278
  (define (with-module-reading-parameterizationwith-module-reading-parameterization5,87
  (define (raise-wrong-module-nameraise-wrong-module-name18,489
  (define (check-module-formcheck-module-form26,758
  (define re:suffixre:suffix61,1991
  (define (resolveresolve63,2039
  (define (datedate>=?69,2181
  (define (read-oneread-one75,2380
  (define-strucstruct:exn:get-module-code100,3232
  (define-strucmake-exn:get-module-code100,3232
  (define-struct (exn:get-module-codeexn:get-module-code?100,3232
  (define-strucexn:get-module-code-path100,3232
  (define-strucset-exn:get-module-code-path!100,3232
  (define-struct (exn:get-module-codeexn:get-module-code100,3232
  (define (get-module-codeget-module-code102,3277
  (define re:dirre:dir159,5504
  (define (force-reltoforce-relto161,5547
  (define resolve-module-pathresolve-module-path178,6021
  (define (resolve-module-path-indexresolve-module-path-index211,6959
  (define (resolve-possible-module-path-indexresolve-possible-module-path-index218,7229
  (define re:path-onlyre:path-only233,7641
  (define collapse-module-pathcollapse-module-path235,7690
  (define (collapse-module-path-indexcollapse-module-path-index307,9660
  (define (show-import-treeshow-import-tree314,9910

./syntax/name.ss,64
  (define (syntax-local-infer-namesyntax-local-infer-name5,74

./syntax/path-spec.ss,52
  (define (resolve-path-specresolve-path-spec6,92

./syntax/primitives.ss,96
   (define (proprocedure-calling-prims6,151
   (define (intinternal-tail-chain-prims25,1070

./syntax/readerr.ss,50
  (define (raise-read-errorraise-read-error4,67

./syntax/struct.ss,238
  (define build-struct-namesbuild-struct-names10,225
  (define build-struct-generationbuild-struct-generation34,863
  (define build-struct-expand-infobuild-struct-expand-info65,1735
  (define (strustruct-declaration-info?102,2835

./syntax/stx.ss,255
  (define (stx-stx-null?9,293
  (define (stx-stx-pair?15,405
  (define (stx-stx-list?21,516
  (define (stx-carstx-car33,777
  (define (stx-cdrstx-cdr39,875
  (define (stx->liststx->list45,987
  (define (modumodule-or-top-identifier=?68,1418

./syntax/toplevel.ss,556
  (define (eval-compile-time-part-of-top-level/compileeval-compile-time-part-of-top-level/compile11,368
  (define (eval-compile-time-part-of-top-leveleval-compile-time-part-of-top-level15,533
  (define (expand-top-level-with-compile-time-evalsexpand-top-level-with-compile-time-evals19,698
  (define (expand-syntax-top-level-with-compile-time-evalsexpand-syntax-top-level-with-compile-time-evals23,850
  (define (compile-and-eval-compile-time-partcompile-and-eval-compile-time-part43,1879
  (define (flatten-out-beginsflatten-out-begins73,3172

./syntax/zodiac-sig.ss,31
  (define-signazodiac^11,231

./syntax/zodiac-unit.ss,33
  (define zodiac@zodiac@15,292

./syntax/zodiac.ss,8924
  (define-valueapp-args8,118
  (define-valueapp-fun8,118
  (define-valueapp?8,118
  (define-valuearglist-vars8,118
  (define-valuearglist?8,118
  (define-valuebegin-form-bodies8,118
  (define-valuebegin-form?8,118
  (define-valuebegin0-form-bodies8,118
  (define-valuebegin0-form?8,118
  (define-valuebinding-orig-name8,118
  (define-valuebinding-var8,118
  (define-valuebinding?8,118
  (define-valuebound-varref-binding8,118
  (define-valuebound-varref?8,118
  (define-valuecase-lambda-form-args8,118
  (define-valuecase-lambda-form-bodies8,118
  (define-valuecase-lambda-form?8,118
  (define-valuecreate-app8,118
  (define-valuecreate-begin-form8,118
  (define-valuecreate-begin0-form8,118
  (define-valuecreate-binding8,118
  (define-valuecreate-bound-varref8,118
  (define-valuecreate-case-lambda-form8,118
  (define-valuecreate-define-syntaxes-form8,118
  (define-valuecreate-define-values-form8,118
  (define-valuecreate-if-form8,118
  (define-valuecreate-let-values-form8,118
  (define-valuecreate-letrec-values-form8,118
  (define-valuecreate-lexical-binding8,118
  (define-valuecreate-lexical-varref8,118
  (define-valuecreate-module-form8,118
  (define-valuecreate-quote-form8,118
  (define-valuecreate-quote-syntax-form8,118
  (define-valuecreate-require/provide-form8,118
  (define-valuecreate-set!-form8,118
  (define-valuecreate-top-level-varref8,118
  (define-valuecreate-with-continuation-mark-form8,118
  (define-valuedefine-syntaxes-form-expr8,118
  (define-valuedefine-syntaxes-form-names8,118
  (define-valuedefine-syntaxes-form?8,118
  (define-valuedefine-values-form-val8,118
  (define-valuedefine-values-form-vars8,118
  (define-valuedefine-values-form?8,118
  (define-valueeof?8,118
  (define-valueif-form-else8,118
  (define-valueif-form-test8,118
  (define-valueif-form-then8,118
  (define-valueif-form?8,118
  (define-valueilist-arglist?8,118
  (define-valuelet-values-form-body8,118
  (define-valuelet-values-form-vals8,118
  (define-valuelet-values-form-vars8,118
  (define-valuelet-values-form?8,118
  (define-valueletrec-values-form-body8,118
  (define-valueletrec-values-form-vals8,118
  (define-valueletrec-values-form-vars8,118
  (define-valueletrec-values-form?8,118
  (define-valuelexical-binding?8,118
  (define-valuelexical-varref?8,118
  (define-valuelist-arglist?8,118
  (define-valuelocation-column8,118
  (define-valuelocation-file8,118
  (define-valuelocation-line8,118
  (define-valuemake-app8,118
  (define-valuemake-arglist8,118
  (define-valuemake-begin-form8,118
  (define-valuemake-begin0-form8,118
  (define-valuemake-binding8,118
  (define-valuemake-bound-varref8,118
  (define-valuemake-case-lambda-form8,118
  (define-valuemake-define-syntaxes-form8,118
  (define-valuemake-define-values-form8,118
  (define-valuemake-empty-back-box8,118
  (define-valuemake-if-form8,118
  (define-valuemake-ilist-arglist8,118
  (define-valuemake-let-values-form8,118
  (define-valuemake-letrec-values-form8,118
  (define-valuemake-lexical-binding8,118
  (define-valuemake-lexical-varref8,118
  (define-valuemake-list-arglist8,118
  (define-valuemake-module-form8,118
  (define-valuemake-parsed8,118
  (define-valuemake-quote-form8,118
  (define-valuemake-quote-syntax-form8,118
  (define-valuemake-require/provide-form8,118
  (define-valuemake-set!-form8,118
  (define-valuemake-sym-arglist8,118
  (define-valuemake-top-level-varref8,118
  (define-valuemake-varref8,118
  (define-valuemake-with-continuation-mark-form8,118
  (define-valuemake-zodiac8,118
  (define-valuemake-zread8,118
  (define-valuemodule-form-body8,118
  (define-valuemodule-form-for-syntax-requires8,118
  (define-valuemodule-form-indirect-provides8,118
  (define-valuemodule-form-kernel-reprovide-hint8,118
  (define-valuemodule-form-name8,118
  (define-valuemodule-form-provides8,118
  (define-valuemodule-form-requires8,118
  (define-valuemodule-form-self-path-index8,118
  (define-valuemodule-form-syntax-body8,118
  (define-valuemodule-form-syntax-provides8,118
  (define-valuemodule-form?8,118
  (define-valueorigin-how8,118
  (define-valueorigin-who8,118
  (define-valueparsed-back8,118
  (define-valueparsed?8,118
  (define-valuequote-form-expr8,118
  (define-valuequote-form?8,118
  (define-valuequote-syntax-form-expr8,118
  (define-valuequote-syntax-form?8,118
  (define-valueregister-client8,118
  (define-valuerequire/provide-form?8,118
  (define-valueset!-form-val8,118
  (define-valueset!-form-var8,118
  (define-valueset!-form?8,118
  (define-valueset-app-args!8,118
  (define-valueset-app-fun!8,118
  (define-valueset-arglist-vars!8,118
  (define-valueset-begin-form-bodies!8,118
  (define-valueset-begin0-form-bodies!8,118
  (define-valueset-binding-orig-name!8,118
  (define-valueset-binding-var!8,118
  (define-valueset-bound-varref-binding!8,118
  (define-valueset-case-lambda-form-args!8,118
  (define-valueset-case-lambda-form-bodies!8,118
  (define-valueset-define-syntaxes-form-expr!8,118
  (define-valueset-define-syntaxes-form-names!8,118
  (define-valueset-define-values-form-val!8,118
  (define-valueset-define-values-form-vars!8,118
  (define-valueset-if-form-else!8,118
  (define-valueset-if-form-test!8,118
  (define-valueset-if-form-then!8,118
  (define-valueset-let-values-form-body!8,118
  (define-valueset-let-values-form-vals!8,118
  (define-valueset-let-values-form-vars!8,118
  (define-valueset-letrec-values-form-body!8,118
  (define-valueset-letrec-values-form-vals!8,118
  (define-valueset-letrec-values-form-vars!8,118
  (define-valueset-module-form-body!8,118
  (define-valueset-module-form-for-syntax-requires!8,118
  (define-valueset-module-form-indirect-provides!8,118
  (define-valueset-module-form-kernel-reprovide-hint!8,118
  (define-valueset-module-form-name!8,118
  (define-valueset-module-form-provides!8,118
  (define-valueset-module-form-requires!8,118
  (define-valueset-module-form-self-path-index!8,118
  (define-valueset-module-form-syntax-body!8,118
  (define-valueset-module-form-syntax-provides!8,118
  (define-valueset-parsed-back!8,118
  (define-valueset-quote-form-expr!8,118
  (define-valueset-quote-syntax-form-expr!8,118
  (define-valueset-set!-form-val!8,118
  (define-valueset-set!-form-var!8,118
  (define-valueset-top-level-varref-exptime?!8,118
  (define-valueset-top-level-varref-module!8,118
  (define-valueset-top-level-varref-position!8,118
  (define-valueset-top-level-varref-slot!8,118
  (define-valueset-varref-var!8,118
  (define-valueset-with-continuation-mark-form-body!8,118
  (define-valueset-with-continuation-mark-form-key!8,118
  (define-valueset-with-continuation-mark-form-val!8,118
  (define-valueset-zodiac-stx!8,118
  (define-valuestruct:app8,118
  (define-valuestruct:arglist8,118
  (define-valuestruct:begin-form8,118
  (define-valuestruct:begin0-form8,118
  (define-valuestruct:binding8,118
  (define-valuestruct:bound-varref8,118
  (define-valuestruct:case-lambda-form8,118
  (define-valuestruct:define-syntaxes-form8,118
  (define-valuestruct:define-values-form8,118
  (define-valuestruct:if-form8,118
  (define-valuestruct:ilist-arglist8,118
  (define-valuestruct:let-values-form8,118
  (define-valuestruct:letrec-values-form8,118
  (define-valuestruct:list-arglist8,118
  (define-valuestruct:module-form8,118
  (define-valuestruct:parsed8,118
  (define-valuestruct:quote-form8,118
  (define-valuestruct:quote-syntax-form8,118
  (define-valuestruct:require/provide-form8,118
  (define-valuestruct:set!-form8,118
  (define-valuestruct:sym-arglist8,118
  (define-valuestruct:top-level-varref8,118
  (define-valuestruct:varref8,118
  (define-valuestruct:with-continuation-mark-form8,118
  (define-valuestruct:zodiac8,118
  (define-valuestruct:zread8,118
  (define-valuestructurize-syntax8,118
  (define-valuesym-arglist?8,118
  (define-valuesyntax->zodiac8,118
  (define-valuetop-level-varref-exptime?8,118
  (define-valuetop-level-varref-module8,118
  (define-valuetop-level-varref-position8,118
  (define-valuetop-level-varref-slot8,118
  (define-valuetop-level-varref?8,118
  (define-valuevarref-var8,118
  (define-valuevarref?8,118
  (define-valuewith-continuation-mark-form-body8,118
  (define-valuewith-continuation-mark-form-key8,118
  (define-valuewith-continuation-mark-form-val8,118
  (define-valuewith-continuation-mark-form?8,118
  (define-valuezodiac->syntax8,118
  (define-valuezodiac-finish8,118
  (define-valuezodiac-origin8,118
  (define-valuezodiac-start8,118
  (define-valuezodiac-stx8,118
  (define-valuezodiac?8,118
  (define-valuezread-object8,118
  (define-valuezread?8,118

./syntax-color/color-selection.ss,469
  (define standard-style-list-text%standard-style-list-text%9,266
  (define color-selection%color-selection%11,348
  (define add/mult-setadd/mult-set103,4497
  (define add/mult-getadd/mult-get107,4589
  (define style-delta-get/setstyle-delta-get/set115,4776
  (define (marshall-stylemarshall-style149,6734
  (define (unmarshall-styleunmarshall-style152,6832
  (define (set-defaultset-default157,7010
  (define set-slatex-styleset-slatex-style167,7288

./syntax-color/colorer-prefs.ss,175
  (define (make-style-deltamake-style-delta9,238
  (define color-selection-panel%color-selection-panel%31,903
  (define (add-to-colorer-prefsadd-to-colorer-prefs44,1177

./syntax-color/colorer.ss,75
  (define (text-mixintext-mixin9,206
  (define (colorercolorer167,6308

./syntax-color/info.ss,52
  (define namename2,51
  (define toolstools3,85

./syntax-color/token-tree.ss,1211
  (define-strucstruct:node7,254
  (define-strucmake-node7,254
  (define-struct nodenode?7,254
  (define-strucnode-token-length7,254
  (define-strucset-node-token-length!7,254
  (define-strucnode-token-data7,254
  (define-strucset-node-token-data!7,254
  (define-strucnode-left-subtree-length7,254
  (define-strucset-node-left-subtree-length!7,254
  (define-strucnode-left7,254
  (define-strucset-node-left!7,254
  (define-strucnode-right7,254
  (define-strucset-node-right!7,254
  (define-struct nodenode7,254
  (define (search!search!9,331
  (define (internal-search!internal-search!18,641
  (define (end-search!end-search!33,1243
  (define (search-max!search-max!38,1365
  (define (search-min!search-min!45,1533
  (define (invalidate-after!invalidate-after!52,1695
  (define (invalidate-before!invalidate-before!58,1827
  (define (splitsplit65,2003
  (define (insert-after!insert-after!74,2305
  (define (update-subtree-length-left-rotate!update-subtree-length-left-rotate!83,2507
  (define (update-subtree-length-right-rotate!update-subtree-length-right-rotate!89,2818
  (define (bottom-up-splay!bottom-up-splay!95,3131
  (define (to-listto-list157,6044

./syntax-color/tool.ss,80
  (define (mixin-definitionmixin-definition9,177
  (define tool@tool@18,483

./test-suite/extension.ss,128
  (define (add-test-suite-extensionadd-test-suite-extension6,104
  (define test-suite-extensionstest-suite-extensions11,273

./test-suite/info.ss,128
  (define namename2,51
  (define toolstools3,80
  (define tool-namestool-names4,123
  (define tool-iconstool-icons5,174

./test-suite/test-suite-tool.ss,136
  (define tool-phases@tool-phases@24,510
  (define test-suite-menu-items@test-suite-menu-items@30,642
  (define tool@tool@87,3237

./test-suite/private/case-layout.ss,82
  (define case-layout@case-layout@16,288
  (define (label-boxlabel-box97,3768

./test-suite/private/case-tab.ss,76
  (define case-tab@case-tab@12,178
  (define (scroll-toscroll-to67,2231