refactor (picrin control list) by following the mannar other monadic
libraries do
This commit is contained in:
parent
43aac4dd29
commit
0f9c7f0c2c
|
@ -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)))
|
||||
|
|
|
@ -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)))))
|
||||
|
|
Loading…
Reference in New Issue