diff --git a/GNUmakefile b/GNUmakefile index 047b05a7..286cdc42 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -28,7 +28,7 @@ check: all ./mes.test ./mes cat scm.mes test.mes | ./mes -boot.mes: mes.mes scm.mes test.mes +boot.mes: mes.mes loop2.mes scm.mes test.mes cat $^ > $@ boot: all diff --git a/loop2.mes b/loop2.mes new file mode 100644 index 00000000..b33dcc50 --- /dev/null +++ b/loop2.mes @@ -0,0 +1,53 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; loop.mes: This file is part of Mes. +;;; +;;; Mes is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Mes is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Mes. If not, see . + +;; The Maxwell Equations of Software -- John McCarthy page 13 +;; http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf + +(define (scm-define x a) + (cond ((atom? (cadr x)) (cons (cadr x) (eval (caddr x) a))) + (#t (cons (caadr x) (cons 'lambda (cons (cdadr x) (cddr x))))))) + +(define (scm-define-macro x a) + (cons '*macro* + (cons (cons (caadr e) (cons 'lambda (cons (cdadr e) (cddr e)))) + (cdr (assoc '*macro* a))))) + +(define (loop2 r e a) + ;; (display '____loop2) + ;; (newline) + ;; (display 'e:) + ;; (display e) + ;; (newline) + (cond ((null? e) r) + ((eq? e 'EOF2) + (display 'loop2-exiting...) + (newline)) + ((atom? e) + (loop2 (eval e a) (readenv a) a)) + ((eq? (car e) 'define) + (loop2 *unspecified* (readenv a) (cons (scm-define e a) a))) + ((eq? (car e) 'define-macro) + (loop2 *unspecified* (readenv a) (cons (scm-define-macro e a) a))) + ((eq? (car e) 'set!) + (loop2 (set-cdr! (assoc (cadr e) a) (eval (caddr e) a)) (readenv a) a)) + (#t (loop2 (eval e a) (readenv a) a)))) + +EOF diff --git a/scm.mes b/scm.mes index 4b847cd4..e13eedc7 100755 --- a/scm.mes +++ b/scm.mes @@ -23,37 +23,6 @@ (define (list . rest) rest) -(define (scm-define x a) - (cond ((atom? (cadr x)) (cons (cadr x) (eval (caddr x) a))) - (#t (cons (caadr x) (cons 'lambda (cons (cdadr x) (cddr x))))))) - -(define (scm-define-macro x a) - (cons '*macro* - (cons (cons (caadr e) (cons 'lambda (cons (cdadr e) (cddr e)))) - (cdr (assoc '*macro* a))))) - -(define (loop2 r e a) - ;; (display '____loop2) - ;; (newline) - ;; (display 'e:) - ;; (display e) - ;; (newline) - (cond ((null? e) r) - ((eq? e 'EOF2) - (display 'loop2-exiting...) - (newline)) - ((atom? e) - (loop2 (eval e a) (readenv a) a)) - ((eq? (car e) 'define) - (loop2 *unspecified* (readenv a) (cons (scm-define e a) a))) - ((eq? (car e) 'define-macro) - (loop2 *unspecified* (readenv a) (cons (scm-define-macro e a) a))) - ((eq? (car e) 'set!) - (loop2 (set-cdr! (assoc (cadr e) a) (eval (caddr e) a)) (readenv a) a)) - (#t (loop2 (eval e a) (readenv a) a)))) - -EOF - (define (+ x y) (- x (- 0 y))) (define-macro (and x y) diff --git a/test.mes b/test.mes index c51a30b8..536283e4 100644 --- a/test.mes +++ b/test.mes @@ -26,7 +26,7 @@ 4 (newline) -(cons (display 'one) (display '-) (display 'two)) +(cons (display 'one-) (display 'two)) (newline) (display 'hello-display-symbol)