From 42ea9205a06080020de2fe38f6fecc109e4165e3 Mon Sep 17 00:00:00 2001 From: Ambrose Bonnaire-Sergeant Date: Wed, 2 Nov 2011 21:13:21 +0800 Subject: [PATCH] Fully migrated to core.logic 0.6.5, fixed up some files --- src/logic_introduction/decl_model.clj | 89 +++++++++++++------------ src/logic_introduction/facts.clj | 4 +- src/logic_introduction/fetch.clj | 4 +- src/logic_introduction/polymorphism.clj | 4 +- src/logic_introduction/subs.clj | 5 +- 5 files changed, 55 insertions(+), 51 deletions(-) diff --git a/src/logic_introduction/decl_model.clj b/src/logic_introduction/decl_model.clj index 3b32d4b..233cedb 100644 --- a/src/logic_introduction/decl_model.clj +++ b/src/logic_introduction/decl_model.clj @@ -1,10 +1,53 @@ (ns logic-introduction.decl-model - (:refer-clojure :exclude [==]) + (:refer-clojure :exclude [== compile]) (:import [java.io Writer]) - (:use ;[clojure.core.logic [minikanren :exclude [LCons walk lfirst lrest lcons?]] prelude nonrel match disequality] - [clojure.walk :only [walk prewalk postwalk]] + (:use [clojure.walk :only [walk prewalk postwalk]] [clojure.core.match [core :exclude [swap]]])) +;; See bottom of file for some thoughts + + +(defprotocol LConsP + (lfirst [this]) + (lrest [this])) + +(defprotocol LConsPrint + (toShortString [this])) + +(deftype LCons [a d] + LConsPrint + (toShortString [this] + (cond + (.. this getClass (isInstance d)) (str a " " (toShortString d)) + :else (str a " . " d ))) + Object + (toString [this] (cond + (.. this getClass (isInstance d)) (str "(" a " " (toShortString d) ")") + :else (str "(" a " . " d ")"))) + LConsP + (lfirst [_] a) + (lrest [_] d)) + +(defn lcons [a d] + "Constructs a sequence a with an improper tail d if d is a logic variable." + (if (or (coll? d) (nil? d)) + (cons a (seq d)) + (LCons. a d ))) + +(defn lcons? [x] + (instance? LCons x)) + +(defmethod print-method LCons [x ^Writer writer] + (.write writer (str x))) + +(defn- rest-nil [n] + (let [r (rest n)] + (if (empty? r) + nil + r))) + + + (defn- composite? "Taken from the old `contrib.core/seqable?`. Since the meaning of 'seqable' is questionable, I will work on phasing it out and using a more meaningful @@ -126,13 +169,6 @@ -(declare lcons? lfirst lrest) -(defn- rest-nil [n] - (let [r (rest n)] - (if (empty? r) - nil - r))) - (defmethod set-or-equals [Object Object] @@ -202,39 +238,6 @@ (reify-solved ~n) :logic-introduction.decl-model/NORESULT))) -(defprotocol LConsP - (lfirst [this]) - (lrest [this])) - -(defprotocol LConsPrint - (toShortString [this])) - -(deftype LCons [a d] - LConsPrint - (toShortString [this] - (cond - (.. this getClass (isInstance d)) (str a " " (toShortString d)) - :else (str a " . " d ))) - Object - (toString [this] (cond - (.. this getClass (isInstance d)) (str "(" a " " (toShortString d) ")") - :else (str "(" a " . " d ")"))) - LConsP - (lfirst [_] a) - (lrest [_] d)) - -(defn lcons [a d] - "Constructs a sequence a with an improper tail d if d is a logic variable." - (if (or (coll? d) (nil? d)) - (cons a (seq d)) - (LCons. a d ))) - -(defn lcons? [x] - (instance? LCons x)) - -(defmethod print-method LCons [x ^Writer writer] - (.write writer (str x))) - ;; Handy predicates diff --git a/src/logic_introduction/facts.clj b/src/logic_introduction/facts.clj index 512c0eb..eeec152 100644 --- a/src/logic_introduction/facts.clj +++ b/src/logic_introduction/facts.clj @@ -29,7 +29,7 @@ (tabled [ancestor descendant] (conde ((derives ancestor descendant)) - ((exist [i] + ((fresh [i] (derived-ancestor ancestor i) (derives i descendant)))))) @@ -62,7 +62,7 @@ ;; Quicksort: Pg 70, Art of Prolog (matche [ts out] ([[?x . ?xs] ?ys] - (exist [littles bigs ls bs] + (fresh [littles bigs ls bs] (partition-by-preference ?xs ?x littles bigs) (sort-by-preference littles ls) (sort-by-preference bigs bs) diff --git a/src/logic_introduction/fetch.clj b/src/logic_introduction/fetch.clj index 8764e7a..2a3af6f 100644 --- a/src/logic_introduction/fetch.clj +++ b/src/logic_introduction/fetch.clj @@ -24,7 +24,7 @@ (defn fetch-data [fetched-data] "Output: fetched-data" - (exist [url datastream] + (fresh [url datastream] (url-to-process url) (slurpo url datastream) (read-jsono datastream fetched-data))) @@ -42,7 +42,7 @@ (defn process-json-object [json-object] "Input: json-object" - (exist [date-value indicator-value temp] + (fresh [date-value indicator-value temp] (json-object-has-value json-object :date date-value) (json-object-has-value json-object :value indicator-value) (project [date-value indicator-value] diff --git a/src/logic_introduction/polymorphism.clj b/src/logic_introduction/polymorphism.clj index dac8a7f..00f1b2d 100644 --- a/src/logic_introduction/polymorphism.clj +++ b/src/logic_introduction/polymorphism.clj @@ -32,12 +32,12 @@ "context is an environment such that expression exp executed in environment context results in type result-type" (conde - ((exist [poly-res-type] + ((fresh [poly-res-type] (polymorphic-type result-type poly-res-type) (env-assoc exp context poly-res-type))) ((matche [exp] ([[:apply ?fun ?arg]] - (exist [arg-type fun-type] + (fresh [arg-type fun-type] (!= ?fun ?arg) (expression-check context ?arg arg-type) (expression-check context ?fun [arg-type :> result-type]))))))) diff --git a/src/logic_introduction/subs.clj b/src/logic_introduction/subs.clj index abfeafb..7e1c5cd 100644 --- a/src/logic_introduction/subs.clj +++ b/src/logic_introduction/subs.clj @@ -1,6 +1,7 @@ (ns logic-introduction.subs - (:use [clojure.core.match.core :only [match]]) - (:refer-clojure :exclude [==])) + (:refer-clojure :exclude [== reify])) + +;; Skeleton of a minikanren-like language (def empty-substitution '())