; In my last post, McCarthy-60 Lisp in Newlisp ; (1) McCarthy-60 Lisp, the version from his "Recursive functions..." ; paper was defined in Newlisp. "Defined" because Newlisp is ; Lisp, so McCarthy-60 Lisp functions (and special operators) ; can be "just defined" as Newlisp functions and special ; operator. Such a Newlisp + defined function behaves like ; original McCarthy's Lisp. I guess that it could be done ; even more easily in Lisp dialects more similar to McCarthy ; 60 Lisp, for example, Picolisp or Scheme. ; (2) The legendary McCarthy's function EVAL was defined. Some ; care was required, because the function as defined in McCarthy's ; article, but also in other contemporary manuals and memos ; had errors. Paul Graham's paper "The Roots of Lisp" can be ; recommended. ; In this post another instance of McCarthy-60 Lisp running on top ; of that is implemented.  ; For clarity, different keywords will be used in each "instance" ; of Lisp. For example, if we write: ; ; (lambda(xx)(cons xx (cons xx (quote ())))) ; ; in Newlisp, then ; ; (LAMBDA(XX)(CONS XX (CONS XX (QUOTE ())))) ; ; will be used in McCarthy-60 Lisp defined in Newlisp, and also ; ; (LAMBDA.1(XX)(CONS.1 XX (CONS.1 XX (QUOTE.1 ())))) ; ; in McCarthy-60 Lisp interpreted in previous Lisp. And also ; ; (LAMBDA.2(XX)(CONS.2 XX (CONS.2 XX (QUOTE.2 ())))) ; ; in McCarthy-60 Lisp interpreted in previous Lisp, described in ; this post. ; ; ; ; -------------- ; ; ; McCarthy-60 EVAL has two arguments: ; ; (EVAL <e> <a>) ; ; where <e> is expression that is evaluated, and <a> is association ; list that contains values of the functions and variables used in ; <e>. For example, <a> might look like: ; ; ((X 37)(f (LAMBDA.1(x)(CONS.1 x (QUOTE.1 NIL))))) ; ; if X or f occurs in <e>, the respective values will be used. ; McCarthy-60 EVAL is not very efficient, but is conceptually ; simple. ; ; Such definition of EVAL allows definition of whole interpreters ; as association list, and that's what is described in this post: ; interpreter of McCarthy-60 Lisp, in the form of association ; list that can be supplied to - McCarthy-60 Lisp. ; ; This is how this interpreter looks like: (setf McCarthy-60-interpreter '(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))))) ) ) ) ; Is there any difference between EVAL.1 and EVAL defined in ; last post? Yes, EVAL used "building blocks" like operators AND ; or LIST. These can be easily defined in Newlisp, but require ; different approach in McCarthy-60 Lisp, where one cannot use ; variable number of arguments or define special operators. ; How code that could be evaluated by EVAL.1 look like? Well, it ; uses keywords like QUOTE.2, ATOM.2, CONS.2. And how it is called? ; Here is an example: ; ; ; (eval (expand '(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 ; ) ; 'McCarthy-60-interpreter ; ) ; ) ; ; The result should be (somedata somedata). ; ; In the rest of this post, McCarthy-60 Lisp is defined in Newlisp, ; more-less, like it was done in previous post, and then the code ; above (using somedata) will be evaluated, so those who are ; interested can, as usually, cut and paste whole post in their ; editor and evaluate in Newlisp. The result of the evaluation ; of the code above (with debug-wrap feature from my library) is ; correct; this is how part of the output on screen can look like.  (load "http://www.instprog.com/Instprog.default-library.lsp") ;--------------------------------------------------------------- ; Newlisp has not dotted pairs, so they are emulated here. ;--------------------------------------------------------------- (define (dotform-atom? L) (atom? L)) (define (dotform-base? L) (and (list? L) (= (length L) 3) (= (nth 1 L) '.))) (define (dotform-recursive? L) (or (dotform-atom? L) (and (dotform-base? L) (dotform-recursive? (first L)) (dotform-recursive? (last L))))) (define (listform-atom?) (and (atom? L) (not (= L 'NIL)))) (define (listform-base? L) (and (list? L) (not (dotform-base? L)))) (define (listform-recursive? L) (or (listorm-atom? L) (and (listform-base? L) (for-all? listform-recursive? L)))) (define (dotform L) (cond ((dotform-atom? L) L) ((dotform-base? L) (list (dotform (first L)) '. (dotform (last L)))) ((= (length L) 0) 'NIL) ((> (length L) 0) (list (dotform (first L)) '. (dotform (rest L)))))) (define (listform L) (cond ((listform-atom? L) L) ((= L '()) L) ((listform-base? L) (cons (listform (first L)) (listform (rest L)))) ((= L 'NIL) '()) ((dotform-base? L) (let((L1 (listform (first L))) (L2 (listform (last L)))) (if (listform-base? L2) (cons L1 L2) (list L1 '. L2)))))) (define (listform-args L) (cond ((empty? L) L) ((= (first L) (quote .))(listform (rest L))) (true (listform L)))) ;=============================================================== ; DEFINITION OF FEW BASIC OPERATORS. ; THESE OPERATORS ARE ELEMENTS OF META-LANGUAGE, DEFINED IN ; META-META-LANGUAGE (Newlisp) ;--------------------------------------------------------------- (define-macro (COND) (letn((done nil) (result nil) (arglist (args)) (largs (listform-args (args)))) (dolist(clause largs done ind) (setf ind (eval (symbol-from-sexpr '(debug-wrap indent)))) ;'(println (dup " " ind) "????? COND clause: " (nth 0 clause)) (let ((l (eval (nth 0 clause)))) (if (= l 'T) (begin '(println (dup " " ind) "+++++ COND clause " (nth 0 clause) " evaluates to: " (listform l)) (setf result (listform (eval (nth 1 clause)))) (setf done true)) '(println (dup " " ind) "----- COND clause evaluates to: " (listform l)) ))) (if (not done) (throw-error (append (dup " " ind) "!!!!! COND without any alternative satisfied.")) (begin '(println (dup " " ind) "!!!!! COND expr evaluates to " (listform result)) result)))) (define-macro (AND) (letn((arglist (args)) (largs (listform arglist))) (if (eval (cons 'and (map (lambda(X)(expand '(= X (quote T)) 'X)) largs))) (quote T) (quote F)))) (define-macro (OR) (letn((arglist (args)) (largs (listform arglist))) (if (eval (cons 'or (map (lambda(X)(expand '(= X (quote T)) 'X)) largs))) (quote T) (quote F)))) (define-macro (NOT X) (let ((lx (listform X))) (if (= (eval lx) (quote T)) (quote F) (if (= (eval lx) (quote F)) (quote T) (throw-error " NOT called with argument evaluating to T OR F."))))) ;--------------------------------------------------------------- (define (LIST) (listform (let((a (args))) (cond ((empty? a) (quote NIL)) ((quote T) (list (dotform (first a)) '. (dotform (rest a)))))))) ;--------------------------------------------------------- (define-macro (QUOTE X) (listform X)) ;--------------------------------------------------------- (define-macro (LAMBDA) (append (lambda) (args))) ;--------------------------------------------------------- (define-macro (LABEL) (let((l1 (first (args))) (l2 (last (args)))) ;(println l1 l2) (set l1 (eval l2)))) ;=============================================================== ; FIVE ELEMENTARY S-FUNCTIONS. ;--------------------------------------------------------------- ; 1. ATOM ;--------------------------------------------------------------- (define (ATOM X) (if (atom? (dotform X)) (quote T) (quote F))) ;--------------------------------------------------------------- ; 2. EQ ;--------------------------------------------------------------- (define (EQ X Y) (let((X (dotform X)) (Y (dotform Y))) (if (and (atom? (dotform X)) (atom? (dotform Y))) (if (= X Y) (quote T) (quote F)) (throw-error (string "** EQ undefined for " X " AND " Y "**"))))) ;--------------------------------------------------------------- ; 3. CAR ;--------------------------------------------------------------- (define (CAR X) (listform (let ((X (dotform X))) (cond ((= X 'NIL) (throw-error "CAR undefined for NIL.")) ((atom? X) (throw-error (string "CAR undefined for atomic symbol " X))) (true (first X)))))) ;--------------------------------------------------------------- ; 4. CDR ;--------------------------------------------------------------- (define (CDR X) (listform (let ((X (dotform X))) (cond ((= X 'NIL) (throw-error "CAR undefined for NIL.")) ((atom? X) (throw-error (string "CDR undefined for atomic symbol " X))) (true (last X)))))) ;--------------------------------------------------------------- ; 5. CONS ;--------------------------------------------------------------- (define (CONS X Y) (listform (let ((X (dotform X)) (Y (dotform Y))) (list X '. Y)))) ;--------------------------------------------------------------- ; DEFINITION OF IMPORTANT S-FUNCTIONS IN META-LANGUAGE ; STRICTLY FOLLOWED MCCARTHY'S ARTICLE. LOOK EXAMPLES AS BEST ; EXPLANATION ;--------------------------------------------------------------- ; NULL ;--------------------------------------------------------------- (define (NULL X) (listform (AND (ATOM X) (EQ X (QUOTE NIL))))) ;--------------------------------------------------------------- ; S-FUNCTIONS USEFUL WHEN S-EXPRESSIONS ARE REGARDED AS LISTS ; DEFINED IN META-LANGUAGE IN MCCARTHY'S PAPER ;--------------------------------------------------------------- ;--------------------------------------------------------------- ; 1. APPEND ;--------------------------------------------------------------- (define (APPEND X Y) (listform (COND ((NULL X) Y) ((QUOTE T) (CONS (CAR X) (APPEND (CDR X) Y)))))) ;--------------------------------------------------------------- ; PAIR ; ; (PAIR (QUOTE (<s1> ... <sn>)) (QUOTE (<t1> ... <tn>))) => ; ((<s1> <t1>) ... (<sn> <tn>)) ; ;--------------------------------------------------------------- (define (PAIR X Y) (listform (COND ((AND (NULL X) (NULL Y)) (QUOTE NIL)) ((AND (NOT (ATOM X)) (NOT (ATOM Y))) (CONS (LIST (CAR X) (CAR Y)) (PAIR (CDR X) (CDR Y))))))) ;--------------------------------------------------------------- ; ASSOC ; ; ASSOC returns the "value" of variable X in "association LIST" y. ; for example, ; ; (ASSOC (QUOTE (X)) (QUOTE ((W (A B)) (X (C D)) (Y (E F))))) ; ; returns (C D). ; ; If variable is NOT "stored" in association LIST, then there ; will be error in attempt to find CAAR of empty list. (define (ASSOC X Y) (let((X (dotform X)) (Y (listform Y))) (when (or (= X 'F) (= X 'T)) (throw-error "ASSOC CALLED WITH WRONG ARGUMENT.")) (listform (COND ((AND (ATOM Y) (EQ Y (QUOTE NIL))) (throw-error (string "ASSOC " X " in " Y " is impossible."))) ((EQ (CAR (CAR Y)) X) (CAR (CDR (CAR Y)))) ((QUOTE T) (ASSOC X (CDR Y))))))) ;--------------------------------------------------------------- ; APPQ ; ; (APPQ (QUOTE (<expr1> ... <exprn>))) ; ; ===> ((QUOTE <expr1>)...(QUOTE <exprn>)) ;--------------------------------------------------------------- (define (APPQ m) (listform (COND ((NULL m) (QUOTE NIL)) ((QUOTE T) (CONS (LIST (QUOTE QUOTE) (CAR m)) (APPQ (CDR m))))))) ;--------------------------------------------------------------- ; EVAL, EVCON, EVLIS ;--------------------------------------------------------------- (define (EVLIS m a) (listform (COND ((NULL m) (QUOTE NIL)) ((QUOTE T) (CONS (EVAL (CAR m) a) (EVLIS (CDR m) a)))))) (define (EVCON c a) (COND ((EVAL (CAR (CAR c)) a) (EVAL (CAR (CDR (CAR c))) a)) ((QUOTE T) (EVCON (CDR c) a)))) (define (EVAL e a) (listform (COND ((ATOM e) (listform (ASSOC e a))) ;---------------------------- ((ATOM (CAR e)) ;---------------------------- (COND ((EQ (CAR e) (QUOTE QUOTE.1)) (CAR (CDR e))) ;---------------------------- ((EQ (CAR e) (QUOTE ATOM.1)) (ATOM (EVAL (CAR (CDR e)) a))) ;---------------------------- ((EQ (CAR e) (QUOTE EQ.1)) (EQ (EVAL (CAR (CDR e)) a) (EVAL (CAR (CDR (CDR e))) a))) ;---------------------------- ((EQ (CAR e) (QUOTE COND.1)) (EVCON (CDR e) a)) ;---------------------------- ((EQ (CAR e) (QUOTE AND.1)) (EVAL (CONS (QUOTE COND.1) (CONS (CDR e) (QUOTE (((QUOTE.1 T) (QUOTE.1 F)))))) a)) ;---------------------------- ((EQ (CAR e) (QUOTE CAR.1)) (CAR (EVAL (CAR (CDR e)) a))) ;---------------------------- ((EQ (CAR e) (QUOTE CDR.1)) (CDR (EVAL (CAR (CDR e)) a))) ;---------------------------- ((EQ (CAR e) (QUOTE CONS.1)) (CONS (EVAL (CAR (CDR e)) a) (EVAL (CAR (CDR (CDR e))) a))) ;---------------------------- ((QUOTE T) (EVAL (listform (CONS (ASSOC (CAR e) a) (CDR e))) a)))) ;---------------------------- ((EQ (CAR (CAR e)) (QUOTE LABEL.1)) (EVAL (listform (CONS (CAR (CDR (CDR (CAR e)))) (CDR e))) (listform (CONS (LIST (CAR (CDR (CAR e))) (CAR e)) a)))) ;---------------------------- ((EQ (CAR (CAR e)) (QUOTE LAMBDA.1)) (EVAL (listform (CAR (CDR (CDR (CAR e))))) (listform (APPEND (PAIR (CAR (CDR (CAR e))) (EVLIS (CDR e) a)) a))))))) (debug-wrap EVAL) (eval (expand '(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 ) 'McCarthy-60-interpreter ) ) (exit) |
No comments:
Post a Comment