From 39ba71cf3a5ae130f6d116aeae38e38b6b644e54 Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Wed, 25 May 2022 21:45:25 +0900
Subject: Add amb.rkt file.

---
 amb.rkt  | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 info.rkt |  2 +-
 main.rkt |  2 +-
 3 files changed, 68 insertions(+), 2 deletions(-)
 create mode 100644 amb.rkt

diff --git a/amb.rkt b/amb.rkt
new file mode 100644
index 0000000..0c6b947
--- /dev/null
+++ b/amb.rkt
@@ -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?)])
diff --git a/info.rkt b/info.rkt
index 2af8b3b..fbc3c37 100644
--- a/info.rkt
+++ b/info.rkt
@@ -1,2 +1,2 @@
 #lang info
-(define deps '("base" "gui-lib" "https://github.com/tojoqk/tojoqk-amb.git"))
+(define deps '("base" "gui-lib"))
diff --git a/main.rkt b/main.rkt
index 4536a0f..2e1bb7f 100644
--- a/main.rkt
+++ b/main.rkt
@@ -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)
-- 
cgit v1.2.3