HXQ 0.2 → 0.3
raw patch · 6 files changed
+91/−24 lines, 6 files
Files
- HXQ.cabal +1/−1
- Main.hs +5/−0
- XQuery.hs +76/−16
- XQueryParser.hs +3/−2
- XQueryParser.y +3/−2
- index.html +3/−3
HXQ.cabal view
@@ -1,5 +1,5 @@ Name: HXQ-Version: 0.2+Version: 0.3 Description: A Compiler from XQuery to Haskell Synopsis: A Compiler from XQuery to Haskell Category: XML
Main.hs view
@@ -29,3 +29,8 @@ ++" return f($d//deptname,$s) " ++" }</good-students> ")) putStrLn (show c)+ let q file = $(xq (" let $d := doc($file)//gradstudent "+ ++" return ($d/../deptname,count($d)) "))+ d <- q $(xe "'data/cs.xml'")+ putStrLn (show d)+
XQuery.hs view
@@ -27,7 +27,6 @@ import Language.Haskell.TH import XQueryParser - {--------------- XML Trees (rose trees) ----------------------------------------------} type Stream = [XMLEvent]@@ -209,6 +208,8 @@ type Function = [Q Exp] -> Q Exp +-- System functions: they can also be defined as Haskell functions of type (XSeq,...,XSeq) -> XSeq+-- but here we make sure they are unfolded and fused with the rest of the query functions :: [(Tag,Int,Function)] functions = [ ( "=", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, x == y ] |] ), ( "==", 2, \[xs,ys] -> [| [ trueXT | x <- $xs, y <- $ys, x == y ] |] ),@@ -269,18 +270,77 @@ in appE fn (tupE args) -{------------ Optimizer --------------------------------------------------------------}+{------------ Remove Backward Steps and Optimize ------------------------------------} --- get rid of backward steps+-- does the expression contain a $var/.. ?+parentOfVar :: Ast -> String -> Bool+parentOfVar (Ast "call" [Avar "parent",Avar x]) var = x == var+parentOfVar (Ast "let" [Avar v,s,_]) var | var == v = parentOfVar s var+parentOfVar (Ast "for" [Avar v,Avar i,s,_]) var | var == v || var == i = parentOfVar s var+parentOfVar (Ast _ args) var = or (map (\x -> parentOfVar x var) args)+parentOfVar _ _ = False+++-- replace $var/.. with $nvar+replaceParentOfVar :: Ast -> String -> String -> Ast+replaceParentOfVar (Ast "call" [Avar "parent",Avar x]) var nvar | x == var = Avar nvar+replaceParentOfVar (Ast "let" [Avar v,s,b]) var nvar | var == v+ = Ast "let" [Avar v,replaceParentOfVar s var nvar,b]+replaceParentOfVar (Ast "for" [Avar v,Avar i,s,b]) var nvar | var == v || var == i+ = Ast "for" [Avar v,Avar i,replaceParentOfVar s var nvar,b]+replaceParentOfVar (Ast f args) var nvar = Ast f (map (\x -> replaceParentOfVar x var nvar) args)+replaceParentOfVar e _ _ = e+++-- Rules to extract the parent of an XQuery expression+-- For every XQuery x and predicates p1 ... pn and for s in [tag,*,@attr]:+-- x/s[p1]...[pn]/.. -> x[s[p1]...[pn]]+-- x//s[p1]...[pn]/.. -> x//*[s[p1]...[pn]]+removeParent :: Ast -> (Ast,Ast,Bool,Ast)+removeParent (Ast "predicate" [c,x])+ = let (nx,cond,childp,tag) = removeParent x+ in (Ast "predicate" [c,nx],cond,childp,tag)+removeParent (Ast "call" [Avar "child",tag,x])+ = (Ast "call" [Avar "child",tag,Avar "."],x,True,tag)+removeParent (Ast "call" [Avar "descendant",tag,x])+ = (Ast "call" [Avar "child",tag,Avar "."],+ Ast "call" [Avar "descendant",Astring "*",x],True,tag)+removeParent (Ast "call" [Avar "attribute",tag,x])+ = (Ast "call" [Avar "attribute",tag,Avar "."],x,False,tag)+removeParent (Ast "call" [Avar "descendant_attribute",tag,x])+ = (Ast "call" [Avar "attribute",tag,Avar "."],+ Ast "call" [Avar "descendant",Astring "*",x],False,tag)+removeParent e = error ("Cannot remove this parent step "++(show e))++ optimize :: Ast -> Ast--- rule: x/tag/.. -> x[tag]-optimize (Ast "call" [Avar "parent",Ast "call" [Avar "child",tag,x]])- = Ast "predicate" [Ast "call" [Avar "child",tag,Avar "."],optimize x]--- rule: x//tag/.. -> x//*[tag]-optimize (Ast "call" [Avar "parent",Ast "call" [Avar "descendant",tag,x]])- = Ast "predicate" [Ast "call" [Avar "child",tag,Avar "."],- Ast "call" [Avar "descendant",Astring "*",optimize x]]+-- must be done bottom-up: /../..+optimize (Ast "call" [Avar "parent",Ast "call" [Avar "parent",x]])+ = let nx = optimize (Ast "call" [Avar "parent",x])+ in optimize (Ast "call" [Avar "parent",nx])+-- get rid of a parent step+optimize (Ast "call" [Avar "parent",x])+ = let (nx,cond,_,_) = removeParent x+ in Ast "predicate" [optimize nx,optimize cond]+-- remove $var/.. in a let-FLWOR+optimize (Ast "let" [Avar var,source,body])+ | parentOfVar body var+ = let (nx,cond,childp,tag) = removeParent source+ in optimize (Ast "let" [Avar (var++"_parent"),Ast "predicate" [nx,cond],+ Ast "let" [Avar var,+ Ast "call" [if childp then Avar "child" else Avar "attribute",+ tag,Avar (var++"_parent")],+ replaceParentOfVar body var (var++"_parent")]])+-- remove $var/.. in a for-FLWOR+optimize (Ast "for" [Avar var,Avar ivar,source,body])+ | parentOfVar body var+ = let (nx,cond,childp,tag) = removeParent source+ in optimize (Ast "for" [Avar (var++"_parent"),Avar "$",Ast "predicate" [nx,cond],+ Ast "for" [Avar var,Avar ivar,+ Ast "call" [if childp then Avar "child" else Avar "attribute",+ tag,Avar (var++"_parent")],+ replaceParentOfVar body var (var++"_parent")]]) -- needs more rules optimize (Ast n args) = Ast n (map optimize args) optimize e = e@@ -300,7 +360,7 @@ -- Compile the AST e into Haskell code -- context: context node -- index: the element position in the parent sequence (=position())--- seqSize: the seqSize of the parent sequence (=last())+-- seqSize: the length of the parent sequence (=last()) compile :: Ast -> Q Exp -> Q Exp -> Q Exp -> Q Exp compile e context index seqSize = case e of@@ -387,10 +447,10 @@ -- collect all input documents and assign them a unique number-getDocs :: Ast -> Int -> (Ast, Int, [(Int, String)])+getDocs :: Ast -> Int -> (Ast, Int, [(Int, Ast)]) getDocs query count = case query of- Ast "call" [Avar "doc",Astring file]+ Ast "call" [Avar "doc",file] -> (Ast "doc" [Aint count], count+1, [(count,file)]) Ast n args -> let (s,c,ns) = foldr (\a r c -> let (e,c1,n1) = getDocs a c (s,c2,n2) = r c1@@ -406,9 +466,9 @@ = let (ast,_,ns) = getDocs query 0 code = compile (optimize ast) context [| [] |] [| [] |] in foldr (\(n,file) r -> let d = lamE [varP (mkName ("_doc"++(show n)))] r- in [| do doc <- readFile $(litE (StringL file))- let x = materialize (parseDocument doc)- $d x+ in [| do let [XText f] = $(compile (optimize file) context [| [] |] [| [] |])+ doc <- readFile f+ $d (materialize (parseDocument doc)) |]) [| return $code |] ns
XQueryParser.hs view
@@ -3652,8 +3652,9 @@ | isSpace c = lexer cs n | isAlpha c = lexVar (c:cs) n | isDigit c = lexNum (c:cs) n-lexer ('$':cs) n = let (var,rest) = span isVar cs- in (Variable var) : lexer rest n+lexer ('$':c:cs) n | isAlpha c+ = let (var,rest) = span isVar (c:cs)+ in (Variable var) : lexer rest n lexer ('\'':'{':cs) n = LESCAPE : lexer cs n lexer (':':'=':cs) n = ASSIGN : lexer cs n lexer ('<':'/':cs) n = STAG : lexer cs n
XQueryParser.y view
@@ -307,8 +307,9 @@ | isSpace c = lexer cs n | isAlpha c = lexVar (c:cs) n | isDigit c = lexNum (c:cs) n-lexer ('$':cs) n = let (var,rest) = span isVar cs- in (Variable var) : lexer rest n+lexer ('$':c:cs) n | isAlpha c+ = let (var,rest) = span isVar (c:cs)+ in (Variable var) : lexer rest n lexer ('\'':'{':cs) n = LESCAPE : lexer cs n lexer (':':'=':cs) n = ASSIGN : lexer cs n lexer ('<':'/':cs) n = STAG : lexer cs n
index.html view
@@ -16,7 +16,7 @@ any stream-based implementation based on SAX filters or finite state machines. Furthermore, the coding is far simpler and extensible since its based on XML trees, rather-than SAX events (both the code generator and the the XQuery parser are about 400 lines each).+than SAX events. For example, the XQuery below against the <a href="http://dblp.uni-trier.de/xml/">DBLP XML database</a> (420MB) runs in 1.5 minutes on my laptop. My high-performance Java implementation of XQuery, called <a href="/XQPull/">XQPull</a>,@@ -24,7 +24,7 @@ <p> HXQ uses the <a href="http://www.flightlab.com/~joe/hxml/">HXML parser for XML</a> (developed by Joe English), which is included in the source.-I have also tried hexpat, but I found it too slow for large documents (too many space leaks).+I have also tried hexpat, but I found it too slow for large documents. I haven't tried HaXML. <p> <h2>Installation Instructions</h2>@@ -37,7 +37,7 @@ <pre> yum install ghc happy </pre>-Then download <a href="/HXQ-0.2.tar.gz">HXQ</a> and untar it.+Then download <a href="/HXQ-0.3.tar.gz">HXQ</a> and untar it. You can either use cabal or make to build it. Then run xquery to test drive it. <p> <h2>Current Status</h2>