部分継続の利用例。
めも。
途中でreturn
(use gauche.partcont) (use util.match) (define (times xs) (fold * 1 xs)) (times '(1 2 3)) ; => 6 ;; (times '(1 2 0 "foo")) ; => *** ERROR: operation * is not defined between "foo" and 0 (define (times/pc xs) (fold (lambda (x n) (if (= x 0) (shift _ 0) (* x n))) 1 xs)) (reset (times/pc '(1 2 3))) ; => 6 (reset (times/pc '(1 2 0 "foo"))) ; => 0
よくあるcps?の例
(define (idlist/cps xs cont) (match xs [() (cont '())] [(x . xs) (cons x (idlist/cps xs cont))])) (idlist/cps '(1 2 3) identity) ; => (1 2 3) (idlist/cps '(1 2 3) (lambda (_) (list 1 3 4))) ; => (1 2 3 1 3 4) (define (idlist xs) (match xs [() (shift k k)] [(x . xs) (cons x (idlist xs))])) (define cont (reset (idlist '(1 2 3)))) (cont '()) ; => (1 2 3) (cont '(1 3 4)) ; => (1 2 3 1 3 4)
失敗が分かったとき全て調べないtravarse
(define (yield x) (shift k (values x k))) (define (traverse tree) (match tree [() (values #f #f)] [(left e right) (traverse left) (yield e) (traverse right)])) (define (node l e r) (list l e r)) (define (leaf e) (list '() e '())) (define (same-fringe tree0 tree1 fn) (receive (x k0) (reset (traverse tree0)) (receive (y k1) (reset (traverse tree1)) (let loop ((x x) (y y) (k0 k0) (k1 k1)) (fn (cons x y)) (cond [(and (not k0) (not k1)) #t] [(= x y) (receive (x* k0*) (k0) (receive (y* k1*) (k1) (loop x* y* k0* k1*)))] [else #f]))))) (same-fringe (node (leaf 1) 2 (leaf 3)) (node (node (leaf 1) 2 '()) 3 '()) identity) ; => #t (same-fringe (node (leaf 1) 2 (leaf 3)) (node (node (leaf 1) 3 '()) 3 '()) identity) ; => #f (same-fringe (node (leaf 1) 2 (leaf 3)) (node (node (leaf 1) 3 '()) 3 '()) print) ;; ; => (1 . 1) ;; (2 . 3) ;; #f
iteratorもどき
(define (traverse-iter tree) (receive (x k) (reset (traverse (node '() '() tree))) ;;ここ嫌い (let ((x x) (k k)) (lambda () (when k (receive (x* k*) (k) (set! k k*) (set! x x*) x)))))) (define cont (traverse-iter (node (node (leaf 1) 2 (leaf 3)) 4 (node (leaf 5) 6 (leaf 7))))) ;;(cont)
resetの中に触れる
(define f (reset (string-append "hello " (shift k (lambda (x) (k x))) "!"))) (f "world") ; => "hello world!" (f "all") ; => "hello all!"
printfっぽいかんじの変換
(define (g xs) (match xs [() '()] [(x . xs*) (cons (shift k (lambda (f) (k (f x)))) (g xs*))])) (define (uncurry knil . fns) (fold (lambda (f k) (k f)) knil fns)) (let1 k (reset (g '("foo" 123))) ((k identity) number->string)) ; => ("foo" "123") (let1 k (reset (g '("foo" 123))) (uncurry k identity number->string)) ; => ("foo" "123") (define (dispatch x) (cond ((string=? x "%s") identity) ((string=? x "%d") number->string) ((string=? x "%b") (lambda (e) (if e "True" "False"))) (else (shift _ 'fail)))) (define (printf-like fmt xs) (reset (let1 fns (map dispatch fmt) (let1 k (reset (g xs)) (apply uncurry k fns))))) (printf-like '("%s") '("foo")) ; => ("foo") (printf-like '("%d" "%s" "%b") '(120 "foo" #t)) ; => ("120" "foo" "True") (printf-like '("%d" "%s" "%b" "%s" "%b") '(120 "foo" #t "bar" #f)) ; => ("120" "foo" "True" "bar" "False") (printf-like '("%d" "%s" "%c" "%s" "%b") '(120 "foo" #t '(1 2 3) "bar" #f)) ; => fail (printf-like '("%d") '(120 #t)) ; => #<closure (g #f #f)> ((printf-like '("%d") '(120 (120))) x->string) ; => ("120" "(120)")
amb
(define (either x y) (shift k (k x) (k y))) (reset (let1 x (either 1 2) (print x))) ;; ; => 1 ;; 2 ;; #<undef> (define (choice xs) (shift k (for-each k xs))) (let1 src '(1 2 3 4 5 6 7 8 9) (reset (let* ((x (choice src)) (y (choice src)) (z (choice src))) (when (= (+ (* x x) (* y y)) (* z z)) (print (list x y z)))))) ; => (3 4 5) ;; (4 3 5) ;; #<undef>