51 lines
2.0 KiB
Scheme
51 lines
2.0 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 (if (and (pair? value) (eq? (first value) 'quote))
|
|
(second value)
|
|
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))])
|
|
(set! bind (subst-var* var-map bind)))
|
|
|
|
(for ([bound-var (in-list (second bind))]
|
|
[frame-var (in-list frame-variables)])
|
|
(set! bind (subst-var bound-var frame-var 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:
|