artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Remove evcon from loop-0.

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

26
module/mes/loop-0.mes
View file

@ -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))