#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: