;;  ------------------------------------------------------------------------
;; |   FILE           :  lexical-address.rkt                                |
;; |   AUTHOR         :  Eugene Wallingford                                 |
;; |   CREATION DATE  :  2025/04/02                                         |
;; |   DESCRIPTION    :  The function lexical-address takes as input an     |
;; |                     expression in a little language consisting of      |
;; |                     variable references, variable-arity functions,     |
;; |                     function applications, and if expressions.         |
;; |                     lexical-address returns an equivalent expression   |
;; |                     in which all variable references are replaced      |
;; |                     with their lexical addresses, in the form          |
;; |                     (: depth position).                                |
;;  ------------------------------------------------------------------------

#lang racket
(require "syntax-procs.rkt")
(require "free-vars.rkt")
(require "list-index.rkt")
(provide lexical-address)

;; -------------------------------------------------------------------------
;; an interface procedure that initializes the list of declarations

(define (lexical-address exp)
  (lexical-address-helper exp (list (free-vars exp))))

;; -------------------------------------------------------------------------
;; the structurally-recursive function that lexically-addresses expressions

(define (lexical-address-helper exp list-of-decls)
  (cond ((varref? exp)
           (lexical-address-for exp list-of-decls 0))
        ((if? exp)
           (make-if (lexical-address-helper (if->test exp) list-of-decls)
                    (lexical-address-helper (if->then exp) list-of-decls)
                    (lexical-address-helper (if->else exp) list-of-decls)))
        ((app? exp)
           (make-app (lexical-address-helper (app->proc exp) list-of-decls)
                     (map (lambda (e)
                            (lexical-address-helper e list-of-decls))
                          (app->args exp))))
        ((lambda? exp)
           (make-lambda (length (lambda->params exp))
                        (lexical-address-helper
                          (lambda->body exp)
                          (cons (lambda->params exp) list-of-decls))))
        (else (error 'lexical-address "unknown exp ~a" exp) )))

;; -------------------------------------------------------------------------
;; a helper function that constructs lexical address expressions, (v : d p)

(define (lexical-address-for var list-of-decls curr-depth)
  (if (null? list-of-decls)
      (error 'lexical-address-for
             "variable ~a -- not found in any block" var)
      (let ( (pos (list-index var (first list-of-decls))) )
        (if (> pos -1)
            (list ': curr-depth pos)
            (lexical-address-for  var  (rest list-of-decls)
                                       (add1 curr-depth))))))

;; -------------------------------------------------------------------------