Permalink
Browse files

* src/main/clojure/clojure/core/logic/arithmetic.clj: docstrings galore

  • Loading branch information...
1 parent 9a92e33 commit 7fb9831d81e599a82681ca93ed67a85b6dcc6189 @swannodette swannodette committed Jul 27, 2011
@@ -5,34 +5,41 @@
(:import [clojure.core.logic.minikanren Substitutions]))
(defmacro = [x y]
+ "Goal for testing whether x and y are equal. Non-relational."
`(fn [a#]
(let [wx# (walk a# ~x)
wy# (walk a# ~y)]
(if (clojure.core/= wx# wy# )
a# nil))))
(defmacro > [x y]
+ "Goal for testing whether x is greater than y. Non-relational."
`(fn [a#]
(let [wx# (walk a# ~x)
wy# (walk a# ~y)]
(if (clojure.core/> wx# wy# )
a# nil))))
(defmacro >= [x y]
+ "Goal for testing whether x is greater than or equal to y.
+ Non-relational."
`(fn [a#]
(let [wx# (walk a# ~x)
wy# (walk a# ~y)]
(if (clojure.core/>= wx# wy# )
a# nil))))
(defmacro < [x y]
+ "Goal for testing whether x is less than y. Non-relational."
`(fn [a#]
(let [wx# (walk a# ~x)
wy# (walk a# ~y)]
(if (clojure.core/< wx# wy# )
a# nil))))
(defmacro <= [x y]
+ "Goal for testing whehter x is less than or equal to y.
+ Non-relational."
`(fn [a#]
(let [wx# (walk a# ~x)
wy# (walk a# ~y)]
@@ -1,30 +1,11 @@
(ns clojure.core.logic.bench
(:refer-clojure :exclude [reify inc ==])
(:use clojure.core.logic.minikanren
- [clojure.core.logic.prelude :only [defne]]
+ [clojure.core.logic.prelude :only [defne membero appendo]]
[clojure.core.logic.disequality :only [!=]])
(:require [clojure.core.logic.nonrel :as nonrel]
[clojure.core.logic.arithmetic :as a]))
-;; =============================================================================
-;; Utilities
-
-(defne membero [x l]
- ([_ [x . ?tail]])
- ([_ [?head . ?tail]]
- (membero x ?tail)))
-
-;; =============================================================================
-;; flatten
-;; =============================================================================
-
-;; =============================================================================
-;; append
-
-(defne appendo [x y z]
- ([() _ y])
- ([[?a . ?d] _ [?a . ?r]] (appendo ?d y ?r)))
-
(comment
(run 1 [q]
(exist [x y]
@@ -82,13 +63,6 @@
(exist [a]
(== (lcons a d) l)))
-(defn membero [x l]
- (conde
- ((firsto l x))
- ((exist [r]
- (resto l r)
- (membero x r)))))
-
(defne righto [x y l]
([_ _ [x y . ?r]])
([_ _ [_ . ?r]] (righto x y ?r)))
@@ -242,5 +242,9 @@
;; Syntax
(defmacro != [u v]
+ "Impose a disequality constraint on u and v. If the two
+ terms ever unify will result in failure. u and v can be
+ compound terms allowing complex conditions to require
+ failure."
`(fn [a#]
(!=-verify a# (unify a# ~u ~v))))
@@ -15,6 +15,7 @@
(reduce concat (map (project-binding s) vars)))
(defmacro project [[& vars] & goals]
+ "Extract the values bound to the specified logic vars. Non-relational."
(let [a (gensym "a")]
`(fn [~a]
(let [~@(project-bindings vars a)]
@@ -110,11 +111,16 @@
(defmacro conda
[& clauses]
+ "Soft cut. Once the head of a clause has succeeded
+ all other clauses will be ignored. Non-relational."
(let [a (gensym "a")]
`(fn [~a]
(ifa* ~@(map (cond-clauses a) clauses)))))
(defmacro condu [& clauses]
+ "Committed choice. Once the head (first goal) of a clause
+ has succeeded, remaining goals of the clause will only
+ be run once. Non-relational."
(let [a (gensym "a")]
`(fn [~a]
(ifu* ~@(map (cond-clauses a) clauses)))))
@@ -123,18 +129,21 @@
;; copy-term
(defn copy-term [u v]
+ "Copies a term u into v. Non-relational."
(project [u]
(== (walk* (build empty-s u) u) v)))
;; =============================================================================
;; lvar nonlvar
(defmacro lvaro [v]
+ "Goal to test whether a logic var is ground. Non-relational."
`(fn [a#]
(if (lvar? (walk a# ~v))
a# nil)))
(defmacro nonlvaro [v]
+ "Goal to test whether a logic var is ground. Non-relational."
`(fn [a#]
(if (not (lvar? (walk a# ~v)))
a# nil)))
@@ -10,36 +10,39 @@
;; Useful goals
(defn nilo [a]
+ "Goal that unifies its argument with nil."
(== nil a))
(defn emptyo [a]
+ "Goal that unifies its argument with the empty list."
(== '() a))
(defn conso [a d l]
+ "The cons operation as a relation. Can be used to
+ construct a list or destructure one."
(== (lcons a d) l))
(defn firsto [l a]
+ "first as a relation."
(exist [d]
(conso a d l)))
(defn resto [l d]
+ "rest as a relation."
(exist [a]
(== (lcons a d) l)))
-(defn membero [x l]
- (conde
- ((firsto l x))
- ((exist [r]
- (resto l r)
- (membero x r)))))
-
;; =============================================================================
-;; Convenient Goal Fns
+;; Goal sugar syntax
(defmacro defne [& rest]
+ "Define a goal fn. Supports pattern matching. All
+ patterns will be tried. See conde."
(apply match/defnm `conde rest))
(defmacro matche [xs & cs]
+ "Pattern matching macro. All patterns will be tried.
+ See conde."
(match/handle-clauses `conde xs cs))
;; -----------------------------------------------------------------------------
@@ -49,17 +52,33 @@
;; the *question* should come first
(defmacro defna [& rest]
+ "Define a soft cut goal. See conda."
(apply match/defnm 'clojure.core.logic.nonrel/conda rest))
(defmacro defnu [& rest]
+ "Define a committed choice goal. See condu."
(apply match/defnm 'clojure.core.logic.nonrel/condu rest))
(defmacro matcha [xs & cs]
+ "Define a soft cut pattern match. See conda."
(match/handle-clauses 'clojure.core.logic.nonrel/conda xs cs))
(defmacro matchu [xs & cs]
+ "Define a committed choice goal. See condu."
(match/handle-clauses 'clojure.core.logic.nonrel/condu xs cs))
+;; ==============================================================================
+;; More convenient goals
+
+(defne membero [x l]
+ ([_ [x . ?tail]])
+ ([_ [?head . ?tail]]
+ (membero x ?tail)))
+
+(defne appendo [x y z]
+ ([() _ y])
+ ([[?a . ?d] _ [?a . ?r]] (appendo ?d y ?r)))
+
;; =============================================================================
;; Rel
@@ -204,6 +223,8 @@
;; TODO: Should probably happen in a transaction
(defn facts
+ "Define a series of facts. Takes a vector of vectors where each vector
+ represents a fact tuple, all with the same number of elements."
([rel [f :as tuples]] (facts rel (count f) tuples))
([^Rel rel arity tuples]
(let [rel-set (var-get (resolve (set-sym (.name rel) arity)))
@@ -220,4 +241,5 @@
(apply merge-with set/union i indexed-tuples))))))))))
(defn fact [rel & tuple]
+ "Add a fact to a relation defined with defrel."
(facts rel [(vec tuple)]))
@@ -141,6 +141,8 @@
;; TODO: consider the concurrency implications much more closely
(defn table [goal]
+ "Function to table a goal. Useful when tabling should only persist
+ for the duration of a run."
(let [table (atom {})]
(fn [& args]
(let [argv args]
@@ -156,6 +158,8 @@
(reuse a argv cache nil nil))))))))
(defmacro tabled [args & grest]
+ "Macro for defining a tabled goal. Prefer ^:tabled with the
+ defne/a/u forms over using this directly."
`(let [table# (atom {})]
(fn [~@args]
(let [argv# ~args]
@@ -49,19 +49,24 @@
:else expr))))
(defn prep [expr]
+ "Prep a quoted expression. All symbols preceded by ? will
+ be replaced with logic vars."
(let [lvars (atom {})
prepped (if (lcons-expr? expr)
(prep* expr lvars true)
(postwalk (replace-lvar lvars) expr))]
(with-meta prepped {:lvars @lvars})))
(defn unifier* [u w]
+ "Unify the terms u and w."
(first
(mk/run* [q]
(mk/== u w)
(mk/== u q))))
(defn binding-map* [u w]
+ "Return the binding map that unifies terms u and w.
+ u and w should prepped terms."
(let [lvars (merge (-> u meta :lvars)
(-> w meta :lvars))
s (mk/unify mk/empty-s u w)]
@@ -71,13 +76,16 @@
lvars)))))
(defn unifier [u w]
+ "Unify the terms u and w. Will prep the terms."
{:pre [(not (mk/lcons? u))
(not (mk/lcons? w))]}
(let [up (prep u)
wp (prep w)]
(unifier* up wp)))
(defn binding-map [u w]
+ "Return the binding map that unifies terms u and w.
+ Will prep the terms."
{:pre [(not (mk/lcons? u))
(not (mk/lcons? w))]}
(let [up (prep u)
@@ -536,14 +536,6 @@
(resto l d)
(listo d)))))
-(defn appendo [l s out]
- (conde
- ((emptyo l) (== s out))
- ((exist [a d res]
- (conso a d l)
- (conso a res out)
- (appendo d s res)))))
-
(defn flatteno [s out]
(conde
((emptyo s) (== '() out))
@@ -681,8 +673,9 @@
(deftest test-flatteno
(is (= (run* [x]
(flatteno '[[a b] c] x))
- '(([[a b] c]) ([a b] (c)) ([a b] c) (a (b) (c)) ([a b] c ()) (a (b) c)
- (a (b) c ()) (a b (c)) (a b c) (a b () (c)) (a b c ()) (a b () c)
+ '(([[a b] c]) ([a b] (c)) ([a b] c) ([a b] c ())
+ (a (b) (c)) (a (b) c) (a (b) c ()) (a b (c))
+ (a b () (c)) (a b c) (a b c ()) (a b () c)
(a b () c ())))))
;; =============================================================================

0 comments on commit 7fb9831

Please sign in to comment.