diff options
-rw-r--r-- | amb.rkt | 66 | ||||
-rw-r--r-- | info.rkt | 2 | ||||
-rw-r--r-- | main.rkt | 2 |
3 files changed, 68 insertions, 2 deletions
@@ -0,0 +1,66 @@ +#lang racket/base +(require racket/sequence) +(require racket/stream) +(require racket/contract) + +(module+ test + (require rackunit) + (require racket/function)) + +(struct amb-fail ()) +(provide amb-fail?) + +(define current-fail (make-parameter amb-fail)) + +(define-syntax amb + (syntax-rules () + [(_) ((current-fail))] + [(_ e0 e1 ...) + (let/cc escape + (let ([previous-fail (current-fail)]) + (let/cc current-fail* + (current-fail current-fail*) + (escape e0)) + (current-fail previous-fail)) + (amb e1 ...))])) +(provide amb) + +(define (call-with-amb th) + (parameterize ([current-fail amb-fail]) + (th))) +(provide/contract [call-with-amb (-> (-> any/c) any/c)]) + +(define (in-amb th) + (let* ([return #f] + [continue (λ (x) (void))] + [yield + (λ (obj) + (let/cc k + (set! continue k) + (return obj)))]) + (define (gen) + (let/cc k + (set! return k) + (continue (void)) + (parameterize ([current-fail (λ () (return (amb-fail)))]) + (yield (th)) + (amb)))) + (in-stream + (let loop () + (let ([result (gen)]) + (if (amb-fail? result) + empty-stream + (stream-cons result (loop)))))))) +(provide/contract [in-amb (-> (-> any/c) any/c)]) + +(module+ test + (check-equal? (sequence->list (in-amb (thunk (amb 1 2 3)))) '(1 2 3)) + (check-equal? (sequence->list (in-amb (thunk + (let* ([x (amb 1 2 3)] + [y (amb 10 20 30)]) + (+ x y))))) + '(11 21 31 12 22 32 13 23 33))) + +(define (amb-clear!) + (current-fail amb-fail)) +(provide/contract [amb-clear! (-> void?)]) @@ -1,2 +1,2 @@ #lang info -(define deps '("base" "gui-lib" "https://github.com/tojoqk/tojoqk-amb.git")) +(define deps '("base" "gui-lib")) @@ -5,7 +5,7 @@ (require racket/function) (require racket/match) (require racket/contract) -(require tojoqk/amb) +(require "amb.rkt") (define CELL-SIZE 30) (define ARROW-LENGTH 30) |