Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-15 08:57:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Warn when importing bad bindings with `only'.

Browse source
This commit is contained in:
Alex Shinn 2011-12-04 13:43:34 +09:00
parent cd708b9f90
commit f2502229e6
1 changed files with 15 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
lib/meta.scm
View file

@ -49,6 +49,15 @@
(define (symbol-append a b) (define (symbol-append a b)
(string->symbol (string-append (symbol->string a) (symbol->string b)))) (string->symbol (string-append (symbol->string a) (symbol->string b))))
;; (define (warn msg . args)
;; (display msg (current-error-port))
;; (display ":" (current-error-port))
;; (for-each (lambda (a)
;; (display " " (current-error-port))
;; (write a (current-error-port)))
;; args)
;; (newline (current-error-port)))
(define (to-id id) (if (pair? id) (car id) id)) (define (to-id id) (if (pair? id) (car id) id))
(define (from-id id) (if (pair? id) (cdr id) id)) (define (from-id id) (if (pair? id) (cdr id) id))
(define (id-filter pred ls) (define (id-filter pred ls)
@ -67,12 +76,15 @@
(and (not (eq? 'only (car x))) (and (not (eq? 'only (car x)))
(module-exports (module-exports
(find-module (car mod-name+imports))))))) (find-module (car mod-name+imports)))))))
;; (if (not (eq? 'only (car x)))
;; (let ((unbound
;; (id-filter (lambda (i) (not (memq i imp-ids))) (cddr x))))
;; (if (pair? unbound)
;; (warn "import excepting unbound identifiers" unbound))))
(cons (car mod-name+imports) (cons (car mod-name+imports)
(case (car x) (case (car x)
((only) ((only)
(if (not imp-ids) (cddr x))
(cddr x)
(id-filter (lambda (i) (memq i (cddr x))) imp-ids)))
((except) ((except)
(id-filter (lambda (i) (not (memq i (cddr x)))) imp-ids)) (id-filter (lambda (i) (not (memq i (cddr x)))) imp-ids))
((rename) ((rename)