; 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) |
Expansion of Free Variables.
Lambda Calculus Interpreter.
; 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. |
--
Change of The Blog Name.
--
--
| I changed the name of the blog from "Programming notes" to "Lisp notes." The reason is practical - more specific information for search engines, so potential readers can find it easier. |
--
McCarthy-60 Lisp in McCarthy-60 Lisp in ... in McCarthy-60 Lisp.
; In this article, I'll show how John McCarthy's Lisp can be interpreted ; in McCarthy's Lisp, which is interpreted in McCarthy's Lisp ... ; and so on, n times. ; ; One of the reasons for harder understanding of early Lisps is ; McCarthy's decision to use same identifiers for Lisp implemented ; in machine code, and for Lisp interpreted by EVAL function. ; ; For example, if McCarthy-60 Lisp expression ; ; ; (EVAL (QUOTE ((LAMBDA (XX) (CONS XX (CONS XX (QUOTE ())))) ; (QUOTE somedata))) ; (QUOTE ())) ; ; ; is evaluated, the first and the last oocurences of QUOTE are ; evaluated as special operators defined in base language (in my ; case Newlisp, in original implementation it was machine code), ; while second and third occurence of QUOTE are interpreted ; following the rules defined in John McCarthy-60 EVAL function. ; ; McCarthy's decision isn't incorrect, but using slightly ; different symbols is not wrong either and it certainly contributes ; to easier understanding. In second article I redefined EVAL so ; it evaluates expressions containing symbols like CONS.1, QUOTE.1 ; ... for example: ; ; ; (EVAL (QUOTE ((LAMBDA.1 (XX) (CONS.1 XX (CONS.1 XX (QUOTE.1 ())))) ; (QUOTE.1 somedata))) ; (QUOTE ())) ; ; ; If we can define LAMBDA.1, QUOTE.1, ... then, why not EVAL.1 as well? ; ; That definition was described in previous article on this topic. It is very ; dry and formal definition, because definition of EVAL.1, and ; all needed helper functions should be written in limited McCarthy-60 ; Lisp EVAL interpreter, and given to EVAL in the form of quoted ; association list. ; ; ; (EVAL <quoted expression to be evaluated> ; <quoted association list> ;<======= HERE ; ) ; ; ; If quoted association list is named McCarthy-60-interpreter.1, ; then example of such expressions is ; ; ; (EVAL (QUOTE (EVAL.1 (QUOTE.1 ((LAMBDA.2 (XX) ; (CONS.2 XX (CONS.2 XX (QUOTE.2 ())))) ; (QUOTE.2 somedata))) ; (QUOTE.1 ()) ; ) ; ) ; <McCarthy-60-interpreter.1> ; ) ; ; ; This is how McCarthy-60-interpreter.1 looks like: ; (McCarthy-60-Lisp in Newlisp library first.) (load (append "http://www.instprog.com/McCarthy-60-LISP/" "McCarthy-60-LISP-in-Newlisp.lsp")) (setf McCarthy-60-interpreter.1 '(QUOTE ( ;------------------------- (EVAL.1 (LABEL.1 EVAL.1 (LAMBDA.1 (e a) (COND.1 ((ATOM.1 e) (ASSOC.1 e a)) ;------------------------- ((ATOM.1 (CAR.1 e)) (COND.1 ((EQ.1 (CAR.1 e) (QUOTE.1 QUOTE.2)) (CAR.1 (CDR.1 e))) ;------------------------- ((EQ.1 (CAR.1 e) (QUOTE.1 ATOM.2)) (ATOM.1 (EVAL.1 (CAR.1 (CDR.1 e)) a))) ;------------------------- ((EQ.1 (CAR.1 e) (QUOTE.1 EQ.2)) (EQ.1 (EVAL.1 (CAR.1 (CDR.1 e)) a) (EVAL.1 (CAR.1 (CDR.1 (CDR.1 e))) a))) ;------------------------- ((EQ.1 (CAR.1 e) (QUOTE.1 COND.2)) (EVCON.1 (CDR.1 e) a)) ;------------------------- ((EQ.1 (CAR.1 e) (QUOTE.1 AND.2)) (EVAL.1 (CONS.1 (QUOTE.1 COND.2) (CONS.1 (CDR.1 e) (QUOTE.1 (((QUOTE.2 T) (QUOTE.2 F)))))) a)) ;------------------------- ((EQ.1 (CAR.1 e) (QUOTE.1 CAR.2)) (CAR.1 (EVAL.1 (CAR.1 (CDR.1 e)) a))) ;------------------------- ((EQ.1 (CAR.1 e) (QUOTE.1 CDR.2)) (CDR.1 (EVAL.1 (CAR.1 (CDR.1 e)) a))) ;------------------------- ((EQ.1 (CAR.1 e) (QUOTE.1 CONS.2)) (CONS.1 (EVAL.1 (CAR.1 (CDR.1 e)) a) (EVAL.1 (CAR.1 (CDR.1 (CDR.1 e))) a))) ;------------------------- ((QUOTE.1 T) (EVAL.1 (CONS.1 (ASSOC.1 (CAR.1 e) a) (CDR.1 e)) a)))) ;------------------------- ((EQ.1 (CAR.1 (CAR.1 e)) (QUOTE.1 LABEL.2)) (EVAL.1 (CONS.1 (CAR.1 (CDR.1 (CDR.1 (CAR.1 e)))) (CDR.1 e)) (CONS.1 (LIST.1 (CAR.1 (CDR.1 (CAR.1 e))) (CAR.1 e)) a))) ;------------------------- ((EQ.1 (CAR.1 (CAR.1 e)) (QUOTE.1 LAMBDA.2)) (EVAL.1 (CAR.1 (CDR.1 (CDR.1 (CAR.1 e)))) (APPEND.1 (PAIR.1 (CAR.1 (CDR.1 (CAR.1 e))) (EVLIS.1 (CDR.1 e) a)) a))) )))) ;------------------------- (APPEND.1 (LABEL.1 APPEND.1 (LAMBDA.1(X Y) (COND.1 ((NULL.1 X) Y) ((QUOTE.1 T) (CONS.1 (CAR.1 X) (APPEND.1 (CDR.1 X) Y))))))) ;------------------------- (ASSOC.1 (LABEL.1 ASSOC.1 (LAMBDA.1 (X Y) (COND.1 ((EQ.1 (CAR.1 (CAR.1 Y)) X) (CAR.1 (CDR.1 (CAR.1 Y)))) ((QUOTE.1 T) (ASSOC.1 X (CDR.1 Y))))))) ;------------------------- (PAIR.1 (LABEL.1 PAIR.1 (LAMBDA.1 (X Y) (COND.1 ((AND.1 (NULL.1 X) (NULL.1 Y)) (QUOTE.1 NIL)) ((AND.1 (NOT.1 (ATOM.1 X)) (NOT.1 (ATOM.1 Y))) (CONS.1 (LIST.1 (CAR.1 X) (CAR.1 Y)) (PAIR.1 (CDR.1 X) (CDR.1 Y)))))))) ;------------------------- (EVLIS.1 (LABEL.1 EVLIS.1 (LAMBDA.1 (m a) (COND.1 ((NULL.1 m) (QUOTE.1 NIL)) ((QUOTE.1 T) (CONS.1 (EVAL.1 (CAR.1 m) a) (EVLIS.1 (CDR.1 m) a))))))) ;------------------------- (EVCON.1 (LABEL.1 EVCON.1 (LAMBDA.1 (c a) (COND.1 ((EVAL.1 (CAR.1 (CAR.1 c)) a) (EVAL.1 (CAR.1 (CDR.1 (CAR.1 c))) a)) ((QUOTE.1 T) (EVCON.1 (CDR.1 c) a)))))) ;------------------------- (NULL.1 (LAMBDA.1 (X) (AND.1 (ATOM.1 X) (EQ.1 X (QUOTE.1 NIL))))) ;------------------------- (NOT.1 (LAMBDA.1 (X) (COND.1 (X (QUOTE.1 F)) ((QUOTE.1 T)(QUOTE.1 T))))) ;------------------------- (LIST.1 (LAMBDA.1 (X Y) (CONS.1 X (CONS.1 Y (QUOTE.1 NIL))))) ) ) ) ; variable McCarthy-60-interpreter.1 cannot be used directly. It ; has to be replaced with its value first. ; ; Once McCarthy-60-interpreter.1 is defined, it is easy to generalize ; it and define McCarthy-60-interpreter.2, McCarthy-60-interpreter.3,... ; Just respective indexes should be changed. ; ; Here is Newlisp function that calculate these interpreters, for ; given n: (define (McCarthy-60-interpreter n) (if (= n 1) McCarthy-60-interpreter.1 (letn((symbols-in-McCarthy-60-interpreter.1 (difference (unique (flat McCarthy-60-interpreter.1)) '(T F NIL))) (assoc-list1 (map (lambda(x) (list x (if (find x '(QUOTE e a X Y m c)) (sym (append "°" (string x) "." (string (- n 1)))) (let ((parsed-x (parse (string x) "."))) (case (last parsed-x) ("1" (sym (append "°" (first parsed-x) "." (string n)))) ("2" (sym (append "°" (first parsed-x) "." (string (+ n 1)))))))))) symbols-in-McCarthy-60-interpreter.1)) (assoc-list2 (map (lambda(x) (list (last x) (sym (rest (string (last x)))))) assoc-list1))) (local(result) (setf result (expand McCarthy-60-interpreter.1 assoc-list1)) (setf result (expand result assoc-list2)) result)))) ; And this is an example how these interpreters could be used (setf McCarthy-60-interpreter.2 (McCarthy-60-interpreter 2)) (debug-wrap EVAL) (eval (expand '(EVAL (QUOTE (EVAL.1 (QUOTE.1 (EVAL.2 (QUOTE.2 (QUOTE.3 somedata)) (QUOTE.2 ()) ) ) McCarthy-60-interpreter.2 ) ) McCarthy-60-interpreter.1 ) 'McCarthy-60-interpreter.1 'McCarthy-60-interpreter.2 ) ) ; McCarthy's EVAL is, however, very inefficient - its purpose was ; purely theoretical, so, if you want to really evaluate this simple ; expression prepare yourself on long waiting. (Less than one hour ; on modern PC, however.) |
Part of the output of the program
---
Subscribe to:
Posts (Atom)