Permalink
Browse files

implement most DQL

  • Loading branch information...
1 parent d26aa3c commit 52c70df9364754d9e4643598e82aecd7ad7b55e8 @mmikulicic committed Jan 4, 2010
Showing with 65 additions and 3 deletions.
  1. +22 −1 src/ast.clj
  2. +3 −0 src/clarsec.clj
  3. +40 −2 src/doroty.clj
View
@@ -13,4 +13,25 @@
{:type 'StructDef :label l :value v})
(defn make-instantiation [set args]
- {:type 'Inst :set set :args args})
+ {:type 'Inst :set set :args args})
+
+(defn make-call [target method args]
+ {:type 'Call :target target :method method :args args})
+
+(defn make-select [fields xp]
+ {:type 'Select :fields fields :xpath xp})
+
+(defn make-xpath [comps]
+ {:type 'XPath :components comps})
+
+(defn make-tagexp [axis tag pred]
+ {:type 'XPathComponent :axis axis :tag tag :pred pred})
+
+(defn make-simple-predicate [xp]
+ {:type 'SimplePredicate :xpath xp})
+
+(defn make-binary-predicate [op xp expr]
+ {:type 'BinaryPredicate :op op :xpath xp :expression expr})
+
+(defn make-xpath-expression [ex]
+ {:type 'XPathPredicate :expression ex})
View
@@ -95,6 +95,9 @@
(defn optional [p]
(<|> p (result nil)))
+(defn option [default p]
+ (<|> p (result default)))
+
;(defn string [strn]
; (let-bind [x (m-sequence (map is-char strn))]
; (result (apply str x))))
View
@@ -36,15 +36,53 @@
args (parens argList)]
(result (make-instantiation set args))))
+(def invocation
+ (let-bind [target identifier
+ _ (string ".")
+ method identifier
+ args (parens argList)]
+ (result (make-call target method args))))
+
(def predecl
(string "undef"))
+(def tagname (either (symb ".")
+ (let-bind [attr (option "" (string "@"))
+ name (either identifier (symb "*"))]
+ (result (str attr name)))))
+
+(def binaryPredicate
+ (let-bind [xp xpath
+ op (symb "=")
+ expr (either (>>== expression make-xpath-expression) xpath)]
+ (result (make-binary-predicate op xp expr))))
+
+(def predicate (either binaryPredicate (>>== xpath make-simple-predicate)))
+
+(def tagexp
+ (let-bind [axis (optional (followedBy identifier (symb "::")))
+ tag tagname
+ pred (optional (brackets predicate))]
+ (result (make-tagexp axis tag pred))))
+
+(def xpath
+ (>>== (sepBy tagexp (string "/"))
+ make-xpath)
+)
+
+(def fieldList
+ (sepBy identifier comma))
+
(def select
- (string "ugo"))
+ (let-bind [_ (symb "select")
+ fields (option [] (parens fieldList))
+ xp xpath]
+ (result (make-select fields xp))))
+
(def expression
- (either instantiation literal))
+ (either instantiation invocation literal))
(def statement

0 comments on commit 52c70df

Please sign in to comment.