(ns
tabling
(:refer-clojure :exclude [==])
(:use [clojure.core.logic]))
(defn create-linear-graph [n]
^{:doc "a graph where each node has a single successor"}
(let [nodes (range n)]
(defn to-node [node to]
(project [node]
(if (< node n)
(== to (inc node))
fail)))
{:nodes nodes
:successors to-node}))
(defn get-successor [graph node next]
((:successors graph) node next))
(defn
^{:doc "succeeds when next is a direct successor of node" }
trans [graph node next]
(fresh [nodes]
(project [graph node]
(get-successor graph node next))))
(defn
^{:doc "solves goal in the current world.
Arguments to the goal are goal, current and next.
Goal should ground next."}
solve-goal [graph current next goal]
(all
(goal graph current next)))
(defn
^{:doc "goals is a list of goals.
Each goal is called, passing the next version of the previous goal as the
current version of the current goal" }
solve-goals [graph curr end goals]
(conda [(emptyo goals)
(== curr end)]
[(fresh [next]
(solve-goal graph curr next (first goals))
(solve-goals graph next end (rest goals)))]))
(defn
^{:doc "goals succeeds an arbitrary number of times.
Tabled to prevent cycles"}
loop-nodes-tabled [ & goals]
(def tabled-loop
(tabled
[graph current end goals]
(conde
[(== current end)]
[(fresh [next]
(solve-goals graph current next goals)
(tabled-loop graph next end goals))])))
(fn [graph current end]
(tabled-loop graph current end goals)))
(defn
^{:doc "goals succeeds an arbitrary number of times.
Same as tabled, except it is untabled"}
loop-nodes-untabled [ & goals]
(defn untabled-loop
[graph current end goals]
(conde
[(== current end)]
[(fresh [next]
(solve-goals graph current next goals)
(untabled-loop graph next end goals))]))
(fn [graph current end]
(untabled-loop graph current end goals)))
(defn go-make-a-coffee []
(let [graph (create-linear-graph 300)]
(run* [e]
(solve-goals
graph 0 299
(list
(loop-nodes-tabled trans))))))
(defn blazingly-fast []
(let [graph (create-linear-graph 300)]
(run* [e]
(solve-goal
graph 0 299
(loop-nodes-tabled trans)))))
(defn untabled-fast []
(let [graph (create-linear-graph 300)]
(run* [e]
(solve-goals
graph 0 299
(list
(loop-nodes-untabled trans))))))