1;;; 2;;; module related utility functions. to be autoloaded. 3;;; 4;;; Copyright (c) 2000-2020 Shiro Kawai <shiro@acm.org> 5;;; 6;;; Redistribution and use in source and binary forms, with or without 7;;; modification, are permitted provided that the following conditions 8;;; are met: 9;;; 10;;; 1. Redistributions of source code must retain the above copyright 11;;; notice, this list of conditions and the following disclaimer. 12;;; 13;;; 2. Redistributions in binary form must reproduce the above copyright 14;;; notice, this list of conditions and the following disclaimer in the 15;;; documentation and/or other materials provided with the distribution. 16;;; 17;;; 3. Neither the name of the authors nor the names of its contributors 18;;; may be used to endorse or promote products derived from this 19;;; software without specific prior written permission. 20;;; 21;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 27;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 28;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 29;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 30;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 31;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32;;; 33 34(define-module gauche.modutil 35 (export export-if-defined use-version describe-symbol-bindings) 36 ) 37(select-module gauche.modutil) 38 39(define-macro (export-if-defined . symbols) 40 ;; CAVEAT: this form sees whether the given symbols are defined or not 41 ;; _at_compile_time_. So the definitions of symbols have to appear 42 ;; before this form. Furthermore, the semantics of this form is ambigous 43 ;; when used except top-level. It's not very nice, so you should 44 ;; avoid this form unless you really need it. 45 ;; NB: filter is in srfi-1, and we don't want to load it here. Ugh. 46 `(export 47 ,@(let loop ([syms symbols] [r '()]) 48 (cond [(null? syms) (reverse! r)] 49 [(not (symbol? (car syms))) 50 (error "non-symbol in export-if-defined form:" (car syms))] 51 [(global-variable-bound? #f (car syms)) 52 (loop (cdr syms) (cons (car syms) r))] 53 [else (loop (cdr syms) r)])))) 54 55;; Inter-version compatibility. 56(define-macro (use-version version) 57 (let1 compat (string-append "gauche/compat/" version) 58 (unless (provided? compat) 59 (let1 path (string-append (gauche-library-directory) "/" compat ".scm") 60 (when (file-exists? path) 61 (let1 module (string->symbol (string-append "gauche-" version)) 62 `(begin 63 (require ,compat) 64 (import ,module)))))))) 65 66;; Called when you describe a symbol in REPL. Look for the symbol 67;; in all named modules. 68(define (describe-symbol-bindings sym) 69 (define const? (with-module gauche.internal gloc-const?)) 70 (define inlinable? (with-module gauche.internal gloc-inlinable?)) 71 (define find-b (with-module gauche.internal find-binding)) 72 (define (describe-binding mod gloc val) 73 (let1 attrs (cond-list [(const? gloc) 'const] 74 [(inlinable? gloc) 'inlinable]) 75 (format #t " In module `~s'" (module-name mod)) 76 (unless (null? attrs) (format #t " ~s" attrs)) 77 (format #t ":\n ~a\n" 78 (guard [e (else "#<unprintable>")] 79 (format "~,,,,50:a" val))))) 80 (let1 bindings (filter-map (^m (and-let* ([g (find-b m sym #t)] 81 [ (global-variable-bound? m sym) ]) 82 (list m g (global-variable-ref m sym)))) 83 (all-modules)) 84 (if (null? bindings) 85 (format #t "No known bindings for variable ~a.\n" sym) 86 (begin (format #t "Known binding~a for variable ~a:\n" 87 (if (null? (cdr bindings)) "" "s") sym) 88 (for-each (cut apply describe-binding <>) bindings)))) 89 (values)) 90