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