Merge pull request #19 from quoll/pabu

Pabu

pabu/family.lg

@@ -0,0 +1,12 @@
+sibling(fred, barney).
+parent(fred, mary).
+sibling(mary, george).
+gender(george, male).
+
+parent(B, C) :- sibling(A, B), parent(A, C).
+brother(A, B) :- sibling(A, B), gender(B, male).
+uncle(A, C) :- parent(A, B), brother(B, C).
+/* sibling(A, B) :- parent(A, P), parent(B, P). */
+gender(F, male) :- father(A, F).
+parent(A, F) :- father(A, F).
+

project.clj

@@ -4,4 +4,7 @@
   #_:license #_{:name "Eclipse Public License"
                 :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.8.0"]
-                 [prismatic/schema "1.0.5"]])
+                 [prismatic/schema "1.0.5"]
+                 [org.clojure/tools.cli "0.3.5"]
+                 [the/parsatron "0.0.7"]]
+  :main naga.cli)

src/naga/cli.clj

@@ -0,0 +1,97 @@
+(ns ^{:doc "Command line interface for interacting with Naga."
+      :author "Paula Gearon"}
+    naga.cli
+  (:require [clojure.tools.cli :refer [parse-opts]]
+            [clojure.string :as string]
+            [clojure.java.io :as io]
+            [naga.lang.pabu :as pabu]
+            [naga.rules :as r]
+            [naga.engine :as e]
+            [naga.store :as store]
+            [naga.storage.memory.core]))
+
+(def stores (map name (keys @store/registered-stores)))
+
+(def cli-options
+  [["-s" "--storage" "Select store type"
+    :validate [(set stores) "Must be a registered storage type."]]
+   ["-h" "--halp" "Print help"]])
+
+(defn exit
+  [status message]
+  (println message)
+  (System/exit status))
+
+(defn usage
+  [{summary :summary}]
+  (->> ["Executes Naga on a program."
+        ""
+        "Usage: naga [filename]"
+        ""
+        summary
+        (str "Store types: " (into [] stores))
+        ""]
+       (string/join \newline)))
+
+(defn run-all
+  "Runs a program, and returns the data processed, the results, and the stats.
+   Takes an input stream. Returns a map of:
+  :input, :output, :stats"
+  [in]
+        ;; read the program
+  (let [{:keys [rules axioms]} (pabu/read-stream in)
+
+        ;; instantiate a database. For the demo we're using "in-memory"
+        fresh-store (store/get-storage-handle {:type :memory})
+
+        ;; assert the initial axioms. The program can do that, but
+        ;; we want to do it here so we can see the original store
+        ;; (we may use it for comparisons some time in the future)
+        original-store (store/assert-data fresh-store axioms)
+
+        ;; Configure the storage the program will use. Provide a store
+        ;; so the program won't try to create its own
+        config {:type :memory :store original-store}
+
+        ;; compile the program
+        program (r/create-program rules [])
+
+        ;; run the program
+        [store results] (e/run config program)
+
+        ;; dump the database by resolving an unbound constraint
+        data (store/resolve-pattern store '[?e ?p ?v])]
+    {:input axioms
+     :output (remove (set axioms) data)
+     :stats results}))
+
+
+(defn- nm
+  "Returns a string version of a keyword. These are not being represented
+   as Clojure keywords, so namespaces (when they exist) are separated by
+   a : character"
+  [k]
+  (if-let [n (namespace k)]
+    (str n ":" (name k))
+    (name k)))
+
+
+(defn- predicate-string
+  "Convert a predicate triplet into a string."
+  [[e p v]]
+  (if (= p :rdf/type)
+    (str (nm e) "(" (nm v) ").")
+    (str (nm p) "(" (nm e) ", " (nm v) ").")))
+
+
+(defn -main [& args]
+  (let [{:keys [options arguments] :as opts} (parse-opts args cli-options)]
+    (when (:halp options) (exit 1 (usage opts)))
+    (let [in-stream (if-let [filename (first arguments)]
+                      (io/input-stream filename)
+                      *in*)
+          {:keys [input output stats]} (run-all in-stream)]
+      (println "INPUT DATA") 
+      (doseq [a input] (println (predicate-string a)))
+      (println "\nNEW DATA")
+      (doseq [a output] (println (predicate-string a))))))

src/naga/engine.clj

@@ -1,13 +1,14 @@
 (ns ^{:doc "Functions to run rules until completion."
       :author "Paula Gearon"}
     naga.engine
-    (:require [naga.structs :as st :refer [EPVPattern RulePatternPair
+    (:require [naga.schema.structs :as st
+                                   :refer [EPVPattern RulePatternPair
                                            StatusMap StatusMapEntry Body Program]]
               [naga.queue :as q]
               [naga.store :as store]
               [naga.util :as u]
               [schema.core :as s])
-    (:import [naga.structs Rule]
+    (:import [naga.schema.structs Rule]
              [naga.store Storage]
              [naga.queue PQueue]))
 

src/naga/lang/pabu.clj

@@ -0,0 +1,68 @@
+(ns ^{:doc "Implements Pabu, which is a Prolog-like language for Naga.
+Parses code and returns Naga rules."
+      :author "Paula Gearon"}
+  naga.lang.pabu
+  (:require [naga.schema.structs :as structs :refer [Axiom Program]]
+            [naga.lang.parser :as parser]
+            [naga.rules :as r]
+            [schema.core :as s])
+  (:import [java.io InputStream]
+           [naga.schema.structs Rule]))
+
+;; TODO: Multi-arity not yet supported
+(def Args
+  [(s/one s/Any "entity")
+   (s/optional s/Any "value")])
+
+(def AxiomAST
+  {:type (s/eq :axiom)
+   :axiom [(s/one s/Keyword "Property")
+           (s/one Args "args")]})
+
+(def Triple
+  [(s/one s/Any "entity")
+   (s/one s/Any "property")
+   (s/one s/Any "value")])
+
+(s/defn triplet :- Triple
+  [[property [s o :as args]]]
+  (if (= 1 (count args))
+    [s :rdf/type property]
+    [s property o]))
+
+(s/defn ast->axiom :- Axiom
+  "Converts the axiom structure returned from the parser"
+  [{axiom :axiom :as axiom-ast} :- AxiomAST]
+  (triplet axiom))
+
+(def VK "Either a Variable or a Keyword" (s/cond-pre s/Keyword s/Symbol))
+
+(def Predicate [(s/one VK "property")
+                (s/one Args "arguments")])
+
+(def RuleAST
+  {:type (s/eq :rule)
+   :head [(s/one VK "property")
+          (s/one Args "arguments")]
+   :body [Predicate]})
+
+(s/defn ast->rule
+  "Converts the rule structure returned from the parser"
+  [{:keys [head body] :as rule-ast} :- RuleAST]
+  (r/rule (triplet head) (map triplet body) (-> head first name gensym name)))
+
+(s/defn read-str :- {:rules [Rule]
+                     :axioms [Axiom]}
+  "Reads a string"
+  [s :- s/Str]
+  (let [program-ast (parser/parse s)
+        axioms (filter (comp (partial = :axiom) :type) program-ast)
+        rules (filter (comp (partial = :rule) :type) program-ast)]
+    {:rules (map ast->rule rules)
+     :axioms (map ast->axiom axioms)}))
+
+(s/defn read-stream :- Program
+  "Reads a input stream"
+  [in :- InputStream]
+  (let [text (slurp in)]
+    (read-str text)))

src/naga/lang/parser.clj

@@ -0,0 +1,121 @@
+(ns ^{:doc "Parser for Pabu, which is a Prolog-like syntax for Naga."
+      :author "Paula Gearon"}
+  naga.lang.parser
+  (:refer-clojure :exclude [char])
+  (:require [the.parsatron :refer :all]))
+
+(defn choice* 
+  "choice with backtracking."
+  [& args]
+  (apply choice (map attempt args)))
+
+(defn either*
+  "either with backtracking."
+  [p q]
+  (either (attempt p) (attempt q)))
+
+(defn upper-case-letter?
+  "Prolog considers underscores to be equivalent to an uppercase letter"
+  [c]
+  (or (Character/isUpperCase ^Character c) (= \_ c)))
+
+(defn upper-case-letter
+  []
+  (token upper-case-letter?))
+
+(def non-star (token (complement #{\*})))
+(def non-slash (token (complement #{\/})))
+
+(defparser cmnt []
+  (let->> [_ (>> (string "/*") (many non-star) (many1 (char \*)))
+           _ (many (>> non-slash (many non-star) (many1 (char \*))))
+           _ (char \/)]
+    (always :cmnt)))
+
+(def whitespace-char (token #{\space \newline \tab}))
+(def opt-whitespace (many (either whitespace-char (cmnt))))
+(def separator (>> opt-whitespace (char \,) opt-whitespace))
+(def open-paren (>> (char \() opt-whitespace))
+(def close-paren (>> opt-whitespace (char \))))
+
+(def word (many1 (letter)))
+
+(def digits (many1 (digit)))
+
+(defparser signed-digits []
+  (let->> [s (token #{\+ \-})
+           ds digits]
+    (always (cons s ds))))
+
+(defparser integer []
+  (let->> [i (either digits (signed-digits))]
+    (always (Long/parseLong (apply str i)))))
+
+(defparser floating-point []
+  (let->> [i (either digits (signed-digits))
+           f (>> (char \.) (many1 (digit)))]
+    (always (Double/parseDouble (apply str (apply str i) \. f)))))
+
+(def number (either* (floating-point) (integer)))
+
+(defparser pstring1 []
+  (let->> [s (many1 (between (char \') (char \') (many (any-char)))) ]
+    (always (flatten (interpose \' s)))))
+
+(defparser pstring2 []
+  (let->> [s (many1 (between (char \") (char \") (many (any-char))))]
+    (always (flatten (interpose \" s)))))
+
+(def pstring (either (pstring1) (pstring2)))
+
+(defparser variable []
+  (let->> [f (upper-case-letter)
+           r (many (letter))]
+    (always (symbol (apply str "?" (Character/toLowerCase f) r) ))))
+
+(defparser kw []
+  (let->> [r word]
+    (always (keyword (apply str r)))))
+
+(defparser atm []
+  (choice (kw) pstring number))
+
+(defparser elt []
+  (choice (variable) (atm)))
+
+(defparser arg-list []
+  (let->> [f (elt)
+           r (many (>> separator (elt)))]
+    (always (cons f r))))
+
+(defparser structure []
+  (let->> [p (elt)
+           args (between open-paren close-paren (arg-list))]
+    (always [p args])))
+
+(defparser structures []
+  (let->> [s (structure)
+           ss (many (attempt (>> separator (structure))))]
+    (always (cons s ss))))
+
+(defparser nonbase-clause []
+  (let->> [head (>> opt-whitespace (structure))
+           _ (>> opt-whitespace (string ":-") opt-whitespace)
+           body (structures)
+           _ (>> opt-whitespace (char \.) opt-whitespace)]
+    (always {:type :rule
+             :head head
+             :body body})))
+
+(defparser base-clause []
+  (let->> [structure (>> opt-whitespace (structure))
+           _ (>> opt-whitespace (char \.) opt-whitespace)]
+    (always {:type :axiom
+             :axiom structure})))
+
+(def program (many (either* (nonbase-clause) (base-clause))))
+
+(defn parse
+  "Parse a string"
+  [s]
+  (run program s))

src/naga/rules.clj

@@ -2,12 +2,12 @@
       :author "Paula Gearon"}
     naga.rules
     (:require [schema.core :as s]
-              [naga.structs :as st :refer [EPVPattern RulePatternPair Body Axiom Program]]
+              [naga.schema.structs :as st :refer [EPVPattern RulePatternPair Body Axiom Program]]
               [naga.util :as u])
     (:import [clojure.lang Symbol]
-             [naga.structs Rule]))
+             [naga.schema.structs Rule]))
 
-(defn- gen-rule-name [] (gensym "rule-"))
+(defn- gen-rule-name [] (name (gensym "rule-")))
 
 (s/defn rule :- Rule
   "Creates a new rule"

src/naga/structs.clj → src/naga/schema/structs.clj

@@ -1,6 +1,6 @@
 (ns ^{:doc "Defines the schemas for rule structures"
       :author "Paula Gearon"}
-    naga.structs
+    naga.schema.structs
     (:require [schema.core :as s]
               [naga.util :as u])
     (:import [clojure.lang Symbol]))

src/naga/storage/memory.clj → src/naga/storage/memory/core.clj

@@ -1,12 +1,12 @@
 (ns ^{:doc "A storage implementation over in-memory indexing. Includes full query engine."
       :author "Paula Gearon"}
-    naga.storage.memory
+    naga.storage.memory.core
     (:require [clojure.set :as set]
               [schema.core :as s]
-              [naga.structs :as st :refer [EPVPattern Results Value]]
+              [naga.schema.structs :as st :refer [EPVPattern Results Value]]
               [naga.store :as store]
               [naga.util :as u]
-              [naga.storage.memory-index :as mem])
+              [naga.storage.memory.index :as mem])
     (:import [clojure.lang Symbol]
              [naga.store Storage]))
 
@@ -191,3 +191,5 @@
   "Factory function to create a store"
   [config]
   empty-store)
+
+(store/register-storage! :memory create-store)

src/naga/storage/memory_index.clj → src/naga/storage/memory/index.clj

@@ -1,6 +1,6 @@
 (ns ^{:doc "A graph implementation with full indexing."
       :author "Paula Gearon"}
-    naga.storage.memory-index
+    naga.storage.memory.index
     (:require [schema.core :as s]))
 
 (def ? :?)

src/naga/util.clj

@@ -14,4 +14,4 @@
   ([keyfn :- (=> s/Any s/Any)
     valfn :- (=> s/Any s/Any)
     s :- [s/Any]]
-    (into {} (map (fn [e] [(keyfn e) (valfn e)]) s))))
+    (into {} (map (juxt keyfn valfn) s))))

test/naga/storage/test_memory.clj

@@ -1,5 +1,5 @@
 (ns naga.storage.test-memory
-  (:require [naga.storage.memory :refer :all]
+  (:require [naga.storage.memory.core :refer :all]
             [naga.store :refer :all]
             [clojure.test :refer :all]
             [schema.test :as st]))