refactor (picrin control list) by following the mannar other monadic

libraries do
This commit is contained in:
Yuichi Nishiwaki 2015-07-19 15:13:17 +09:00
parent 43aac4dd29
commit 0f9c7f0c2c
2 changed files with 29 additions and 16 deletions

View File

@ -2,18 +2,29 @@
(import (scheme base)
(picrin control))
(define-syntax for
(define unit list)
(define (bind m f)
(apply append (map f m)))
(define-syntax reify
(syntax-rules ()
((_ expr ...)
(reset expr ...))))
((_ expr)
(reset (unit expr)))))
(define (in m)
(shift k (apply append (map k m))))
(define (reflect m)
(shift k (bind m k)))
(define (yield x)
(list x))
(define zero '())
(define (null . x)
'())
(define plus append)
(export for in yield null))
(export unit
bind
zero
plus
reify
reflect
(rename reify for)
(rename reflect in)
(rename unit yield)))

View File

@ -4,18 +4,20 @@
(test '(1 2 3)
(for
(yield (in '(1 2 3)))))
(in '(1 2 3))))
(test '((1 a) (1 b) (1 c) (2 a) (2 b) (2 c) (3 a) (3 b) (3 c))
(test '((1 . a) (1 . b) (1 . c) (2 . a) (2 . b) (2 . c) (3 . a) (3 . b) (3 . c))
(for
(let ((n (in '(1 2 3)))
(c (in '(a b c))))
(yield (list n c)))))
(cons n c))))
(test '((2 a) (2 b) (2 c))
(define (fail) (in zero))
(test '((2 . a) (2 . b) (2 . c))
(for
(let ((n (in '(1 2 3)))
(c (in '(a b c))))
(if (even? n)
(yield (list n c))
(null)))))
(cons n c)
(fail)))))