; COSC 152
; Fall 2005
; Dennis Brylow
;
; Lecture 17 Demo
; Lexical Address with abstract data structures.

(define-datatype expr expr?
                 (lit-expr (datum number?))
                 (var-expr (id symbol?))
                 (if-expr (test-expr expr?)
                         (true-expr expr?)
                         (false-expr expr?))
                 (lambda-expr (ids (list-of symbol?))
                              (body expr?))
                 (app-expr (rator expr?)
                           (rands (list-of expr?)))
                 (lex-info (id symbol?)
                           (depth number?)
                           (position number?))
                 (free-info (id symbol?))
                 )

(define parse
  (lambda (x)
    (cond
      ((null? x) (eopl:error 'parse "Can't parse ~s." x))
      ((number? x) (lit-expr x))
      ((symbol? x) (var-expr x))
      ((not (pair? x)) (eopl:error 'parse "Can't parse ~s." x))
      ((eqv? (car x) 'if)
       (if-expr (parse (cadr x)) 
                (parse (caddr x)) 
                (parse (cadddr x))))
      ((eqv? (car x) 'lambda)
       (lambda-expr (cadr x)
                    (parse (caddr x))))
      (else
       (app-expr (parse (car x))
                 (map parse (cdr x))))
      )))
                
(define unparse
  (lambda (x)
    (cases expr x
      (lit-expr (datum) datum)
      (var-expr  (id)    id)
      (if-expr (test-exp true-exp false-exp)
              (list 'if (unparse test-exp)
                    (unparse true-exp) (unparse false-exp)))
      (lambda-expr (ids body)
                   (list 'lambda ids (unparse body)))
      (app-expr (rator rands)
                (cons (unparse rator) (map unparse rands)))
      (lex-info (id dep pos)
                (list id ': dep pos))
      (free-info (id)
                 (list id 'free))
      )))
      
      
      
(define test-list
  '(5 x (if x y z) (lambda (x) x) (x y)))

(define test
  (lambda ()
    (for-each (lambda (x) (display (unparse (parse x))) (newline)) test-list)))

(define empty-env
  (lambda () '()))

(define extend-env
  (lambda (vars env)
    (cons vars env)))

(define apply-env
  (lambda (a env)
    (letrec ([apply-env-helper 
           (lambda (a env depth)
             (if (null? env)
                 (free-info a)
                 (if (member a (car env))
                     (lex-info a depth (list-index a 0 (car env)))
                     (apply-env-helper a (cdr env) (+ 1 depth))
                 )))]
             [list-index 
              (lambda (a index lst)
                (if (null? lst)
                    #f
                    (if (eqv? a (car lst))
                        index
                        (list-index a (+ 1 index) (cdr lst)))))])
      (apply-env-helper a env 0))))

(define lex-addr
  (lambda (exp env)
    (cases expr exp
      (lit-expr (datum) (lit-expr datum))
      (var-expr (id)    (apply-env id env))
      (if-expr (test true false)
               (if-expr (lex-addr test env)
                        (lex-addr true env)
                        (lex-addr false env)))
      (lambda-expr (ids body)
                   (lambda-expr ids 
                                (lex-addr body (extend-env ids env))))
      (app-expr (rator rands)
                (app-expr (lex-addr rator env)
                          (map (lambda (x) (lex-addr x env)) rands)))
      (lex-info (id pos dep) exp)
      (free-info (id) exp)
      )))

(define lexical-address
  (lambda (exp)
    (lex-addr exp (empty-env))))