forked from threatgrid/naga
-
Notifications
You must be signed in to change notification settings - Fork 2
/
pabu.cljc
157 lines (132 loc) · 4.74 KB
/
pabu.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
(ns naga.lang.pabu
"Implements Pabu, which is a Prolog-like language for Naga. Parses code and returns Naga rules."
(:require [naga.schema.store-structs :refer [Axiom Triple EPVPattern Pattern FilterPattern]]
[naga.schema.structs :as structs :refer #?(:clj [Program]
:cljs [Program Rule])]
[naga.lang.parser :as parser]
[naga.rules :as r]
[naga.util :as u]
[clojure.string :as str]
#?(:clj [schema.core :as s]
:cljs [schema.core :as s :include-macros true]))
#?(:clj (: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")]})
(s/defn triplets :- [Triple]
"Converts raw parsed predicate information into a seq of triples"
[[property [s o :as args]]]
(case (count args)
0 [[s :rdf/type :owl/thing]]
1 [[s :rdf/type property]]
2 [[s property o]]
(throw (ex-info "Multi-arity predicates not yet supported" {:args args}))))
(s/defn triplet :- Triple
"Converts raw parsed predicate information into a single triple"
[raw]
(first (triplets raw)))
(def property-namespaces
"Set of namespaces that refer to data properties and never to functions"
#{"naga" "rdf" "rdfs" "owl"})
(s/defn not-data-property?
[k]
(not (property-namespaces (namespace k))))
(defn structure
"Converts the AST for a structure into either a seq of triplets or predicates.
Types are intentionally loose, since it's either a pair or a list."
[ast-data]
(if (vector? ast-data)
(let [[p args] ast-data]
(if-let [f (and (keyword? p) (not-data-property? p) (u/get-fn-reference p))]
[(with-meta (cons f args) (meta args))]
(triplets ast-data)))
;; a filter predicate. Wrap in extra vector for syntax purposes
[[ast-data]]))
(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 PatternPredicate [(s/one VK "property")
(s/one Args "arguments")])
(def ExpressionPredicate (s/pred list?))
(def Predicate (s/cond-pre ExpressionPredicate PatternPredicate))
(def RuleAST
{:type (s/eq :rule)
:head [[(s/one VK "property")
(s/one Args "arguments")]]
:body [Predicate]})
(s/defn ast->rule :- Rule
"Converts the rule structure returned from the parser"
[{:keys [head body] :as rule-ast} :- RuleAST]
(r/rule (map triplet head)
(mapcat structure body)
(-> head ffirst 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)}))
#?(:clj
(s/defn read-stream :- Program
"Reads a input stream"
[in :- InputStream]
(let [text (slurp in)]
(read-str text))))
;;;; output
(def builtins
{= "="
not= "!="
< "<"
> ">"
>= ">="
<= "<="})
(def builtin-labels (set (vals builtins)))
(defn ps
[e]
(letfn [(pabu-var [e] (str (str/upper-case (second e)) (subs e 2)))]
(cond
(symbol? e) (let [n (name e)]
(if (= \? (first n)) (pabu-var n) n))
(keyword? e) (subs (str e) 1)
:default (if-let [l (builtins e)] l e))))
(s/defn predicate->string :- s/Str
[epv :- EPVPattern]
(let [[e p v] (map ps epv)]
(case (count epv)
1 e
2 (str p "(" e ")")
3 (if (= :rdf/type p) (str v "(" e ")") (str p "(" e ", " v ")")))))
(s/defn filter->string :- s/Str
[[p] :- FilterPattern]
(let [args (map ps p)]
(if (builtin-labels (first args))
(let [[op l r] args]
(str l " " op " " r))
(str "(" (str/join " " args) ")"))))
(s/defn pattern->string :- s/Str
[p :- Pattern]
(if (vector? p)
(if (list? (first p))
(filter->string p)
(predicate->string p))
(throw (ex-info "Unknown structure type" {:pattern p}))))
(s/defn rule->str :- s/Str
"Creates a textual representation for the rule"
([rule :- Rule] (rule->str rule false))
([{:keys [head body name] :as rule} :- Rule, include-name? :- s/Bool]
(let [main (str (str/join ", " (map predicate->string head))
" :- "
(str/join ", " (map pattern->string body))
".")]
(if include-name? (str main " /* " name " */") main))))