Skip to content

Instantly share code, notes, and snippets.

@swannodette
Created November 27, 2012 23:45
Show Gist options
  • Star 3 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save swannodette/4158004 to your computer and use it in GitHub Desktop.
Save swannodette/4158004 to your computer and use it in GitHub Desktop.
path_constraint.clj
;; using defc from core.logic master
;; guarantee that a path of keys does not occur in map x,
;; note that the body of a defc is in fact just regular
;; Clojure code
(defc not-pathc [x path]
(= (get-in x path :not-found) :not-found))
(comment
;; note the path does not need to be ground
(run* [q]
(fresh [x]
(not-pathc q [:a x])
(== q {:a {:c 1}})
(== x :b)))
;; => ({:a {:c 1}})
(run* [q]
(fresh [x]
(not-pathc q [:a x])
(== q {:a {:c 1}})
(== x :c)))
;; => ()
;; order of constraints and unification does not matter
(run* [q]
(fresh [x]
(== x :c)
(not-pathc q [:a x])
(== q {:a {:c 1}})))
;; => ()
)
;; without defc much more verbose & protocol details are likely to change
(defn -pathc
([x path] (-pathc x path nil))
([x path id]
(reify
clojure.lang.IFn
(invoke [this a]
(let [x (walk a x)]
(if (not (map? x))
((remcg this) a)
(when (= (get-in x path ::not-found) ::not-found)
((remcg this) a)))))
IConstraintOp
(rator [_] `pathc)
(rands [_] [x])
IWithConstraintId
(with-id [_ id]
(-pathc x path id))
IRunnable
(runnable? [_ s]
(not (lvar? (walk s x))))
IRelevant
(-relevant? [_ s] true)
IConstraintWatchedStores
(watched-stores [_] #{::subst}))))
(defn pathc [x path]
(cgoal (-pathc x path)))
(comment
(run* [q]
(pathc q [:a :b])
(== q 1))
;; (1)
(run* [q]
(pathc q [:a :b])
(== q {:a 2}))
;; => ({:a 2})
(run* [q]
(pathc q [:a :b])
(== q {:a {:c 2}}))
;; => ({:a {:c 2}})
(run* [q]
(pathc q [:a :b])
(== q {:a {:b 1}}))
;; => ()
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment