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

Merge branch 'ir-refactor'

This commit is contained in:
Yuichi Nishiwaki 2014-07-19 18:33:24 +09:00
parent dda989ac94 8b82498cd7
commit f5eb71ed71
1 changed files with 46 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
piclib/picrin/macro.scm
View File

@ -28,29 +28,41 @@
(list->vector (map proc (vector->list expr)))) (list->vector (map proc (vector->list expr))))
(define (walk proc expr) (define (walk proc expr)
"walk on symbols"
(if (null? expr) (if (null? expr)
'() '()
(if (pair? expr) (if (pair? expr)
(cons (walk proc (car expr)) (cons (walk proc (car expr))
(walk proc (cdr expr))) (walk proc (cdr expr)))
(if (vector? expr) (if (vector? expr)
(vector-map proc expr) (list->vector (walk proc (vector->list expr)))
(proc expr))))) (if (symbol? expr)
(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 (make-syntactic-closure env free form)
(define cache (make-dictionary))
(define resolve
(memoize
(lambda (sym)
(make-identifier sym env))))
(walk (walk
(lambda (atom) (lambda (sym)
(if (not (symbol? atom)) (if (memq sym free)
atom sym
(if (memq atom free) (resolve sym)))
atom
(if (dictionary-has? cache atom)
(dictionary-ref cache atom)
(begin
(define id (make-identifier atom env))
(dictionary-set! cache atom id)
id)))))
form)) form))
(define (close-syntax form env) (define (close-syntax form env)
@ -71,15 +83,10 @@
(define (er-macro-transformer f) (define (er-macro-transformer f)
(lambda (expr use-env mac-env) (lambda (expr use-env mac-env)
(define cache (make-dictionary)) (define rename
(memoize
(define (rename sym) (lambda (sym)
(if (dictionary-has? cache sym) (make-identifier sym mac-env))))
(dictionary-ref cache sym)
(begin
(define id (make-identifier sym mac-env))
(dictionary-set! cache sym id)
id)))
(define (compare x y) (define (compare x y)
(if (not (symbol? x)) (if (not (symbol? x))
@ -93,45 +100,19 @@
(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 (wrap expr) (define inject
(walk (memoize
(lambda (atom) (lambda (sym)
(if (not (symbol? atom)) (define id (make-identifier sym use-env))
atom (dictionary-set! icache* id sym)
(begin id)))
(define id (make-identifier atom use-env))
(dictionary-set! protects id atom) ; lookup *atom* from id
id)))
expr))
(define (unwrap expr) (define rename
(define cache (make-dictionary)) (memoize
(walk (lambda (sym)
(lambda (atom) (make-identifier sym mac-env))))
(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)
(if (dictionary-has? cache sym)
(dictionary-ref cache sym)
(begin
(define id (make-identifier sym use-env))
(dictionary-set! cache sym id)
id)))
(define (compare x y) (define (compare x y)
(if (not (symbol? x)) (if (not (symbol? x))
@ -140,7 +121,11 @@
#f #f
(identifier=? mac-env x mac-env y)))) (identifier=? mac-env x mac-env y))))
(unwrap (f (wrap expr) inject compare)))) (walk (lambda (sym)
(if (dictionary-has? icache* sym)
(dictionary-ref icache* sym)
(rename sym)))
(f (walk inject expr) inject compare))))
(export make-syntactic-closure (export make-syntactic-closure
close-syntax close-syntax