Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

* src/main/clojure/clojure/core/logic.clj: organize protocols

  • Loading branch information...
commit ae6fa2ff2ed1a9a3c22201dbd746965ca27d844b 1 parent 5699506
David Nolen authored
Showing with 109 additions and 70 deletions.
  1. +109 −70 src/main/clojure/clojure/core/logic.clj
View
179 src/main/clojure/clojure/core/logic.clj
@@ -11,10 +11,10 @@
(def ^{:dynamic true} *expand-doms*)
;; =============================================================================
-;; Core Protocols
+;; miniKanren Protocols
;; -----------------------------------------------------------------------------
-;; miniKanren Protocols
+;; Unification protocols for core Clojure types
(defprotocol IUnifyTerms
(unify-terms [u v s]))
@@ -40,6 +40,26 @@
(defprotocol IUnifyWithSet
(unify-with-set [v u s]))
+;; -----------------------------------------------------------------------------
+;; Utility protocols
+
+(defprotocol LConsSeq
+ (lfirst [this])
+ (lnext [this]))
+
+(defprotocol LConsPrint
+ (toShortString [this]))
+
+;; -----------------------------------------------------------------------------
+;; Substitution
+
+(defprotocol ISubstitutions
+ (ext-no-check [this x v])
+ (walk [this x] [this x wrap?]))
+
+;; -----------------------------------------------------------------------------
+;; Protocols for terms
+
(defprotocol IReifyTerm
(reify-term [v s]))
@@ -52,6 +72,9 @@
(defprotocol IBuildTerm
(build-term [u s]))
+;; -----------------------------------------------------------------------------
+;; Goal protocols
+
(defprotocol IBind
(bind [this g]))
@@ -61,43 +84,44 @@
(defprotocol ITake
(take* [a]))
-(defprotocol ISubstitutions
- (ext-no-check [this x v])
- (walk [this x] [this x wrap?]))
-
-(defprotocol ISubstitutionsCLP
- (update [this x v]))
-
;; -----------------------------------------------------------------------------
-;; cKanren protocols
+;; soft cut & committed choice protocols
-(defprotocol IUnifyWithRefinable
- (unify-with-refinable [v u s]))
+(defprotocol IIfA
+ (ifa [b gs c]))
-(defprotocol IUnifyWithInteger
- (unify-with-integer [v u s]))
+(defprotocol IIfU
+ (ifu [b gs c]))
-(defprotocol IUnifyWithFiniteDomain
- (unify-with-domain [v u s]))
+;; =============================================================================
+;; Rel protocols
-(defprotocol IUnifyWithIntervalFD
- (unify-with-interval [v u s]))
+(defprotocol IRel
+ (setfn [this arity f])
+ (indexes-for [this arity])
+ (add-indexes [this arity index]))
-(defprotocol IUnifyWithMultiIntervalFD
- (unify-with-multi-interval [v u s]))
+;; =============================================================================
+;; Tabling protocols
-(defprotocol IRunnable
- (runnable? [c s]))
+(defprotocol ITabled
+ (-reify-tabled [this v])
+ (reify-tabled [this v])
+ (alpha-equiv? [this x y])
+ (reuse [this argv cache start end])
+ (subunify [this arg ans]))
-(defprotocol IRefinable
- (refinable? [x]))
+(defprotocol ISuspendedStream
+ (ready? [this]))
-(defprotocol IRefine
- (refine [x v]))
+;; =============================================================================
+;; cKanren protocols
-(extend-type Object
- IRefinable
- (refinable? [_] false))
+(defprotocol ISubstitutionsCLP
+ (update [this x v]))
+
+;; -----------------------------------------------------------------------------
+;; Constraint Store
(defprotocol IConstraintStore
(addc [this c])
@@ -109,6 +133,22 @@
;;(update-proc [this id proc])
)
+;; -----------------------------------------------------------------------------
+;; Generic constraint protocols
+
+(defprotocol IRunnable
+ (runnable? [c s]))
+
+(defprotocol IRefinable
+ (refinable? [x]))
+
+(defprotocol IRefine
+ (refine [x v]))
+
+(extend-type Object
+ IRefinable
+ (refinable? [_] false))
+
(defprotocol IWithConstraintId
(with-id [this id]))
@@ -156,6 +196,9 @@
;; INeedsStore
;; (needs-store? [_] false))
+;; -----------------------------------------------------------------------------
+;; Finite domain protocol types
+
(defprotocol IInterval
(lb [this])
(ub [this])
@@ -182,6 +225,43 @@
(intersection [this that])
(difference [this that]))
+;; -----------------------------------------------------------------------------
+;; Unification for finite domains
+
+(defprotocol IUnifyWithRefinable
+ (unify-with-refinable [v u s]))
+
+(defprotocol IUnifyWithInteger
+ (unify-with-integer [v u s]))
+
+(defprotocol IUnifyWithFiniteDomain
+ (unify-with-domain [v u s]))
+
+(defprotocol IUnifyWithIntervalFD
+ (unify-with-interval [v u s]))
+
+(defprotocol IUnifyWithMultiIntervalFD
+ (unify-with-multi-interval [v u s]))
+
+;; -----------------------------------------------------------------------------
+;; Tree Constraints
+
+(defprotocol ITreeConstraint
+ (tree-constraint? [this]))
+
+(extend-type Object
+ ITreeConstraint
+ (tree-constraint? [this] false))
+
+(defprotocol IPrefix
+ (prefix [this]))
+
+(defprotocol IWithPrefix
+ (with-prefix [this p]))
+
+;; -----------------------------------------------------------------------------
+;; force-ans support
+
(defprotocol IForceAnswerTerm
(-force-ans [v x]))
@@ -1063,15 +1143,8 @@
`(unchecked-add-int ~@args)
`(unchecked-add ~@args)))
-(defprotocol LConsSeq
- (lfirst [this])
- (lnext [this]))
-
;; TODO: clean up the printing code
-(defprotocol LConsPrint
- (toShortString [this]))
-
(declare lcons?)
(deftype LCons [a d ^{:unsynchronized-mutable true :tag int} cache meta]
@@ -2154,12 +2227,6 @@
;; TODO : conda and condu should probably understanding logging
-(defprotocol IIfA
- (ifa [b gs c]))
-
-(defprotocol IIfU
- (ifu [b gs c]))
-
;; TODO : if -> when
(defmacro ifa*
@@ -2593,11 +2660,6 @@
(def-apply-to-helper 20)
-(defprotocol IRel
- (setfn [this arity f])
- (indexes-for [this arity])
- (add-indexes [this arity index]))
-
;; TODO: consider moving the set/indexes inside Rel, perf implications?
(defmacro RelHelper [arity]
@@ -2763,9 +2825,6 @@
;; Data Structures
;; (atom []) is cache, waiting streams are PersistentVectors
-(defprotocol ISuspendedStream
- (ready? [this]))
-
(deftype SuspendedStream [cache ansv* f]
clojure.lang.ILookup
(valAt [this k]
@@ -2811,13 +2870,6 @@
;; -----------------------------------------------------------------------------
;; Extend Substitutions to support tabling
-(defprotocol ITabled
- (-reify-tabled [this v])
- (reify-tabled [this v])
- (alpha-equiv? [this x y])
- (reuse [this argv cache start end])
- (subunify [this arg ans]))
-
;; CONSIDER: subunify, reify-term-tabled, extending all the necessary types to
;; them
@@ -3520,19 +3572,6 @@
;; =============================================================================
;; CLP(Tree)
-(defprotocol ITreeConstraint
- (tree-constraint? [this]))
-
-(extend-type Object
- ITreeConstraint
- (tree-constraint? [this] false))
-
-(defprotocol IPrefix
- (prefix [this]))
-
-(defprotocol IWithPrefix
- (with-prefix [this p]))
-
(defn prefix-s [s <s]
(letfn [(prefix* [s <s]
(if (identical? s <s)

0 comments on commit ae6fa2f

Please sign in to comment.
Something went wrong with that request. Please try again.