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
	
	 Yuichi Nishiwaki
						Yuichi Nishiwaki