55 lines
2.3 KiB
Scheme
55 lines
2.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)
|
|
(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 frame/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)))))
|
|
|
|
(for ([bound-var (in-list (second bind))]
|
|
[frame-var (in-list frame-variables)])
|
|
(define (sv form) (subst-var bound-var frame-var form))
|
|
(set! bind `(#%bind ,(subst bound-var frame-var (second bind))
|
|
,@(map sv (cddr bind)))))
|
|
|
|
(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:
|