suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Show blueboxes info in xrepl with ,describe

Browse Source
This commit is contained in:
Asumu Takikawa 2014-08-01 16:41:47 -04:00
parent 4315018ace
commit ac93668a20
1 changed files with 11 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/xrepl-pkgs/xrepl-lib/xrepl/xrepl.rkt
View File

@ -37,6 +37,9 @@
(defautoload setup/path-to-relative path->relative-string/setup) (defautoload setup/path-to-relative path->relative-string/setup)
(defautoload syntax/modcode get-module-code) (defautoload syntax/modcode get-module-code)
(defautoload racket/path find-relative-path) (defautoload racket/path find-relative-path)
(defautoload setup/xref load-collections-xref)
(defautoload scribble/xref xref-binding->definition-tag)
(defautoload scribble/blueboxes fetch-blueboxes-strs)
;; similar, but just for identifiers ;; similar, but just for identifiers
(define hidden-namespace (make-base-namespace)) (define hidden-namespace (make-base-namespace))
@ -637,6 +640,9 @@
(define-values [src-mod src-id nominal-src-mod nominal-src-id (define-values [src-mod src-id nominal-src-mod nominal-src-id
src-phase import-phase nominal-export-phase] src-phase import-phase nominal-export-phase]
(apply values b)) (apply values b))
(define tag
(xref-binding->definition-tag (load-collections-xref) b 0))
(define bluebox-strs (and tag (fetch-blueboxes-strs tag)))
(set! src-mod (->relname (mpi->name src-mod))) (set! src-mod (->relname (mpi->name src-mod)))
(set! nominal-src-mod (->relname (mpi->name nominal-src-mod))) (set! nominal-src-mod (->relname (mpi->name nominal-src-mod)))
(printf "; `~s' is a bound identifier~a,\n" sym at-phase) (printf "; `~s' is a bound identifier~a,\n" sym at-phase)
@ -650,7 +656,11 @@
(if (not (eq? sym nominal-src-id)) (if (not (eq? sym nominal-src-id))
(format " where it is defined as `~s'" nominal-src-id) (format " where it is defined as `~s'" nominal-src-id)
"")))) ""))))
(printf "~a" (phase->name nominal-export-phase "; (exported-~a)\n"))])) (printf "~a" (phase->name nominal-export-phase "; (exported-~a)\n"))
(when bluebox-strs
(displayln "; documentation:")
(for-each (λ (s) (display "; ") (displayln s))
bluebox-strs))]))
(define (describe-module sexpr mod-path/sym also?) (define (describe-module sexpr mod-path/sym also?)
(define get (define get
(if (symbol? mod-path/sym) (if (symbol? mod-path/sym)