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.
This commit is contained in:
Jan Nieuwenhuizen 2016-10-18 19:50:07 +02:00
parent c8e87f3021
commit 97f1d71de6
1 changed files with 13 additions and 13 deletions

View File

@ -74,18 +74,19 @@
;; enter reading loop-0 ;; enter reading loop-0
(display "loop-0 ...\n") (display "loop-0 ...\n")
(define (evcon c a) (define-macro (cond . clauses)
;; (display "evcon c=") (list 'if (null? clauses) *unspecified*
;; (display c) (if (null? (cdr clauses))
;; (newline) (list 'if (car (car clauses))
(if (null? c) *unspecified* (list (cons 'lambda (cons '() (cons (car (car clauses)) (cdr (car clauses))))))
(if (eval-env (caar c) a) *unspecified*)
(if (null? (cdar c) (eval-env (caar c) a)) (if (eq? (car (cadr clauses)) 'else)
(if (null? (cddar c)) (eval-env (cadar c) a) (list 'if (car (car clauses))
((lambda () (list (cons 'lambda (cons '() (car clauses))))
(eval-env (cadar c) a) (list (cons 'lambda (cons '() (cons *unspecified* (cdr (cadr clauses)))))))
(evcon (cons (cons #t (cddar c)) '()) a))))) (list 'if (car (car clauses))
(evcon (cdr c) a)))) (list (cons 'lambda (cons '() (car clauses))))
(cons 'cond (cdr clauses)))))))
(define (not x) (define (not x)
(if x #f #t)) (if x #f #t))
@ -139,7 +140,6 @@
((eq? (car e) 'begin) (eval-begin-env e a)) ((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) 'lambda) (make-closure (cadr e) (cddr e) (assq '*closure* a)))
((eq? (car e) '*closure*) e) ((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) 'if) (eval-if-env (cdr e) a))
((eq? (car e) 'define) (env:define (cons (sexp:define e a) '()) 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)) ((eq? (car e) 'define-macro) (env:define (env:macro (sexp:define e a)) a))