{------------------------------------------------------------------------------------- - - The XQuery Interpreter - Programmer: Leonidas Fegaras - Email: fegaras@cse.uta.edu - Web: http://lambda.uta.edu/ - Creation: 03/22/08, last update: 05/02/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. - Any use is at your own risk. Permission is hereby granted to use or copy this program - for any purpose, provided the above notices are retained on all copies. - --------------------------------------------------------------------------------------} {-# OPTIONS_GHC -fth #-} module XQueryInterpreter where import List(sortBy) import XMLParse(parseDocument) import System.Console.Readline import XQueryParser import XTree import XQueryOptimizer import XQueryCompiler -- system functions (=, concat, etc) systemFunctions :: [(String,Int,[XSeq]->XSeq)] systemFunctions = $(iFunctions) -- XPath step functions (child, descendant, etc) pathFunctions :: [(String,Tag->XTree->XSeq)] pathFunctions = $(pFunctions) -- run-time bindings of FLOWR variables type Environment = [(String,XSeq)] -- a user-defined function is (fname,parameters,body) 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 -> Bool -> Environment -> Functions -> XSeq applyPredicates [] xs _ _ _ = xs applyPredicates ((Aint n):preds) xs _ env fncs -- shortcut that improves laziness = applyPredicates preds [xs !! (n-1)] True env fncs applyPredicates (pred:preds) xs True env fncs -- top-k like | maxPosition pathPosition pred > 0 = applyPredicates (pred:preds) (take (maxPosition pathPosition pred) xs) False env fncs applyPredicates (pred:preds) xs _ env fncs | 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 [XInt k] -> k == i -- indexing b -> conditionTest b then x:r else r) [] xs 1) True env fncs applyPredicates (pred:preds) xs _ env fncs = applyPredicates preds (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) True env fncs -- The XQuery interpreter -- 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 -> XTree -> Int -> Int -> String -> Environment -> Functions -> XSeq eval e context position last effective_axis env fncs = case e of 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,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 "descendant_any" (body:tags)):predicates) -> let ts = map (\(Avar tag) -> tag) tags in foldr (\x r -> (applyPredicates predicates (descendant_any_with_tagged_children ts x) True env fncs)++r) [] (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) True env fncs)++r) [] (eval body context position last effective_axis env fncs) Ast "step" [exp] -> eval exp context position last effective_axis env fncs Ast "step" (exp:predicates) -> applyPredicates predicates (eval exp context position last effective_axis env fncs) True env fncs Ast "predicate" [condition,body] -> applyPredicates [condition] (eval body context position last effective_axis env fncs) True 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 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 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 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 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 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 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 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 -> let p = maxPosition (Avar ivar) body ns = if p > 0 -- there is a top-k like restriction then Ast "step" [source,Ast "call" [Avar "<=",Ast "step" [pathPosition],Aint p]] else source in foldir (\a i r -> (eval body a i undefv3 "" ((var,[a]):(ivar,[XInt i]):env) fncs)++r) [] (eval ns 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 effective_axis env fncs))]) [XElem "" [] 0 (eval exp context position last effective_axis env fncs)] orderBys) ] Ast "sort" (exp:ordList) -- blocking -> let ce = map (\(XElem _ _ _ xs) -> map (\(XElem _ _ _ ys) -> ys) xs) (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 o -> o) (\xs ys -> EQ) ordList in concatMap head (sortBy (\(_:xs) (_:ys) -> ordering xs ys) ce) _ -> error ("Illegal XQuery: "++(show e)) -- evaluate from input continuously evalInput :: (String -> Environment -> Functions -> IO(Environment,Functions)) -> Environment -> Functions -> IO () evalInput eval vs fs = do let oneline prompt = do line <- readline prompt case line of Nothing -> return "quit" Just t -> if t == "" then oneline prompt else return t readlines x = do line <- oneline ": " if last line == '}' then return (x++" "++(init line)) else if line == "quit" then return line else readlines (x++" "++line) line <- oneline "> " stmt <- if head line == '{' then if last line == '}' then return (init (tail line)) else readlines (tail line) else return line if stmt == "quit" then putStrLn "Bye!" else do addHistory stmt (nvs,nfs) <- eval (map (\c -> if c=='\"' then '\'' else c) stmt) vs fs evalInput eval nvs nfs xqueryE :: String -> Environment -> Functions -> IO (XSeq,Environment,Functions) xqueryE query variables functions = let asts = parse (scan query) fncs = foldr (\e r -> case e of Ast "function" ((Avar f):b:args) -> (f,map (\(Avar v) -> v) args,optimize b):r _ -> r) functions asts vars = foldl (\r e -> case e of Ast "variable" [Avar v,u] -> (v,eval (optimize u) undefv1 undefv2 undefv3 "" r fncs):r _ -> r) variables asts exprp e = case e of Ast f _ | elem f ["function","variable"] -> True; _ -> False (ast,_,ns) = getDocs (concatenateAll (dropWhile exprp asts)) 0 in do 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) undefv1 undefv2 undefv3 "" (env++vars) fncs,vars,fncs) -- the XQuery interpreter xquery :: String -> IO XSeq xquery query = do (u,_,_) <- xqueryE query [] []; return u -- Read an XQuery fom a file and run it xfile :: String -> IO XSeq xfile file = do query <- readFile file xquery query