From 346494524fdabffb487f33d5eb6eef5a4b6d0efb Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 19 Jul 2014 18:10:14 +0900 Subject: [PATCH] share cache between wrap and inject --- piclib/picrin/macro.scm | 69 +++++++++++++++++++++-------------------- 1 file changed, 35 insertions(+), 34 deletions(-) diff --git a/piclib/picrin/macro.scm b/piclib/picrin/macro.scm index f1281fec..ffb713b5 100644 --- a/piclib/picrin/macro.scm +++ b/piclib/picrin/macro.scm @@ -93,44 +93,26 @@ (define (ir-macro-transformer f) (lambda (expr use-env mac-env) - (define protects (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 icache (make-dictionary)) + (define icache* (make-dictionary)) (define (inject sym) - (if (dictionary-has? cache sym) - (dictionary-ref cache sym) + (if (dictionary-has? icache sym) + (dictionary-ref icache sym) (begin (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))) (define (compare x y) @@ -140,6 +122,25 @@ #f (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)))) (export make-syntactic-closure