From 97f1d71de6947bc9c9f0a6991e32c272862d2700 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 18 Oct 2016 19:50:07 +0200 Subject: [PATCH] Remove evcon from loop-0. * module/mes/loop-0.mes (loop-0): Handle define-macro. (cond): New macro. (eval-env-expand): Remove 'cond clause. (evcon): Remove. --- module/mes/loop-0.mes | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/module/mes/loop-0.mes b/module/mes/loop-0.mes index 28977fe6..0b548fe6 100644 --- a/module/mes/loop-0.mes +++ b/module/mes/loop-0.mes @@ -74,18 +74,19 @@ ;; enter reading loop-0 (display "loop-0 ...\n") -(define (evcon c a) - ;; (display "evcon c=") - ;; (display c) - ;; (newline) - (if (null? c) *unspecified* - (if (eval-env (caar c) a) - (if (null? (cdar c) (eval-env (caar c) a)) - (if (null? (cddar c)) (eval-env (cadar c) a) - ((lambda () - (eval-env (cadar c) a) - (evcon (cons (cons #t (cddar c)) '()) a))))) - (evcon (cdr c) a)))) +(define-macro (cond . clauses) + (list 'if (null? clauses) *unspecified* + (if (null? (cdr clauses)) + (list 'if (car (car clauses)) + (list (cons 'lambda (cons '() (cons (car (car clauses)) (cdr (car clauses)))))) + *unspecified*) + (if (eq? (car (cadr clauses)) 'else) + (list 'if (car (car clauses)) + (list (cons 'lambda (cons '() (car clauses)))) + (list (cons 'lambda (cons '() (cons *unspecified* (cdr (cadr clauses))))))) + (list 'if (car (car clauses)) + (list (cons 'lambda (cons '() (car clauses)))) + (cons 'cond (cdr clauses))))))) (define (not x) (if x #f #t)) @@ -139,7 +140,6 @@ ((eq? (car e) 'begin) (eval-begin-env e a)) ((eq? (car e) 'lambda) (make-closure (cadr e) (cddr e) (assq '*closure* a))) ((eq? (car e) '*closure*) e) - ((eq? (car e) 'cond) (evcon (cdr e) a)) ((eq? (car e) 'if) (eval-if-env (cdr e) a)) ((eq? (car e) 'define) (env:define (cons (sexp:define e a) '()) a)) ((eq? (car e) 'define-macro) (env:define (env:macro (sexp:define e a)) a))