{-------------------------------------------------------------------------------------
-
- The XQuery Interpreter
- Programmer: Leonidas Fegaras
- Email: fegaras@cse.uta.edu
- Web: http://lambda.uta.edu/- Creation: 03/22/08, last update: 06/21/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 -fglasgow-exts #-}moduleXML.HXQ.InterpreterwhereimportControl.MonadimportList(sortBy)importXMLParse(parseDocument)importSystem.Console.ReadlineimportXML.HXQ.ParserimportXML.HXQ.XTreeimportXML.HXQ.OptimizerimportXML.HXQ.CompilerimportDatabase.HDBCimportXML.HXQ.DBimportXML.HXQ.DBConnect-- 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 variablestypeEnvironment=[(String,XSeq)]-- a user-defined function is (fname,parameters,body)typeFunctions=[(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->XSeqapplyPredicates[]xs___=xsapplyPredicates((Aintn):preds)xs_envfncs-- shortcut that improves laziness=applyPredicatespreds[xs!!(n-1)]TrueenvfncsapplyPredicates(pred:preds)xsTrueenvfncs-- top-k like|maxPositionpathPositionpred>0=applyPredicates(pred:preds)(take(maxPositionpathPositionpred)xs)FalseenvfncsapplyPredicates(pred:preds)xs_envfncs|containsLastpred-- blocking: use only when last() is used in the predicate=letlast=lengthxsinapplyPredicatespreds(foldir(\xir->caseevalpredxilast""envfncsof[XIntk]->ifk==ithenx:relser-- indexingb->ifconditionTestbthenx:relser)[]xs1)TrueenvfncsapplyPredicates(pred:preds)xs_envfncs=applyPredicatespreds(foldir(\xir->caseevalpredxiundefv3""envfncsof[XIntk]->ifk==ithenx:relser-- indexingb->ifconditionTestbthenx:relser)[]xs1)Trueenvfncs-- 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 functionseval::Ast->XTree->Int->Int->String->Environment->Functions->XSeqevalecontextpositionlasteffective_axisenvfncs=caseeofAvar"."->[context]Avarv->findVvenvAintn->[XIntn]Afloatn->[XFloatn]Astrings->[XTexts]Ast"context"[v,Astringdp,body]->foldr(\xr->(evalbodyxpositionlastdpenvfncs)++r)[](evalvcontextpositionlasteffective_axisenvfncs)Ast"call"[Avar"position"]->[XIntposition]Ast"call"[Avar"last"]->[XIntlast]Ast"child_step"[tag,Avar"."]|effective_axis/=""->eval(Asteffective_axis[tag,Avar"."])contextpositionlast""envfncsAst"step"((Ast"descendant_any"(body:tags)):predicates)->letts=map(\(Avartag)->tag)tagsinfoldr(\xr->(applyPredicatespredicates(descendant_any_with_tagged_childrentsx)Trueenvfncs)++r)[](evalbodycontextpositionlasteffective_axisenvfncs)Ast"step"((Astpath_step[Astringtag,body]):predicates)|memVpath_steppathFunctions->foldr(\xr->(applyPredicatespredicates((findVpath_steppathFunctions)tagx)Trueenvfncs)++r)[](evalbodycontextpositionlasteffective_axisenvfncs)Ast"descendant_any"(body:tags)->letts=map(\(Avartag)->tag)tagsinfoldr(\xr->(descendant_any_with_tagged_childrentsx)++r)[](evalbodycontextpositionlasteffective_axisenvfncs)Astpath_step[Astringtag,body]|memVpath_steppathFunctions->foldr(\xr->((findVpath_steppathFunctions)tagx)++r)[](evalbodycontextpositionlasteffective_axisenvfncs)Ast"step"(exp:predicates)->applyPredicatespredicates(evalexpcontextpositionlasteffective_axisenvfncs)TrueenvfncsAst"predicate"[condition,body]->applyPredicates[condition](evalbodycontextpositionlasteffective_axisenvfncs)TrueenvfncsAst"append"args->appendText(map(\x->evalxcontextpositionlasteffective_axisenvfncs)args)Ast"call"((Avarfname):args)->casefilter(\(n,_,_)->n==fname||("fn:"++n)==fname)systemFunctionsof[(_,len,f)]->if(lengthargs)==lenthenf(map(\x->evalxcontextpositionlasteffective_axisenvfncs)args)elseerror("Wrong number of arguments in system call: "++fname)_->casefilter(\(n,_,_)->n==fname)fncsof(_,params,body):_->if(lengthparams)==(lengthargs)thenevalbodycontextundefv2undefv3""((zipWith(\pa->(p,evalacontextpositionlasteffective_axisenvfncs))paramsargs)++env)fncselseerror("Wrong number of arguments in function call: "++fname)_->error("Undefined function: "++fname)Ast"construction"[Astringtag,Ast"attributes"[],body]->[XElemtag[]0parent_error(evalbodycontextpositionlasteffective_axisenvfncs)]Ast"construction"[tag,Ast"attributes"al,body]->letalc=map(\(Ast"pair"[a,v])->letac=evalacontextpositionlasteffective_axisenvfncsvc=evalvcontextpositionlasteffective_axisenvfncsin(qNameac,showXSvc))alct=evaltagcontextpositionlasteffective_axisenvfncsbc=evalbodycontextpositionlasteffective_axisenvfncsin[XElem(qNamect)alc0parent_errorbc]Ast"let"[Avarvar,source,body]->evalbodycontextpositionlasteffective_axis((var,evalsourcecontextpositionlasteffective_axisenvfncs):env)fncsAst"for"[Avarvar,Avar"$",source,body]-- a for-loop without an index->foldr(\ar->(evalbodyaundefv2undefv3""((var,[a]):env)fncs)++r)[](evalsourcecontextpositionlasteffective_axisenvfncs)Ast"for"[Avarvar,Avarivar,source,body]-- a for-loop with an index->letp=maxPosition(Avarivar)bodyns=ifp>0-- there is a top-k like restrictionthenAst"step"[source,Ast"call"[Avar"<=",pathPosition,Aintp]]elsesourceinfoldir(\air->(evalbodyaiundefv3""((var,[a]):(ivar,[XInti]):env)fncs)++r)[](evalnscontextpositionlasteffective_axisenvfncs)1Ast"sortTuple"(exp:orderBys)-- prepare each FLWOR tuple for sorting->[XElem""[]0parent_error(foldl(\ra->r++[XElem""[]0parent_error(text(evalacontextpositionlasteffective_axisenvfncs))])[XElem""[]0parent_error(evalexpcontextpositionlasteffective_axisenvfncs)]orderBys)]Ast"sort"(exp:ordList)-- blocking->letce=map(\(XElem____xs)->map(\(XElem____ys)->ys)xs)(evalexpcontextpositionlasteffective_axisenvfncs)ordering=foldr(\(Avarord)r(x:xs)(y:ys)->casecompareXSeqs(ord=="ascending")xyofEQ->rxsyso->o)(\xsys->EQ)ordListinconcatMaphead(sortBy(\(_:xs)(_:ys)->orderingxsys)ce)_->error("Illegal XQuery: "++(showe))-- The monadic applyPredicates that propagates IO stateapplyPredicatesM::[Ast]->XSeq->Bool->Environment->Functions->IOXSeqapplyPredicatesM[]xs___=returnxsapplyPredicatesM((Aintn):preds)xs_envfncs-- shortcut that improves laziness=applyPredicatesMpreds[xs!!(n-1)]TrueenvfncsapplyPredicatesM(pred:preds)xsTrueenvfncs-- top-k like|maxPositionpathPositionpred>0=applyPredicatesM(pred:preds)(take(maxPositionpathPositionpred)xs)FalseenvfncsapplyPredicatesM(pred:preds)xs_envfncs|containsLastpred-- blocking: use only when last() is used in the predicate=doletlast=lengthxsvs<-foldir(\xir->dovs<-evalMpredxilast""envfncss<-rreturn(ifcasevsof[XIntk]->k==i-- indexingb->conditionTestbthenx:selses))(return[])xs1applyPredicatesMpredsvsTrueenvfncsapplyPredicatesM(pred:preds)xs_envfncs=dovs<-foldir(\xir->dovs<-evalMpredxiundefv3""envfncss<-rreturn(ifcasevsof[XIntk]->k==i-- indexingb->conditionTestbthenx:selses))(return[])xs1applyPredicatesMpredsvsTrueenvfncs-- The monadic XQuery interpreter; it is like eval but has plumbing to propagate IO stateevalM::Ast->XTree->Int->Int->String->Environment->Functions->IOXSeqevalMecontextpositionlasteffective_axisenvfncs=caseeofAvar"."->return[context]Avarv->return(findVvenv)Aintn->return[XIntn]Afloatn->return[XFloatn]Astrings->return[XTexts]-- for non-IO XQuery, use the regular evalAst"nonIO"[u]->return(evalucontextpositionlasteffective_axisenvfncs)Ast"context"[v,Astringdp,body]->dovs<-evalMvcontextpositionlasteffective_axisenvfncsfoldr(\xr->(liftM2(++))(evalMbodyxpositionlastdpenvfncs)r)(return[])vsAst"call"[Avar"position"]->return[XIntposition]Ast"call"[Avar"last"]->return[XIntlast]Ast"child_step"[tag,Avar"."]|effective_axis/=""->evalM(Asteffective_axis[tag,Avar"."])contextpositionlast""envfncsAst"step"((Ast"descendant_any"(body:tags)):predicates)->dovs<-evalMbodycontextpositionlasteffective_axisenvfncsletts=map(\(Avartag)->tag)tagsfoldr(\xr->(liftM2(++))(applyPredicatesMpredicates(descendant_any_with_tagged_childrentsx)Trueenvfncs)r)(return[])vsAst"step"((Astpath_step[Astringtag,body]):predicates)|memVpath_steppathFunctions->dovs<-evalMbodycontextpositionlasteffective_axisenvfncsfoldr(\xr->(liftM2(++))(applyPredicatesMpredicates((findVpath_steppathFunctions)tagx)Trueenvfncs)r)(return[])vsAst"descendant_any"(body:tags)->dovs<-evalMbodycontextpositionlasteffective_axisenvfncsletts=map(\(Avartag)->tag)tagsreturn(foldr(\xr->(descendant_any_with_tagged_childrentsx)++r)[]vs)Astpath_step[Astringtag,body]|memVpath_steppathFunctions->dovs<-evalMbodycontextpositionlasteffective_axisenvfncsreturn(foldr(\xr->((findVpath_steppathFunctions)tagx)++r)[]vs)Ast"step"(exp:predicates)->dovs<-evalMexpcontextpositionlasteffective_axisenvfncsapplyPredicatesMpredicatesvsTrueenvfncsAst"predicate"[condition,body]->dovs<-evalMbodycontextpositionlasteffective_axisenvfncsapplyPredicatesM[condition]vsTrueenvfncsAst"executeSQL"[Avarvar,args]->doas<-evalMargscontextpositionlasteffective_axisenvfncslet[XStmtstmt]=findVvarenvexecuteSQLstmtasAst"call"[Avarnm,c,t,e]-- this is the only lazy function|elemnm["if","fn:if"]->doce<-evalMccontextpositionlasteffective_axisenvfncsevalM(ifconditionTestcethentelsee)contextpositionlasteffective_axisenvfncsAst"append"args->(liftMappendText)(mapM(\x->evalMxcontextpositionlasteffective_axisenvfncs)args)Ast"call"((Avarfname):args)-- Note: strict function application->casefilter(\(n,_,_)->n==fname||("fn:"++n)==fname)systemFunctionsof[(_,len,f)]->if(lengthargs)==lenthen(liftMf)(mapM(\x->evalMxcontextpositionlasteffective_axisenvfncs)args)elseerror("Wrong number of arguments in system call: "++fname)_->casefilter(\(n,_,_)->n==fname)fncsof(_,params,body):_->if(lengthparams)==(lengthargs)thendovs<-mapM(\a->evalMacontextpositionlasteffective_axisenvfncs)argsevalMbodycontextundefv2undefv3""((zipWith(\pa->(p,a))paramsvs)++env)fncselseerror("Wrong number of arguments in function call: "++fname)_->error("Undefined function: "++fname)Ast"construction"[Astringtag,Ast"attributes"[],body]->dob<-evalMbodycontextpositionlasteffective_axisenvfncsreturn[XElemtag[]0parent_errorb]Ast"construction"[tag,Ast"attributes"al,body]->doalc<-mapM(\(Ast"pair"[a,v])->doac<-evalMacontextpositionlasteffective_axisenvfncsvc<-evalMvcontextpositionlasteffective_axisenvfncsreturn(qNameac,showXSvc))alct<-evalMtagcontextpositionlasteffective_axisenvfncsbc<-evalMbodycontextpositionlasteffective_axisenvfncsreturn[XElem(qNamect)alc0parent_errorbc]Ast"let"[Avarvar,source,body]->dos<-evalMsourcecontextpositionlasteffective_axisenvfncsevalMbodycontextpositionlasteffective_axis((var,s):env)fncsAst"for"[Avarvar,Avar"$",source,body]-- a for-loop without an index->dovs<-evalMsourcecontextpositionlasteffective_axisenvfncsfoldr(\ar->(liftM2(++))(evalMbodyaundefv2undefv3""((var,[a]):env)fncs)r)(return[])vsAst"for"[Avarvar,Avarivar,source,body]-- a for-loop with an index->doletp=maxPosition(Avarivar)bodyns=ifp>0-- there is a top-k like restrictionthenAst"step"[source,Ast"call"[Avar"<=",pathPosition,Aintp]]elsesourcevs<-evalMnscontextpositionlasteffective_axisenvfncsfoldir(\air->(liftM2(++))(evalMbodyaiundefv3""((var,[a]):(ivar,[XInti]):env)fncs)r)(return[])vs1Ast"sortTuple"(exp:orderBys)-- prepare each FLWOR tuple for sorting->dovs<-evalMexpcontextpositionlasteffective_axisenvfncsos<-mapM(\a->evalMacontextpositionlasteffective_axisenvfncs)orderBysreturn[XElem""[]0parent_error(foldl(\ra->r++[XElem""[]0parent_error(texta)])[XElem""[]0parent_errorvs]os)]Ast"sort"(exp:ordList)-- blocking->dovs<-evalMexpcontextpositionlasteffective_axisenvfncsletce=map(\(XElem____xs)->map(\(XElem____ys)->ys)xs)vsordering=foldr(\(Avarord)r(x:xs)(y:ys)->casecompareXSeqs(ord=="ascending")xyofEQ->rxsyso->o)(\xsys->EQ)ordListreturn(concatMaphead(sortBy(\(_:xs)(_:ys)->orderingxsys)ce))_->error("Illegal XQuery: "++(showe))-- evaluate from input continuouslyevalInput::(String->Environment->Functions->IO(Environment,Functions))->Environment->Functions->IO()evalInputevalvsfs=doletonelineprompt=doline<-readlinepromptcaselineofNothing->return"quit"Justt->ift==""thenonelinepromptelsereturntreadlinesx=doline<-oneline": "iflastline=='}'thenreturn(x++" "++(initline))elseifline=="quit"thenreturnlineelsereadlines(x++" "++line)line<-oneline"> "stmt<-ifheadline=='{'theniflastline=='}'thenreturn(init(tailline))elsereadlines(tailline)elsereturnlineifstmt=="quit"thenputStrLn"Bye!"elsedoaddHistorystmt(nvs,nfs)<-eval(map(\c->ifc=='\"'then'\''elsec)stmt)vsfsevalInputevalnvsnfsxqueryE::String->Environment->Functions->(String->IOXSeq)->Bool->IO(XSeq,Environment,Functions)xqueryEqueryvariablesfunctionsdbmapperverbose=doletasts=parse(scanquery)fncs=foldr(\er->caseeofAst"function"((Avarf):b:args)->(f,map(\(Avarv)->v)args,optimizeb):r_->r)functionsastsvars<-foldl(\re->caseeofAst"variable"[Avarv,u]->dos<-ruv<-evalM(optimizeu)undefv1undefv2undefv3""sfncsreturn((v,uv):s)_->r)(returnvariables)astsletexprpe=caseeofAstf_|elemf["function","variable"]->True;_->Falseexps=concatenateAll(dropWhileexprpasts)opt_exps=optimizeexps(ast,ns)=liftIOSourcesopt_expsifverbosethendoputStrLn"Abstract Syntax Tree (AST):"putStrLn(ppAstexps)putStrLn"Optimized AST:"putStrLn(ppAstopt_exps)putStrLn"Result:"elsereturn()env<-foldr(\(n,s)r->casesofAvarm->doenv<-rreturn((n,findVmenv):env)Ast"prepareSQL"[Astringsql]->doenv<-rt<-dbmappersqlreturn((n,t):env)Astringfile->dodoc<-readFilefileenv<-rreturn((n,[materialize(parseDocumentdoc)]):env))(return[])nse<-evalMastundefv1undefv2undefv3""(env++vars)fncsreturn(e,vars,fncs)-- | Evaluate the XQuery using the interpreter.xquery::String->IOXSeqxqueryquery=do(u,_,_)<-xqueryEquery[][](\sql->return[])Falsereturnu-- | Read an XQuery from a file and run it using the interpreter.xfile::String->IOXSeqxfilefile=doquery<-readFilefilexqueryquery-- | Evaluate the XQuery with database connectivity using the interpreter.xqueryDB::(IConnectionconn)=>String->conn->IOXSeqxqueryDBquerydb=do(u,_,_)<-xqueryEquery[][](\sql->dostmt<-prepareSQLdbsqlreturn[XStmtstmt])Falsereturnu-- | Read an XQuery with database connectivity from a file and run it using the interpreter.xfileDB::(IConnectionconn)=>String->conn->IOXSeqxfileDBfiledb=doquery<-readFilefilexqueryDBquerydb