Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 3613104776
Fetching contributors…

Cannot retrieve contributors at this time

142 lines (107 sloc) 3.099 kb
(ns eu.dnetlib.dlms.parser
(:gen-class
:name eu.dnetlib.dlms.ClojureDQLParser
:implements [eu.dnetlib.dlms.jdbc.parser.IDQLParser]
)
(:use [eu.dnetlib.clojure.clarsec]
[eu.dnetlib.dlms.ast]
[eu.dnetlib.clojure.monad])
)
(declare instantiation invocation literal reference parameter)
(declare xpath)
(def expression
(delay (either
instantiation
invocation
literal
reference
parameter)))
(def stringLit
(>>== stringLiteral make-string-lit))
(def number
(>>== natural make-number-lit))
(def reference
(>>== identifier make-reference))
(def parameter
(>>== (>> (symb ":") baseIdentifier) make-parameter))
(def baseLabel
(either (stringify (m-sequence [baseIdentifier (string ":") baseIdentifier]))
baseIdentifier))
(def label (lexeme baseLabel))
(def structureDef
(let-bind [label label
_ (symb "=")
val expression]
(result (make-struct-def label val))))
(def structure
(>>== (brackets (sepBy structureDef comma))
make-struct))
(def collection
(delay
(>>== (braces (sepBy expression comma))
make-struct)))
(def literal
(either collection structure number stringLit))
(def argList
(delay (sepBy expression comma)))
(def instantiation
(let-bind [_ (symb "new")
set identifier
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))))
(defn decl [typ]
(let-bind [name identifier
_ (symb "=")
e expression]
(result (make-decl-init typ name e))))
(defn assign [name]
(let-bind [_ (symb "=")
e expression]
(result (make-assign name e))))
(def predecl
(let-bind [name identifier]
(either (decl name) (assign name))))
(def tagname (lexeme (either (symb ".")
(stringify (m-sequence [(optional (string "@")) baseLabel])))))
(def binaryPredicate
(delay
(let-bind [xp xpath
op (symb "=")
expr (either xpath (>>== expression make-xpath-expression))]
(result (make-binary-predicate op xp expr)))))
(def predicate (delay (either binaryPredicate (>>== xpath make-simple-predicate))))
(def tagexp
(delay
(let-bind [axis (optional (followedBy identifier (symb "::")))
tag tagname
pred (optional (brackets predicate))]
(result (make-tagexp axis tag pred)))))
(def xpath
(delay
(>>== (sepBy tagexp (symb "/"))
make-xpath)))
(def fieldList
(sepBy identifier comma))
(def select
(let-bind [_ (symb "select")
fields (option [] (parens fieldList))
xp xpath]
(result (make-select fields xp))))
(def statement
(either predecl
select
(>>== expression make-run-expr)))
(def body
(followedBy (sepBy1 statement semi) (optional semi)))
(def source
(followedBy body (lexeme eof)))
(defn -main []
(println (parse source "1")))
(defn -parse [this strn]
(:value (parse source strn)))
Jump to Line
Something went wrong with that request. Please try again.