andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implement variable-argument and, or.

This commit is contained in:
Jan Nieuwenhuizen 2016-07-16 20:02:14 +02:00
parent 47fd339305
commit 44b26569a6
2 changed files with 37 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
scm.mes
View File

@ -46,12 +46,24 @@
(#t (memq x (cdr lst)))))
(define memv memq)
(define-macro (or x y)
(define-macro (or2 x y)
`(cond (,x ,x) (#t ,y)))
(define-macro (and x y)
(define-macro (and2 x y)
`(cond (,x ,y) (#t #f)))
(define-macro (or . x)
(cond
((null? x) #f)
((null? (cdr x)) (car x))
(#t `(cond (,(car x))
(#t (or ,@(cdr x)))))))
(define-macro (and . x)
(cond ((null? x) #t)
((null? (cdr x)) (car x))
(#t `(cond (,(car x) (and ,@(cdr x)))))))
(define (split-params bindings params)
(cond ((null? bindings) params)
(#t (split-params (cdr bindings)
@ -121,3 +133,10 @@
,@(letrec-setters bindings '())
,@body))
;; TODO
;; (define gensym
;; (let ((counter 0))
;; (lambda (. rest)
;; (let ((val (number->string counter)))
;; (set! counter (+ counter 1))
;; (string->symbol (string-append "g" val))))))

24
test.mes
View File

@ -42,18 +42,26 @@
(newline)
(display 'and-0-1:)
(display (and 0 1))
(display "(and): ")
(display (and))
(newline)
(display 'and-#f-2:)
(display (and #f 2))
(display "(and 1): ")
(display (and 1))
(newline)
(display "(and 1 (= 0 1)): ")
(display (and 1 (= 0 1)))
(newline)
(display 'or-0-1:)
(display (or 0 1))
(display "(or): ")
(display (or))
(newline)
(display 'or-#f-2:)
(display (or #f 2))
(display "(or 1): ")
(display (or 1))
(newline)
(display "(or #f (= 0 1) 3): ")
(display (or #f (= 0 1) 3))
(newline)
(display (or (= 0 1) #f (and (display "YEAH") (newline) 'woet)))
(newline)
(let ((p 5)