Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

small meta tweaks for reloading

Browse source
This commit is contained in:
Alex Shinn 2012-05-15 23:00:55 +09:00
parent d8e0abc3cb
commit ddc99fbf79
1 changed files with 18 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
lib/meta.scm
View file

@ -10,6 +10,7 @@
(define (make-module exports env meta) (vector exports env meta #f)) (define (make-module exports env meta) (vector exports env meta #f))
(define (%module-exports mod) (vector-ref mod 0)) (define (%module-exports mod) (vector-ref mod 0))
(define (module-env mod) (vector-ref mod 1)) (define (module-env mod) (vector-ref mod 1))
(define (module-env-set! mod env) (vector-set! mod 1 env))
(define (module-meta-data mod) (vector-ref mod 2)) (define (module-meta-data mod) (vector-ref mod 2))
(define (module-exports mod) (define (module-exports mod)
@ -46,6 +47,18 @@
(cond ((assoc name *modules*) => cdr) (cond ((assoc name *modules*) => cdr)
(else #f))))) (else #f)))))
(define (add-module! name module)
(set! *modules* (cons (cons name module) *modules*)))
(define (delete-module! name)
(let lp ((ls *modules*) (prev #f))
(cond ((null? ls))
((equal? name (car (car ls)))
(if prev
(set-cdr! prev (cdr ls))
(set! *modules* (cdr ls))))
(else (lp (cdr ls) ls)))))
(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))))
@ -118,8 +131,8 @@
(else (else
(error "couldn't find import" x)))) (error "couldn't find import" x))))
(define (eval-module name mod) (define (eval-module name mod . o)
(let ((env (make-environment)) (let ((env (if (pair? o) (car o) (make-environment)))
(dir (module-name-prefix name))) (dir (module-name-prefix name)))
(define (load-modules files extension fold?) (define (load-modules files extension fold?)
(for-each (for-each
@ -175,7 +188,7 @@
(define (load-module name) (define (load-module name)
(let ((mod (find-module name))) (let ((mod (find-module name)))
(if (and mod (not (module-env mod))) (if (and mod (not (module-env mod)))
(vector-set! mod 1 (eval-module name mod))) (module-env-set! mod (eval-module name mod)))
mod)) mod))
(define define-library-transformer (define define-library-transformer
@ -185,7 +198,7 @@
(body (cddr expr)) (body (cddr expr))
(tmp (rename 'tmp)) (tmp (rename 'tmp))
(this-module (rename '*this-module*)) (this-module (rename '*this-module*))
(modules (rename '*modules*))) (add-module! (rename 'add-module!)))
`(let ((,tmp ,this-module)) `(let ((,tmp ,this-module))
(define (rewrite-export x) (define (rewrite-export x)
(if (pair? x) (if (pair? x)
@ -201,9 +214,7 @@
(cond ((assq 'export ,this-module) (cond ((assq 'export ,this-module)
=> (lambda (x) (map rewrite-export (cdr x)))) => (lambda (x) (map rewrite-export (cdr x))))
(else '())))) (else '()))))
(set! ,modules (,add-module! ',name (make-module exports #f ,this-module)))
(cons (cons ',name (make-module exports #f ,this-module))
,modules)))
(set! ,this-module ,tmp)))))) (set! ,this-module ,tmp))))))
(define-syntax define-library define-library-transformer) (define-syntax define-library define-library-transformer)