From 1297ef9fb8e176a2d75cc7975c35a35a26385aff Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 19 Jul 2014 18:26:03 +0900 Subject: [PATCH] add memoize function --- piclib/picrin/macro.scm | 65 ++++++++++++++++++++--------------------- 1 file changed, 31 insertions(+), 34 deletions(-) diff --git a/piclib/picrin/macro.scm b/piclib/picrin/macro.scm index bec9cdd0..a5155b21 100644 --- a/piclib/picrin/macro.scm +++ b/piclib/picrin/macro.scm @@ -40,19 +40,29 @@ (proc expr) expr))))) + (define (memoize f) + "memoize on a symbol" + (define cache (make-dictionary)) + (lambda (sym) + (if (dictionary-has? cache sym) + (dictionary-ref cache sym) + (begin + (define val (f sym)) + (dictionary-set! cache sym val) + val)))) (define (make-syntactic-closure env free form) - (define cache (make-dictionary)) + + (define resolve + (memoize + (lambda (sym) + (make-identifier sym env)))) + (walk (lambda (sym) (if (memq sym free) sym - (if (dictionary-has? cache sym) - (dictionary-ref cache sym) - (begin - (define id (make-identifier sym env)) - (dictionary-set! cache sym id) - id)))) + (resolve sym))) form)) (define (close-syntax form env) @@ -73,15 +83,10 @@ (define (er-macro-transformer f) (lambda (expr use-env mac-env) - (define cache (make-dictionary)) - - (define (rename sym) - (if (dictionary-has? cache sym) - (dictionary-ref cache sym) - (begin - (define id (make-identifier sym mac-env)) - (dictionary-set! cache sym id) - id))) + (define rename + (memoize + (lambda (sym) + (make-identifier sym mac-env)))) (define (compare x y) (if (not (symbol? x)) @@ -95,27 +100,19 @@ (define (ir-macro-transformer f) (lambda (expr use-env mac-env) - (define icache (make-dictionary)) (define icache* (make-dictionary)) - (define (inject sym) - (if (dictionary-has? icache sym) - (dictionary-ref icache sym) - (begin - (define id (make-identifier sym use-env)) - (dictionary-set! icache sym id) - (dictionary-set! icache* id sym) - id))) + (define inject + (memoize + (lambda (sym) + (define id (make-identifier sym use-env)) + (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 rename + (memoize + (lambda (sym) + (make-identifier sym mac-env)))) (define (uninject sym) (if (dictionary-has? icache* sym)