diff --git a/HXQ.cabal b/HXQ.cabal --- a/HXQ.cabal +++ b/HXQ.cabal @@ -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 diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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) diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -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 diff --git a/Test2.hs b/Test2.hs --- a/Test2.hs +++ b/Test2.hs @@ -17,7 +17,7 @@ f(x,y) = $(xe "{$x,', ',$y}") main = do a <- $(xq ("{ " - ++" 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 { $i, ') ', $x/booktitle/text(), " diff --git a/XQueryCompiler.hs b/XQueryCompiler.hs --- a/XQueryCompiler.hs +++ b/XQueryCompiler.hs @@ -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 diff --git a/XQueryInterpreter.hs b/XQueryInterpreter.hs --- a/XQueryInterpreter.hs +++ b/XQueryInterpreter.hs @@ -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 - diff --git a/XQueryParser.hs b/XQueryParser.hs --- a/XQueryParser.hs +++ b/XQueryParser.hs @@ -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 diff --git a/XQueryParser.y b/XQueryParser.y --- a/XQueryParser.y +++ b/XQueryParser.y @@ -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 diff --git a/compile b/compile new file mode 100644 --- /dev/null +++ b/compile @@ -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 diff --git a/data/dblp.xq b/data/dblp.xq new file mode 100644 --- /dev/null +++ b/data/dblp.xq @@ -0,0 +1,8 @@ +{ + for $x at $i in doc('data/dblp.xml')//inproceedings + where $x/author = 'Leonidas Fegaras' + order by $x/year descending + return { $i, ') ', $x/booktitle/text(), + ': ', $x/title/text() + } + } diff --git a/data/q2.xq b/data/q2.xq new file mode 100644 --- /dev/null +++ b/data/q2.xq @@ -0,0 +1,8 @@ +{ +let $a := distinct-values(doc("data/cs.xml")//gradstudent) +for $s in $a order by $s//firstname +return { + doc("data/cs.xml")//gradstudent[.//lastname = $s//lastname]//name, + count(.//*) + } +} diff --git a/index.html b/index.html --- a/index.html +++ b/index.html @@ -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. - +

For example, the XQuery given at the bottom of this page, which is against the DBLP XML -database (420MB), runs in 39 seconds on my laptop. +database (420MB), runs in 39 seconds on my laptop (using 64MB of heap space). +To contrast this, Qexo, which +compiles XQueries to Java bytecode, took 1 minute 17 seconds (using 2048MB of heap space).

HXQ uses the HXML parser for XML (developed by Joe English), which is included in the source. @@ -37,7 +39,7 @@ 

 yum install ghc happy
-Then download HXQ and untar it. +Then download HXQ and untar it. You can either use cabal or make to build it. Then run xquery to test drive it.

Current Status

@@ -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 @@ Another example, can be found in Test1.hs.

+You can compile an XQuery file into a Haskell program (Temp.hs) using xquery -c file. Or better, you +can use the Unix shell script compile to compile the XQuery file to an executable. For example: +

+compile data/q1.xq
+
+will compile the XQuery file data/q1.xq into a.out. +

Using the Interpreter

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 @@

-

Last modified: 03/30/08 by Leonidas Fegaras
+
Last modified: 04/11/08 by Leonidas Fegaras