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)


                                 

Lambda Calculus Interpreter.






Later edit: there is newer, improved version of this interpreter, check
this post and few posts before that.



; Lambda calculus implemented in Newlisp. It would be too ambitious
; to explain what is lambda calculus in this post, so I'll assume
; that reader familiarized himself with notion of lambda calculus
; somewhere else, and I'll provide only code for evaluation ("reduction")
; of lambda-expressions. Instead of lambda symbol, I'll use ^ -
; and it was original symbol used by Church.

; Only beta-reduction (but this is only important one) and normal
; order evaluation (better one, used for Haskell and fexprs) - from
; outside to inside implemented.

(set 'is-variable (lambda(x)(symbol? x)))

(set 'is-function (lambda(L)(and (list? L)
                                 (= (first L) '^)
                                 (= (nth 2 L) '.))))
                                 
(set 'function-variable (lambda(f)(nth 1 f)))
(set 'function-body (lambda(f)(last f)))
                                 
(set 'is-application (lambda(L)(and (list? L)
                                    (= (length L) 2))))

(set 'substitute-free-occurences ; of variable V in E with F
     (lambda(V E F)
     
       (cond ((is-variable E) (if (= E V) F E))

             ((is-function E)
             
                  (if (= (function-variable E) V)
                      
                      E ; V is bounded in E - no substitution
                      
                      (list '^
                            (function-variable E)
                            '.
                            (substitute-free-occurences V
                                   (function-body E)
                                   F))))
                        
              ((is-application E)
               (list (substitute-free-occurences V (first E) F)
                     (substitute-free-occurences V (last E) F))))))
                        

(set 'reduce-once
     (lambda(E)
        (cond ((is-variable E) E)
              ((is-function E) E)      
              ((is-application E)
                (let ((E1 (first E))
                      (E2 (last E)))
                
                (if (is-function E1)
                
                    ;E=((^V._) E2) ==> E10[V:=E2]
                    

                    (substitute-free-occurences (function-variable E1)
                                                (function-body E1)
                                                E2)
                          
                     ;E=(E1 E2) ==>
                     
                     (let ((new-E1 (reduce-once E1)))

                           (if (!= new-E1 E1)
                               (list new-E1 E2)
                               (list E1 (reduce-once E2))))))))))
                                  

(set 'reduce (lambda(new-expression)
                (local(expression)
                  (println "\n--------------\n\n" (string new-expression))
                  (do-while (!= new-expression expression)
                            (setf expression new-expression)
                            (setf new-expression (reduce-once expression))
                            (if (!= new-expression expression)
                                (println " ==> " (string new-expression))
                                (println "\n     Further reductions are impossible."))
                new-expression))))

; The list of reduced expressions

(dolist (i '( x
             (^ x . x)
             ((^ x . x) y)
             ((^ x . a) ((^ y . y) z))  
             ((^ y . (^ z . z)) ((^ x . (x x)) (^ v . (v v))))
             ((((^ v . (^ t . (^ f . ((v t) f)))) (^ x . (^ y . x))) a) b)
             ((((^ v . (^ t . (^ f . ((v t) f)))) (^ x . (^ y . y))) a) b)
             ; (^ f . ((^ x . (f (x x))) (^ x . (f (x x))))) Y-combinator - test it!
             ((^ x . (x x)) (^ x . (x x)))
             ;((^ x . (x (x x))) (^ x . (x (x x))))
             ))
   
   ;(println "\n\n=== " (+ $idx 1) ": "  i "\n\n")
   
   (reduce i))
   
(exit)


                                      OUTPUT
                                   
                                   

--------------

x

     Further reductions are impossible.

--------------

(^ x . x)

     Further reductions are impossible.

--------------

((^ x . x) y)
 ==> y

     Further reductions are impossible.

--------------

((^ x . a) ((^ y . y) z))
 ==> a

     Further reductions are impossible.

--------------

((^ y . (^ z . z)) ((^ x . (x x)) (^ v . (v v))))
 ==> (^ z . z)

     Further reductions are impossible.

--------------

((((^ v . (^ t . (^ f . ((v t) f)))) (^ x . (^ y . x))) a) b)
 ==> (((^ t . (^ f . (((^ x . (^ y . x)) t) f))) a) b)
 ==> ((^ f . (((^ x . (^ y . x)) a) f)) b)
 ==> (((^ x . (^ y . x)) a) b)
 ==> ((^ y . a) b)
 ==> a

     Further reductions are impossible.

--------------

((((^ v . (^ t . (^ f . ((v t) f)))) (^ x . (^ y . y))) a) b)
 ==> (((^ t . (^ f . (((^ x . (^ y . y)) t) f))) a) b)
 ==> ((^ f . (((^ x . (^ y . y)) a) f)) b)
 ==> (((^ x . (^ y . y)) a) b)
 ==> ((^ y . y) b)
 ==> b

     Further reductions are impossible.

--------------

((^ x . (x x)) (^ x . (x x)))

     Further reductions are impossible.











--