Expansion of Free Variables.





; The function "expand" is a Newlisp version of mathematical operation
; of the substitution. It is very useful function. For example,
; in code
;
;               (setf 'x 'new-variable)
;               (expand '(lambda(x y)(print x)) 'x)
;
;   ===>        (lambda (new-variable y) (print new-variable))
;
; Newlisp "expands" all occurences of the symbol x with symbol
; new-variable.
;
; However, it is not always convenient to apply substitution on
; all occurences. For example, let us assume that you want to
; write interpreter for some other dialect of Lisp in Newlisp.
; That interpreter should be able to compute expressions like
;
;      ((lambda(x)(+ x (* 2 x) (let((x 5))(* x x)))) 3).
;
; It can be accompplished by substituting argument of the function (3)
; on place of parameter of the function (x) of the body of the
; function
;               (+ x (* 2 x) (let((x 5))(* x x))).
;
; However, the substitution is needed only for first two occurences
; of x, while not for third, fourth and fifth occurence - these
; occurences are not "free", they are "bounded."
;
; I defined expand-free-variable function so it recognizes few most
; important ways for binding of the variables: lambda, lambda-macro,
; local, let, letn and letex. As many of these operations are
; "polymorphic", only the most basic form is supported. It turned
; to be relatively hard to write, because almost every binding
; operator, every form of it, requires slightly different code.

(set 'function-parameters (lambda(f)(first f)))
(set 'function-body (lambda(f)(rest f)))

(set 'expand-free-variables
  (lambda(E)
    (let ((vars-to-expand (args)))

         (cond ((symbol? E) (eval (append '(expand)
                                           (map quote (list E))
                                           (map quote vars-to-expand))))

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

               ((or (lambda? E)
                    (macro? E))
                        
                    (letn((new-vars-to-expand
                             (difference vars-to-expand
                                         (function-parameters E)))
                                                          
                          (new-expand-function
                             (append (lambda(expr))
                                (list (append '(expand-free-variables expr)
                                               (map quote new-vars-to-expand))))))

                         (append (cond ((lambda? E) '(lambda))
                                       ((macro? E) '(lambda-macro)))
                                       
                                 (list (function-parameters E))
                                 
                                 (map new-expand-function
                                      (function-body E)))))
                
                ;-----------------------------------------------

                ((and (list? E)
                      (starts-with E 'local))
                
                    (letn((new-vars-to-expand (difference vars-to-expand
                                                          (nth 1 E)))
                                                          
                         (new-expand-function
                           (append (lambda(expr))
                             (list (append '(expand-free-variables expr)
                                            (map quote new-vars-to-expand))))))

                         (append '(local)
                                  (list (nth 1 E))
                                  (map new-expand-function
                                       (rest (rest E))))))
                                       
                ;-----------------------------------------------

                ((and (list? E)
                      (or (starts-with E 'let)
                          (starts-with E 'letn)
                          (starts-with E 'letex)))
                     
                     (letn((new-vars-to-expand
                              (difference vars-to-expand
                                          (map first (nth 1 E))))
                                          
                           (new-expand-function
                              (append (lambda(expr))
                                 (list (append '(expand-free-variables expr)
                                                (map quote new-vars-to-expand))))))

                         (append (cond ((starts-with E 'let) '(let))
                                       ((starts-with E 'letn) '(letn))
                                       ((starts-with E 'letex) '(letex)))

                                  (list (first (rest E)))
                                  (map new-expand-function
                                       (rest (rest E))))))
                                       
               ;------------------------------------------------
                                       
               ((list? E)(let((new-expand-function
                                (append (lambda(expr))
                                  (list (append '(expand-free-variables expr)
                                                 (map quote vars-to-expand))))))

                              (map new-expand-function E)))

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

               ((or (number? E)
                    (string? E))
                    E)

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

               ((quote? E)
                (list 'quote (eval (append '(expand-free-variables)
                                            (list (list 'quote (eval E)))
                                            (map quote vars-to-expand)))))
                                      
               ;------------------------------------------------

               (true (println "Expand for " E " is not defined.\n")
                     (throw-error "expand isn't defined."))))))



;                     FEW TESTS


(setf x 1 y 2 z 3 v 4 w 5)
(println (expand-free-variables '(local(x y z)x y z v w 7) 'x 'v))

; (local (x y z)
;  x y z 4 w 7)

(println (expand-free-variables '('('(x)) '('(z)) '''y (local(x)x y)) 'x 'y))

; ((quote ((quote (1)))) (quote ((quote (z)))) (quote (quote (quote 2)))
;  (local (x)
;   x 2))
;

(println (expand-free-variables '(lambda(x a y) x b z) 'x 'y 'z 'w))

; (lambda (x a y) x b 3)

(setf x 'new-variable)
(println (expand-free-variables (list 'x '(lambda(x y)(print x))) 'x))

; (new-variable
;  (let ((x 3))
;   (x even-newer-variable
;    (letex ((y 4)) y))))
;

(setf x 'new-variable y 'even-newer-variable)
(println (expand-free-variables '(x (let((x 3)) (x y (letex((y 4))y)))) 'x 'y))

; (lambda (x a y) x b 3)

(exit)


                                 

No comments:

Post a Comment