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

Making define-library hygienic in case you really want to use it outside the meta env.

Browse source
This commit is contained in:
Alex Shinn 2014-01-08 14:52:19 -05:00
parent b7852d583e
commit ab9b284099
1 changed files with 70 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

99
lib/meta.scm
View file

@ -1,5 +1,5 @@
;; meta.scm -- meta langauge for describing modules ;; meta.scm -- meta langauge for describing modules
;; Copyright (c) 2009-2012 Alex Shinn. All rights reserved. ;; Copyright (c) 2009-2014 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt ;; BSD-style license: http://synthcode.com/license.txt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -228,11 +228,35 @@
(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!))
(_make-module (rename 'make-module))
(_define (rename 'meta-define)) (_define (rename 'meta-define))
(_lambda (rename 'lambda))
(_let (rename 'let)) (_let (rename 'let))
(_map (rename 'map))
(_if (rename 'if)) (_if (rename 'if))
(_cond (rename 'cond)) (_cond (rename 'cond))
(_set! (rename 'set!))) (_set! (rename 'set!))
(_quote (rename 'quote))
(_and (rename 'and))
(_= (rename '=))
(_eq? (rename 'eq?))
(_pair? (rename 'pair?))
(_null? (rename 'null?))
(_reverse (rename 'reverse))
(_append (rename 'append))
(_assq (rename 'assq))
(_=> (rename '=>))
(_else (rename 'else))
(_length (rename 'length))
(_identifier->symbol (rename 'identifier->symbol))
(_error (rename 'error))
(_cons (rename 'cons))
(_car (rename 'car))
(_cdr (rename 'cdr))
(_caar (rename 'caar))
(_cadr (rename 'cadr))
(_cdar (rename 'cdar))
(_cddr (rename 'cddr)))
;; Check for suspicious defines. ;; Check for suspicious defines.
(for-each (for-each
(lambda (x) (lambda (x)
@ -244,52 +268,63 @@
`(,_let ((,tmp ,this-module)) `(,_let ((,tmp ,this-module))
(,_define (rewrite-export x) (,_define (rewrite-export x)
(,_if (pair? x) (,_if (pair? x)
(,_if (and (= 3 (length x)) (,_if (,_and (,_= 3 (,_length x))
(eq? 'rename (identifier->symbol (car x)))) (,_eq? (,_quote rename)
(cons (car (cddr x)) (cadr x)) (,_identifier->symbol (,_car x))))
(error "invalid module export" x)) (,_cons (,_car (,_cddr x)) (,_cadr x))
(,_error "invalid module export" x))
x)) x))
(,_define (extract-exports) (,_define (extract-exports)
(,_cond (,_cond
((assq 'export-all ,this-module) ((,_assq (,_quote 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 (,_quote ())))
(,_cond (,_cond
((null? ls) res) ((,_null? ls) res)
((and (pair? (car ls)) (eq? 'export (caar ls))) ((,_and (,_pair? (,_car ls))
(lp (cdr ls) (append (map rewrite-export (cdar ls)) res))) (,_eq? (,_quote export) (,_caar ls)))
(else (lp (cdr ls) res))))))) (lp (,_cdr ls)
(,_set! ,this-module '()) (,_append (,_map rewrite-export (,_cdar ls)) res)))
(,_else (lp (,_cdr ls) res)))))))
(,_set! ,this-module (,_quote ()))
,@body ,@body
(,_set! ,this-module (reverse ,this-module)) (,add-module! (,_quote ,name)
(,add-module! ',name (make-module (extract-exports) #f ,this-module)) (,_make-module (extract-exports)
#f
(,_reverse ,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)
(define-syntax define-config-primitive (define-syntax define-meta-primitive
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
`(define-syntax ,(cadr expr) (let ((name (cadr expr)))
`(define-syntax ,name
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
(let ((this-module (rename '*this-module*))) (let ((this-module (rename '*this-module*))
`(set! ,this-module (cons ',expr ,this-module))))))))) (_set! (rename 'set!))
(_cons (rename 'cons))
(_quote (rename 'syntax-quote)))
`(,_set! ,this-module
(,_cons (,_quote ,(cons ',name (cdr expr)))
,this-module))))))))))
(define-config-primitive import) (define-meta-primitive import)
(define-config-primitive import-immutable) (define-meta-primitive import-immutable)
(define-config-primitive export) (define-meta-primitive export)
(define-config-primitive export-all) (define-meta-primitive export-all)
(define-config-primitive include) (define-meta-primitive include)
(define-config-primitive include-ci) (define-meta-primitive include-ci)
(define-config-primitive include-shared) (define-meta-primitive include-shared)
(define-config-primitive body) (define-meta-primitive body)
(define-config-primitive begin) (define-meta-primitive begin)
;; The `import' binding used by (chibi) and (scheme base), etc. ;; The `import' binding used by (chibi) and (scheme base), etc.
(define-syntax repl-import (define-syntax repl-import