Implementação do LISP de John McCarthy, de 1960
Implementação do LISP de JMC de 1960 em LTK
Hoje tive tempo para acabar a implementação do LISP de 1960 de John McCarthy (Recursive Functions of Symbolic Expressions and Their Computation by Machine, Part I, Communications of the ACM 3:4, April 1960, pp. 184-195) em LTK. O código está aqui.
A imagem mostra uma das funções descrita no artigo.
(provide :1960-lisp) (load "/home/tca/lisp_packages/ltk/ltk.lisp") (defpackage :1960-lisp (:use :common-lisp :ltk) (:export lisp) (:documentation "1960-lisp is a CL implementation of John McCarthy's LISP from the paper Recursive Functions of Symbolic Expressions and Their Computation by Machine, higly inspired in Paul Graham's The Roots of Lisp")) (in-package :1960-lisp) (setf tutorial "Examples: 1. ((eq 'a 'a) '()) => t 2. ((eq 'a 'b) '()) => nil 3. ((cons x '(b c))'((x a ) (y b))) => (a b c) 4. (((label firstatom (lambda (x) (cond ((atom x) x) ('t (firstatom (car x)))))) y) '((y ((a b) (c d))))) => a 5. ((cons x (cdr y)) '((x a) (y (b c d)))) => (a b c) 6. (((lambda (x) (cons 'a x)) '(b c)) '((f (lambda (x) (cons 'a x))))) => (a b c) 7. (((label ident (lambda (x) x)) y) '((y ident))) => indent 8. (((lambda (x) x) '((lambda (x) x))) '()) => (lambda (x) x) 9. (((label diag (lambda (x) (list x (list 'quote x)))) y) '((y list))) => (list (quote list)) 10. (((label diag (lambda (x) (list x (list 'quote x)))) y) '((y diag))) => (diag (quote diag)) 11. From the original paper og JMC (((label ff (lambda (x) (cond ((atom x) x) ('t (ff (car x)))))) y) '((y ((a b) (c d))))) => a ") (defun not. (x) (cond (x '()) ('t 't))) (defun null. (x) (eq x '())) (defun and. (x y) (cond (x (cond (y't) ('t '()))) ('t '()))) (defun pair. (x y) (cond ((and. (null. x) (null. y)) '()) ((and. (not. (atom x)) (not. (atom y))) (cons (list (car x) (car y)) (pair. (cdr x) (cdr y)))))) (defun append. (x y) (cond ((null. x) y) ('t (cons (car x) (append. (cdr x) y))))) (defun assoc. (x y) (cond ((eq (caar y) x) (cadar y)) ('t (assoc. x (cdr y))))) (defun eval. (e a) (cond ((atom e) (assoc. e a)) ((atom (car e)) (cond ((eq (car e) 'quote) (cadr e)) ((eq (car e) 'atom) (atom (eval. (cadr e) a))) ((eq (car e) 'eq) (eq (eval. (cadr e) a) (eval. (caddr e) a))) ((eq (car e) 'car) (car (eval. (cadr e) a))) ((eq (car e) 'cdr) (cdr (eval. (cadr e) a))) ((eq (car e) 'cons) (cons (eval. (cadr e) a) (eval. (caddr e) a))) ((eq (car e) 'cond) (evcon. (cdr e) a)) ((eq (car e) 'list) (evlis. (cdr e) a)) ((eq (car e) 'list) (evlis. (cdr e) a)) ('t (eval. (cons (assoc. (car e) a) (cdr e)) a)))) ((eq (caar e) 'label) (eval. (cons (caddar e) (cdr e)) (cons (list (cadar e) (car e)) a))) ((eq (caar e) 'lambda) (eval. (caddar e) (append. (pair. (cadar e) (evlis. (cdr e) a)) a))))) (defun evcon. (c a) (cond ((eval. (caar c) a) (eval. (cadar c) a)) ('t (evcon. (cdr c) a)))) (defun evlis. (m a) (cond ((null. m) '()) ('t (cons (eval. (car m) a) (evlis. (cdr m) a))))) (defun apply. (f a) (eval. (cons f (appq. a)) '())) (defun appq. (m) (cond ((null m) '()) (t (cons (list 'quote (car m)) (appq. (cdr m)))))) (defun lisp () (with-ltk () (wm-title *tk* "LISP") (let* ((frame-menus (make-menubar)) (menu-help (make-menu frame-menus "Help")) (f-1 (make-instance 'frame)) (f-2 (make-instance 'frame)) (f-3 (make-instance 'frame)) (f-tutorial (make-instance 'frame)) (f-eval (make-instance 'frame)) (f-t-1 (make-instance 'frame)) (f-t-2 (make-instance 'frame)) (title-f-1 (make-instance 'label :master f-1 :text "Input box: ")) (title-f-2 (make-instance 'label :master f-2 :text "Output box: ")) (input-text (make-instance 'text :master f-1)) (output-text (make-instance 'text :master f-2)) (b-clear-in (make-instance 'button :text "Clear Input" :master f-3 :width 7 :command (lambda () (clear-text input-text)))) (b-clear-out (make-instance 'button :text "Clear Output" :master f-3 :width 8 :command (lambda () (clear-text output-text)))) (b-eval (make-instance 'button :text "Eval" :master f-eval :width 4 :command (lambda () (setf (text output-text) (eval-input-text (read-from-string (text input-text)))))))) (make-menubutton menu-help "Tutorial" (lambda () (let* ((w-about (make-instance 'toplevel :takefocus nil)) (txt (make-instance 'scrolled-text :master w-about))) (wm-title w-about "Examples") (pack txt) (setf (text txt) tutorial)))) (make-menubutton menu-help "About" (lambda () (let* ((w-about (make-instance 'toplevel :takefocus nil)) (txt (make-instance 'text :master w-about :width 60 ))) (wm-title w-about "About") (pack txt) (setf (text txt) "GPLv3 - (c) Tiago Charters de Azevedo <tca@diale.org>")))) (pack f-1 :side :top :expand t :fill :both) (pack title-f-1 :side :top :expand t :fill :both) (pack input-text) (pack f-2 :side :top :expand t :fill :both) (pack title-f-2 :side :top :expand t :fill :both) (pack output-text) (pack f-3 :side :left :expand nil :fill :none) (pack b-clear-in :side :left) (pack b-clear-out :side :left) (pack f-eval :side :right :expand t :fill :both) (pack b-eval :side :right) ))) (defun eval-input-text (txt) (eval. (car txt) (cadadr txt))) (lisp)
P.S. 160125: Código LTK actualizado.
Palavras chave/keywords: LISP, John McCarthy, original paper, LTKCriado/Created: NaN
Última actualização/Last updated: 10-10-2022 [14:47]
(c) Tiago Charters de Azevedo