{-------------------------------------------------------------------------------------
-
- The XQuery Interpreter
- Programmer: Leonidas Fegaras
- Email: fegaras@cse.uta.edu
- Web: http://lambda.uta.edu/- Creation: 03/22/08, last update: 03/27/09
-
- 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.
-
--------------------------------------------------------------------------------------}moduleText.XML.HXQ.Interpreter(xquery,xqueryDB,xfileDB,evalInput,xqueryE)whereimportText.XML.HXQ.ParserimportText.XML.HXQ.XTreeimportText.XML.HXQ.OptionalDBimportControl.MonadimportList(sortBy)importData.List(foldl')importXMLParse(parseDocument)importReadlineimportText.XML.HXQ.OptimizerimportText.XML.HXQ.FunctionsimportText.XML.HXQ.CompilerimportText.XML.HXQ.Types-- 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->Environment->Functions->XSeqapplyPredicatespredsxsenvfncs=foldl'(\sp->applyPredspTrue)xspredswhereapplyPred[]__=[]applyPredxs(Aintn)_-- shortcut that improves laziness=indexxs(n-1)applyPredxs(Ast"call"[Avar"last"])_=[lastxs]applyPredxspredTrue-- top-k like|pos>0=applyPred(takeposxs)predFalsewherepos=maxPositionpathPositionpredapplyPredxspred_|containsLastpred-- blocking: use only when last() is used in the predicate=letlast=lengthxsinfoldir(\xir->caseevalpredxilast""envfncsof[XIntk]->ifk==ithenx:relser-- indexingb->ifconditionTestbthenx:relser)[]xs1applyPredxspred_=foldir(\xir->caseevalpredxiundefv3""envfncsof[XIntk]->ifk==ithenx:relser-- indexingb->ifconditionTestbthenx:relser)[]xs1-- 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-- 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"step"(Avar"child":tag:Avar".":preds)|effective_axis/=""->eval(Ast"step"(Avareffective_axis:tag:Avar".":preds))contextpositionlast""envfncsAst"step"(Avar"descendant_any":Ast"tags"tags:e:preds)->letts=map(\(Avartag)->tag)tagsv=evalecontextpositionlasteffective_axisenvfncsinifv==[XNull]thenvelsefoldr(\xr->(applyPredicatespreds(descendant_any_with_tagged_childrentsx)envfncs)++r)[]vAst"step"(Avarstep:Astringtag:e:preds)->letstep_fnc=findVsteppathFunctionsv=evalecontextpositionlasteffective_axisenvfncsinifv==[XNull]thenvelsefoldr(\xr->(applyPredicatespreds(step_fnctagx)envfncs)++r)[]vAst"filter"(e:preds)->applyPredicatespreds(evalecontextpositionlasteffective_axisenvfncs)envfncsAst"predicate"[condition,body]->ifconditionTest(evalconditionundefv1undefv2undefv3""envfncs)thenevalbodycontextpositionlasteffective_axisenvfncselse[]Ast"append"args->appendText(map(\x->evalxcontextpositionlasteffective_axisenvfncs)args)Ast"if"[c,t,e]->ifconditionTest(evalccontextpositionlasteffective_axisenvfncs)thenevaltcontextpositionlasteffective_axisenvfncselseevalecontextpositionlasteffective_axisenvfncsAstf_|elemf["insert","delete","replace"]->error"Updates must be over XML data stored in databases"Ast"call"(v@(Avarfname):args)->letvs=map(\x->evalxcontextpositionlasteffective_axisenvfncs)argsincasefilter(\(n,_,_,_)->n==fname||("fn:"++n)==fname)systemFunctionsof[]->ifisBuildInTypefname&&lengthvs==1thencastAs(headvs)velseerror"External function calls must be within the IO monad"fs->casefilter(\(_,len,_,_)->len<0||lengthargs==len)fsof[]->error("wrong number of arguments in function call: "++fname)(_,_,f,_):_->fvsAst"construction"[tag,id,parent,Ast"attributes"al,body]->letct=evaltagcontextpositionlasteffective_axisenvfncsbc=evalbodycontextpositionlasteffective_axisenvfncs(as,bs)=span(\x->casexofXAttr__->True;_->False)bcalc=concatMap(\(Ast"pair"[a,v])->letac=evalacontextpositionlasteffective_axisenvfncsvc=evalvcontextpositionlasteffective_axisenvfncsinifvc==[XNull]then[]else[(qNameac,showXSvc)])al++[(n,v)|XAttrnv<-as][XTextvid]=evalidcontextpositionlasteffective_axisenvfncsvparent=evalparentcontextpositionlasteffective_axisenvfncsin[XElem(qNamect)alc(readvid)(ifnullvparentthenparent_errorelseheadvparent)bs]Ast"attribute_construction"[name,value]->letns=evalnamecontextpositionlasteffective_axisenvfncsvs=evalvaluecontextpositionlasteffective_axisenvfncsin[XAttr(qNamens)(showXSvs)]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->letee=evalexpcontextpositionlasteffective_axisenvfncsin[XElem""[]0parent_error(foldl(\ra->r++[XElem""[]0parent_error(toData(evalacontextpositionlasteffective_axisenvfncs))])[XElem""[]0parent_erroree]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)Ast"type"[tp]->[XTypetp]_->error("Illegal XQuery: "++(showe))typeStatements=[(String,Statement)]-- The monadic applyPredicates that propagates IO stateapplyPredicatesM::[Ast]->XSeq->Environment->Functions->Connection->Statements->IOXSeqapplyPredicatesMpredsxsenvfncsdbstmts=foldl'(\sp->s>>=\r->applyPredrpTrue)(returnxs)predswhereapplyPred[]__=return[]applyPredxs(Aintn)_-- shortcut that improves laziness=return$!indexxs(n-1)applyPredxs(Ast"call"[Avar"last"])_=return$![lastxs]applyPredxspredTrue-- top-k like|pos>0=applyPred(takeposxs)predFalsewherepos=maxPositionpathPositionpredapplyPredxspred_|containsLastpred-- blocking: use only when last() is used in the predicate=letlast=lengthxsinfoldir(\xir->dovs<-evalMpredxilast""envfncsdbstmtss<-rreturn$!(ifcasevsof[XIntk]->k==i-- indexingb->conditionTestbthenx:selses))(return[])xs1applyPredxspred_=foldir(\xir->dovs<-evalMpredxiundefv3""envfncsdbstmtss<-rreturn$!(ifcasevsof[XIntk]->k==i-- indexingb->conditionTestbthenx:selses))(return[])xs1-- The monadic XQuery interpreter; it is like eval but has plumbing to propagate IO stateevalM::Ast->XTree->Int->Int->String->Environment->Functions->Connection->Statements->IOXSeqevalMecontextpositionlasteffective_axisenvfncsdbstmts=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_axisenvfncsdbstmtsfoldr(\xr->(liftM2(++))(evalMbodyxpositionlastdpenvfncsdbstmts)r)(return[])vsAst"call"[Avar"position"]->return$![XIntposition]Ast"call"[Avar"last"]->return$![XIntlast]Ast"call"[Avarf,Astringfile]|elemf["doc","fn:doc"]->dodoc<-downloadFilefilereturn$![materializeFalse(parseDocumentdoc)]Ast"call"[Avar"debug",c]->doec<-evalMccontextpositionlasteffective_axisenvfncsdbstmtsdebugSessionecenvfncs[]dbAst"call"[Avar"eval",x]->doxc<-evalMxcontextpositionlasteffective_axisenvfncsdbstmtscasexcof[XTextq]->do(res,_,_,_)<-evalQueryM(parse(scanq))envfncs[]dbFalsereturnres_->error$"The eval argument must be a string: "++showxcAst"step"(Avar"child":tag:Avar".":preds)|effective_axis/=""->evalM(Ast"step"(Avareffective_axis:tag:Avar".":preds))contextpositionlast""envfncsdbstmtsAst"step"(Avar"descendant_any":Ast"tags"tags:e:preds)->dovs<-evalMecontextpositionlasteffective_axisenvfncsdbstmtsletts=map(\(Avartag)->tag)tagsifvs==[XNull]thenreturnvselsefoldr(\xr->(liftM2(++))(applyPredicatesMpreds(descendant_any_with_tagged_childrentsx)envfncsdbstmts)r)(return[])vsAst"step"(Avarstep:Astringtag:e:preds)->letstep_fnc=findVsteppathFunctionsindovs<-evalMecontextpositionlasteffective_axisenvfncsdbstmtsifvs==[XNull]thenreturnvselsefoldr(\xr->(liftM2(++))(applyPredicatesMpreds(step_fnctagx)envfncsdbstmts)r)(return[])vsAst"filter"(e:preds)->dovs<-evalMecontextpositionlasteffective_axisenvfncsdbstmtsapplyPredicatesMpredsvsenvfncsdbstmtsAst"predicate"[condition,body]->doeb<-evalMconditionundefv1undefv2undefv3""envfncsdbstmtsifconditionTestebthenevalMbodycontextpositionlasteffective_axisenvfncsdbstmtselsereturn[]Ast"executeSQL"[Avarvar,args]->doas<-evalMargscontextpositionlasteffective_axisenvfncsdbstmtsexecuteSQL(findVvarstmts)asAst"append"args->(liftMappendText)(mapM(\x->evalMxcontextpositionlasteffective_axisenvfncsdbstmts)args)Ast"if"[c,t,e]-- this is the only lazy function->doce<-evalMccontextpositionlasteffective_axisenvfncsdbstmtsevalM(ifconditionTestcethentelsee)contextpositionlasteffective_axisenvfncsdbstmtsAst"insert"[e1,e2]->dov1<-evalMe1contextpositionlasteffective_axisenvfncsdbstmtsv2<-evalMe2contextpositionlasteffective_axisenvfncsdbstmtsinsertDBdbv1v2Ast"delete"[e]->dov<-evalMecontextpositionlasteffective_axisenvfncsdbstmtsdeleteDBdbvAst"replace"[e1,e2]->dov1<-evalMe1contextpositionlasteffective_axisenvfncsdbstmtsv2<-evalMe2contextpositionlasteffective_axisenvfncsdbstmtsreplaceDBdbv1v2Ast"call"(v@(Avarfname):args)-- Note: strict function application->casefilter(\(n,_,_,_)->n==fname||("fn:"++n)==fname)systemFunctionsof[]->dovs<-mapM(\a->evalMacontextpositionlasteffective_axisenvfncsdbstmts)argsifisBuildInTypefname&&lengthvs==1thenreturn$!castAs(headvs)velsecasefilter(\(n,_,_)->n==fname)fncsof(_,params,body):_->if(lengthparams)==(lengthargs)thenevalMbodycontextundefv2undefv3""((zipparamsvs)++env)fncsdbstmtselseerror("Wrong number of arguments in function call: "++fname)_->error("Undefined function: "++fname)fs->casefilter(\(_,len,_,_)->len<0||lengthargs==len)fsof[]->error("wrong number of arguments in function call: "++fname)(_,_,f,_):_->dovs<-mapM(\x->evalMxcontextpositionlasteffective_axisenvfncsdbstmts)argsreturn$fvsAst"construction"[tag,id,parent,Ast"attributes"al,body]->doct<-evalMtagcontextpositionlasteffective_axisenvfncsdbstmtsbc<-evalMbodycontextpositionlasteffective_axisenvfncsdbstmtslet(as,bs)=span(\x->casexofXAttr__->True;_->False)bcalc<-foldM(\r(Ast"pair"[a,v])->doac<-evalMacontextpositionlasteffective_axisenvfncsdbstmtsvc<-evalMvcontextpositionlasteffective_axisenvfncsdbstmtsifvc==[XNull]thenreturnrelsereturn$!(qNameac,showXSvc):r)[]al[XTextvid]<-evalMidcontextpositionlasteffective_axisenvfncsdbstmtsvparent<-evalMparentcontextpositionlasteffective_axisenvfncsdbstmtsreturn$![XElem(qNamect)(alc++[(n,v)|XAttrnv<-as])(readvid)(ifnullvparentthenparent_errorelseheadvparent)bs]Ast"attribute_construction"[name,value]->don<-evalMnamecontextpositionlasteffective_axisenvfncsdbstmtsv<-evalMvaluecontextpositionlasteffective_axisenvfncsdbstmtsreturn$![XAttr(qNamen)(showXSv)]Ast"let"[Avarvar,source,body]->dos<-evalMsourcecontextpositionlasteffective_axisenvfncsdbstmtsevalMbodycontextpositionlasteffective_axis((var,s):env)fncsdbstmtsAst"for"[Avarvar,Avar"$",source,body]-- a for-loop without an index->dovs<-evalMsourcecontextpositionlasteffective_axisenvfncsdbstmtsfoldr(\ar->(liftM2(++))(evalMbodyaundefv2undefv3""((var,[a]):env)fncsdbstmts)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_axisenvfncsdbstmtsfoldir(\air->(liftM2(++))(evalMbodyaiundefv3""((var,[a]):(ivar,[XInti]):env)fncsdbstmts)r)(return[])vs1Ast"sortTuple"(exp:orderBys)-- prepare each FLWOR tuple for sorting->dovs<-evalMexpcontextpositionlasteffective_axisenvfncsdbstmtsos<-mapM(\a->evalMacontextpositionlasteffective_axisenvfncsdbstmts)orderBysreturn$![XElem""[]0parent_error(foldl(\ra->r++[XElem""[]0parent_error(toDataa)])[XElem""[]0parent_errorvs]os)]Ast"sort"(exp:ordList)-- blocking->dovs<-evalMexpcontextpositionlasteffective_axisenvfncsdbstmtsletce=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))Ast"type"[tp]->return[XTypetp]_->error("Illegal XQuery: "++(showe))-- evaluate from input continuouslyevalInput::(String->Environment->Functions->Functions->IO(Environment,Functions,Functions))->Environment->Functions->Functions->String->XSeq->IOXSeqevalInputevalesfsvspromptdvalue=doletbracss=(length$filter(=='{')s)-(length$filter(=='}')s)onelineprompt=doline<-readlinepromptcaselineofNothing->return("quit",0)Justt->ift==""thenonelinepromptelsereturn$!(t,bracst)readlinesxc=do(line,bs)<-oneline": "iflastline=='}'&&bs+c==0thenreturn$!(x++" "++(initline),0)elseifline=="quit"thenreturn$!(line,0)elsereadlines(x++" "++line)(bs+c)(line,c)<-onelineprompt(stmt,_)<-ifheadline=='{'theniflastline=='}'&&c==0thenreturn$!(init(tailline),0)elsereadlines(tailline)celsereturn$!(line,0)ifstmt=="quit"thendoputStrLn$ifprompt=="> "then"Bye!"else""returndvalueelseiftake7stmt=="return "thendo(result,_,_,_)<-xqueryE(drop7stmt)esfsvs(error"Cannot use database operations here")FalsereturnresultelsedoaddHistorystmt(nes,nfs,nvs)<-evalstmtesfsvsevalInputevalnesnfsnvspromptdvaluedebugSession::XSeq->Environment->Functions->Functions->Connection->IOXSeqdebugSessioneenvfncsviewsdb=doletse=showeputStrLn$"*** HXQ debugger: "++ifnull(indexse20)thenseelse(take20se)++" ..."putStr$"Local variables:"mapMputStr(distinct$map(\(v,_)->" $"++v)env)putStrLn"\nYou may evaluate any XQuery. Type ctr-D to exit and return the argument; type 'return exp' to exit and return exp."evalInput(\sesfsvs->do(result,evs,nfs,nvs)<-xqueryEsesfsvsdbFalseputXSeqresultreturn(evs,nfs,nvs))envfncsviews"debug> "eevalQueryM::[Ast]->Environment->Functions->Functions->Connection->Bool->IO(XSeq,Environment,Functions,Functions)evalQueryM[]variablesfunctionsviewsdbverbose=return$!([],variables,functions,views)evalQueryM(query:xs)variablesfunctionsviewsdbverbose=casequeryofAst"function"((Avarf):body:args)->doletopt=optimize(expandViewsviewsbody)ifverbosethendoputStrLn"Abstract Syntax Tree (AST):"putStrLn(ppAstbody)putStrLn"Optimized AST:"putStrLn(ppAstopt)elsereturn()evalQueryMxsvariables((f,map(\(Avarv)->v)args,opt):functions)viewsdbverboseAst"view"((Avarf):body:args)->evalQueryMxsvariablesfunctions((f,map(\(Avarv)->v)args,body):views)dbverboseAst"variable"[Avarv,u]->douv<-evalM(optimizeu)undefv1undefv2undefv3""variablesfunctionsdb[]evalQueryMxs((v,uv):variables)functionsviewsdbverbose_->doletopt=optimize(expandViewsviewsquery)(ast,ns)=liftIOSourcesoptifverbosethendoputStrLn"Abstract Syntax Tree (AST):"putStrLn(ppAstquery)putStrLn"Optimized AST:"putStrLn(ppAst(foldl(\r(n,_,e)->Ast"let"[Avarn,caseeofAstring_->Ast"doc"[e];_->e,r])astns))putStrLn"Result:"elsereturn()env<-foldr(\(n,b,s)r->casesofAvarm->doenv<-rreturn$!((n,findVmenv):env)Astringfile->dodoc<-downloadFilefileenv<-rreturn$!((n,[materializeb(parseDocumentdoc)]):env)_->r)(return[])nsstmts<-foldr(\(n,_,s)r->casesofAst"prepareSQL"[Astringsql]->dostmts<-rt<-prepareSQLdbsqlreturn$!((n,t):stmts)_->r)(return[])nsresult<-evalMastundefv1undefv2undefv3""(env++variables)functionsdbstmts(rest,renv,rfuns,rviews)<-evalQueryMxsvariablesfunctionsviewsdbverbosereturn$!(result++rest,renv,rfuns,rviews)xqueryE::String->Environment->Functions->Functions->Connection->Bool->IO(XSeq,Environment,Functions,Functions)xqueryEqueryvariablesfunctionsviewsdbverbose=evalQueryM(parse(scanquery))variablesfunctionsviewsdbverbose-- | Evaluate the XQuery using the interpreter.xquery::String->IOXSeqxqueryquery=do(u,_,_,_)<-xqueryEquery[][][](error"No database connectivity")Falsereturn$!u-- | Evaluate the XQuery with database connectivity using the interpreter.xqueryDB::String->Connection->IOXSeqxqueryDBquerydb=do(u,_,_,_)<-xqueryEquery[][][]dbFalsereturn$!u-- | Read an XQuery with database connectivity from a file and run it using the interpreter.xfileDB::String->Connection->IOXSeqxfileDBfiledb=doquery<-readFilefilexqueryDBquerydb