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

Avoid cons* in base.

Browse source 
* module/mes/base-0.mes (cond, simple-let, let): Rewrite without cons*.
* module/mes/base.mes (or): Likewise.
This commit is contained in:
Jan Nieuwenhuizen 2016-10-18 08:24:47 +02:00
parent 2a8d3c57b7
commit 4ff96673c7
2 changed files with 20 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
module/mes/base-0.mes
View file

@ -51,26 +51,31 @@
(cons (car rest) (loop (cdr rest)))))
(loop (cons x rest)))
(define-macro cond
(lambda clauses
(if (null? clauses) *unspecified*
(define-macro (cond . clauses)
(list 'if (null? clauses) *unspecified*
(if (null? (cdr clauses))
(list 'if (car (car clauses))
(cons* 'begin (car (car clauses)) (cdr (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))
(cons* 'begin (car (car clauses)) (cdr (car clauses)))
(cons* 'begin *unspecified* (cdr (cadr clauses))))
(list (cons 'lambda (cons '() (car clauses))))
(list (cons 'lambda (cons '() (cons *unspecified* (cdr (cadr clauses)))))))
(list 'if (car (car clauses))
(cons* 'begin (car (car clauses)) (cdr (car clauses)))
(cons* 'cond (cdr clauses))))))))
(list (cons 'lambda (cons '() (car clauses))))
(cons 'cond (cdr clauses)))))))
(define else #t)
(define (map f l . r)
(if (null? l) '()
(if (null? r) (cons (f (car l)) (map f (cdr l)))
(if (null? (cdr r))
(cons (f (car l) (caar r)) (map f (cdr l) (cdar r)))))))
(define-macro (simple-let bindings . rest)
(cons (cons 'lambda (cons (map car bindings) rest))
(map cadr bindings)))
(define-macro (let bindings . rest)
(cons* 'simple-let bindings rest))
(cons 'simple-let (cons bindings rest)))

2
module/mes/base.mes
View file

@ -35,7 +35,7 @@
(if (null? x) #f
(if (null? (cdr x)) (car x)
(list 'if (car x) (car x)
(cons* 'or (cdr x))))))
(cons 'or (cdr x))))))
(define-macro (and . x)
(if (null? x) #t