conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

share cache between wrap and inject

This commit is contained in:
Yuichi Nishiwaki 2014-07-19 18:10:14 +09:00
parent dda989ac94
commit 346494524f
1 changed files with 35 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
piclib/picrin/macro.scm
View File

@ -93,44 +93,26 @@
(define (ir-macro-transformer f) (define (ir-macro-transformer f)
(lambda (expr use-env mac-env) (lambda (expr use-env mac-env)
(define protects (make-dictionary)) (define icache (make-dictionary))
(define icache* (make-dictionary))
(define (wrap expr)
(walk
(lambda (atom)
(if (not (symbol? atom))
atom
(begin
(define id (make-identifier atom use-env))
(dictionary-set! protects id atom) ; lookup *atom* from id
id)))
expr))
(define (unwrap expr)
(define cache (make-dictionary))
(walk
(lambda (atom)
(if (not (symbol? atom))
atom
(if (dictionary-has? protects atom)
(dictionary-ref protects atom)
(if (dictionary-has? cache atom)
(dictionary-ref cache atom)
(begin
;; implicit renaming
(define id (make-identifier atom mac-env))
(dictionary-set! cache atom id)
id)))))
expr))
(define cache (make-dictionary))
(define (inject sym) (define (inject sym)
(if (dictionary-has? cache sym) (if (dictionary-has? icache sym)
(dictionary-ref cache sym) (dictionary-ref icache sym)
(begin (begin
(define id (make-identifier sym use-env)) (define id (make-identifier sym use-env))
(dictionary-set! cache sym id) (dictionary-set! icache sym id)
(dictionary-set! icache* id sym)
id)))
(define rcache (make-dictionary))
(define (rename sym)
(if (dictionary-has? rcache sym)
(dictionary-ref rcache sym)
(begin
(define id (make-identifier sym mac-env))
(dictionary-set! rcache sym id)
id))) id)))
(define (compare x y) (define (compare x y)
@ -140,6 +122,25 @@
#f #f
(identifier=? mac-env x mac-env y)))) (identifier=? mac-env x mac-env y))))
(define (wrap expr)
(walk
(lambda (atom)
(if (not (symbol? atom))
atom
(inject atom)))
expr))
(define (unwrap expr)
(define cache (make-dictionary))
(walk
(lambda (atom)
(if (not (symbol? atom))
atom
(if (dictionary-has? icache* atom)
(dictionary-ref icache* atom)
(rename atom))))
expr))
(unwrap (f (wrap expr) inject compare)))) (unwrap (f (wrap expr) inject compare))))
(export make-syntactic-closure (export make-syntactic-closure