HXQ 0.6 → 0.7
raw patch · 12 files changed
+185/−127 lines, 12 files
Files
- HXQ.cabal +4/−1
- Main.hs +18/−11
- Makefile +1/−1
- Test2.hs +1/−1
- XQueryCompiler.hs +74/−70
- XQueryInterpreter.hs +48/−34
- XQueryParser.hs +2/−2
- XQueryParser.y +2/−2
- compile +5/−0
- data/dblp.xq +8/−0
- data/q2.xq +8/−0
- index.html +14/−5
HXQ.cabal view
@@ -1,5 +1,5 @@ Name: HXQ-Version: 0.6+Version: 0.7 Description: A Compiler from XQuery to Haskell Synopsis: A Compiler from XQuery to Haskell Category: XML@@ -14,6 +14,8 @@ index.html data/cs.xml data/q1.xq+ data/q2.xq+ data/dblp.xq XQuery.hs XQueryParser.hs XQueryParser.y@@ -21,6 +23,7 @@ XQueryInterpreter.hs Test1.hs Test2.hs+ compile hxml-0.2/Arrow.hs hxml-0.2/LLParsing.hs hxml-0.2/XML.hs
Main.hs view
@@ -2,7 +2,7 @@ - - The main program of the XQuery interpreter - Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 03/30/2008+- Date: 04/12/2008 - ---------------------------------------------------------------} @@ -16,14 +16,21 @@ main = do env <- getArgs- putStrLn "HXQ: XQuery Interpreter version 0.6"- if (length env) == 1 && (head env) == "-help"+ putStrLn "HXQ: XQuery Interpreter version 0.7"+ if (length env) > 0 && (head env) == "-help" then putStrLn ("Functions: "++(foldr (\(f,_,_) r -> f++" "++r) "" functions))- else do result <- if (length env) == 1- then xfile (head env)- else do let readl x = do t <- getLine- if null t then return x else readl (x++" "++t)- putStrLn "Write an XQuery (finish the query with an empty line)"- query <- readl ""- xquery query- putStrLn (show result)+ else if (length env) > 1 && (head env) == "-c"+ then do query <- readFile (head (tail env))+ let qf = map (\c -> if c=='\"' then '\'' else c)+ (foldr1 (\a r -> a++" "++r) (lines query))+ let pr = "{-# OPTIONS_GHC -fth #-}\nmodule Main where\nimport XQuery\n\nmain = do res <- $(xq \""+ ++ qf ++ "\")\n putStrLn (show res)\n"+ writeFile "Temp.hs" pr+ else do result <- if (length env) == 1+ then xfile (head env)+ else do let readl x = do t <- getLine+ if null t then return x else readl (x++" "++t)+ putStrLn "Write an XQuery (finish the query with an empty line)"+ query <- readl ""+ xquery query+ putStrLn (show result)
Makefile view
@@ -24,4 +24,4 @@ runhaskell Setup.lhs sdist clean:- /bin/rm -f *~ *.o *.hi $(hxml)/*.o $(hxml)/*.hi XQueryParser.hs *.stat *.prof *.ps *.aux *.hp xquery test1 test2+ /bin/rm -f *~ *.o *.hi $(hxml)/*.o $(hxml)/*.hi XQueryParser.hs *.stat *.prof *.ps *.aux *.hp xquery test1 test2 Temp.hs a.out
Test2.hs view
@@ -17,7 +17,7 @@ f(x,y) = $(xe "<a>{$x,', ',$y}</a>") main = do a <- $(xq ("<result>{ "- ++" for $x at $i in doc('/home/fegaras/data/dblp.xml')//inproceedings "+ ++" for $x at $i in doc('data/dblp.xml')//inproceedings " ++" where $x/author = 'Leonidas Fegaras' " ++" order by $x/year descending " ++" return <paper>{ $i, ') ', $x/booktitle/text(), "
XQueryCompiler.hs view
@@ -4,7 +4,7 @@ - Programmer: Leonidas Fegaras - Email: fegaras@cse.uta.edu - Web: http://lambda.uta.edu/-- Creation: 02/15/08, last update: 03/30/08+- Creation: 02/15/08, last update: 04/10/08 - - Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved. - This material is provided as is, with absolutely no warranty expressed or implied.@@ -144,18 +144,6 @@ trueXT = XBool True -toString :: XSeq -> [String]-toString xs = foldr (\x r -> case x of- XElem _ _ _ [XText t] -> t:r- XElem _ _ _ [XInt n] -> (show n):r- XElem _ _ _ [XFloat n] -> (show n):r- XElem _ _ _ [XBool n] -> (show n):r- XText t -> t:r- XInt n -> (show n):r- XFloat n -> (show n):r- XBool n -> (show n):r- _ -> r) [] xs- readNum :: String -> Maybe XTree readNum cs = case span isDigit cs of (n,[]) -> Just (XInt (read n))@@ -164,22 +152,6 @@ _ -> Nothing _ -> Nothing -toNum :: XSeq -> XSeq-toNum xs = foldr (\x r -> case x of- XElem _ _ _ [XText s]- -> case readNum s of- Just t -> t:r- _ -> r- XElem _ _ _ [z@(XInt n)] -> z:r- XElem _ _ _ [z@(XFloat n)] -> z:r- XElem _ _ _ [z@(XBool n)] -> z:r- XInt n -> x:r- XFloat n -> x:r- XText s -> case readNum s of- Just t -> t:r- _ -> r- _ -> r) [] xs- text :: XSeq -> XSeq text xs = foldr (\x r -> case x of XElem _ _ _ [z@(XText _)] -> z:r@@ -192,12 +164,30 @@ XBool _ -> x:r _ -> r) [] xs +toString :: XSeq -> [String]+toString xs = map (\x -> case x of + XText t -> t+ XInt n -> show n+ XFloat n -> show n+ XBool n -> show n)+ (text xs)++toNum :: XSeq -> XSeq+toNum xs = foldr (\x r -> case x of+ XInt n -> x:r+ XFloat n -> x:r+ XText s -> case readNum s of+ Just t -> t:r+ _ -> r+ _ -> r) [] (text xs)+ toFloat :: XTree -> Float toFloat (XText s) = case readNum s of Just (XInt n) -> fromIntegral n Just (XFloat n) -> n toFloat (XInt n) = fromIntegral n toFloat (XFloat n) = n+toFloat x = error("Cannot convert to a float: "++(show x)) contains :: String -> String -> Bool contains xs ys | ((take (length ys) xs) == ys) = True@@ -315,13 +305,12 @@ ( "true", 0, \[] -> [| [trueXT] |] ), ( "false", 0, \[] -> [| [] |] ), ( "if", 3, \[cs,ts,es] -> [| if conditionTest $cs then $ts else $es |] ),- ( "element", 2, \[tags,xs] -> [| [ x | tag <- toString $tags, x <- $xs,- case x of XElem t _ _ _ -> t==tag || tag=="*"; _ -> False ] |] ),+ ( "element", 2, \[tags,xs] -> [| [ x | tag <- toString $tags, x@(XElem t _ _ _) <- $xs, (t==tag || tag=="*") ] |] ), ( "attribute", 2, \[tags,xs] -> [| [ z | tag <- toString $tags, x <- $xs, z <- attribute_step tag x ] |] ), ( "name", 1, \[xs] -> [| [ XText tag | XElem tag _ _ _ <- $xs ] |] ), ( "contains", 2, \[xs,text] -> [| [ trueXT | x <- toString $xs, t <- toString $text, contains x t ] |] ), ( "concatenate", 2, \[xs,ys] -> [| $xs ++ $ys |] ),- ( "concat", 2, \[xs,ys] -> [| [ XText ((showXS $xs)++(showXS $ys)) ] |] ),+ ( "concat", 2, \[xs,ys] -> [| [ XText (showXS ($xs ++ $ys)) ] |] ), ( "distinct-values", 1, \[xs] -> [| distinct $xs |] ), ( "union", 2, \[xs,ys] -> [| distinct ($xs ++ $ys) |] ), ( "intersect", 2, \[xs,ys] -> [| filter (\x -> elem x $ys) $xs |] ),@@ -361,7 +350,7 @@ in appE fn (tupE args) -{------------ Remove Backward Steps and Optimize ------------------------------------}+{------------ Preprocessing, Remove Backward Steps and Optimize ------------------------------------} -- collect attribute constructions inside element constructions@@ -445,7 +434,7 @@ else "attribute_step") [tag,Avar (var++"_parent")] ], replaceParentOfVar body var (var++"_parent")]])--- remove $var/.. in a for-FLWOR+-- remove $var/.. from a for-FLWOR optimize (Ast "for" [Avar var,Avar "$",source,body]) | parentOfVar body var = let (nx,cond,childp,tag) = removeParent source@@ -467,6 +456,11 @@ {------------ Compiler ---------------------------------------------------------------} +undef1 = [| error "Undefined XQuery context (.)" |]+undef2 = [| error "Undefined position()" |]+undef3 = [| error "Undefined last()" |]++ -- does the expression contain a last()? containsLast :: Ast -> Bool containsLast (Ast "step" [Ast "call" [Avar "last"]]) = True@@ -485,13 +479,13 @@ = compilePredicates preds [| let bl = $xs len = length bl- in foldir (\x i r -> if case $(compile pred [| [ x ] |] [| [XInt i] |] [| [XInt len] |]) of+ in foldir (\x i r -> if case $(compile pred [| x |] [| [XInt i] |] [| [XInt len] |] "") of [XInt k] -> k == i -- indexing b -> conditionTest b then x:r else r) [] bl 1 |] compilePredicates (pred:preds) xs = compilePredicates preds- [| foldir (\x i r -> if case $(compile pred [| [ x ] |] [| [XInt i] |] [| [] |]) of+ [| foldir (\x i r -> if case $(compile pred [| x |] [| [XInt i] |] undef3 "") of [XInt k] -> k == i -- indexing b -> conditionTest b then x:r else r) [] $xs 1 |]@@ -507,10 +501,12 @@ -- context: context node (XPath .) -- position: the element position in the parent sequence (XPath position()) -- last: the length of the parent sequence (XPath last())-compile :: Ast -> Q Exp -> Q Exp -> Q Exp -> Q Exp-compile e context position last+-- effective_axis: the XPath axis in /axis::tag(exp)+-- (eg, the effective axis of //(A | B) is "descendant_step"+compile :: Ast -> Q Exp -> Q Exp -> Q Exp -> String -> Q Exp+compile e context position last effective_axis = case e of- Avar "." -> context+ Avar "." -> [| [ $context :: XTree ] |] Avar v -> let x = varE (mkName v) in [| $x :: XSeq |] Aint n -> let x = litE (IntegerL (toInteger n))@@ -519,66 +515,70 @@ in [| [ XFloat $x ] |] Astring s -> let x = litE (StringL s) in [| [ XText $x ] |]- Ast "context" [v,body]- -> compile body (compile v context position last) position last+ Ast "context" [v,Astring dp,body]+ -> [| foldr (\x r -> $(compile body [| x |] position last dp)++r)+ [] $(compile v context position last effective_axis) |] Ast "doc" [Aint n] -> let d = varE (mkName ("_doc"++(show n))) in [| [ $d ] |] Ast "call" [Avar "position"] -> position Ast "call" [Avar "last"] -> last+ Ast "step" [Ast "child_step" [tag, Avar "."]]+ | effective_axis /= ""+ -> compile (Ast "step" [Ast effective_axis [tag, Avar "."]]) context position last "" Ast "step" [Ast path_step [Astring tag,body]] | memV path_step paths- -> let bc = compile body context position last+ -> let bc = compile body context position last effective_axis tc = litE (stringL tag) in [| foldr (\a s -> ($(findV path_step paths) $tc a)++s) [] $bc |] Ast "step" ((Ast path_step [Astring tag,body]):predicates) | memV path_step paths- -> let bc = compile body context position last+ -> let bc = compile body context position last effective_axis tc = litE (stringL tag) in [| foldr (\x r -> $(compilePredicates predicates [| $(findV path_step paths) $tc x |])++r) [] $bc |] Ast "step" [exp]- -> compile exp context position last+ -> compile exp context position last effective_axis Ast "step" (exp:predicates)- -> compilePredicates predicates (compile exp context position last)+ -> compilePredicates predicates (compile exp context position last effective_axis) Ast "predicate" [condition,body]- -> compilePredicates [condition] (compile body context position last)+ -> compilePredicates [condition] (compile body context position last effective_axis) Ast "call" ((Avar f):args)- -> callF f (map (\x -> compile x context position last) args)+ -> callF f (map (\x -> compile x context position last effective_axis) args) Ast "construction" [Astring tag,Ast "attributes" [],body] -> let ct = litE (StringL tag)- bc = compile body context position last+ bc = compile body context position last effective_axis in [| [ XElem $ct [] 0 $bc ] |] Ast "construction" [tag,Ast "attributes" al,body] -> let alc = foldr (\(Ast "pair" [a,v]) r- -> let ac = compile a context position last- vc = compile v context position last+ -> let ac = compile a context position last effective_axis+ vc = compile v context position last effective_axis in [| (qName $ac,showXS (text $vc)) : $r |]) [| [] |] al- ct = compile tag context position last- bc = compile body context position last+ ct = compile tag context position last effective_axis+ bc = compile body context position last effective_axis in [| [ XElem (qName $ct) $alc 0 $bc ] |] Ast "let" [Avar var,source,body]- -> do s <- compile source context position last- b <- compile body context position last+ -> do s <- compile source context position last effective_axis+ b <- compile body context position last effective_axis return (AppE (LamE [VarP (mkName var)] b) s) Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index- -> let b = compile body [| $(varE (mkName var)) |] [| [] |] [| [] |]- f = lamE [varP (mkName var)] [| \x -> $b ++ x |]- s = compile source context position last+ -> let b = compile body [| head $(varE (mkName var)) |] undef2 undef3 ""+ f = lamE [varP (mkName var)] [| \r -> $b ++ r |]+ s = compile source context position last effective_axis in [| foldr (\x -> $f [x]) [] $s |] Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index- -> let b = compile body [| $(varE (mkName var)) |]- [| $(varE (mkName ivar)) |] [| [] |]- f = lamE [varP (mkName var)] (lamE [varP (mkName ivar)] [| \x -> $b ++ x |])- s = compile source context position last+ -> let b = compile body [| head $(varE (mkName var)) |]+ [| $(varE (mkName ivar)) |] undef3 ""+ f = lamE [varP (mkName var)] (lamE [varP (mkName ivar)] [| \r -> $b ++ r |])+ s = compile source context position last effective_axis in [| foldir (\x i -> $f [x] [XInt i]) [] $s 1 |] Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting- -> let res = foldl (\r a -> let ac = compile a context position last+ -> let res = foldl (\r a -> let ac = compile a context position last effective_axis in [| $r++[text $ac] |] )- [| [ $(compile exp context position last) ] |] orderBys+ [| [ $(compile exp context position last effective_axis) ] |] orderBys in [| [ $res ] |] Ast "sort" (exp:ordList)- -> let ce = compile exp context position last+ -> let ce = compile exp context position last effective_axis ordering = foldr (\(Avar ord) r -> let asc = if ord == "ascending" then [| True |]@@ -601,15 +601,17 @@ -> (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- in (e:s,c2,n1++n2))+ in (e:s,c2,docUnion n1 n2)) (\c -> ([],c,[])) args count in (Ast n s,c,ns) _ -> (query,count,[])+ where docUnion xs ((n,s):ys) = (n,foldr(\(m,d) r -> if s==d then Aint m else r) s xs):(docUnion xs ys)+ docUnion xs [] = xs -- optimize and compile an AST compileAst :: Ast -> Q Exp-compileAst ast = compile (optimize ast) [| [] |] [| [] |] [| [] |]+compileAst ast = compile (optimize ast) undef1 undef2 undef3 "" -- compile an XQuery AST that reads XML documents@@ -626,10 +628,12 @@ compileQuery [query] = let (ast,_,ns) = getDocs query 0 code = compileAst ast- in foldr (\(n,file) r -> let d = lamE [varP (mkName ("_doc"++(show n)))] r- in [| do let [XText f] = $(compileAst file)- doc <- readFile f- $d (materialize (parseDocument doc)) |])+ in foldl (\r (n,file) -> let d = lamE [varP (mkName ("_doc"++(show n)))] r+ in case file of+ Aint m -> [| $d $(varE (mkName ("_doc"++(show m)))) |]+ _ -> [| do let [XText f] = $(compileAst file)+ doc <- readFile f+ $d (materialize (parseDocument doc)) |]) [| return $code |] ns
XQueryInterpreter.hs view
@@ -4,7 +4,7 @@ - Programmer: Leonidas Fegaras - Email: fegaras@cse.uta.edu - Web: http://lambda.uta.edu/-- Creation: 03/22/08, last update: 03/30/08+- Creation: 03/22/08, last update: 04/10/08 - - Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved. - This material is provided as is, with absolutely no warranty expressed or implied.@@ -39,6 +39,11 @@ type Functions = [(String,[String],Ast)] +undefv1 = error "Undefined XQuery context (.)"+undefv2 = error "Undefined position()"+undefv3 = error "Undefined last()"++ -- Each XPath predicate must calculate position() and last() from its input XSeq -- if last() is used, then the evaluation is blocking (need to store the whole input XSeq) applyPredicates :: [Ast] -> XSeq -> Environment -> Functions -> XSeq@@ -47,13 +52,13 @@ | containsLast pred -- blocking: use only when last() is used in the predicate = let last = length xs in applyPredicates preds- (foldir (\x i r -> if case eval pred [x] i last env fncs of+ (foldir (\x i r -> if case eval pred x i last "" env fncs of [XInt k] -> k == i -- indexing b -> conditionTest b then x:r else r) [] xs 1) env fncs applyPredicates (pred:preds) xs env fncs = applyPredicates preds- (foldir (\x i r -> if case eval pred [x] i 0 env fncs of+ (foldir (\x i r -> if case eval pred x i undefv3 "" env fncs of [XInt k] -> k == i -- indexing b -> conditionTest b then x:r else r) [] xs 1) env fncs@@ -63,70 +68,77 @@ -- context: context node (XPath .) -- position: the element position in the parent sequence (XPath position()) -- last: the length of the parent sequence (XPath last())+-- effective_axis: the XPath axis in /axis::tag(exp)+-- (eg, the effective axis of //(A | B) is "descendant_step" -- env: contains FLOWR variable bindings -- fncs: user-defined functions-eval :: Ast -> XSeq -> Int -> Int -> Environment -> Functions -> XSeq-eval e context position last env fncs+eval :: Ast -> XTree -> Int -> Int -> String -> Environment -> Functions -> XSeq+eval e context position last effective_axis env fncs = case e of- Avar "." -> context+ Avar "." -> [ context ] Avar v -> findV v env Aint n -> [ XInt n ] Afloat n -> [ XFloat n ] Astring s -> [ XText s ] Ast "doc" [Aint n] -> findV ("_doc"++(show n)) env- Ast "context" [v,body] -> context+ Ast "context" [v,Astring dp,body]+ -> foldr (\x r -> (eval body x position last dp env fncs)++r)+ [] (eval v context position last effective_axis env fncs) Ast "call" [Avar "position"] -> [XInt position] Ast "call" [Avar "last"] -> [XInt last]+ Ast "step" [Ast "child_step" [tag, Avar "."]]+ | effective_axis /= ""+ -> eval (Ast "step" [Ast effective_axis [tag, Avar "."]]) context position last "" env fncs Ast "step" [Ast path_step [Astring tag,body]] | memV path_step pathFunctions -> foldr (\x r -> ((findV path_step pathFunctions) tag x)++r)- [] (eval body context position last env fncs)+ [] (eval body context position last effective_axis env fncs) Ast "step" ((Ast path_step [Astring tag,body]):predicates) | memV path_step pathFunctions -> foldr (\x r -> (applyPredicates predicates ((findV path_step pathFunctions) tag x) env fncs)++r)- [] (eval body context position last env fncs)+ [] (eval body context position last effective_axis env fncs) Ast "step" [exp]- -> eval exp context position last env fncs+ -> eval exp context position last effective_axis env fncs Ast "step" (exp:predicates)- -> applyPredicates predicates (eval exp context position last env fncs) env fncs+ -> applyPredicates predicates (eval exp context position last effective_axis env fncs) env fncs Ast "predicate" [condition,body]- -> applyPredicates [condition] (eval body context position last env fncs) env fncs+ -> applyPredicates [condition] (eval body context position last effective_axis env fncs) env fncs Ast "call" ((Avar fname):args) -> case filter (\(n,_,_) -> n == fname || ("fn:"++n) == fname) systemFunctions of [(_,len,f)] -> if (length args) == len- then f (map (\x -> eval x context position last env fncs) args)+ then f (map (\x -> eval x context position last effective_axis env fncs) args) else error ("Wrong number of arguments in system call: "++fname) _ -> case filter (\(n,_,_) -> n == fname) fncs of [(_,params,body)] -> if (length params) == (length args)- then eval body context 0 0 - ((zipWith (\p a -> (p,eval a context position last env fncs))+ then eval body context undefv2 undefv3 ""+ ((zipWith (\p a -> (p,eval a context position last effective_axis env fncs)) params args)++env) fncs else error ("Wrong number of arguments in function call: "++fname) _ -> error ("Undefined function: "++fname) Ast "construction" [Astring tag,Ast "attributes" [],body]- -> [ XElem tag [] 0 (eval body context position last env fncs) ]+ -> [ XElem tag [] 0 (eval body context position last effective_axis env fncs) ] Ast "construction" [tag,Ast "attributes" al,body] -> let alc = map (\(Ast "pair" [a,v])- -> let ac = eval a context position last env fncs- vc = eval v context position last env fncs+ -> let ac = eval a context position last effective_axis env fncs+ vc = eval v context position last effective_axis env fncs in (qName ac,showXS (text vc))) al- ct = eval tag context position last env fncs- bc = eval body context position last env fncs+ ct = eval tag context position last effective_axis env fncs+ bc = eval body context position last effective_axis env fncs in [ XElem (qName ct) alc 0 bc ] Ast "let" [Avar var,source,body]- -> eval body context position last ((var,eval source context position last env fncs):env) fncs+ -> eval body context position last effective_axis ((var,eval source context position last effective_axis env fncs):env) fncs Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index- -> foldr (\a r -> (eval body [a] 0 0 ((var,[a]):env) fncs)++r)- [] (eval source context position last env fncs)+ -> foldr (\a r -> (eval body a undefv2 undefv3 "" ((var,[a]):env) fncs)++r)+ [] (eval source context position last effective_axis env fncs) Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index- -> foldir (\a i r -> (eval body [a] i 0 ((var,[a]):(ivar,[XInt i]):env) fncs)++r)- [] (eval source context position last env fncs) 1+ -> foldir (\a i r -> (eval body a i undefv3 "" ((var,[a]):(ivar,[XInt i]):env) fncs)++r)+ [] (eval source context position last effective_axis env fncs) 1 Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting- -> [ XElem "" [] 0 (foldl (\r a -> r++[XElem "" [] 0 (text (eval a context position last env fncs))])- [XElem "" [] 0 (eval exp context position last env fncs)] orderBys) ]+ -> [ XElem "" [] 0 (foldl (\r a -> r++[XElem "" [] 0 (text (eval a context position last effective_axis env fncs))])+ [XElem "" [] 0 (eval exp context position last effective_axis env fncs)] orderBys) ] Ast "sort" (exp:ordList) -> let ce = map (\(XElem _ _ _ xs) -> map (\(XElem _ _ _ ys) -> ys) xs)- (eval exp context position last env fncs)+ (eval exp context position last effective_axis env fncs) ordering = foldr (\(Avar ord) r (x:xs) (y:ys) -> case compareXSeqs (ord == "ascending") x y of EQ -> r xs ys@@ -144,18 +156,20 @@ Ast "function" ((Avar f):b:args) -> (f,map (\(Avar v) -> v) args,optimize b):r _ -> r) [] asts vars = foldl (\r e -> case e of- Ast "variable" [Avar v,u] -> (v,eval (optimize u) [] 0 0 r fncs):r+ Ast "variable" [Avar v,u] -> (v,eval (optimize u) undefv1 undefv2 undefv3 "" r fncs):r _ -> r) [] asts (ast,_,ns) = getDocs (last asts) 0- env <- foldr (\(n,Astring file) r -> do doc <- readFile file- env <- r- return (("_doc"++(show n),[materialize (parseDocument doc)]):env))+ env <- foldr (\(n,s) r -> case s of+ Astring file -> do doc <- readFile file+ env <- r+ return (("_doc"++(show n),[materialize (parseDocument doc)]):env)+ Aint m -> do env <- r+ return (("_doc"++(show n),findV ("_doc"++(show m)) env):env)) (return []) ns- return (eval (optimize ast) [] 0 0 (env++vars) fncs)+ return (eval (optimize ast) undefv1 undefv2 undefv3 "" (env++vars) fncs) -- Read an XQuery fom a file and run it xfile :: String -> IO XSeq xfile file = do query <- readFile file xquery query-
XQueryParser.hs view
@@ -5097,9 +5097,9 @@ happy_x_1 = case happyOut8 happy_x_2 of { happy_var_2 -> happyIn26- (\_ e -> if e == Avar "."+ (\t e -> if e == Avar "." then concatenateAll happy_var_2- else Ast "context" [e,concatenateAll happy_var_2]+ else Ast "context" [e,Astring t,concatenateAll happy_var_2] )} happyReduce_113 = happySpecReduce_2 26# happyReduction_113
XQueryParser.y view
@@ -259,9 +259,9 @@ primary_expr : var { \_ _ -> $1 } | '.' { \_ e -> e }- | '(' expl ')' { \_ e -> if e == Avar "."+ | '(' expl ')' { \t e -> if e == Avar "." then concatenateAll $2- else Ast "context" [e,concatenateAll $2] }+ else Ast "context" [e,Astring t,concatenateAll $2] } | '(' ')' { \_ _ -> call "empty" [] } | 'QName' '(' expl ')' { \_ e -> if e == Avar "." then call $1 $3
+ compile view
@@ -0,0 +1,5 @@+#!/bin/sh++./xquery -c $1+if [$2 == ""]; then file="a.out"; else file=$2; fi+ghc -O2 -ihxml-0.2 --make Temp.hs -o $file
+ data/dblp.xq view
@@ -0,0 +1,8 @@+<result>{+ for $x at $i in doc('data/dblp.xml')//inproceedings+ where $x/author = 'Leonidas Fegaras'+ order by $x/year descending+ return <paper>{ $i, ') ', $x/booktitle/text(),+ ': ', $x/title/text()+ }</paper>+ }</result>
+ data/q2.xq view
@@ -0,0 +1,8 @@+<result>{+let $a := distinct-values(doc("data/cs.xml")//gradstudent)+for $s in $a order by $s//firstname+return <st>{+ doc("data/cs.xml")//gradstudent[.//lastname = $s//lastname]//name,+ count(.//*)+ }</st>+}</result>
index.html view
@@ -17,10 +17,12 @@ 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.-+<p> For example, the XQuery given at the bottom of this page, which is against the <a href="http://dblp.uni-trier.de/xml/">DBLP XML-database</a> (420MB), runs in 39 seconds on my laptop.+database</a> (420MB), runs in 39 seconds on my laptop (using 64MB of heap space).+To contrast this, <a href="http://www.gnu.org/software/qexo/">Qexo</a>, which+compiles XQueries to Java bytecode, took 1 minute 17 seconds (using 2048MB of heap space). <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.@@ -37,7 +39,7 @@ <pre> yum install ghc happy </pre>-Then download <a href="/HXQ-0.6.tar.gz">HXQ</a> and untar it.+Then download <a href="/HXQ-0.7.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>@@ -73,7 +75,7 @@ f(x,y) = $(xe "<article><first>{$x}</first><second>{$y}</second></article>") main = do a <- $(xq ("<result>{ "- ++" for $x in doc('data/dblp.xml')//inproceedings at $i "+ ++" for $x at $i in doc('data/dblp.xml')//inproceedings " ++" where $x/author = 'Leonidas Fegaras' " ++" order by $x/year descending " ++" return <paper>{ $i, ') ', $x/booktitle/text(), "@@ -86,6 +88,13 @@ </pre> Another example, can be found in <a href="Test1.hs">Test1.hs</a>. <p>+You can compile an XQuery file into a Haskell program (<tt>Temp.hs</tt>) using <tt>xquery -c file</tt>. Or better, you+can use the Unix shell script <tt>compile</tt> to compile the XQuery file to an executable. For example:+<pre>+compile data/q1.xq+</pre>+will compile the XQuery file <tt>data/q1.xq</tt> into <tt>a.out</tt>.+<p> <h2>Using the Interpreter</h2> <p> The HXQ interpreter is far more slower than the compiler; use it only if you need to evaluate ad-hoc XQueries read from input or from files.@@ -114,4 +123,4 @@ <p> <hr> <p>-<address>Last modified: 03/30/08 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>+<address>Last modified: 04/11/08 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>