So, I was wondering if anyone had implemented the amb operator in
Clojure, so I decided to give it a try. This is my first Clojure
program bigger then 5 lines, the code still needs ALOT of work, it is
ugly as hell atm, but I think it kind of works. (Yes, I know, it's
very easy to bug it, its just a sketch). Notice that unlike most
continuation based amb operators, the amount of backtracking this
implementation has to do depends on the order of the requires, not the
amb assignments.
If anyone wants to clear or improve the code, go ahead.
I also would like to know how to be able to write @baker instead of
the current (myderef baker), I tried using a proxy and implementing
IDeref, but then I couldn't acess the amb-struct private data. Since
Clojure doesn't have continuations I had to use a try catch block to
do the stack unwinding, and some redundant calculations might be done
because of it.
Here is the code:
(defstruct amb-struct :instance :orig :possible)
(def amb-stack nil)
(defn amb [choices]
(struct-map amb-struct :instance false :orig choices :possible
choices))
(defn myderef [a]
(if (:instance @a)
(:value @a)
(do
(set! amb-stack (cons a amb-stack))
(let
[oldpos (:possible @a)]
(var-set a (assoc @a
:value (first oldpos)
:instance true
:possible (rest oldpos))))
(:value @a))))
(defn amb-require [condition]
(if condition
nil
(do
(throw (.Exception "nothing")))))
(defn bindnext []
(if (empty? amb-stack)
'nomatchfound
(let [lastbind (first amb-stack)
oldpos (:possible @lastbind)]
(if (empty? oldpos)
(do
(var-set lastbind (assoc @lastbind :instance false :possible (:orig
@lastbind)))
(set! amb-stack (rest amb-stack))
(recur))
(do
(var-set lastbind (assoc @lastbind :value (first oldpos) :possible
(rest oldpos)))
'recur)))))
(defmacro amb-let [declarations & body]
`(with-local-vars
~declarations
(binding [amb-stack nil]
(loop []
(let [retvalue#
(try
(do ~...@body)
(catch Exception ~'except
(bindnext)))]
(cond
(= retvalue# 'recur) (recur)
true retvalue#))))))
(defn distinct-seq? [s]
(cond
(empty? (rest s)) true
(= (first s) (second s)) false
true (and (distinct-seq? (cons (first s) (rest (rest s))))
(distinct-seq? (rest s)))))
(amb-let [baker (amb [1 2 3 4 5])
cooper (amb [1 2 3 4 5])
fletcher (amb [1 2 3 4 5])
miller (amb [1 2 3 4 5])
smith (amb [1 2 3 4 5])]
(amb-require (distinct-seq? (map myderef (list baker cooper fletcher
miller smith))))
(amb-require (not (= (myderef baker) 5)))
(amb-require (not (= (myderef cooper) 1)))
(amb-require (not (= (myderef fletcher) 1)))
(amb-require (not (= (myderef fletcher) 5)))
(amb-require (> (myderef miller) (myderef cooper)))
(amb-require (not (= 1 (. java.lang.Math abs (- (myderef smith)
(myderef fletcher))))))
(amb-require (not (= 1 (. java.lang.Math abs (- (myderef fletcher)
(myderef cooper))))))
[['baker (myderef baker)]
['cooper (myderef cooper)]
['fletcher (myderef fletcher)]
['miller (myderef miller)]
['smith (myderef smith)]])
Running it returns [[baker 3] [cooper 2] [fletcher 4] [miller 5]
[smith 1]]
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"Clojure" group.
To post to this group, send email to clojure@googlegroups.com
To unsubscribe from this group, send email to
clojure+unsubscr...@googlegroups.com
For more options, visit this group at
http://groups.google.com/group/clojure?hl=en
-~----------~----~----~----~------~----~------~--~---
