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