72 lines
3.3 KiB
Scheme
72 lines
3.3 KiB
Scheme
#lang scheme/base
|
|
|
|
(require scheme/list)
|
|
(require (file "utilities.scm"))
|
|
(require (file "primitives.scm"))
|
|
|
|
(provide map-variables)
|
|
|
|
(define (map-variables lambda/template-form)
|
|
(let ([bind (fourth lambda/template-form)]
|
|
[g-vars '()]
|
|
[unused-g-vars global-variables]
|
|
[i-vars '()])
|
|
(define (add-g-var value)
|
|
(cond
|
|
[(or (eq? value #f) (equal? value '(quote #f))) '#%f]
|
|
[(equal? value '(quote ())) '#%nil]
|
|
[else (let ([value (cond [(and (pair? value) (eq? (first value) 'quote)) (second value)]
|
|
[(symbol? value) `(#%builtin ,(symbol->string value))]
|
|
[else value])])
|
|
(let/cc return
|
|
(for ([g-var (in-list global-variables)]
|
|
[val (in-list g-vars)])
|
|
(when (eq? value val) (return g-var)))
|
|
(let ([g-var (first unused-g-vars)])
|
|
(set! unused-g-vars (cdr unused-g-vars))
|
|
(set! g-vars (append g-vars (list value)))
|
|
g-var)))]))
|
|
|
|
(let* ([free-vars (filter transient/instance-variable? (free-variables bind))]
|
|
[var-map (for/list ([free-var (in-list free-vars)]
|
|
[inst-var (in-list instance-variables)])
|
|
(set! i-vars (append i-vars (list free-var)))
|
|
(list free-var inst-var))])
|
|
(define (sv* form) (subst-var* var-map form))
|
|
(set! bind `(#%bind ,(subst* var-map (second bind))
|
|
,@(map sv* (cddr bind)))))
|
|
|
|
(let* ([var-map (map (lambda (v) (list v '#%undef)) (second bind))]
|
|
[exprs (for/list ([expr (in-list (cddr bind))]
|
|
[tvar (in-list transient-variables)])
|
|
(if (and (pair? expr) (eq? (first expr) '#%set!))
|
|
(let ([var (second expr)]
|
|
[newexpr `(#%set! ,tvar ,(subst-var* var-map (third expr)))])
|
|
(set! var-map (map (lambda (vm)
|
|
(if (eq? (first vm) var)
|
|
(list var tvar)
|
|
vm))
|
|
var-map))
|
|
(when (simple-value? (third newexpr))
|
|
(set! newexpr `(#%set! ,tvar (#%if #%f #%undef ,(third newexpr)))))
|
|
newexpr)
|
|
`(#%set! ,tvar ,(subst-var* var-map expr))))])
|
|
(set! bind `(#%bind ,(for/list ([s (in-list (cddr bind))]
|
|
[v (in-list transient-variables)])
|
|
v)
|
|
,@exprs)))
|
|
|
|
(set! bind (map-form bind
|
|
#:lambda (lambda (recurse op inner-g-vars i-vars bind)
|
|
`(#%make-lambda ,((compose add-g-var map-variables)
|
|
`(#%template ,inner-g-vars ,i-vars ,bind))))
|
|
#:variable (lambda (recurse kind form)
|
|
(if (machine-variable? form) form (add-g-var form)))
|
|
#:literal (lambda (recurse kind form)
|
|
(if (eq? form '%nil) form (add-g-var form)))))
|
|
|
|
`(,(if (null? i-vars) '#%lambda '#%template) ,g-vars ,i-vars
|
|
,bind)))
|
|
|
|
; vim:set sw=2 expandtab:
|