[racket-dev] [plt] Push #24721: master branch updated

From: Matthias Felleisen (matthias at ccs.neu.edu)
Date: Fri May 18 16:07:48 EDT 2012

Was this an attempt to show the interfaces of a module? I do wish we had one inside of DrRacket. 


On May 18, 2012, at 4:05 PM, asumu at racket-lang.org wrote:

> asumu has updated `master' from f34258e253 to a00cd7ebff.
>  http://git.racket-lang.org/plt/f34258e253..a00cd7ebff
> 
> =====[ 1 Commits ]======================================================
> 
> Directory summary:
> 100.0% collects/drracket/private/module-interface/
> 
> ~~~~~~~~~~
> 
> a00cd7e Asumu Takikawa <asumu at racket-lang.org> 2012-05-18 15:50
> :
> | Remove drracket/private/module-interface.
> |
> | With permission from Jon Rafkind.
> :
>  D collects/drracket/private/module-interface/check.rkt
>  D collects/drracket/private/module-interface/gui.rkt
> 
> =====[ Overall Diff ]===================================================
> 
> collects/drracket/private/module-interface/check.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/drracket/private/module-interface/check.rkt
> +++ /dev/null
> @@ -1,560 +0,0 @@
> -#lang racket/base
> -
> -#|
> -Show imports (symbols that come from requires) and exports (symbols that are provided)
> -
> -1. How can I avoid showing imported symbols from the lang line? It would be nice to
> -ignore all the symbols from racket/base if a file starts with
> -#lang racket/base
> -
> -|#
> -
> -(require racket/match
> -         unstable/generics
> -         racket/pretty
> -         syntax/parse
> -         (for-syntax racket/struct-info
> -                     racket/base
> -                     syntax/parse
> -                     racket/match))
> -
> -(provide get-exports
> -         (struct-out provided))
> -
> -(define module-name
> -  (compose resolved-module-path-name module-path-index-resolve))
> -
> -(define-syntax (import-struct stx)
> - (syntax-parse stx
> -   [(_ ([struct-name:identifier instance:identifier] more ...) body ...)
> -    (define (get-fields struct instance)
> -      ;; (printf "Import struct for ~a\n" #'struct-name)
> -      (let ([info (syntax-local-value struct (lambda () #f))])
> -        (match (extract-struct-info info)
> -               [(list name init-field-count auto-field-count accessor-proc
> -                      mutator-proc immutable-k-list)
> -                (begin
> -                  ;; messing around with strings is bad, whats a better solution?
> -                  (define (make-local-field field-stx)
> -                    (let* ([field (substring (symbol->string (syntax->datum field-stx))
> -                                             (- (string-length (string-append (symbol->string (syntax->datum name)) "-"))
> -                                                (string-length "struct:")))]
> -                           [final (string->symbol (string-append (symbol->string
> -                                                                   (syntax->datum instance))
> -                                                                 "."
> -                                                                 field))])
> -                      (datum->syntax instance final instance instance)))
> -                  #;
> -                  (apply printf "name: ~a init-field-count: ~a auto-field-count: ~a accessor-proc: ~a mutator-proc: ~a immutable-k-list: ~a\n"
> -                         (list name init-field-count auto-field-count (map syntax->datum accessor-proc)
> -                               mutator-proc immutable-k-list))
> -                  (with-syntax ([(field ...)
> -                                 (map make-local-field accessor-proc)]
> -                                [(setter! ...) mutator-proc]
> -                                [instance instance]
> -                                [(accessor ...) accessor-proc])
> -                    #|
> -                    (printf "bind: ~a\n" (map syntax->datum (syntax->list #'(field ...))))
> -                    (printf "setter: ~a\n" (map syntax->datum (syntax->list #'(setter! ...))))
> -                    |#
> -                    (begin
> -                     #;syntax-local-introduce
> -                      #;
> -                      #'(let ([my-accessor])
> -                          let-syntax ([field (make-rename-transformer my-accessor)] ...)
> -                          body)
> -
> -                      #;
> -                      #'(let ([field (make-rename-transformer #'field
> -                                                              (accessor instance))]
> -                              ...)
> -                          body)
> -
> -                      #'([field (make-set!-transformer
> -                                  (lambda (stx)
> -                                    (syntax-case stx (set!)
> -                                      [(set! id v) (if #'setter!
> -                                                     #'(setter! instance v)
> -                                                     #'(error 'with-struct "field ~a is not mutable so no set! is available" 'field))]
> -                                      [id #'(accessor instance)])))]
> -                         ...)
> -
> -                      #;
> -                      #'(let-syntax ([field (make-set!-transformer
> -                                              (lambda (stx)
> -                                                (syntax-case stx (set!)
> -                                                  [(set! id v) (if #'setter!
> -                                                                 #'(setter! instance v)
> -                                                                 #'(error 'with-struct "field ~a is not mutable so no set! is available" 'field))]
> -                                                  [id #'(accessor instance)])))]
> -                                     ...)
> -                          body ...)
> -
> -                      #;
> -                      #'(let-syntax ([field (lambda (stx)
> -                                              #'(accessor instance))]
> -                                     ...)
> -                          body1 body ...))))])))
> -    (with-syntax ([(field ...) (get-fields #'struct-name #'instance)])
> -      ;; (printf "Final let syntax is ~a\n" (syntax->datum #'(let-syntax (field ...) body ...)))
> -      #'(let-syntax (field ...)
> -          (import-struct (more ...) body ...)))]
> -   [(_ () body ...)
> -    #'(begin body ...)]))
> -
> -(generics module-symbol
> -          (print module-symbol)
> -          (get-symbol module-symbol))
> -
> -(provide print)
> -
> -(define-syntax-rule (define-module-symbol name (fields ...) rest ...)
> -                    (define-struct name (fields ...)
> -                                   #:property prop:module-symbol
> -                                   rest ...))
> -
> -(define-module-symbol symbol:normal (name)
> -                      (define-methods module-symbol
> -                                      (define (get-symbol self) (symbol:normal-name self))
> -                                      (define (print self)
> -                                        (import-struct ([symbol:normal self])
> -                                                       (format "~a" self.name)))))
> -
> -(define-module-symbol symbol:normal/contract (name contract)
> -               (define-methods module-symbol
> -                               (define (get-symbol self) (symbol:normal-name self))
> -                               (define (print self)
> -                                 (import-struct ([symbol:normal/contract self])
> -                                                (format "~a contract ~a" self.name self.contract)))))
> -
> -(define-module-symbol symbol:renamed (provided defined)
> -               (define-methods module-symbol
> -                               (define (get-symbol self) (symbol:renamed-provided self))
> -                               (define (print self)
> -                                 (import-struct ([symbol:renamed self])
> -                                                (format "~a as ~a" self.defined self.provided)))))
> -
> -(define-module-symbol symbol:module-exported (where)
> -               (define-methods module-symbol
> -                               (define/generic symbol-print print)
> -                               (define (get-symbol self)
> -                                 (raise 'get-symbol "Not defined"))
> -                               (define (print self)
> -                                 (format "from ~a"
> -                                         (module-name
> -                                             (symbol:module-exported-where self))
> -                                         ))))
> -
> -(define-module-symbol symbol:module-exported-from (original where)
> -               (define-methods module-symbol
> -                               (define/generic symbol-print print)
> -                               (define (get-symbol self)
> -                                 (raise 'get-symbol "Not defined"))
> -                               (define (print self)
> -                                 (import-struct ([symbol:module-exported-from self])
> -                                                (format "from ~a ~a"
> -                                                        (module-name self.where)
> -                                                        (symbol-print self.original))))))
> -
> -(define-module-symbol symbol:module-exported-as
> -               (where phase-shift imported-name import-shift)
> -               (define-methods module-symbol
> -                               (define/generic symbol-print print)
> -                               (define (get-symbol self)
> -                                 (symbol:module-exported-as-imported-name self))
> -                               (define (print self)
> -                                 (import-struct ([symbol:module-exported-as self])
> -                                 (format "from ~a as ~a"
> -                                         (module-name self.where)
> -                                         self.imported-name)))))
> -
> -(define-module-symbol symbol:multiple-modules (symbol modules)
> -               (define-methods module-symbol
> -                               (define/generic symbol-print print)
> -                               (define/generic symbol-get-symbol get-symbol)
> -                               (define (get-symbol self)
> -                                 (symbol-get-symbol
> -                                   (symbol:multiple-modules-symbol self)))
> -                               (define (print self)
> -                                 (import-struct ([symbol:multiple-modules self])
> -                                                (format "~a ~a"
> -                                                        (symbol-print self.symbol)
> -                                                        (let ([modules self.modules])
> -                                                          (if (null? modules)
> -                                                            ""
> -                                                            (for/fold ([start (symbol-print (car modules))])
> -                                                                      ([next (cdr modules)])
> -                                                                      (format "~a and ~a" start (symbol-print next))))))))))
> -
> -(struct provided (phase variables syntaxes))
> -
> -(define get-namespace
> -  (let ([namespaces (make-hash)])
> -    (lambda (file)
> -      (hash-ref namespaces file (lambda ()
> -                                  (let ([new (make-base-namespace)])
> -                                    (hash-set! namespaces file new)
> -                                    new))))))
> -
> -(define (read-file file)
> -  (parameterize ([read-accept-reader #t])
> -    (with-input-from-file file (lambda () (read)))))
> -
> -;; extract the symbol from the module and call `contract-name' on its contract
> -(define (get-contract symbol file)
> -  (parameterize ([current-namespace
> -                   (get-namespace file)
> -                   #;
> -                   (make-base-namespace)])
> -    ;; FIXME! it would be nice if we could pull multiple symbols out
> -    ;; in the same `dynamic-require' call
> -    (define has-contract? (dynamic-require 'racket/contract 'has-contract?))
> -    (define value-contract (dynamic-require 'racket/contract 'value-contract))
> -    (define contract-name (dynamic-require 'racket/contract 'contract-name))
> -    ;; syntax expansion might fail, just ignore it
> -    (with-handlers ([exn:fail:syntax? (lambda (e) #f)])
> -      (let ([result (dynamic-require file symbol (lambda () #f))])
> -        #;
> -        (printf "Result is ~a\n" result)
> -        #;
> -        (printf "v is ~a\n" v)
> -        #;
> -        (printf "v has contract? ~a\n" (has-contract? v))
> -        (if (has-contract? result)
> -          (contract-name (value-contract result))
> -          #f)))))
> -
> -(define (make-symbol something file get-contract?)
> -  (define (populate-symbol symbol)
> -    (if (not get-contract?)
> -      (symbol:normal symbol)
> -      (let ([contract (get-contract symbol file)])
> -        (if contract
> -          (symbol:normal/contract symbol contract)
> -          (symbol:normal symbol)))))
> -  (define (extract-module path)
> -    (match path
> -           [(and (? module-path-index?) module)
> -            (symbol:module-exported module)]
> -           [(list path phase-shift imported-name imported-phase)
> -            (symbol:module-exported-as path
> -                                       phase-shift
> -                                       imported-name
> -                                       imported-phase)]))
> -  (match something
> -         [(list exported (list paths ...))
> -          (symbol:multiple-modules (populate-symbol exported)
> -                                   (map extract-module paths))]))
> -
> -(define (extract-base-module module-code)
> -  (syntax-parse module-code
> -    [(module name base . rest) (syntax->datum #'base)]))
> -
> -(define (module=? module1 module2)
> -  (define (resolve module)
> -    (cond
> -      [(symbol? module) (module-path-index-resolve (module-path-index-join module #f))]
> -      [(resolved-module-path? module) module]
> -      ;; [(module-path-index? module) (
> -      [(module-path-index? module)
> -       (module-path-index-resolve module)
> -       #;
> -       (let-values ([(path base) (module-path-index-split module)])
> -         (printf "Split module path ~a base ~a\n" path base)
> -         ((current-module-name-resolver) path))]
> -      [else (error 'module=? "Dont understand ~a" module)]))
> -  (define (raw-exports module)
> -    (parameterize ([current-namespace
> -                     (get-namespace (resolved-module-path-name module))
> -                     #;
> -                     (make-base-namespace)])
> -      (dynamic-require (resolved-module-path-name module) #f)
> -      (call-with-values (lambda () (module->exports (resolved-module-path-name module)))
> -                        (lambda v v))))
> -  #;
> -  (printf "~a resolved ~a. ~a resolved ~a\n" module1 (resolve module1)
> -          module2 (resolve module2))
> -  (eq? (resolve module1) (resolve module2))
> -  #;
> -  (equal? (raw-exports (resolve module1))
> -          (raw-exports (resolve module2)))
> -  #;
> -  (equal? (resolve module1) (resolve module2)))
> -
> -(define (get-imports file all?)
> -  (let ([imports (parameterize ([current-namespace
> -                                  (get-namespace file)
> -                                  #;
> -                                  (make-base-namespace)])
> -                               (dynamic-require file #f)
> -                               (module->imports file))])
> -    (define (combine-provides provides)
> -      ;; provides is guaranteed to have at least one thing or we wouldn't get here
> -      (for/fold ([all (car provides)])
> -                ([provide (cdr provides)])
> -        (provided (provided-phase all)
> -                  (append (provided-variables all)
> -                          (provided-variables provide))
> -                  (append (provided-syntaxes all)
> -                          (provided-syntaxes provide)))))
> -    (define phase-imports (make-hash))
> -    (define base-module (extract-base-module (read-file file)))
> -    (define (fixup-paths path exports)
> -      (for/list ([export exports])
> -                (match export
> -                  [(symbol:multiple-modules symbol modules)
> -                   (symbol:multiple-modules symbol
> -                                            (if (null? modules)
> -                                              (list (symbol:module-exported path))
> -                                              (map (lambda (module)
> -                                                     (symbol:module-exported-from
> -                                                       module path))
> -                                                   modules)))])))
> -    (define (add-provide phase provide)
> -      (hash-set! phase-imports
> -                 phase
> -                 (cons provide (hash-ref phase-imports phase (lambda () (list))))))
> -    ;; (printf "Base module is ~a ~a\n" base-module (make-resolved-module-path base-module))
> -    (for ([import imports])
> -         (match import
> -           [(list phase-shift paths ...)
> -            ;; (printf "Import at phase shift ~a\n" phase-shift)
> -            (for ([path paths])
> -                 ;; (printf " Module ~a\n" (module-name path))
> -                 (define module-path (let-values ([(module-path rest) (module-path-index-split path)])
> -                                               ;; (printf "Module path is ~a. Rest is ~a\n" module-path rest)
> -                                               module-path))
> -                 ; (define resolved-module-path (module-path-index-resolve path))
> -                 ;; (define resolved-module-path (make-resolved-module-path module-path))
> -                 ;; (printf "base ~a = resolved ~a is ~a\n" base-module path (module=? base-module path))
> -                 (when (or all? (not (module=? path base-module)))
> -                   (let ([exports (get-exports module-path #f)])
> -                     (for ([export exports])
> -                          (match export
> -                                 [(provided phase variables syntaxes)
> -                                  (add-provide (+ phase phase-shift)
> -                                               (provided (+ phase phase-shift)
> -                                                         (fixup-paths path variables)
> -                                                         (fixup-paths path syntaxes)))])))))]))
> -    (hash-map phase-imports (lambda (phase provides)
> -                              (combine-provides provides)))))
> -
> -(define (get-exports file get-contracts?)
> -  (define (sort-symbols symbols)
> -    (sort symbols (lambda (a b)
> -                    (define (get-symbol what)
> -                      (match what
> -                        [(list name rest ...) (symbol->string name)]))
> -                    (string<? (get-symbol a)
> -                              (get-symbol b)))))
> -  (define (make-symbol* export)
> -    (make-symbol export file get-contracts?))
> -  (let-values ([(exported-variables
> -                  exported-syntaxes)
> -                (parameterize ([current-namespace
> -                                 (get-namespace file)
> -                                 #;
> -                                 (make-base-namespace)])
> -                              (dynamic-require file #f)
> -                              (module->exports file))])
> -    #;
> -    (pretty-print (syntax->datum 
> -                              (parameterize ([current-namespace (make-base-namespace)])
> -                                            (expand (read-file file)))))
> -
> -
> -    ; (printf "Expanded is ~a\n" expanded)
> -    ; (printf "Variables ~a\n" (syntax-property expanded 'module-variable-provides))
> -    ; (printf "Syntaxes ~a\n" (syntax-property expanded 'module-syntax-provides))
> -    (define exports (make-hash))
> -    (for ([export exported-variables])
> -     (match export
> -            [(list (and (? number?) phase) symbols ...)
> -             (hash-set! exports phase (provided phase
> -                                                (map make-symbol* (sort-symbols symbols))
> -                                                '()))]))
> -    (for ([export exported-syntaxes])
> -     (match export
> -            [(list (and (? number?) phase) symbols ...)
> -             (hash-set! exports phase
> -                        (let ([existing (hash-ref exports phase (lambda () (provided phase '() '())))])
> -                          (provided phase
> -                                    (provided-variables existing)
> -                                    (map make-symbol* (sort-symbols symbols)))))]))
> -    (hash-map exports (lambda (a b) b))))
> -
> -
> -(define (phase-name phase)
> -  (case phase
> -    [(0) " (runtime)"]
> -    [(1) " (syntax)"]
> -    [(-1) " (template)"]
> -    [else ""]))
> -
> -#|
> -(define (find-file provides category search)
> -  (struct levenshtein (name distance phase))
> -  ;; find the levenshtein distance between the searched-for term and the name
> -  (define (fuzzy-search search name)
> -    (local-require (prefix-in neil: (planet neil/levenshtein:1:3/levenshtein)))
> -    ;; (printf "Name is ~a\n" name)
> -    (define real-name (symbol->string (get-symbol name)))
> -    (let ([search-in real-name])
> -      (define distance (neil:string-levenshtein search search-in))
> -      (levenshtein real-name distance 0)))
> -
> -  (define (compare-levenshtein object1 object2)
> -    (< (levenshtein-distance object1)
> -       (levenshtein-distance object2)))
> -  (define (do-search export)
> -    (match export
> -        [(provided phase variables syntaxes)
> -         ;; replace the phase from the fuzzy-search with the phase from the export
> -         (define (update-phase stuff)
> -           (for/list ([object stuff])
> -             (match object
> -               [(levenshtein name distance dont-care)
> -                (levenshtein name distance phase)])))
> -         (let ([found-variables (map (lambda (variable)
> -                                       (fuzzy-search search variable))
> -                                     variables)]
> -               [found-syntaxes (map (lambda (syntax)
> -                                      (fuzzy-search search syntax))
> -                                    syntaxes)])
> -           (append (update-phase found-variables)
> -                   (update-phase found-syntaxes)))]))
> -  (let* ([exports provides]
> -         [found (apply append (map do-search exports))]
> -         [sorted (sort found compare-levenshtein)])
> -    (if (null? sorted)
> -      (printf "No ~as available\n" category)
> -      (for ([i (in-range 1 6)]
> -            [found sorted])
> -        (match found
> -          [(levenshtein name distance phase)
> -           (printf "~a. Found ~a `~a' at phase ~a\n" i category name phase)])))))
> -
> -(define (find-file-export file search)
> -  (find-file (get-exports file #f) "export" search))
> -
> -(define (find-file-import file search)
> -  (find-file (get-imports file #t) "import" search))
> -|#
> -
> -(define (find-defines file)
> -  (define defines
> -    (parameterize ([current-load-relative-directory (let-values ([(care a b)
> -                                                                  (split-path (path->complete-path (resolve-path (string->path file))))])
> -                                                      care)])
> -      (let ([code (parameterize ([current-namespace (make-base-namespace)])
> -                    (expand (read-file file)))])
> -        (syntax-case code (module)
> -          [(module name base (module-begin stuff ...))
> -           (apply append
> -                  (for/list ([top-level (syntax->list #'(stuff ...))])
> -                    (syntax-case top-level (define-values define-syntaxes)
> -                      [(define-values (name ...) . body)
> -                       (for/list ([name (syntax->list #'(name ...))])
> -                         (symbol->string (syntax->datum name))
> -                         #;
> -                         (printf "~a\n" (syntax->datum name)))]
> -                      [(define-syntaxes (name ...) . body)
> -                       (for/list ([name (syntax->list #'(name ...))])
> -                         (symbol->string (syntax->datum name))
> -                         #;
> -                         (printf "~a\n" (syntax->datum name)))]
> -                      [else (list)])))]))))
> -  (for ([item (sort defines string<?)])
> -    (printf "~a\n" item)))
> -
> -(define (check-file/raw file phase show-imports? show-exports?)
> -  (define (print-all stuff)
> -    (for ([symbol stuff])
> -         (printf "~a\n" (print symbol))))
> -  (define (show-all provides)
> -    (for ([provide provides])
> -      (when (or (eq? phase 'all)
> -                (equal? phase (provided-phase provide)))
> -        (print-all (provided-variables provide))
> -        (print-all (provided-syntaxes provide)))))
> -
> -  (define (show-imports)
> -    (show-all (get-imports file #f)))
> -  (define (show-exports)
> -    (show-all (get-exports file #f)))
> -  (when show-imports?
> -    (show-imports))
> -  (when show-exports?
> -    (show-exports)))
> -
> -(define (check-file file phase show-imports? show-exports?)
> -  (define (print-all prefix stuff)
> -    (for ([symbol stuff])
> -         (printf "~a~a\n" prefix (print symbol))))
> -  (define (show-all what provides)
> -    (define (space n)
> -      (make-string n #\space))
> -    (printf "~a\n" what)
> -    (for ([provide provides])
> -         (when (or (eq? phase 'all)
> -                   (equal? phase (provided-phase provide)))
> -           (printf "  Phase ~a~a\n" (provided-phase provide)
> -                   (phase-name (provided-phase provide)))
> -           (printf "    Variables\n")
> -           (print-all (space 6) (provided-variables provide))
> -           (printf "    Syntaxes\n")
> -           (print-all (space 6) (provided-syntaxes provide)))))
> -  (define (show-imports)
> -    (show-all "Imports" (get-imports file #f)))
> -  (define (show-exports)
> -    (show-all "Exports" (get-exports file #t)))
> -  (when show-imports?
> -    (show-imports)
> -    (printf "\n"))
> -  (when show-exports?
> -    (show-exports)))
> -
> -#|
> -(define mode (make-parameter 'show))
> -(define only-phase (make-parameter 'all))
> -(define show-imports (make-parameter #t))
> -(define show-exports (make-parameter #t))
> -(define find-export (make-parameter #f))
> -(define find-import (make-parameter #f))
> -
> -(define (do-parse-command-line)
> -  (local-require racket/cmdline)
> -  (command-line
> -    #:program "checker"
> -    #:once-each
> -    [("--raw") "Just print a list of identifiers without any formatting"
> -               (mode 'raw)]
> -    [("--phase") phase
> -               "Only show identifiers at this phase"
> -               (only-phase (string->number phase))]
> -    [("--exports") "Only show exports"
> -                   (show-imports #f)]
> -    [("--imports") "Only show imports"
> -                   (show-exports #f)]
> -    [("--defines") "Only show defined identifiers"
> -                   (mode 'defines)]
> -    [("--find-export") export "Do a fuzzy match for an export"
> -                       (begin
> -                         (mode 'find-export)
> -                         (find-export export))]
> -    [("--find-import") import "Do a fuzzy match for an import"
> -                       (begin
> -                         (mode 'find-import)
> -                         (find-import import))]
> -    #:args files
> -    files))
> -
> -(for ([file (do-parse-command-line)])
> -  (printf "Checking file ~a\n" file)
> -  (case (mode)
> -    [(show) (check-file (string->path file) (only-phase) (show-imports) (show-exports))]
> -    [(raw) (check-file/raw (string->path file) (only-phase) (show-imports) (show-exports))]
> -    [(defines) (find-defines file)]
> -    [(find-export) (find-file-export file (find-export))]
> -    [(find-import) (find-file-import file (find-import))]))
> -|#
> 
> collects/drracket/private/module-interface/gui.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/drracket/private/module-interface/gui.rkt
> +++ /dev/null
> @@ -1,52 +0,0 @@
> -#lang racket/base
> -
> -;; Shows a gui of provided identifiers with some extra information such as
> -;;  contracts (works)
> -;;  typed racket types (doesn't work)
> -
> -(require (prefix-in check: "check.rkt")
> -         framework/framework
> -         racket/gui/base
> -         racket/class)
> -
> -(provide build-gui)
> -
> -(define (build-gui gui-parent file)
> -  (define exports (check:get-exports file #true))
> -  (for ([provide (map check:provided-syntaxes exports)])
> -    (printf "syntaxes exports (~a): ~a\n" (length provide) (map check:print provide)))
> -
> -  (for ([provide (map check:provided-variables exports)])
> -    (printf "variables (~a): ~a\n" (length provide) (map check:print provide)))
> -
> -  #;
> -  (printf "exports: ~a\n" (map check:print
> -                               (map check:provided-syntaxes
> -                                    (check:get-exports "x.rkt" #true))))
> -
> -  (define stuff (new vertical-pane% [parent gui-parent]))
> -  (new message% [parent stuff] [label "Contracts"])
> -  (define contract-pane (new horizontal-panel% [parent stuff]))
> -  (define contract-text (new racket:text%))
> -  (define contract-editor (new editor-canvas% [parent contract-pane] [editor contract-text]))
> -  (new message% [parent stuff] [label "No contracts"])
> -  (define non-contract-pane (new horizontal-panel% [parent stuff]))
> -  (define non-contract-text (new racket:text%))
> -  (define non-contract-editor (new editor-canvas% [parent non-contract-pane] [editor non-contract-text]))
> -  (for ([provide/phase (map check:provided-syntaxes exports)])
> -    (for ([symbol provide/phase])
> -      (send contract-text insert (check:print symbol))
> -      (send contract-text insert "\n")
> -      ))
> -  (for ([provide/phase (map check:provided-variables exports)])
> -    (for ([symbol provide/phase])
> -      (send non-contract-text insert (check:print symbol))
> -      (send non-contract-text insert "\n")
> -      ))
> -  )
> -
> -#|
> -(let ([frame (new frame:basic% [label ""] [width 500] [height 500])])
> -  (build-gui (send frame get-area-container))
> -  (send frame show #true))
> -|#



Posted on the dev mailing list.