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

Catching common error of using unwrapped define in library declarations.

Browse source
This commit is contained in:
Alex Shinn 2012-12-31 07:36:48 +09:00
parent 902a37b259
commit 6a9725996b
1 changed files with 27 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
lib/meta.scm
View file

@ -201,6 +201,9 @@
(module-env-set! mod (eval-module name mod))) (module-env-set! mod (eval-module name mod)))
mod)) mod))
(define-syntax meta-begin begin)
(define-syntax meta-define define)
(define define-library-transformer (define define-library-transformer
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
@ -208,34 +211,39 @@
(body (cddr expr)) (body (cddr expr))
(tmp (rename 'tmp)) (tmp (rename 'tmp))
(this-module (rename '*this-module*)) (this-module (rename '*this-module*))
(add-module! (rename 'add-module!))) (add-module! (rename 'add-module!))
`(let ((,tmp ,this-module)) (_define (rename 'meta-define))
(define (rewrite-export x) (_let (rename 'let))
(if (pair? x) (_if (rename 'if))
(if (and (= 3 (length x)) (_cond (rename 'cond))
(eq? 'rename (identifier->symbol (car x)))) (_set! (rename 'set!)))
`(,_let ((,tmp ,this-module))
(,_define (rewrite-export x)
(,_if (pair? x)
(,_if (and (= 3 (length x))
(eq? 'rename (identifier->symbol (car x))))
(cons (car (cddr x)) (cadr x)) (cons (car (cddr x)) (cadr x))
(error "invalid module export" x)) (error "invalid module export" x))
x)) x))
(define (extract-exports) (,_define (extract-exports)
(cond (,_cond
((assq 'export-all ,this-module) ((assq 'export-all ,this-module)
=> (lambda (x) => (lambda (x)
(if (pair? (cdr x)) (if (pair? (cdr x))
(error "export-all takes no parameters" x)) (error "export-all takes no parameters" x))
#f)) #f))
(else (else
(let lp ((ls ,this-module) (res '())) (,_let lp ((ls ,this-module) (res '()))
(cond (,_cond
((null? ls) res) ((null? ls) res)
((and (pair? (car ls)) (eq? 'export (caar ls))) ((and (pair? (car ls)) (eq? 'export (caar ls)))
(lp (cdr ls) (append (map rewrite-export (cdar ls)) res))) (lp (cdr ls) (append (map rewrite-export (cdar ls)) res)))
(else (lp (cdr ls) res))))))) (else (lp (cdr ls) res)))))))
(set! ,this-module '()) (,_set! ,this-module '())
,@body ,@body
(set! ,this-module (reverse ,this-module)) (,_set! ,this-module (reverse ,this-module))
(,add-module! ',name (make-module (extract-exports) #f ,this-module)) (,add-module! ',name (make-module (extract-exports) #f ,this-module))
(set! ,this-module ,tmp)))))) (,_set! ,this-module ,tmp))))))
(define-syntax define-library define-library-transformer) (define-syntax define-library define-library-transformer)
(define-syntax module define-library-transformer) (define-syntax module define-library-transformer)
@ -249,7 +257,6 @@
(let ((this-module (rename '*this-module*))) (let ((this-module (rename '*this-module*)))
`(set! ,this-module (cons ',expr ,this-module))))))))) `(set! ,this-module (cons ',expr ,this-module)))))))))
(define-syntax orig-begin begin)
(define-config-primitive import) (define-config-primitive import)
(define-config-primitive import-immutable) (define-config-primitive import-immutable)
(define-config-primitive export) (define-config-primitive export)
@ -268,7 +275,7 @@
(let lp ((ls (cdr expr)) (res '())) (let lp ((ls (cdr expr)) (res '()))
(cond (cond
((null? ls) ((null? ls)
(cons (rename 'orig-begin) (reverse res))) (cons (rename 'meta-begin) (reverse res)))
(else (else
(let ((mod+imps (resolve-import (car ls)))) (let ((mod+imps (resolve-import (car ls))))
(cond (cond
@ -293,3 +300,8 @@
(cons '(srfi 0) (make-module (list 'cond-expand) (cons '(srfi 0) (make-module (list 'cond-expand)
(current-environment) (current-environment)
(list (list 'export 'cond-expand)))))) (list (list 'export 'cond-expand))))))
(define-syntax define
(er-macro-transformer
(lambda (expr rename compare)
(error "invalid use of define in library declarations - did you forget to wrap it in begin?" expr))))