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

lib/srfi/srfi-0.scm: add.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-23 12:54:34 +02:00
parent b63444d919
commit 502336bf30
3 changed files with 16 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lib/srfi/srfi-0.scm Normal file
View file

@ -0,0 +1,10 @@
(define mes '(0 1))
(define (cond-expand-expander clauses)
(let loop ((clauses clauses))
(if (defined? (caar clauses))
(eval (cons 'begin (cdar clauses)) (current-module))
(loop (cdr clauses)))))
(define-macro (cond-expand . clauses)
`(cond-expand-expander (quote ,clauses)))

6
scm.mes
View file

@ -98,8 +98,8 @@
(define (apply f args)
(eval (cons f args) (current-module)))
(define (defined? x)
(assq x (current-module)))
(define-macro (defined? x)
`(assq ,x (cddr (current-module))))
(define (procedure? p)
(cond ((builtin? p) #t)
@ -199,8 +199,6 @@
(set! counter (+ counter 1))
(string->symbol (string-append "g" value))))))
()
;; srfi-1
(define (last-pair lst)
(let loop ((lst lst))

5
test.mes
View file

@ -32,7 +32,8 @@
((car t) (display ": pass") (newline) (set! pass (+ pass 1)))
(#t (display ": fail") (newline) (set! fail (+ fail 1)))))))
(define (guile?) (defined? 'gc))
;;(define (guile?) (defined? 'gc))
(define (guile?) #f)
(when (guile?)
(module-define! (current-module) 'builtin? (lambda (. x) #t))
(use-modules (srfi srfi-1)))
@ -234,6 +235,8 @@
;; (circular-list? x))
;; #t))
(pass-if "cond-expand" (sequal? (cond-expand (foobar #f) (mes (display ": pass: *YAY*") 'mes)) 'mes))
(newline)
(display "passed: ") (display (car (result))) (newline)
(display "failed: ") (display (cadr (result))) (newline)