HXQ 0.18.2 → 0.19.0
raw patch · 38 files changed
+1550/−1452 lines, 38 filesdep ~HTTPdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: HTTP, base
API changes (from Hackage documentation)
+ Text.XML.HXQ.XQuery: commandLineInterpreter :: [String] -> IO ()
- Text.XML.HXQ.XQuery: QName :: Prefix -> URI -> LocalName -> QName
+ Text.XML.HXQ.XQuery: QName :: !Prefix -> !URI -> !LocalName -> QName
- Text.XML.HXQ.XQuery: TAttribute :: String -> Type -> Type
+ Text.XML.HXQ.XQuery: TAttribute :: !String -> !Type -> Type
- Text.XML.HXQ.XQuery: TBase :: QName -> Type
+ Text.XML.HXQ.XQuery: TBase :: !QName -> Type
- Text.XML.HXQ.XQuery: TChoice :: Type -> Type -> Type
+ Text.XML.HXQ.XQuery: TChoice :: !Type -> !Type -> Type
- Text.XML.HXQ.XQuery: TElement :: String -> Type -> Type
+ Text.XML.HXQ.XQuery: TElement :: !String -> !Type -> Type
- Text.XML.HXQ.XQuery: TInterleaving :: Type -> Type -> Type
+ Text.XML.HXQ.XQuery: TInterleaving :: !Type -> !Type -> Type
- Text.XML.HXQ.XQuery: TItem :: String -> Type
+ Text.XML.HXQ.XQuery: TItem :: !String -> Type
- Text.XML.HXQ.XQuery: TNamed :: QName -> Type
+ Text.XML.HXQ.XQuery: TNamed :: !QName -> Type
- Text.XML.HXQ.XQuery: TQualified :: Type -> TQualifier -> Type
+ Text.XML.HXQ.XQuery: TQualified :: !Type -> !TQualifier -> Type
- Text.XML.HXQ.XQuery: TSequence :: Type -> Type -> Type
+ Text.XML.HXQ.XQuery: TSequence :: !Type -> !Type -> Type
- Text.XML.HXQ.XQuery: TVariable :: TVar -> Type
+ Text.XML.HXQ.XQuery: TVariable :: !TVar -> Type
- Text.XML.HXQ.XQuery: localName :: QName -> LocalName
+ Text.XML.HXQ.XQuery: localName :: QName -> !LocalName
- Text.XML.HXQ.XQuery: prefix :: QName -> Prefix
+ Text.XML.HXQ.XQuery: prefix :: QName -> !Prefix
- Text.XML.HXQ.XQuery: uri :: QName -> URI
+ Text.XML.HXQ.XQuery: uri :: QName -> !URI
Files
- HXQ.cabal +27/−29
- LICENSE +1/−1
- Main.hs +0/−128
- Makefile +42/−33
- Test1.hs +0/−41
- Test2.hs +0/−24
- Test2a.hs +0/−26
- TestDB.hs +0/−25
- TestDB2.hs +0/−21
- TestDBLP.hs +0/−35
- TestDBa.hs +0/−26
- TestXMark.hs +0/−22
- XQueryParser.y +0/−793
- compile +1/−1
- db.html +9/−7
- index.html +29/−22
- release.html +4/−1
- src/Text/XML/HXQ/Compiler.hs +8/−1
- src/Text/XML/HXQ/Functions.hs +5/−2
- src/Text/XML/HXQ/Optimizer.hs +3/−3
- src/Text/XML/HXQ/Parser.hs +119/−134
- src/Text/XML/HXQ/TypeInference.hs +2/−2
- src/Text/XML/HXQ/Types.hs +12/−6
- src/Text/XML/HXQ/XQuery.hs +146/−2
- src/Text/XML/HXQ/XTree.hs +77/−57
- src/XQueryParser.y +793/−0
- src/hxml-0.2/LLParsing.hs +0/−1
- src/withDB/Text/XML/HXQ/DB.hs +19/−9
- tests/Test1.hs +41/−0
- tests/Test2.hs +24/−0
- tests/Test2a.hs +24/−0
- tests/TestDB.hs +25/−0
- tests/TestDB2.hs +21/−0
- tests/TestDBLP.hs +35/−0
- tests/TestDBa.hs +26/−0
- tests/TestXMark.hs +22/−0
- tests/Validate.hs +20/−0
- xquery.hs +15/−0
HXQ.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: >= 1.2 Name: HXQ-Version: 0.18.2+Version: 0.19.0 Synopsis: A Compiler from XQuery to Haskell Description: HXQ is a fast and space-efficient compiler from XQuery (the standard@@ -13,27 +13,29 @@ License-file: LICENSE License: BSD3 Author: Leonidas Fegaras-Copyright: 2008, 2009 Leonidas Fegaras+Copyright: 2008-2011 Leonidas Fegaras Stability: experimental-Maintainer: fegaras@cse.uta.edu+Maintainer: Leonidas Fegaras <fegaras@cse.uta.edu> Homepage: http://lambda.uta.edu/HXQ/ Extra-Source-Files:+ Makefile src/DeepSeq.hs src/noDB/Text/XML/HXQ/OptionalDB.hs src/withDB/Text/XML/HXQ/DB.hs src/withDB/Text/XML/HXQ/OptionalDB.hs src/mysql/Connect.hs src/sqlite/Connect.hs- Makefile- XQueryParser.y- Test1.hs- Test2.hs- Test2a.hs- TestDB.hs- TestDBa.hs- TestDB2.hs- TestDBLP.hs- TestXMark.hs+ src/XQueryParser.y+ tests/Test1.hs+ tests/Test2.hs+ tests/Test2a.hs+ tests/TestDB.hs+ tests/TestDBa.hs+ tests/TestDB2.hs+ tests/TestDBLP.hs+ tests/TestXMark.hs+ tests/Validate.hs+ xquery.hs compile compile.bat data-files:@@ -68,6 +70,10 @@ Description: provides database connectivity using HDBC and HDBC-sqlite. Default: False +Flag base3+ Description: Use Version 3 of Base+ Default: False+ Library Exposed-Modules: Text.XML.HXQ.XQuery Other-Modules: HXML, DeepSeq, ETree, Misc, Tree, AssocList, PrintXML, XML, TreeBuild, DTD, XMLScanner, LLParsing, XMLParse,@@ -75,8 +81,14 @@ Text.XML.HXQ.Functions, Text.XML.HXQ.Compiler, Text.XML.HXQ.Interpreter, Text.XML.HXQ.Optimizer, Text.XML.HXQ.OptionalDB, Text.XML.HXQ.Parser hs-source-dirs: . src src/hxml-0.2- Build-Depends: base >= 4 && < 5, haskell98, array, regex-base, regex-compat, template-haskell, mtl, haskeline, HTTP- ghc-options: -O2 -funfolding-use-threshold=16+ if flag(base3)+ CPP-Options: -D_BASE_3_+ Build-Depends: base >= 3 && < 4+ ghc-options: -funfolding-use-threshold=16+ else+ Build-Depends: base >= 4 && < 5+ ghc-options: -funfolding-use-threshold=16 -fspec-constr-count=100+ Build-Depends: haskell98, array, regex-base, regex-compat, template-haskell, mtl, haskeline, HTTP > 4000.0.4 if flag(mysql) Other-Modules: Text.XML.HXQ.DB, Connect Build-Depends: HDBC, HDBC-odbc@@ -84,20 +96,6 @@ else { if flag(sqlite) Other-Modules: Text.XML.HXQ.DB, Connect- Build-Depends: HDBC, HDBC-sqlite3- hs-source-dirs: src/withDB, src/sqlite- else- hs-source-dirs: src/noDB-}--Executable xquery- Main-is: Main.hs- hs-source-dirs: . src src/hxml-0.2- if flag(mysql)- Build-Depends: HDBC, HDBC-odbc- hs-source-dirs: src/withDB, src/mysql- else {- if flag(sqlite) Build-Depends: HDBC, HDBC-sqlite3 hs-source-dirs: src/withDB, src/sqlite else
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2008, 2009 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+Copyright (c) 2008-2010 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.
− Main.hs
@@ -1,128 +0,0 @@-{------------------------------------------------------------------ The main program of the XQuery interpreter-- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 10/08/2009------------------------------------------------------------------}--{-# OPTIONS -cpp #-}--module Main where--import List(sort)-import System.Environment-import System.CPUTime-import Text.XML.HXQ.XQuery-import Text.XML.HXQ.Functions-import Text.XML.HXQ.XTree-import Text.XML.HXQ.Types-import Text.XML.HXQ.Interpreter(evalInput,xqueryE,xfileDB)-import qualified Control.OldException as C---type E = C.Exception---version = "0.18.2"---parseEnv :: [String] -> [(String,String)]-parseEnv [] = [("o","Temp.hs")]-parseEnv ("-help":xs) = ("help",""):(parseEnv xs)-parseEnv ("-c":file:xs) = ("c",file):(parseEnv xs)-parseEnv ("-o":file:xs) = ("o",file):(parseEnv xs)-parseEnv ("-db":file:xs) = ("db",file):(parseEnv xs)-parseEnv ("-v":xs) = ("v",""):(parseEnv xs)-parseEnv ("-tp":xs) = ("tp",""):(parseEnv xs)-parseEnv ("-t":xs) = ("t",""):(parseEnv xs)-parseEnv ("-p":query:file:xs) = ("p","doc('"++file++"')"++query):(parseEnv xs)-parseEnv (('-':x):_) = error ("Unrecognized option -"++x++". Use -help.")-parseEnv (file:xs) = ("r",file):(parseEnv xs)---noDBerror = error "Missing Database Connection; use the option -db in xquery"---main = do senv <- getArgs- let env = parseEnv senv- verbose = case lookup "v" env of Nothing -> False; _ -> True- timing = case lookup "t" env of Nothing -> False; _ -> True- typecheck = case lookup "tp" env of Nothing -> False; _ -> True- putTime t = if timing then putStrLn $ "Evaluation time: "++show (div t (10^9))++" milliseconds" else return ()- case lookup "help" env of- Just _ -> do putStrLn ("HXQ: XQuery Interpreter version "++version)- putStrLn "The documentation is availabe at http://lambda.uta.edu/HXQ/"- putStrLn "Command line options and files:"- putStrLn " xquery-file evaluate the XQuery in xquery-file using the interpreter"- putStrLn " -db database use the relational database during querying"- putStrLn " -c xquery-file compile the XQuery in xquery-file into Haskell code"- putStrLn " -o haskell-file set the Haskell file for -c (default is Temp.hs)"- putStrLn " -p XPath-query xml-file interpret the XPath query against the xml-file"- putStrLn " -v print verbose information (AST and optimized plan)"- putStrLn " -t print timing information"- putStrLn " -tp print typing information"- putStrLn "Without an xquery-file, it reads and evaluates the input using the HXQ interpreter."- putStrLn " The input may be an XQuery or a 'declare variable' or a 'declare function'."- putStrLn " To write an XQuery in multiple lines, wrap it in {}."- putStrLn $ "Functions (name/arity): " ++ (unwords $ sort $ map (\(f,c,_,_,_) -> f++"/"++show c) systemFunctions)- putStrLn $ "Path Steps: " ++ (unwords $ map fst pathFunctions)- putStrLn $ "Build-in Types: xs:anyAtomicType " ++ (unwords $ map fst buildInTypes)- _ -> case lookup "c" env of- Just file -> do query <- readFile file- let qf = foldr (\c r -> if c=='\"' then '\\':c:r else c:r)- "" (foldr1 (\a r -> a++" "++r) (lines query))- db = case lookup "db" env of Just filepath -> filepath; _ -> ""- pr = "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\nimport Text.XML.HXQ.XQuery\n\nmain = do "- ++ (if db=="" then "res <- " else "db <- connect \""++db++"\"\n res <- ")- ++ (if db=="" then "$(xq \"" else "$(xqdb \"")- ++ qf ++ "\")"++(if db=="" then "" else " db")++"\n putXSeq res\n"- Just ofile = lookup "o" env- writeFile ofile pr- _ -> case lookup "r" env of- Just file -> case lookup "db" env of- Just filepath -> do db <- connect filepath- t1 <- getCPUTime- query <- readFile file- (result,_,_,_,_) <- xqueryE query [] [] initialNS [] db verbose typecheck- putXSeq result- t2 <- getCPUTime- putTime (t2-t1)- commit db- _ -> do query <- readFile file- t1 <- getCPUTime- (result,_,_,_,_) <- xqueryE query [] [] initialNS [] noDBerror verbose typecheck- putXSeq result- t2 <- getCPUTime- putTime (t2-t1)- _ -> case lookup "p" env of- Just query -> do t1 <- getCPUTime- (result,_,_,_,_) <- xqueryE query [] [] initialNS [] noDBerror verbose typecheck- putXSeq result- t2 <- getCPUTime- putTime (t2-t1)- _ -> do putStrLn ("HXQ: XQuery Interpreter version "++version++". Use -help for help.")- case lookup "db" env of- Just filepath- -> do db <- connect filepath- evalInput (\s es fs ns vs -> C.catch- (do t1 <- getCPUTime- (result,nes,nfs,nns,nvs) <- xqueryE s es fs ns vs db verbose typecheck- putXSeq result- t2 <- getCPUTime- putTime (t2-t1)- commit db- return (nes,nfs,nns,nvs))- (\e -> do putStrLn (show (e::E))- return (es,fs,ns,vs))) [] [] initialNS [] "> " []- return ()- _ -> do evalInput (\s es fs ns vs -> C.catch- (do t1 <- getCPUTime- (result,nes,nfs,nns,nvs) <- xqueryE s es fs ns vs noDBerror verbose typecheck- putXSeq result- t2 <- getCPUTime- putTime (t2-t1)- return (nes,nfs,nns,nvs))- (\e -> do putStrLn (show (e::E))- return (es,fs,ns,vs))) [] [] initialNS [] "> " []- return ()
Makefile view
@@ -1,80 +1,89 @@ # Programmer: Leonidas Fegaras # The database driver must be mysql, sqlite, or nodb # for using MySQL through ODBC, Sqlite, or no database at all+# set base3 to true for base-3 ghc (old ghc)+# set extras to -rtsopts for GHC > 7.0 driver = mysql+base3 = false+extras = -rtsopts + ifeq (${driver},mysql)-args = -isrc -isrc/hxml-0.2 -isrc/withDB -isrc/mysql+argss = -isrc -isrc/hxml-0.2 -isrc/withDB -isrc/mysql else ifeq (${driver},sqlite)-args = -isrc -isrc/hxml-0.2 -isrc/withDB -isrc/sqlite+argss = -isrc -isrc/hxml-0.2 -isrc/withDB -isrc/sqlite else-args = -isrc -isrc/hxml-0.2 -isrc/noDB+argss = -isrc -isrc/hxml-0.2 -isrc/noDB endif +ifeq (${base3},true)+args=${argss} -package base-3.0.3.1 -cpp -D_BASE_3_+else+args=${argss} -fspec-constr-count=100 ${extras}+endif+ parser = src/Text/XML/HXQ/Parser.hs ghc = ghc -O2 -funfolding-use-threshold=16 ${args} src = * src/hxml-0.2/* src/noDB/Text/XML/HXQ/* src/withDB/Text/XML/HXQ/* \ src/* src/Text/XML/HXQ/* src/mysql/* src/sqlite/* # build the xquery interpreter-all: $(parser) Main.hs- $(ghc) --make Main.hs -o xquery+all: $(parser) xquery.hs+ $(ghc) --make xquery.hs -o xquery # generate the XQuery parser using happy-$(parser): XQueryParser.y- happy -g -a -c -o $(parser) XQueryParser.y+$(parser): src/XQueryParser.y+ happy -g -a -c -o $(parser) src/XQueryParser.y -test1: $(parser) Test1.hs- $(ghc) --make Test1.hs -o a.out+test1: $(parser) tests/Test1.hs+ $(ghc) --make tests/Test1.hs -o a.out ./a.out # testing on a large file (dblp.xml)-test2: $(parser) Test2.hs- $(ghc) --make Test2.hs -o a.out- time ./a.out +RTS -H2m+test2: $(parser) tests/Test2.hs+ $(ghc) --make tests/Test2.hs -o a.out+ time ./a.out +RTS -H10m # like test2 but uses quasi-quotes (for ghc >= 6.9 only)-test2a: $(parser) Test2a.hs- $(ghc) --make Test2a.hs -o a.out- ./a.out +RTS -H2m -s+test2a: $(parser) tests/Test2a.hs+ $(ghc) --make tests/Test2a.hs -o a.out+ ./a.out +RTS -H10m -s -test3: $(parser) TestDB.hs- $(ghc) --make TestDB.hs -o a.out+test3: $(parser) tests/TestDB.hs+ $(ghc) --make tests/TestDB.hs -o a.out ./a.out -test4: $(parser) TestDB2.hs- $(ghc) --make TestDB2.hs -o a.out+test4: $(parser) tests/TestDB2.hs+ $(ghc) --make tests/TestDB2.hs -o a.out ./a.out # validate dblp.xml against dblp.xsd-validate: $(parser) Validate.hs- $(ghc) --make Validate.hs -o a.out+validate: $(parser) tests/Validate.hs+ $(ghc) --make tests/Validate.hs -o a.out time ./a.out +RTS -H2m -s -xmark: $(parser) TestXMark.hs- $(ghc) --make TestXMark.hs -o a.out+xmark: $(parser) tests/TestXMark.hs+ $(ghc) --make tests/TestXMark.hs -o a.out time ./a.out +RTS -H2m -s # populate the DBLP database using the dblp.xml file-dblp: $(parser) TestDBLP.hs- $(ghc) --make TestDBLP.hs -o a.out+dblp: $(parser) tests/TestDBLP.hs+ $(ghc) --make tests/TestDBLP.hs -o a.out time ./a.out +RTS -K20m -# run in the ghci interpreter and load HXQ-ghci: $(parser)- ghci -XTemplateHaskell -XQuasiQuotes ${args} Main.hs+xsym: $(parser) xsym10.hs+ $(ghc) --make xsym10.hs -o a.out+ time ./a.out +RTS -K20m # run multiple tests test: $(parser) data/test.xq ./xquery data/test.xq | diff - data/test-results.txt # heap profiling of the compiler-profile: $(parser) Test2.hs- ghc -O2 -funfolding-use-threshold=16 -isrc -isrc/hxml-0.2 -isrc/noDB \- --make Test2.hs -o a.out- ghc -O2 -funfolding-use-threshold=16 -isrc -isrc/hxml-0.2 -isrc/noDB \- -prof -auto-all -osuf p_o --make Test2.hs -o a.out+profile: $(parser) tests/Test2.hs+ $(ghc) -isrc -isrc/hxml-0.2 -isrc/noDB --make tests/Test2.hs -o a.out+ $(ghc) -isrc -isrc/hxml-0.2 -isrc/noDB -prof -auto-all -osuf p_o --make tests/Test2.hs -o a.out time ./a.out +RTS -hc hp2ps -color a.out.hp
− Test1.hs
@@ -1,41 +0,0 @@-{------------------------------------------------------------------ A main program to test the XQuery processor-- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 07/24/2008------------------------------------------------------------------}--{-# LANGUAGE TemplateHaskell #-}---module Main where--import Text.XML.HXQ.XQuery---f(d,s) = $(xq "<student dept='{$d/text()}'>{$s//firstname/text(),$s//lastname/text()}</student>")--main = do a <- $(xq " for $s in doc('data/cs.xml')//gradstudent \- \ order by $s/gpa descending, $s//lastname \- \ return <student>{$s//firstname/text(), \- \ $s//lastname/text(), \- \ $s/gpa/text()}</student> ")- putXSeq a- let query name = $(xq " doc('data/cs.xml')//gradstudent[.//lastname = $name]//firstname ")- b <- query $(xe " 'Galanis' ")- putXSeq b- c <- $(xq " <good-students>{ \- \ let $d := doc('data/cs.xml') \- \ for $s in $d//gradstudent \- \ where $s/gpa = 4.0 \- \ return f($d//deptname,$s) \- \ }</good-students> ")- putXSeq c- d <- $(xq " let $d := doc('data/cs.xml')//gradstudent \- \ return ($d/../deptname,count($d)) ")- putXSeq d- putStrLn "Type an XQuery:"- iquery <- getLine -- read an XQuery from input- e <- xquery iquery -- evaluate it using the XQuery interpreter- putXSeq e
− Test2.hs
@@ -1,24 +0,0 @@-{------------------------------------------------------------------ Testing the XQuery compiler on a large file-- Download dblp.xml.gz from http://dblp.uni-trier.de/xml/-- and uncompress it in the data directory.-- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 12/10/2008------------------------------------------------------------------}--{-# LANGUAGE TemplateHaskell #-}--module Main where--import Text.XML.HXQ.XQuery--main = do a <- $(xq "<result>{ \- \ for $x at $i in doc('data/dblp.xml')//inproceedings \- \ where $x/author = 'Leonidas Fegaras' \- \ return <paper>{ $i, $x/booktitle/text(), \- \ ':', $x/title/text() \- \ }</paper> \- \ }</result> ")- putXSeq a
− Test2a.hs
@@ -1,26 +0,0 @@-{------------------------------------------------------------------ Testing the XQuery compiler on a large file-- Download dblp.xml.gz from http://dblp.uni-trier.de/xml/-- and uncompress it in the data directory.-- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 12/14/2008------------------------------------------------------------------}--{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-}--module Main where--import Text.XML.HXQ.XQuery---main = do a <- [$qx| <result>{- for $x at $i in doc('data/dblp.xml')//inproceedings- where $x/author = 'Leonidas Fegaras'- return <paper>{ $i, $x/booktitle/text(),- ':', $x/title/text()- }</paper>- }</result> |]- putXSeq a
− TestDB.hs
@@ -1,25 +0,0 @@-{------------------------------------------------------------------ A main program to test XQuery connected to a Sqlite database-- To create the database load the file data/company.sql in sqlite3---- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 07/24/2008------------------------------------------------------------------}--{-# LANGUAGE TemplateHaskell #-}--module Main where--import Text.XML.HXQ.XQuery---main = do db <- connect "hxq"- e <- $(xqdb (" for $r in sql(' select e.fname, d.dname \- \ from employee e, department d \- \ where e.dno = d.dnumber \- \ and e.lname = ? ', \- \ 'English') \- \ return <result>{$r/fname,$r/dname}</result> ")) db- putXSeq e
− TestDB2.hs
@@ -1,21 +0,0 @@-{------------------------------------------------------------------ A main program to test XML shredding and publishing---- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 07/24/2008------------------------------------------------------------------}--{-# LANGUAGE TemplateHaskell #-}--module Main where--import Text.XML.HXQ.XQuery---main = do db <- connect "hxq"- res <- $(xqdb (" for $s in publish('hxq','c')//gradstudent \- \ where $s//lastname='Galanis' \- \ return $s//gpa ")) db- putXSeq res
− TestDBLP.hs
@@ -1,35 +0,0 @@-{------------------------------------------------------------------ Creating the DBLP database-- Download dblp.xml.gz from http://dblp.uni-trier.de/xml/-- and uncompress it in the data directory.-- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 02/01/2009------------------------------------------------------------------}--{-# LANGUAGE TemplateHaskell #-}--module Main where--import Text.XML.HXQ.XQuery-import System.IO---main = do db <- connect "hxq"- exists <- isSchema db "d"- ans <- if exists- then do putStr $ "The DBLP database already exists. Do you want to rebuild it? [y/n] "- hFlush stdout- line <- getLine- return $ line == "y"- else return True- if ans- then do putStrLn "Generating the relational schema for the DBPL database using hybrid inlining."- -- ignore the HTML tags <i>, <sub>, <sup>, and <tt>- genSchema db "data/dblp.xml" "d" ["i","sub","sup","tt"]- putStrLn "Populating the DBPL database (will insert about 5M tuples)."- shred db "data/dblp.xml" "d"- putStrLn "Creating an index on author name."- createIndex db "d" "author"- else return ()
− TestDBa.hs
@@ -1,26 +0,0 @@-{------------------------------------------------------------------ A main program to test XQuery connected to a Sqlite database-- To create the database load the file data/company.sql in sqlite3---- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 12/14/2008------------------------------------------------------------------}--{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-}--module Main where--import Text.XML.HXQ.XQuery---main = do _db <- connect "hxq"- e <- [$qx| for $r in sql(' select e.fname, d.dname- from employee e, department d- where e.dno = d.dnumber- and e.lname = ? ',- 'English')- return <result>{$r/fname,$r/dname}</result> |]- putXSeq e
− TestXMark.hs
@@ -1,22 +0,0 @@-{------------------------------------------------------------------ Test the XQuery processor using the XMark benchmark-- Dowmload and compile XMark from-- http://monetdb.cwi.nl/xml/index.html-- Then use parameter -f 10 to create 1.1GB test file xdata.xml-- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 03/29/2009------------------------------------------------------------------}--{-# LANGUAGE TemplateHaskell #-}---module Main where--import Text.XML.HXQ.XQuery--main = do a <- $(xq " for $m in doc('data/xdata.xml')//europe//mail \- \ where $m/date='08/06/1999' \- \ return <mail>from: {$m/child::from/text()}, to: {$m/child::to/text()}</mail> ")- putXSeq a
− XQueryParser.y
@@ -1,793 +0,0 @@-{----------------------------------------------------------------------------------------- An XQuery parser-- Programmer: Leonidas Fegaras-- Email: fegaras@cse.uta.edu-- Web: http://lambda.uta.edu/-- Creation: 02/15/08, last update: 01/07/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.-----------------------------------------------------------------------------------------}--{-module Text.XML.HXQ.Parser(Ast(..),scan,parse,call,concatenateAll,ppAst) where-import Char-}--%name parse-%tokentype { Token }-%error { parseError }--%token- 'return' { RETURN }- 'some' { SOME }- 'every' { EVERY }- 'if' { IF }- 'then' { THEN }- 'else' { ELSE }- '[' { LB }- ']' { RB }- '(' { LP }- ')' { RP }- '{' { LSB }- '}' { RSB }- 'to' { TO }- '+' { PLUS }- '-' { MINUS }- '*' { TIMES }- 'div' { DIV }- 'idiv' { IDIV }- 'mod' { MOD }- '=' { TEQ }- '!=' { TNE }- '<' { TLT }- '<=' { TLE }- '>' { TGT }- '>=' { TGE }- '<<' { PRE }- '>>' { POST }- 'is' { IS }- 'eq' { SEQ }- 'ne' { SNE }- 'lt' { SLT }- 'le' { SLE }- 'gt' { SGT }- 'ge' { SGE }- 'and' { AND }- 'or' { OR }- 'not' { NOT }- 'union' { UNION }- 'intersect' { INTERSECT }- 'except' { EXCEPT }- 'for' { FOR }- 'let' { LET }- 'in' { IN }- 'as' { AS }- ',' { COMMA }- ':=' { ASSIGN }- 'where' { WHERE }- 'order' { ORDER }- 'by' { BY }- 'ascending' { ASCENDING }- 'descending' { DESCENDING }- 'element' { ELEMENT }- 'attribute' { ATTRIBUTE }- '</' { STAG }- '/>' { ETAG }- 'satisfies' { SATISFIES }- '@' { ATSIGN }- '/' { SLASH }- 'QName' { QName $$ }- 'declare' { DECLARE }- 'function' { FUNCTION }- 'variable' { VARIABLE }- 'view' { VIEW }- 'at' { AT }- '..' { DOTS }- '.' { DOT }- ';' { SEMI }- ':' { COLON }- 'insert' { INSERT }- 'delete' { DELETE }- 'replace' { REPLACE }- 'type' { TYPE }- 'into' { INTO }- 'from' { FROM}- 'with' { WITH }- 'instance' { INSTANCE }- 'of' { OF }- '?' { QMARK }- 'cast' { CAST }- 'castable' { CASTABLE }- 'case' { CASE }- 'default' { DEFAULT }- 'typeswitch' { TYPESWITCH }- 'import' { IMPORT }- 'namespace' { NAMESPACE }- 'schema' { SCHEMA }- 'validate' { VALIDATE }- 'Variable' { Variable $$ }- 'XMLtext' { XMLtext $$ }- 'Integer' { TInteger $$ }- 'Double' { TFloat $$ }- 'String' { TString $$ }- 'EOF' { TokenEOF }---%nonassoc 'for' 'let' 'satisfies' 'return' 'typeswitch'-%nonassoc 'with' 'from' 'into' 'instance' 'cast' 'castable' 'case' 'default'-%nonassoc 'else'-%left 'intersect' 'union' 'except'-%right 'or'-%right 'and'-%nonassoc 'not'-%left 'to'-%left '=' '<' '>' '<=' '>=' '!=' '>>' '<<' 'is' 'eq' 'ne' 'lt' 'le' 'gt' 'ge'-%left '+' '-'-%left '*' 'div' 'idiv' 'mod'-%nonassoc UMINUS---%%-main :: { [ Ast ] }-main : prog 'EOF' { $1 }--prog :: { [ Ast ] }-prog : def { [$1] }- | def 'XMLtext' { [$1] }- | prog ';' def { $1++[$3] }- | prog ';' def 'XMLtext' { $1++[$3] }--def :: { Ast }-def : expr { $1 }- | 'declare' 'variable' var ':=' expr { Ast "variable" [$3,Avar "any",$5] }- | 'declare' 'variable' var 'as' type- ':=' expr { Ast "variable" [$3,$5,$7] }- | 'declare' 'function' qname- '(' opt_params ')' '{' expr '}' { if (null $5)- then parseError [TError ("Nullary functions are not supported: "++$3)]- else Ast "function" ([Avar $3,$8,Avar "any"]++mkPairs $5) }- | 'declare' 'function' qname- '(' opt_params ')' 'as' type- '{' expr '}' { if (null $5)- then parseError [TError ("Nullary functions are not supported: "++$3)]- else Ast "function" ([Avar $3,$10,$8]++mkPairs $5) }- | 'declare' 'view' qname- '(' opt_params ')' '{' expr '}' { if (null $5)- then parseError [TError ("Nullary views are not supported: "++$3)]- else Ast "view" ([Avar $3,$8]++map fst $5) }- | 'function' qname '(' opt_params ')'- 'as' type { Ast "signature" ([Avar $2,$7]++map snd $4) }- | 'declare' 'element' qname- 'of' 'type' type { Ast "element" [Avar $3,$6] }- | 'declare' 'type' qname '=' type { Ast "type" [Avar $3,$5] }- | 'import' 'schema' prefix- string opt_slist { Ast "import" ($3:$4:$5) }- | 'declare' prefix string { Ast "schema" [$2,$3] }--prefix :: { Ast }-prefix : 'namespace' 'QName' '=' { Avar $2 }- | 'default' 'element' 'namespace' { Avar "default-element" }- | 'default' 'function' 'namespace' { Avar "default-function" }- | { Avar "" }--opt_slist :: { [ Ast ] }-opt_slist : 'at' string slist { $2:$3 }- | { [] }--slist :: { [ Ast ] }-slist : ',' string slist { $3++[$2] }- | { [] }--qname :: { String }-qname : 'QName' { $1 }- | 'QName' ':' 'QName' { $1++":"++$3 }--opt_params :: { [ (Ast,Ast) ] }-opt_params : params { $1 }- | { [] }--params :: { [ (Ast,Ast) ] }-params : var { [($1,Avar "any")] }- | var 'as' type { [($1,$3)] }- | params ',' var { $1++[($3,Avar "any")] }- | params ',' var 'as' type { $1++[($3,$5)] }--type :: { Ast }-type : qname %prec 'case' { Avar $1 }- | qname '+' { Ast "+" [Avar $1] }- | qname '*' { Ast "*" [Avar $1] }- | qname '?' { Ast "?" [Avar $1] }- | sequence_type %prec 'case' { $1 }- | sequence_type '+' { Ast "+" [$1] }- | sequence_type '*' { Ast "*" [$1] }- | sequence_type '?' { Ast "?" [$1] }--sequence_type :: { Ast }-sequence_type : 'element' '(' ')' { Ast "element" [] }- | 'attribute' '(' ')' { Ast "attribute" [] }- | qname '(' ')' { Ast $1 [] }- | 'element' '(' typeparams ')' { Ast "element" $3 }- | 'attribute' '(' typeparams ')' { Ast "attribute" $3 }--typeparams :: { [ Ast ] }- : '*' { [Avar "*"] }- | qname { [Avar $1] }- | '*' ',' qname { [Avar "*",Avar $3] }- | qname ',' qname { [Avar $1,Avar $3] }- | '*' ',' qname '?' { [Avar "*",Ast "?" [Avar $3]] }- | qname ',' qname '?' { [Avar $1,Ast "?" [Avar $3]] }--var :: { Ast }-var : 'Variable' { Avar $1 }--expr :: { Ast }-expr : clauses opt_where opt_order- 'return' expr { (snd $3) ($1 ($2 ((fst $3) $5))) }- | 'some' for_bindings- 'satisfies' expr { call "some" [$2 $4] }- | 'every' for_bindings - 'satisfies' expr { call "not" [call "some" [$2 (call "not" [$4])]] }- | 'if' expr 'then' expr 'else' expr { Ast "if" [$2,$4,$6] }- | full_path { $1 }- | element { $1 }- | computed { $1 }- | expr 'to' expr { call "to" [$1,$3] }- | expr '+' expr { call "+" [$1,$3] }- | expr '-' expr { call "-" [$1,$3] }- | expr '*' expr { call "*" [$1,$3] }- | expr 'div' expr { call "div" [$1,$3] }- | expr 'idiv' expr { call "idiv" [$1,$3] }- | expr 'mod' expr { call "mod" [$1,$3] }- | expr '=' expr { call "=" [$1,$3] }- | expr '!=' expr { call "!=" [$1,$3] }- | expr '<' expr { call "<" [$1,$3] }- | expr '<=' expr { call "<=" [$1,$3] }- | expr '>' expr { call ">" [$1,$3] }- | expr '>=' expr { call ">=" [$1,$3] }- | expr '<<' expr { call "<<" [$1,$3] }- | expr '>>' expr { call ">>" [$1,$3] }- | expr 'is' expr { call "is" [$1,$3] }- | expr 'eq' expr { call "eq" [$1,$3] }- | expr 'ne' expr { call "ne" [$1,$3] }- | expr 'lt' expr { call "lt" [$1,$3] }- | expr 'le' expr { call "le" [$1,$3] }- | expr 'gt' expr { call "gt" [$1,$3] }- | expr 'ge' expr { call "ge" [$1,$3] }- | expr 'and' expr { call "and" [$1,$3] }- | expr 'or' expr { call "or" [$1,$3] }- | expr 'not' expr { call "not" [$1,$3] }- | expr 'union' expr { call "union" [$1,$3] }- | expr 'intersect' expr { call "intersect" [$1,$3] }- | expr 'except' expr { call "except" [$1,$3] }- | expr 'instance' 'of' type { call "instance-of" [$1,Ast "type" [$4]] }- | expr 'cast' 'as' type { call "cast-as" [$1,Ast "type" [$4]] }- | expr 'castable' 'as' type { call "castable-as" [$1,Ast "type" [$4]] }- | 'typeswitch' '(' expr ')' typecases { let v = "_tc" in Ast "let" [Avar v,$3,$5 v] }- | '+' expr %prec UMINUS { call "uplus" [$2] }- | '-' expr %prec UMINUS { call "uminus" [$2] }- | 'not' expr %prec UMINUS { call "not" [$2] }- | string { $1 }- | 'Integer' { Aint $1 }- | 'Double' { Afloat $1 }- | 'validate' '{' expr '}' { Ast "validate" [$3] }- | 'insert' expr 'into' expr { Ast "insert" [$2,Ast "destination" [$4]] }- | 'delete' 'from' expr { Ast "delete" [$3] }- | 'replace' expr 'with' expr { Ast "replace" [$2,$4] }--expl :: { [ Ast ] }-expl : expr { [$1] }- | expl ',' expr { $1++[$3] }--clauses :: { Ast -> Ast }-clauses : 'for' for_bindings { $2 }- | 'let' let_bindings { $2 }- | clauses 'for' for_bindings { $1 . $3 }- | clauses 'let' let_bindings { $1 . $3 }--for_bindings :: { Ast -> Ast }-for_bindings : var 'in' expr { \x -> Ast "for" [$1,Avar "$",$3,x] }- | var 'at' var 'in' expr { \x -> Ast "for" [$1,$3,$5,x] }- | for_bindings ',' var 'in' expr { \x -> $1(Ast "for" [$3,Avar "$",$5,x]) }- | for_bindings ',' var 'at' var- 'in' expr { \x -> $1(Ast "for" [$3,$5,$7,x]) }--let_bindings :: { Ast -> Ast }-let_bindings : var ':=' expr { \x -> Ast "let" [$1,$3,x] }- | let_bindings ','- var ':=' expr { \x -> $1(Ast "let" [$3,$5,x]) }--opt_where :: { Ast -> Ast }-opt_where : 'where' expr { \x -> Ast "predicate" [$2,x] }- | {- empty -} { id }--opt_order :: { ( Ast -> Ast, Ast -> Ast ) }-opt_order : 'order' 'by' order_list { (\x -> Ast "sortTuple" (x:(fst $3)),- \x -> Ast "sort" (x:(snd $3))) }- | {- empty -} { (id,id) }--order_list :: { ( [ Ast ], [ Ast ] ) }-order_list : expr mode { ([$1],[$2]) }- | order_list ',' expr mode { ((fst $1)++[$3],(snd $1)++[$4]) }--mode :: { Ast }-mode : 'ascending' { Avar "ascending" }- | 'descending' { Avar "descending" }- | {- empty -} { Avar "ascending" }--computed :: { Ast }-computed : 'element' '(' qname ')' { call "element" [Avar $3] }- | 'attribute' '(' qname ')' { call "attribute" [Avar $3] }--element :: { Ast }-element : stag '>' content '</' qname '>' { if head $1 == Astring $5- then Ast "element_construction" ($1++[Ast "append" $3])- else parseError [TError ("Unmatched tags in element construction: "- ++(show (head $1))++" '"++$5++"'")] }- | stag '>' '</' qname '>' { if head $1 == Astring $4- then Ast "element_construction" ($1++[Ast "append" []])- else parseError [TError ("Unmatched tags in element construction: "- ++(show (head $1))++" '"++$4++"'")] }- | stag '/>' { Ast "element_construction" ($1++[Ast "append" []]) }- | 'element' '{' expr '}' '{' expl '}' { Ast "element_construction" [$3,Ast "attributes" [],concatenateAll $6] }- | 'attribute' '{' expr '}''{' expl '}'{ Ast "attribute_construction" [$3,concatenateAll $6] }- | 'element' qname '{' expl '}' { Ast "element_construction" [Astring $2,Ast "attributes" [],concatenateAll $4] }- | 'attribute' qname '{' expl '}' { Ast "attribute_construction" [Astring $2,concatenateAll $4] }--stag :: { [ Ast ] }-stag : '<' qname { [Astring $2,Ast "attributes" []] }- | '<' qname attributes { [Astring $2,Ast "attributes" $3] }--content :: { [ Ast ] }-content : '{' expl '}' { [concatenateAll $2] }- | 'String' { [Astring $1] }- | 'XMLtext' { [Astring $1] }- | element { [$1] }- | content '{' expl '}' { $1++[concatenateAll $3] }- | content 'String' { $1++[Astring $2] }- | content 'XMLtext' { $1++[Astring $2] }- | content element { $1++[$2] }--string :: { Ast }-string : stringc { if length $1 == 0 then Astring ""- else if length $1 == 1 then head $1 else Ast "append" $1 }--stringc :: { [Ast] }-stringc : 'String' { if $1=="" then [] else [Astring $1] }- | '{' expl '}' { [concatAll $2] }- | stringc 'String' { if $2=="" then $1 else $1++[Astring $2] }- | stringc '{' expl '}' { $1++[concatAll $3] }--attributes :: { [ Ast ] }-attributes : qname '=' string { [Ast "pair" [Astring $1,$3]] }- | attributes qname '=' string { $1++[Ast "pair" [Astring $2,$4]] }--full_path :: { Ast }-full_path : simple_step predicates { $1 "child" (Avar ".") $2 }- | '@' simple_step predicates { $2 "attribute" (Avar ".") $3 }- | simple_step predicates path { $3 ($1 "child" (Avar ".") $2) }- | '@' simple_step predicates path { $4 ($2 "attribute" (Avar ".") $3) }--path :: { Ast -> Ast }-path : step { $1 }- | path step { $2 . $1 }--step :: { Ast -> Ast }-step : '/' simple_step predicates { \e -> $2 "child" e $3 }- | '/' '@' simple_step predicates { \e -> $3 "attribute" e $4 }- | '/' '/' simple_step predicates { \e -> $3 "descendant" e $4 }- | '/' '/' '@' simple_step predicates { \e -> $4 "attribute-descendant" e $5 }- | '/' '..' { \e -> Ast "step" [Avar "parent",Astring "*",e] }--predicates :: { [ Ast ] }-predicates : predicates '[' expr ']' { $1 ++ [$3] }- | {- empty -} { [] }--simple_step :: { String -> Ast -> [ Ast ] -> Ast }-simple_step : primary_expr { \t e ps -> if null ps- then $1 t e- else Ast "filter" ($1 t e:ps) }- | '*' { \t e ps -> Ast "step" ((Avar t):(Astring "*"):e:ps) }- | qname { \t e ps -> if elem $1 path_steps- then parseError [TError ("Axis "++$1++" is missing a node step")]- else Ast "step" ((Avar t):(Astring $1):e:ps) }- | 'QName' ':' ':' qname { \t e ps -> if elem $1 path_steps- then if t == "child"- then Ast "step" ((Avar $1):(Astring $4):e:ps)- else parseError [TError ("The navigation step must be /"++$1++"::"++$4)]- else parseError [TError ("Not a valid axis name: "++$1)] }- | 'QName' ':' ':' '*' { \t e ps -> if elem $1 path_steps- then if t == "child"- then Ast "step" ((Avar $1):(Astring "*"):e:ps)- else parseError [TError ("The navigation step must be /"++$1++"::*")]- else parseError [TError ("Not a valid axis name: "++$1)] }--primary_expr :: { String -> Ast -> Ast }-primary_expr : var { \_ _ -> $1 }- | '.' { \_ e -> e }- | '(' expl ')' { \t e -> if e == Avar "."- then concatenateAll $2- else Ast "context" [e,Astring t,concatenateAll $2] }- | '(' ')' { \_ _ -> call "empty" [] }- | qname '(' expl ')' { \t e -> if e == Avar "."- then call $1 $3- else Ast "context" [e,Astring t,call $1 $3] }- | qname '(' ')' { \_ e -> if elem $1 ["last","position","true","false","empty","select"]- then call $1 []- else call $1 [e] }--typecases :: { String -> Ast }-typecases : 'case' type 'return' expr- 'default' 'return' expr { \v -> Ast "if" [call "instance-of" [Avar v,Ast "type" [$2]],$4,$7] }- | 'case' type 'return' expr typecases { \v -> Ast "if" [call "instance-of" [Avar v,Ast "type" [$2]],$4,$5 v] }---{---- Abstract Syntax Tree for XQueries-data Ast = Ast String [Ast]- | Avar String- | Aint Int- | Afloat Double- | Astring String- deriving Eq---instance Show Ast- where show (Ast s []) = s ++ "()"- show (Ast s (x:xs)) = s ++ "(" ++ show x- ++ foldr (\a r -> ","++show a++r) "" xs- ++ ")"- show (Avar s) = s- show (Aint n) = show n- show (Afloat n) = show n- show (Astring s) = "\'" ++ s ++ "\'"---screenSize = 80::Int--prettyAst :: Ast -> Int -> (String,Int)-prettyAst (Avar s) p = (s,(length s)+p)-prettyAst (Aint n) p = let s = show n in (s,(length s)+p)-prettyAst (Afloat n) p = let s = show n in (s,(length s)+p)-prettyAst (Astring s) p = ("\'" ++ s ++ "\'",(length s)+p+2)-prettyAst (Ast s args) p- = let (ps,np) = prettyArgs args- in (s++"("++ps++")",np+1)- where prettyArgs [] = ("",p+1)- prettyArgs xs = let ss = show (head xs) ++ foldr (\a r -> ","++show a++r) "" (tail xs)- np = (length s)+p+1- in if (length ss)+p < screenSize- then (ss,(length ss)+p)- else let ds = map (\x -> let (s,ep) = prettyAst x np- in (s ++ ",\n" ++ space np,ep)) (init xs)- (ls,lp) = prettyAst (last xs) np- in (concatMap fst ds ++ ls,lp)- space n = replicate n ' '---ppAst :: Ast -> String-ppAst e = let (s,_) = prettyAst e 0 in s---call :: String -> [Ast] -> Ast-call name args = Ast "call" ((Avar name):args)---concatenateAll :: [Ast] -> Ast-concatenateAll [x] = x-concatenateAll (x:xs) = foldl (\a r -> call "concatenate" [a,r]) x xs-concatenateAll _ = call "empty" []---concatAll :: [Ast] -> Ast-concatAll [x] = call "string" [x]-concatAll (x:xs) = foldl (\a r -> call "concatenate" [call "string" [a],r]) x xs-concatAll _ = call "empty" []---mkPairs = map (\(x,y) -> Ast "pair" [x,y])---path_steps = ["child", "descendant", "attribute", "self", "descendant-or-self", "following-sibling", "following",- "attribute-descendant", "parent", "ancestor", "preceding-sibling", "preceding", "ancestor-or-self" ]---data Token- = RETURN | SOME | EVERY | IF | THEN | ELSE | LB | RB | LP | RP | LSB | RSB- | TO | PLUS | MINUS | TIMES | DIV | IDIV | MOD | AS | QMARK- | TEQ | TNE | TLT | TLE | TGT | TGE | SEQ | SNE | SLT | SLE | SGT | SGE- | AND | OR | NOT | UNION | INTERSECT | EXCEPT | FOR | LET | IN | COMMA- | ASSIGN | WHERE | ORDER | BY | ASCENDING | DESCENDING | ELEMENT- | ATTRIBUTE | STAG | ETAG | SATISFIES | ATSIGN | SLASH | DECLARE | SEMI | COLON- | FUNCTION | VARIABLE | VIEW | AT | DOT | DOTS | TokenEOF | PRE | POST | IS- | INSERT | INTO | DELETE | FROM | REPLACE | TYPE | WITH | INSTANCE | OF- | CAST | CASTABLE | CASE | DEFAULT | TYPESWITCH | IMPORT | NAMESPACE | SCHEMA | VALIDATE- | QName String | Variable String | XMLtext String | TInteger Int- | TFloat Double | TString String | TError String- deriving Eq---instance Show Token- where show (QName s) = "QName("++s++")"- show (Variable s) = "Variable("++s++")"- show (XMLtext s) = "XMLtext("++s++")"- show (TInteger n) = "Integer("++(show n)++")"- show (TFloat n) = "Double("++(show n)++")"- show (TString s) = "String("++s++")"- show (TError s) = "'"++s++"'"- show t = case filter (\(n,_) -> n==t) tokenList of- (_,b):_ -> b- _ -> "Illegal token"---printToken (QName s) = s-printToken (Variable s) = "$"++s-printToken (XMLtext s) = "'"++s++"'"-printToken (TInteger n) = show n-printToken (TFloat n) = show n-printToken (TString s) = "\""++s++"\""-printToken (TError s) = "error("++s++")"-printToken t = case filter (\(n,_) -> n==t) tokenList of- (_,b):_ -> b- _ -> "Illegal token"---tokenList :: [(Token,String)]-tokenList = [(TokenEOF,"EOF"),(RETURN,"return"),(SOME,"some"),(EVERY,"every"),(IF,"if"),(THEN,"then"),(ELSE,"else"),- (LB,"["),(RB,"]"),(LP,"("),(RP,")"),(LSB,"{"),(RSB,"}"),(QMARK,"?"),- (TO,"to"),(PLUS,"+"),(MINUS,"-"),(TIMES,"*"),(DIV,"div"),(IDIV,"idiv"),(MOD,"mod"),- (TEQ,"="),(TNE,"!="),(TLT,"<"),(TLE,"<="),(TGT,">"),(TGE,">="),(PRE,"<<"),(POST,">>"),- (IS,"is"),(SEQ,"eq"),(SNE,"ne"),(SLT,"lt"),(SLE,"le"),(SGT,"gt"),(SGE,"ge"),(AND,"and"),- (OR,"or"),(NOT,"not"),(UNION,"|"),(INTERSECT,"intersect"),(EXCEPT,"except"),- (FOR,"for"),(LET,"let"),(IN,"in"),(AS,"as"),(COMMA,"','"),(ASSIGN,":="),(WHERE,"where"),(ORDER,"order"),- (BY,"by"),(ASCENDING,"ascending"),(DESCENDING,"descending"),(ELEMENT,"element"),- (ATTRIBUTE,"attribute"),(STAG,"</"),(ETAG,"/>"),(SATISFIES,"satisfies"),(ATSIGN,"@"),- (SLASH,"/"),(DECLARE,"declare"),(FUNCTION,"function"),(VARIABLE,"variable"),(VIEW,"view"),- (INSERT,"insert"),(INTO,"into"),(DELETE,"delete"),(FROM,"from"),(REPLACE,"replace"),(WITH,"with"),- (TYPE,"type"),(AT,"at"),(DOTS,".."),(DOT,"."),(SEMI,";"),(COLON,":"),(INSTANCE,"instance"),(OF,"of"),- (CAST,"cast"),(CASTABLE,"castable"),(CASE,"case"),(DEFAULT,"default"),(TYPESWITCH,"typeswitch"),- (VALIDATE,"validate")]---parseError tk = error (case tk of- ((TError s):_) -> "Parse error: "++s- (TokenEOF:_) -> "Parse error: Unexpected end of file"- _ -> "Parse error: "++(foldr (\a r -> (printToken a)++" "++r) "" (init (take 11 tk))))---scan :: String -> [Token]-scan cs = lexer cs ""---xmlText :: String -> [Token]-xmlText "" = []-xmlText text = [XMLtext text]----- scans XML syntax and returns an XMLtext token with the text-xml :: String -> String -> String -> [Token]-xml ('{':cs) text n = (xmlText text)++(LSB : lexer cs ('{':n))-xml ('<':'/':cs) text n = (xmlText text)++(STAG : lexer cs ('<':'/':n))-xml ('<':'!':'-':cs) text n = xmlComment cs (text++"<!-") n-xml ('<':'?':cs) text n = xmlComment cs (text++"<?") n-xml ('<':cs) text n = (xmlText text)++(TLT : lexer cs ('<':n))-xml ('(':':':cs) text n = xqComment cs text n-xml (c:cs) text n = xml cs (text++[c]) n-xml [] text _ = xmlText text---xqComment :: String -> String -> String -> [Token]-xqComment (':':')':cs) text n = xml cs text n-xqComment (_:cs) text n = xqComment cs text n-xqComment [] text _ = xmlText text---xmlComment :: String -> String -> String -> [Token]-xmlComment ('-':'!':'>':cs) text n = xml cs (text++"-!>") n-xmlComment ('?':'>':cs) text n = xml cs (text++"?>") n-xmlComment (c:cs) text n = xmlComment cs (text++[c]) n-xmlComment [] text _ = xmlText text---isQN :: Char -> Bool-isQN c = elem c "_-." || isDigit c || isAlpha c---isVar :: Char -> Bool-isVar c = elem c "_-." || isDigit c || isAlpha c---inXML :: String -> Bool-inXML ('>':'<':_) = True-inXML _ = False----- the XQuery scanner-lexer :: String -> String -> [Token]-lexer [] "" = [ TokenEOF ]-lexer [] _ = [ TError "Unexpected end of input" ]-lexer (' ':'>':' ':cs) n = TGT : lexer cs n-lexer (c:cs) n- | isSpace c = lexer cs n- | isAlpha c || c=='_' = lexVar (c:cs) n- | isDigit c = lexNum (c:cs) n-lexer ('$':c:cs) n | isAlpha c- = let (var,rest) = span isVar (c:cs)- in (Variable var) : lexer rest n-lexer (':':'=':cs) n = ASSIGN : lexer cs n-lexer ('<':'/':cs) n = STAG : lexer cs ('<':'/':n)-lexer ('<':'=':cs) n = TLE : lexer cs n-lexer ('>':'=':cs) n = TGE : lexer cs n-lexer ('<':'<':cs) n = PRE : lexer cs n-lexer ('>':'>':cs) n = POST : lexer cs n-lexer ('/':'>':cs) m = case m of- '<':n -> ETAG : (if inXML n then xml cs "" n else lexer cs n)- _ -> [ TError "Unexpected token: '/>'" ]-lexer ('(':':':cs) n = lexComment cs n-lexer ('<':'!':'-':cs) n = lexXmlComment cs "<!-" n-lexer ('<':'?':cs) n = lexXmlComment cs "<?" n-lexer ('.':'.':cs) n = DOTS : lexer cs n-lexer ('.':cs) n = DOT : lexer cs n-lexer ('!':'=':cs) n = TNE : lexer cs n-lexer ('\'':cs) n = lexString cs "" ('\'':n)-lexer ('\"':cs) n = lexString cs "" ('\"': n)-lexer ('[':cs) n = LB : lexer cs n-lexer (']':cs) n = RB : lexer cs n-lexer ('(':cs) n = LP : lexer cs n-lexer (')':cs) n = RP : lexer cs n-lexer ('}':cs) m = case m of- '{':'\"':n -> RSB : lexString cs "" ('\"':n)- '{':'\'':n -> RSB : lexString cs "" ('\'':n)- '{':n -> RSB : (if inXML n then xml cs "" n else lexer cs n)- _ -> [ TError "Unexpected token: '}'" ]-lexer ('+':cs) n = PLUS : lexer cs n-lexer ('-':cs) n = MINUS : lexer cs n-lexer ('*':cs) n = TIMES : lexer cs n-lexer ('=':cs) n = TEQ : lexer cs n-lexer ('<':c:cs) n = TLT : (lexer (c:cs) (if isAlpha c then ('<':n) else n))-lexer ('>':cs) m = case m of- '<':'/':'>':'<':n -> TGT : (if inXML n then xml cs "" n else lexer cs n)- '<':n -> TGT : xml cs "" ('>':m) - _ -> TGT : lexer cs m-lexer (',':cs) n = COMMA : lexer cs n-lexer ('@':cs) n = ATSIGN : lexer cs n-lexer ('?':cs) n = QMARK : lexer cs n-lexer ('/':cs) n = SLASH : lexer cs n-lexer ('{':cs) n = LSB : lexer cs ('{':n)-lexer ('|':cs) n = UNION : lexer cs n-lexer (';':cs) n = SEMI : lexer cs n-lexer (':':cs) n = COLON : lexer cs n-lexer (c:cs) n = TError ("Illegal character: '"++[c,'\'']) : lexer cs n---lexExp :: String -> (String,String)-lexExp (e:cs)- | e == 'e' || e == 'E'- = case cs of- '+':rest -> span isDigit rest- '-':rest -> let (s,rest1) = span isDigit rest- in ('-':s,rest1)- rest -> span isDigit rest-lexExp cs = ("",cs)---lexNum :: String -> String -> [Token]-lexNum cs n- = let (si,rest) = span isDigit cs- in case rest of- '.':rest1- -> let (sd,rest2) = span isDigit rest1- in case lexExp rest2 of- ("",_) -> (TFloat (read $ si ++ "." ++ sd)) : lexer rest2 n- (exp,rest3) -> (TFloat (read $ si ++ "." ++ sd ++ "e" ++ exp)) : lexer rest3 n- _ -> case lexExp rest of- ("",_) -> (TInteger (read si)) : lexer rest n- (exp,rest3) -> (TFloat (read $ si ++ "e" ++ exp)) : lexer rest3 n---lexString :: String -> String -> String -> [Token]-lexString ('\"':cs) s m = case m of- '\"':n -> (TString s) : (lexer cs n)- _ -> lexString cs (s++"\"") m-lexString ('\'':cs) s m = case m of- '\'':n -> (TString s) : (lexer cs n)- _ -> lexString cs (s++"\'") m--- a string in an attribute value must evaluate between {}-lexString ('{':cs) s (c:'<':n) = (TString s) : LSB : (lexer cs ('{':c:'<':n))-lexString ('\\':'n':cs) s n = lexString cs (s++['\n']) n-lexString ('\\':'r':cs) s n = lexString cs (s++['\r']) n-lexString (c:cs) s n = lexString cs (s++[c]) n-lexString [] s n = [ TError "End of input while in string" ]---lexComment :: String -> String -> [Token]-lexComment (':':')':cs) n = lexer cs n-lexComment (_:cs) n = lexComment cs n-lexComment [] n = [ TError "End of input while in comment" ]---lexXmlComment :: String -> String -> String -> [Token]-lexXmlComment ('-':'!':'>':cs) text n = (xmlText (text++"-!>"))++(lexer cs n)-lexXmlComment ('?':'>':cs) text n = (xmlText (text++"?>"))++(lexer cs n)-lexXmlComment (c:cs) text n = lexXmlComment cs (text++[c]) n-lexXmlComment [] text _ = xmlText text---lexVar :: String -> String -> [Token]-lexVar cs n =- let (nm,rest) = span isQN cs- token = case nm of- "return" -> RETURN- "some" -> SOME- "every" -> EVERY- "if" -> IF- "then" -> THEN- "else" -> ELSE- "to" -> TO- "div" -> DIV- "idiv" -> IDIV- "mod" -> MOD- "and" -> AND- "or" -> OR- "not" -> NOT- "union" -> UNION- "intersect" -> INTERSECT- "except" -> EXCEPT- "for" -> FOR- "let" -> LET- "in" -> IN- "as" -> AS- "where" -> WHERE- "order" -> ORDER- "by" -> BY- "ascending" -> ASCENDING- "descending" -> DESCENDING- "element" -> ELEMENT- "attribute" -> ATTRIBUTE- "satisfies" -> SATISFIES- "declare" -> DECLARE- "function" -> FUNCTION- "variable" -> VARIABLE- "namespace" -> NAMESPACE- "view" -> VIEW- "at" -> AT- "eq" -> SEQ- "ne" -> SNE- "lt" -> SLT- "le" -> SLE- "gt" -> SGT- "ge" -> SGE- "is" -> IS- "insert" -> INSERT- "into" -> INTO- "delete" -> DELETE- "from" -> FROM- "replace" -> REPLACE- "type" -> TYPE- "with" -> WITH- "instance" -> INSTANCE- "of" -> OF- "cast" -> CAST- "castable" -> CASTABLE- "case" -> CASE- "default" -> DEFAULT- "typeswitch" -> TYPESWITCH- "schema" -> SCHEMA- "import" -> IMPORT- "validate" -> VALIDATE- var -> QName var- in case token of- QName v1 -> case rest of- ':':':':'*':rest2 -> [QName v1,COLON,COLON,TIMES] ++ lexer rest2 n- ':':':':rest2 -> let (v2,rest3) = span isQN rest2- in [QName v1,COLON,COLON,QName v2] ++ lexer rest3 n- ':':rest2 -> let (v2,rest3) = span isQN rest2- in [QName v1,COLON,QName v2] ++ lexer rest3 n- _ -> QName v1 : lexer rest n- x -> x : lexer rest n-}
compile view
@@ -1,5 +1,5 @@ #!/bin/sh -xquery -c $1+./xquery -c $1 if [$2 == ""]; then file="a.out"; else file=$2; fi ghc -O2 -v0 -funfolding-use-threshold=16 --make Temp.hs -o $file
db.html view
@@ -7,7 +7,7 @@ <body> <center> <h1>HXQ with Database Connectivity</h1>-<h3>Download <a href="/HXQ-0.18.2.tar.gz">HXQ-0.18.2.tar.gz</a></h3>+<h3>Download <a href="/HXQ-0.19.0.tar.gz">HXQ-0.19.0.tar.gz</a></h3> </center> <p> <h2>Installation Instructions (HXQ with database connectivity)</h2>@@ -36,13 +36,14 @@ </pre> (Make sure that your username/password works and that the Driver has the correct path.) Then, start the mysql server (using <tt>service mysqld start</tt> as root on Linux)-and create a database using the mysql command+and create a database using the <tt>mysql</tt> command <tt>create database hxq</tt>. <p> The simplest way to install HXQ with MySQL is to use cabal (see <a href="index.html">HXQ without Database Connectivity</a>): <pre> cabal install HXQ -fmysql </pre>+and then compile <tt>xquery.hs</tt>. Alternatively, you can download and install the packages <a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HDBC">HDBC</a> and@@ -62,6 +63,7 @@ <pre> cabal install HXQ -fsqlite </pre>+and then compile <tt>xquery.hs</tt>. Alternatively, you can download and install the packages <a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HDBC">HDBC</a> and@@ -98,11 +100,11 @@ form <tt>sql(query,args)</tt>, where <tt>query</tt> is the sql query that may contain parameters (denoted by ?), which are bound to the values in <tt>args</tt> (an XSeq). An example can be found-in <a href="TestDB.hs">TestDB.hs</a>. To run this example, you need to+in <a href="tests/TestDB.hs">tests/TestDB.hs</a>. To run this example, you need to install the <a href="data/company.sql">company</a> database (using <tt>source data/company.sql</tt> in mysql or <tt>.read data/company.sql</tt> in sqlite3)-and then compile and run <tt>TestDB.hs</tt>.+and then compile and run <tt>tests/TestDB.hs</tt>. <p> <h2>Shredding</h2> <p>@@ -151,7 +153,7 @@ constant strings. HXQ will do its best to push relevant predicates to the generated SQL query (using partial evaluation and code folding), thus deriving an efficient execution. One example-is <a href="TestDB2.hs">TestDB2.hs</a>.+is <a href="tests/TestDB2.hs">tests/TestDB2.hs</a>. <p> <h2>Updates</h2> <p>@@ -192,7 +194,7 @@ <p> First download and uncompress <tt>dblp.xml.gz</tt> from <a href="http://dblp.uni-trier.de/xml/">DBLP</a>. To install the DBLP database, compile and execute-<a href="TestDBLP.hs">TestDBLP.hs</a>.+<a href="tests/TestDBLP.hs">tests/TestDBLP.hs</a>. Then, you may evaluate queries, such as <a href="data/q4.xq">data/q4.xq</a>, using the HXQ interpreter, <tt>xquery -db hxq -t data/q4.xq</tt>, which takes about 90 milliseconds with MySQL. <p>@@ -205,4 +207,4 @@ <p> <hr> <p>-<address>Last modified: 09/29/09 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>+<address>Last modified: 01/09/10 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>
index.html view
@@ -7,7 +7,7 @@ <body> <center> <h1>HXQ: A Compiler from XQuery to Haskell</h1>-<h3>Download <a href="/HXQ-0.18.2.tar.gz">HXQ-0.18.2.tar.gz</a></h3>+<h3>Download <a href="/HXQ-0.19.0.tar.gz">HXQ-0.19.0.tar.gz</a></h3> </center> <p> <h2>Description</h2>@@ -47,7 +47,7 @@ <h2>Performance</h2> <p> HXQ shines best when used for data intensive applications. For example,-the XQuery in <a href="Test2.hs">Test2.hs</a>, which is against+the XQuery in <a href="tests/Test2.hs">tests/Test2.hs</a>, which is against the <a href="http://dblp.uni-trier.de/xml/">DBLP XML document</a> (420MB), runs in 36 seconds on my laptop PC and uses a maximum of 3.2MB of heap space (using the runtime options <tt>+RTS -H2m -M3.2m</tt>).@@ -60,10 +60,10 @@ which is written in C++, takes 1 minute and 10 secs and uses 1150MB of heap space. For simple XPath queries, the fastest implementation I have ever tried is-using <a href="http://lambda.uta.edu/cse5335/examples/sax.java">SAX+using <a href="/cse5335/examples/sax.java">SAX pipelines</a>, which runs in 17secs and needs 3MB heap. Unfortunately, it is very hard to implement complex XQuery constructs-using <a href="http://lambda.uta.edu/XStreamQuery.pdf">SAX</a>,+using <a href="/XStreamQuery.pdf">SAX</a>, and one may end up simulating lazy evaluation using ad-hoc techniques. <p> For better performance in data intensive applications, one may use the@@ -76,7 +76,7 @@ source. I have also tried hexpat, tagsoup, HXT, and HaXML Xtract, but they all have space leaks. <p>-HXQ has two parsers: one that generates simple rose trees from XML+HXQ has two XML parsers: one that generates simple rose trees from XML documents, which can be processed by forward queries without space leaks, and another parser where each tree node has a reference to its parent. Some, but not all, backward axis steps (such as the parent@@ -104,14 +104,20 @@ On Linux, you can install Haskell and cabal using <tt>yum install ghc happy cabal-install</tt>. You must then update the list of known packages using <tt>cabal update</tt>. <p>-The simplest way to install HXQ is by using the cabal command:+The simplest way to install the HXQ library is by using the cabal command: <pre> cabal install HXQ </pre> which will automatically download and install all required packages. <p>+(If you use the old base-3 ghc library, use the option <tt>-fbase3</tt> in cabal).+Then, to compile the <tt>xquery</tt> command line interpreter, you download +<a href="xquery.hs">xquery.hs</a> and you do:+<pre>+ghc --make xquery.hs -o xquery+</pre> An alternative way of installing HXQ is to download and install all required packages one-by-one:-First download <a href="/HXQ-0.18.2.tar.gz">HXQ version 0.18.2</a> and untar+First download <a href="/HXQ-0.19.0.tar.gz">HXQ version 0.19.0</a> and untar it (using <tt>tar xfz</tt> on Linux/Mac or <a href="http://www.7-zip.org/">7z x</a> on Windows). Then, you execute the following commands inside the HXQ directory:@@ -120,12 +126,12 @@ runhaskell Setup.lhs build runhaskell Setup.lhs install </pre>-If the configure command indicates that haskeline is missing, install the packages-<a href="http://hackage.haskell.org/package/extensible-exceptions">extensible-exceptions</a> and-<a href="http://hackage.haskell.org/package/haskeline">haskeline</a> first-using the same process.+If the configure command indicates that some packages are missing,+download these packages+from <a href="http://hackage.haskell.org/">Hackage</a> and install+them using the same process. <p>-HXQ consists of the executable <tt>xquery</tt>, which is the XQuery interpreter, and the+HXQ consists of the executable <tt>xquery</tt>, which is the XQuery command line interpreter, and the HXQ library. <p> To use the HXQ library in a Haskell program,@@ -163,8 +169,8 @@ The complete XQuery syntax in HXQ is described in <a href="hxq-manual.pdf">hxq-manual.pdf</a>. I have also written a <a href="/updates09.pdf">paper</a> that describes some of the database related methods used in the implementation.-Here some tutorials on <a href="http://lambda.uta.edu/cse5335/queries.pdf">XPath</a>-and <a href="http://lambda.uta.edu/cse5335/xquery.pdf">XQuery</a>.+Here some tutorials on <a href="/cse5335/queries.pdf">XPath</a>+and <a href="/cse5335/xquery.pdf">XQuery</a>. Here are two relevant courses on XML and databases at <a href="http://www.stanford.edu/class/cs345b/">Stanford</a> and <a href="http://www.dbis.ethz.ch/education/ws0708/xml_db_ws2007">ETH</a>. <p>@@ -203,10 +209,10 @@ b <- $(xq " f( $a/paper[10], $a/paper[8] ) ") putXSeq b </pre>-Another example, can be found in <a href="Test1.hs">Test1.hs</a>. You compile it using-<tt>ghc -O2 --make Test1.hs -o a.out</tt>.+Another example, can be found in <a href="tests/Test1.hs">tests/Test1.hs</a>. You compile it using+<tt>ghc -O2 --make tests/Test1.hs -o a.out</tt>. Using the latest ghc (version >= 6.9), one may use <a href="http://haskell.org/haskellwiki/Quasiquotation">quasi-quotations</a>-instead of strings, as is shown in <a href="Test2a.hs">Test2a.hs</a>.+instead of strings, as is shown in <a href="tests/Test2a.hs">tests/Test2a.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@@ -228,13 +234,14 @@ which evaluates an XQuery in a string. The HXQ interpreter doesn't recognize Haskell variables and functions (but you may declare XQuery variables and functions using the XQuery-'declare' syntax). The main HXQ program, called <tt>xquery</tt>,-evaluates an XQuery in a file using the interpreter. For example:+'declare' syntax). The HXQ command line interpreter, called <tt>xquery</tt>,+can evaluate an XQuery in a file using the interpreter. For example: <pre> xquery data/q1.xq-</pre> Without an argument, it reads and evaluates XQueries and+</pre>+Without an argument, it reads and evaluates XQueries and variable/function declarations from input. With <tt>xquery -p-xpath-query xml-file</tt> you can evaluate an XPath query against an XML+xpath-query xml-file</tt>, you can evaluate an XPath query against an XML file. For example, <pre> xquery -p "//inproceedings[100]" data/dblp.xml@@ -262,4 +269,4 @@ <p> <hr> <p>-<address>Last modified: 10/08/09 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>+<address>Last modified: 01/08/10 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>
release.html view
@@ -10,6 +10,9 @@ </center> <p> <dl>+<dt> HXQ-0.19.0 (released on 01/09/10)</dt>+<dd>+<p> <dt> HXQ-0.18.0 (released on 09/29/09)</dt> <dd> Added namespaces, XML Schema validation, and type inference. Added general URL for doc files based on the HTTP package. <p>@@ -40,4 +43,4 @@ <p> <hr> <p>-<address>Last modified: 09/29/09 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>+<address>Last modified: 01/09/10 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>
src/Text/XML/HXQ/Compiler.hs view
@@ -27,6 +27,7 @@ import Control.Monad import Char(toLower) import List(sortBy)+import Data.List(foldl') import XMLParse(parseDocument) import Text.XML.HXQ.Optimizer import Text.XML.HXQ.Functions@@ -741,10 +742,16 @@ type QuasiQuoter = String #endif +quasi_error = \_ -> error "XQuery patterns are not allowed"+ -- | Quasi-quotation for HXQ (for ghc 6.09 or later). For example, @[qx| doc(\"data\/cs.xml\")\/\/gpa |]@ is equivalent to @xq \"doc(\\\"data\/cs.xml\\\")\/\/gpa\"@. qx :: QuasiQuoter+#if __GLASGOW_HASKELL__ >= 700+qx = QuasiQuoter { quoteExp = xq, quotePat = quasi_error, quoteType = quasi_error, quoteDec = quasi_error }+#else #if __GLASGOW_HASKELL__ >= 609-qx = QuasiQuoter xq (\_ -> error "XQuery patterns are not allowed")+qx = QuasiQuoter xq quasi_error #else qx = error "Quasi-quotation not permitted in earlier ghc versions"+#endif #endif
src/Text/XML/HXQ/Functions.hs view
@@ -36,6 +36,7 @@ -- XPath step self /. self_step :: QName -> XTree -> XSeq+{-# INLINE self_step #-} self_step tag x = case x of XElem t _ _ _ _@@ -45,6 +46,7 @@ -- XPath step /tag or / * child_step :: QName -> XTree -> XSeq+{-# INLINE child_step #-} child_step tag x = case x of XElem _ _ _ _ bs@@ -73,7 +75,7 @@ descendant_step _ _ = [] --- It's like //* but has tagged children, which are derived statically+-- It's like // * but has tagged children, which are derived statically -- After examining 100 children it gives up: this avoids space leaks descendant_any_with_tagged_children :: [QName] -> XTree -> XSeq descendant_any_with_tagged_children tags (XElem t _ _ _ cs)@@ -92,6 +94,7 @@ -- XPath step /@attr or /@* attribute_step :: QName -> XTree -> XSeq+{-# INLINE attribute_step #-} attribute_step attr x = case x of XElem _ al _ _ _@@ -246,7 +249,7 @@ -- lazy: like foldr but with an index foldir :: (a -> Int -> b -> b) -> b -> [a] -> Int -> b {-# INLINE foldir #-}-{-# SPECIALIZE foldir :: (XTree -> Int -> XSeq -> XSeq) -> XSeq -> XSeq -> Int -> XSeq #-}+-- SPECIALIZE foldir :: (XTree -> Int -> XSeq -> XSeq) -> XSeq -> XSeq -> Int -> XSeq foldir c n [] i = n foldir c n (x:xs) i = c x i (foldir c n xs $! (i+1))
src/Text/XML/HXQ/Optimizer.hs view
@@ -80,7 +80,7 @@ -- Rules to extract the parent of an XQuery expression -- For every XQuery x and predicates p1 ... pn and for s in [tag,*,@attr]: -- x/s[p1]...[pn]/.. -> x[s[p1]...[pn]]--- x//s[p1]...[pn]/.. -> x//*[s[p1]...[pn]]+-- x//s[p1]...[pn]/.. -> x// *[s[p1]...[pn]] removeParent :: Ast -> Maybe (Ast,Ast,Bool,Ast) removeParent (Ast "predicate" [c,x]) = do (nx,cond,childp,tag) <- removeParent x@@ -113,7 +113,7 @@ removeParent e = Nothing --- to speed up //* step, find possible immediate tagged children, if any (eg, x in //*/x)+-- to speed up // * step, find possible immediate tagged children, if any (eg, x in // */x) tagged_children :: String -> Ast -> [String] tagged_children context (Ast "step" (Avar "child":Astring tag:Avar v:_)) | v == context@@ -176,7 +176,7 @@ (Ast "pair" [Astring "_id",id]):(Ast "pair" [Astring "_parent",parent]):atts -> simplify (Ast "construction" [tag,id,parent,Ast "attributes" atts,nc]) atts -> simplify (Ast "construction" [tag,Astring "0",Ast "call" [Avar "empty"],Ast "attributes" atts,nc])--- if //* collect all children tagnames to use descendant_any+-- if / / * collect all children tagnames to use descendant_any simplify (Ast "for" [Avar var,i,Ast "step" (Avar "descendant":Astring "*":path:preds),body]) | not (null ((tagged_children var body))) || any (not . null . (tagged_children ".")) preds = let ctags = distinct ((tagged_children var body)++(concatMap (tagged_children ".") preds))
src/Text/XML/HXQ/Parser.hs view
@@ -1,246 +1,239 @@+{-# OPTIONS_GHC -w #-} {-# OPTIONS -fglasgow-exts -cpp #-} module Text.XML.HXQ.Parser(Ast(..),scan,parse,call,concatenateAll,ppAst) where import Char-#if __GLASGOW_HASKELL__ >= 503-import Data.Array-#else-import Array-#endif-#if __GLASGOW_HASKELL__ >= 503-import GHC.Exts-#else-import GlaExts-#endif+import qualified Data.Array as Happy_Data_Array+import qualified GHC.Exts as Happy_GHC_Exts --- parser produced by Happy Version 1.18.2+-- parser produced by Happy Version 1.18.6 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607-type HappyAny = GHC.Exts.Any+type HappyAny = Happy_GHC_Exts.Any #else type HappyAny = forall a . a #endif happyIn4 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn4 x = unsafeCoerce# x+happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn4 #-} happyOut4 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut4 x = unsafeCoerce# x+happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut4 #-} happyIn5 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn5 x = unsafeCoerce# x+happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn5 #-} happyOut5 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut5 x = unsafeCoerce# x+happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut5 #-} happyIn6 :: (Ast) -> (HappyAbsSyn )-happyIn6 x = unsafeCoerce# x+happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn6 #-} happyOut6 :: (HappyAbsSyn ) -> (Ast)-happyOut6 x = unsafeCoerce# x+happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut6 #-} happyIn7 :: (Ast) -> (HappyAbsSyn )-happyIn7 x = unsafeCoerce# x+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn7 #-} happyOut7 :: (HappyAbsSyn ) -> (Ast)-happyOut7 x = unsafeCoerce# x+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut7 #-} happyIn8 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn8 x = unsafeCoerce# x+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn8 #-} happyOut8 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut8 x = unsafeCoerce# x+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut8 #-} happyIn9 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn9 x = unsafeCoerce# x+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn9 #-} happyOut9 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut9 x = unsafeCoerce# x+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut9 #-} happyIn10 :: (String) -> (HappyAbsSyn )-happyIn10 x = unsafeCoerce# x+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn10 #-} happyOut10 :: (HappyAbsSyn ) -> (String)-happyOut10 x = unsafeCoerce# x+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut10 #-} happyIn11 :: ([ (Ast,Ast) ]) -> (HappyAbsSyn )-happyIn11 x = unsafeCoerce# x+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn11 #-} happyOut11 :: (HappyAbsSyn ) -> ([ (Ast,Ast) ])-happyOut11 x = unsafeCoerce# x+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut11 #-} happyIn12 :: ([ (Ast,Ast) ]) -> (HappyAbsSyn )-happyIn12 x = unsafeCoerce# x+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn12 #-} happyOut12 :: (HappyAbsSyn ) -> ([ (Ast,Ast) ])-happyOut12 x = unsafeCoerce# x+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut12 #-} happyIn13 :: (Ast) -> (HappyAbsSyn )-happyIn13 x = unsafeCoerce# x+happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn13 #-} happyOut13 :: (HappyAbsSyn ) -> (Ast)-happyOut13 x = unsafeCoerce# x+happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut13 #-} happyIn14 :: (Ast) -> (HappyAbsSyn )-happyIn14 x = unsafeCoerce# x+happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn14 #-} happyOut14 :: (HappyAbsSyn ) -> (Ast)-happyOut14 x = unsafeCoerce# x+happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut14 #-} happyIn15 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn15 x = unsafeCoerce# x+happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn15 #-} happyOut15 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut15 x = unsafeCoerce# x+happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut15 #-} happyIn16 :: (Ast) -> (HappyAbsSyn )-happyIn16 x = unsafeCoerce# x+happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn16 #-} happyOut16 :: (HappyAbsSyn ) -> (Ast)-happyOut16 x = unsafeCoerce# x+happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut16 #-} happyIn17 :: (Ast) -> (HappyAbsSyn )-happyIn17 x = unsafeCoerce# x+happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn17 #-} happyOut17 :: (HappyAbsSyn ) -> (Ast)-happyOut17 x = unsafeCoerce# x+happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut17 #-} happyIn18 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn18 x = unsafeCoerce# x+happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn18 #-} happyOut18 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut18 x = unsafeCoerce# x+happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut18 #-} happyIn19 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn19 x = unsafeCoerce# x+happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn19 #-} happyOut19 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut19 x = unsafeCoerce# x+happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut19 #-} happyIn20 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn20 x = unsafeCoerce# x+happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn20 #-} happyOut20 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut20 x = unsafeCoerce# x+happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut20 #-} happyIn21 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn21 x = unsafeCoerce# x+happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn21 #-} happyOut21 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut21 x = unsafeCoerce# x+happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut21 #-} happyIn22 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn22 x = unsafeCoerce# x+happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn22 #-} happyOut22 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut22 x = unsafeCoerce# x+happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut22 #-} happyIn23 :: (( Ast -> Ast, Ast -> Ast )) -> (HappyAbsSyn )-happyIn23 x = unsafeCoerce# x+happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn23 #-} happyOut23 :: (HappyAbsSyn ) -> (( Ast -> Ast, Ast -> Ast ))-happyOut23 x = unsafeCoerce# x+happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut23 #-} happyIn24 :: (( [ Ast ], [ Ast ] )) -> (HappyAbsSyn )-happyIn24 x = unsafeCoerce# x+happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn24 #-} happyOut24 :: (HappyAbsSyn ) -> (( [ Ast ], [ Ast ] ))-happyOut24 x = unsafeCoerce# x+happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut24 #-} happyIn25 :: (Ast) -> (HappyAbsSyn )-happyIn25 x = unsafeCoerce# x+happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn25 #-} happyOut25 :: (HappyAbsSyn ) -> (Ast)-happyOut25 x = unsafeCoerce# x+happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut25 #-} happyIn26 :: (Ast) -> (HappyAbsSyn )-happyIn26 x = unsafeCoerce# x+happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn26 #-} happyOut26 :: (HappyAbsSyn ) -> (Ast)-happyOut26 x = unsafeCoerce# x+happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut26 #-} happyIn27 :: (Ast) -> (HappyAbsSyn )-happyIn27 x = unsafeCoerce# x+happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn27 #-} happyOut27 :: (HappyAbsSyn ) -> (Ast)-happyOut27 x = unsafeCoerce# x+happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut27 #-} happyIn28 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn28 x = unsafeCoerce# x+happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn28 #-} happyOut28 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut28 x = unsafeCoerce# x+happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut28 #-} happyIn29 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn29 x = unsafeCoerce# x+happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn29 #-} happyOut29 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut29 x = unsafeCoerce# x+happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut29 #-} happyIn30 :: (Ast) -> (HappyAbsSyn )-happyIn30 x = unsafeCoerce# x+happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn30 #-} happyOut30 :: (HappyAbsSyn ) -> (Ast)-happyOut30 x = unsafeCoerce# x+happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut30 #-} happyIn31 :: ([Ast]) -> (HappyAbsSyn )-happyIn31 x = unsafeCoerce# x+happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn31 #-} happyOut31 :: (HappyAbsSyn ) -> ([Ast])-happyOut31 x = unsafeCoerce# x+happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut31 #-} happyIn32 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn32 x = unsafeCoerce# x+happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn32 #-} happyOut32 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut32 x = unsafeCoerce# x+happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut32 #-} happyIn33 :: (Ast) -> (HappyAbsSyn )-happyIn33 x = unsafeCoerce# x+happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn33 #-} happyOut33 :: (HappyAbsSyn ) -> (Ast)-happyOut33 x = unsafeCoerce# x+happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut33 #-} happyIn34 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn34 x = unsafeCoerce# x+happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn34 #-} happyOut34 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut34 x = unsafeCoerce# x+happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut34 #-} happyIn35 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn35 x = unsafeCoerce# x+happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn35 #-} happyOut35 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut35 x = unsafeCoerce# x+happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut35 #-} happyIn36 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn36 x = unsafeCoerce# x+happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn36 #-} happyOut36 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut36 x = unsafeCoerce# x+happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut36 #-} happyIn37 :: (String -> Ast -> [ Ast ] -> Ast) -> (HappyAbsSyn )-happyIn37 x = unsafeCoerce# x+happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn37 #-} happyOut37 :: (HappyAbsSyn ) -> (String -> Ast -> [ Ast ] -> Ast)-happyOut37 x = unsafeCoerce# x+happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut37 #-} happyIn38 :: (String -> Ast -> Ast) -> (HappyAbsSyn )-happyIn38 x = unsafeCoerce# x+happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn38 #-} happyOut38 :: (HappyAbsSyn ) -> (String -> Ast -> Ast)-happyOut38 x = unsafeCoerce# x+happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut38 #-} happyIn39 :: (String -> Ast) -> (HappyAbsSyn )-happyIn39 x = unsafeCoerce# x+happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyIn39 #-} happyOut39 :: (HappyAbsSyn ) -> (String -> Ast)-happyOut39 x = unsafeCoerce# x+happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOut39 #-} happyInTok :: (Token) -> (HappyAbsSyn )-happyInTok x = unsafeCoerce# x+happyInTok x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyInTok #-} happyOutTok :: (HappyAbsSyn ) -> (Token)-happyOutTok x = unsafeCoerce# x+happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x {-# INLINE happyOutTok #-} @@ -259,7 +252,7 @@ happyTable :: HappyAddr happyTable = HappyA# "\x00\x00\x11\x00\x12\x00\x13\x00\xb4\x00\x65\x01\x70\x01\x0c\x01\x14\x00\x74\x01\x15\x00\x66\x01\x19\x01\x16\x00\x17\x00\x18\x00\x15\x00\x57\x00\x19\x00\x43\x00\xef\x00\x19\x00\xe7\x00\x46\x00\xe8\x00\xca\x00\x20\x01\x42\x00\x45\x00\x43\x00\x46\x00\x21\x01\xab\x00\x22\x01\xcb\x00\x59\x00\x1a\x00\xef\x00\xb2\x00\xbb\x00\x1b\x00\x1c\x00\x75\x01\x19\x00\x1d\x01\xba\x00\x1e\x01\xbb\x00\xac\x00\xad\x00\x0d\x01\x1d\x00\x1e\x00\xcd\x00\x36\x00\xb5\x00\x1f\x00\x14\x00\x20\x00\x21\x00\x22\x00\x89\x01\xce\x00\x36\x00\x18\x00\x23\x00\x5a\x00\x36\x00\x24\x00\x25\x00\x26\x00\x36\x00\x14\x00\xac\x00\xad\x00\xae\x00\x80\x00\x36\x00\x36\x00\x18\x00\xbb\x00\x8b\x01\x27\x00\x28\x00\x71\x01\x0e\x01\x29\x00\x2a\x00\x0f\x01\x2b\x00\x2c\x00\x2d\x00\x11\x00\x12\x00\x13\x00\x23\x01\x14\x00\x2d\x00\x58\x00\x14\x00\x84\x00\x15\x00\x81\x00\x18\x00\x16\x00\x17\x00\x18\x00\x20\x00\x1f\x01\x68\x01\xaf\x00\x82\x01\x19\x00\xb0\x00\x23\x00\x66\x01\xbc\x00\xbb\x00\x30\x01\x5c\x01\x03\x01\x04\x01\x20\x00\x81\x01\x29\x01\x83\x01\xb6\x00\x1a\x00\x05\x01\x23\x00\x38\x01\x1b\x00\x1c\x00\x3a\x01\x08\x01\xbc\x00\x2a\x00\xb7\x00\xbd\x00\x31\x01\x62\x01\xbf\x00\x1d\x00\x1e\x00\x2d\x01\x63\x01\x20\x00\x1f\x00\x6d\x01\x20\x00\x62\x01\x2a\x00\xbb\x00\x23\x00\xb6\x00\x66\x01\x23\x00\xbb\x00\x36\x00\x24\x00\x25\x00\x26\x00\xc0\x00\xbb\x00\x78\x01\xb8\x00\xbb\x00\xbb\x00\xbb\x00\x15\x01\x16\x01\x7a\x01\x0c\x00\x27\x00\x46\x00\x2a\x00\x36\x00\x29\x00\x2a\x00\xa4\x00\x2b\x00\x2c\x00\x2d\x00\x11\x00\x12\x00\x13\x00\x4a\x01\x2d\x00\x02\x00\x03\x00\x14\x00\x52\x00\x15\x00\x04\x00\x48\x00\x16\x00\x17\x00\x18\x00\xa5\x00\x05\x00\x06\x00\x04\x00\x07\x00\x19\x00\x48\x00\x47\x01\x0c\x00\x05\x00\x49\x00\x08\x00\x09\x00\x0a\x00\x46\x00\x0b\x00\x0c\x00\x38\x00\x0d\x00\x47\x00\x1a\x00\x56\x01\x0e\x00\x0f\x00\x1b\x00\x1c\x00\x39\x00\x3a\x00\x3b\x00\x5e\x01\x59\x01\x0f\x00\x04\x00\x5c\x00\x5d\x00\x1d\x00\x1e\x00\x3c\x00\x05\x00\x5e\x00\x1f\x00\x48\x00\x20\x00\x3b\x01\xe2\x00\x53\x00\x58\x01\x3d\x00\xe3\x00\x23\x00\x3e\x00\x48\x00\x24\x00\x25\x00\x26\x00\x54\x00\x3e\x01\xe2\x00\x26\x01\x2b\x01\x0f\x00\xe3\x00\xe1\x00\xe2\x00\x5a\x01\x11\x01\x27\x00\xe3\x00\x7c\x01\x13\x01\x29\x00\x2a\x00\x2e\x01\x2b\x00\x2c\x00\x2d\x00\x11\x00\x12\x00\x13\x00\x54\x01\x0c\x00\x02\x00\x03\x00\x14\x00\xed\x00\x15\x00\x04\x00\x06\x01\x16\x00\x17\x00\x18\x00\x04\x00\x05\x00\x06\x00\x04\x00\x07\x00\x19\x00\x05\x00\x3d\x00\x43\x01\x05\x00\x3e\x00\x08\x00\x09\x00\x0a\x00\x45\x01\x0b\x00\x0c\x00\xf7\x00\x0d\x00\xfa\x00\x1a\x00\xf8\x00\x0e\x00\x0f\x00\x1b\x00\x1c\x00\x00\x01\x2d\x01\x0f\x00\x06\x01\x01\x01\x0f\x00\x04\x00\x32\x01\x0c\x00\x1d\x00\x1e\x00\x08\x01\x05\x00\x40\x00\x1f\x00\x43\x00\x20\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x23\x00\xdd\x00\x0c\x00\x24\x00\x25\x00\x26\x00\xa8\x00\x0a\x00\xa9\x00\x11\x01\x3f\x00\x0f\x00\x7d\x01\x13\x01\x0a\x01\x0a\x00\xa6\x00\x27\x00\xc3\x00\xb9\x00\xc8\x00\x29\x00\x2a\x00\xc6\x00\x2b\x00\x2c\x00\x2d\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x32\x01\x11\x01\xb1\x00\xb2\x00\x76\x01\x13\x01\xce\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x2b\x01\xcf\x00\x7c\x00\x7d\x00\xd1\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xd0\x00\x7b\x00\xd2\x00\xdf\x00\x7c\x00\x7d\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xda\x00\x7b\x00\xd3\x00\x0c\x00\x7c\x00\x7d\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x36\x00\x7b\x00\x34\x00\x55\x00\x7c\x00\x7d\x00\x8f\x01\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x04\x00\x40\x00\x7c\x00\x7d\x00\x45\x01\x8b\x01\x05\x00\x4e\x00\x50\x01\x07\x00\x11\x01\x43\x00\x4b\x00\x48\x01\x13\x01\x5a\x00\x08\x00\x09\x00\x0a\x00\x8d\x01\x0b\x00\x0c\x00\x11\x01\x0d\x00\x85\x01\x4b\x01\x13\x01\x0e\x00\x0f\x00\x11\x01\x86\x01\x89\x01\x4c\x01\x13\x01\x7b\x00\x7a\x01\xb4\x00\x7c\x00\x7d\x00\x87\x01\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x88\x01\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x11\x01\x81\x00\x36\x00\x3a\x01\x13\x01\x04\x00\x7b\x00\x69\x01\x6a\x01\x7c\x00\x7d\x00\x05\x00\x06\x00\x11\x01\x07\x00\x11\x01\x3d\x01\x13\x01\x12\x01\x13\x01\x6b\x01\x08\x00\x09\x00\x0a\x00\x6c\x01\x0b\x00\x0c\x00\x11\x01\x0d\x00\xb4\x00\x16\x01\x13\x01\x0e\x00\x0f\x00\x6f\x01\x7b\x00\x72\x01\x76\x01\x7c\x00\x7d\x00\xdd\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xf3\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x11\x01\x7a\x01\x78\x01\x17\x01\x13\x01\x04\x00\x7b\x00\x4a\x01\x2a\x00\x7c\x00\x7d\x00\x05\x00\x4e\x00\x51\x01\x07\x00\x4e\x01\x62\x00\x63\x00\x64\x00\x65\x00\x4f\x01\x08\x00\x09\x00\x0a\x00\x50\x01\x0b\x00\x0c\x00\x2a\x00\x0d\x00\xb4\x00\x5d\x01\x5e\x01\x0e\x00\x0f\x00\x62\x01\x7b\x00\x1b\x01\x36\x00\x7c\x00\x7d\x00\xf6\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x1c\x01\x2a\x01\x34\x01\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x35\x01\x36\x01\x37\x01\x39\x01\x7b\x00\x04\x00\xb5\x00\x7c\x00\x7d\x00\x60\x01\x61\x01\x05\x00\x24\x01\x2a\x00\x07\x00\x40\x01\x41\x01\x43\x01\x42\x01\x25\x01\x45\x01\x08\x00\x09\x00\x0a\x00\x2a\x00\x0b\x00\x0c\x00\x47\x01\x0d\x00\xca\x00\xe5\x00\xe6\x00\x0e\x00\x0f\x00\xe9\x00\x7b\x00\xea\x00\xeb\x00\x7c\x00\x7d\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xec\x00\xed\x00\xf2\x00\xf5\x00\xd7\x00\x2a\x00\x36\x00\x7b\x00\xfc\x00\x04\x00\x7c\x00\x7d\x00\x2a\x00\xb5\x00\x10\x01\x05\x00\x4e\x00\x27\x01\x07\x00\x36\x00\x11\x01\xb6\x00\xc1\x00\x1a\x01\x85\x00\x08\x00\x09\x00\x0a\x00\x86\x00\x0b\x00\x0c\x00\x87\x00\x0d\x00\x2a\x00\xd9\x00\x7b\x00\x0e\x00\x0f\x00\x7c\x00\x7d\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xa8\x00\x36\x00\xb6\x00\xc1\x00\x36\x00\xc5\x00\x04\x00\x7b\x00\xc2\x00\x36\x00\x7c\x00\x7d\x00\x05\x00\x4e\x00\xf0\x00\x07\x00\xc8\x00\x2a\x00\xd6\x00\xcc\x00\x36\x00\xd5\x00\x08\x00\x09\x00\x0a\x00\x36\x00\x0b\x00\x0c\x00\xff\xff\x0d\x00\x2f\x00\x31\x00\x30\x00\x0e\x00\x0f\x00\x00\x00\x36\x00\x33\x00\x00\x00\x00\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x04\x00\x3f\x00\x2a\x00\x36\x00\x2a\x00\x7e\x00\x05\x00\x4e\x00\xf3\x00\x07\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x4e\x00\x09\x01\x07\x00\x00\x00\x7b\x00\x00\x00\x00\x00\x7c\x00\x7d\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x4e\x00\x82\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x4e\x00\xb0\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x4e\x00\x4f\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x4e\x00\x50\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x8f\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x8d\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x7b\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x7e\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x7f\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x80\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x6c\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x72\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x52\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x53\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x55\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x57\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x23\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x3c\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xdf\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xe0\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xf6\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xf9\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xfc\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xfd\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xfe\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xff\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x05\x01\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x87\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x88\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x89\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x8a\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x8b\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x8c\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x8d\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x8e\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x8f\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x90\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x91\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x92\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x93\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x94\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x95\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x96\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x97\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x98\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x99\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x9a\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x9b\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x9c\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x9d\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x9e\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x9f\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xa0\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xa1\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xa2\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xa3\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xc2\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xc5\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xd7\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xd9\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\xdb\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x31\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x33\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x4a\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x4c\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x4d\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x00\x00\x05\x00\x52\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x0c\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0f\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x00\x00\x77\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# -happyReduceArr = array (1, 174) [+happyReduceArr = Happy_Data_Array.array (1, 174) [ (1 , happyReduce_1), (2 , happyReduce_2), (3 , happyReduce_3),@@ -2686,20 +2679,20 @@ {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp -{-# LINE 28 "templates/GenericTemplate.hs" #-}+{-# LINE 30 "templates/GenericTemplate.hs" #-} -data Happy_IntList = HappyCons Int# Happy_IntList+data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList -{-# LINE 49 "templates/GenericTemplate.hs" #-}+{-# LINE 51 "templates/GenericTemplate.hs" #-} -{-# LINE 59 "templates/GenericTemplate.hs" #-}+{-# LINE 61 "templates/GenericTemplate.hs" #-} -{-# LINE 68 "templates/GenericTemplate.hs" #-}+{-# LINE 70 "templates/GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a)@@ -2734,49 +2727,40 @@ happyFail i tk st -1# -> {- nothing -} happyAccept i tk st- n | (n <# (0# :: Int#)) -> {- nothing -}+ n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} - (happyReduceArr ! rule) i tk st- where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))+ (happyReduceArr Happy_Data_Array.! rule) i tk st+ where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) n -> {- nothing -} happyShift new_state i tk st- where new_state = (n -# (1# :: Int#))- where off = indexShortOffAddr happyActOffsets st- off_i = (off +# i)- check = if (off_i >=# (0# :: Int#))- then (indexShortOffAddr happyCheck off_i ==# i)+ where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))+ where (off) = indexShortOffAddr happyActOffsets st+ (off_i) = (off Happy_GHC_Exts.+# i)+ check = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))+ then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i) else False- action | check = indexShortOffAddr happyTable off_i- | otherwise = indexShortOffAddr happyDefActions st+ (action)+ | check = indexShortOffAddr happyTable off_i+ | otherwise = indexShortOffAddr happyDefActions st -{-# LINE 127 "templates/GenericTemplate.hs" #-}+{-# LINE 130 "templates/GenericTemplate.hs" #-} indexShortOffAddr (HappyA# arr) off =-#if __GLASGOW_HASKELL__ > 500- narrow16Int# i-#elif __GLASGOW_HASKELL__ == 500- intToInt16# i-#else- (i `iShiftL#` 16#) `iShiftRA#` 16#-#endif+ Happy_GHC_Exts.narrow16Int# i where-#if __GLASGOW_HASKELL__ >= 503- i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)-#else- i = word2Int# ((high `shiftL#` 8#) `or#` low)-#endif- high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))- low = int2Word# (ord# (indexCharOffAddr# arr off'))- off' = off *# 2#+ i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)+ high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))+ low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))+ off' = off Happy_GHC_Exts.*# 2# -data HappyAddr = HappyA# Addr#+data HappyAddr = HappyA# Happy_GHC_Exts.Addr# @@ -2784,13 +2768,13 @@ ----------------------------------------------------------------------------- -- HappyState data type (not arrays) -{-# LINE 170 "templates/GenericTemplate.hs" #-}+{-# LINE 163 "templates/GenericTemplate.hs" #-} ----------------------------------------------------------------------------- -- Shifting a token happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =- let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in+ let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in -- trace "shifting the error token" $ happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) @@ -2825,7 +2809,7 @@ happyReduce k i fn 0# tk st sts stk = happyFail 0# tk st sts stk happyReduce k nt fn j tk st sts stk- = case happyDrop (k -# (1# :: Int#)) sts of+ = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of sts1@((HappyCons (st1@(action)) (_))) -> let r = fn stk in -- it doesn't hurt to always seq here... happyDoSeq r (happyGoto nt j tk st1 sts1 r)@@ -2834,28 +2818,28 @@ = happyFail 0# tk st sts stk happyMonadReduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))- where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+ where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk happyMonad2Reduce k nt fn 0# tk st sts stk = happyFail 0# tk st sts stk happyMonad2Reduce k nt fn j tk st sts stk = happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))- where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+ where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) drop_stk = happyDropStk k stk - off = indexShortOffAddr happyGotoOffsets st1- off_i = (off +# nt)- new_state = indexShortOffAddr happyTable off_i+ (off) = indexShortOffAddr happyGotoOffsets st1+ (off_i) = (off Happy_GHC_Exts.+# nt)+ (new_state) = indexShortOffAddr happyTable off_i happyDrop 0# l = l-happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t+happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t happyDropStk 0# l = l-happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs+happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs ----------------------------------------------------------------------------- -- Moving to a new state after a reduction@@ -2864,9 +2848,9 @@ happyGoto nt j tk st = {- nothing -} happyDoAction j tk new_state- where off = indexShortOffAddr happyGotoOffsets st- off_i = (off +# nt)- new_state = indexShortOffAddr happyTable off_i+ where (off) = indexShortOffAddr happyGotoOffsets st+ (off_i) = (off Happy_GHC_Exts.+# nt)+ (new_state) = indexShortOffAddr happyTable off_i @@ -2894,17 +2878,18 @@ -- save the old token and carry on. happyFail i tk (action) sts stk = -- trace "entering error recovery" $- happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)+ happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) -- Internal happy errors: +notHappyAtAll :: a notHappyAtAll = error "Internal Happy error\n" ----------------------------------------------------------------------------- -- Hack to get the typechecker to accept our action functions -happyTcHack :: Int# -> a -> a+happyTcHack :: Happy_GHC_Exts.Int# -> a -> a happyTcHack x y = y {-# INLINE happyTcHack #-}
src/Text/XML/HXQ/TypeInference.hs view
@@ -16,7 +16,7 @@ --------------------------------------------------------------------------------------} -module Text.XML.HXQ.TypeInference(typeInference,typeCheck) where+module Text.XML.HXQ.TypeInference where import List(nub,intersect,union) import Control.Monad@@ -375,7 +375,7 @@ -- XQuery Type Inference typeInf :: Ast -> Assumptions -> Type -> Signatures -> NS -> TI Type typeInf e assumptions context fncs ns- = do t <- (ti $! e) assumptions context+ = do t <- ti e assumptions context s <- getSubst --trace (show e++" "++show assumptions++" "++show s++" -> "++show t) (return t) return t
src/Text/XML/HXQ/Types.hs view
@@ -14,6 +14,10 @@ --------------------------------------------------------------------------------------} +{-# OPTIONS_GHC -funbox-strict-fields #-}+{-# LANGUAGE BangPatterns #-}++ module Text.XML.HXQ.Types where import Char(isDigit,isSpace)@@ -22,6 +26,7 @@ import Text.XML.HXQ.XTree import XMLParse(XMLEvent(..),parseDocument) import HXML(Name,AttList)+import DeepSeq buildInTypes :: [(String,String)]@@ -438,7 +443,7 @@ -- validate the XML sequence xs against the XML Schema type tp typeValidate :: Type -> XSeq -> Match XSeq-typeValidate tp xs+typeValidate !tp xs = v tp xs [] where allV t xs as = case v t xs as of@@ -450,10 +455,10 @@ | all isSpace s = sp xs sp x = x- v t (XText s:xs) as+ v !t (XText s:xs) as | all isSpace s = v t xs as- v t xs as+ v !t xs as = case t of TEmpty -> Success xs TAny -> Success []@@ -523,7 +528,7 @@ -- Validate the XML data using XML Schema validateXSeq :: XSeq -> NS -> Match XSeq-validateXSeq xs ns+validateXSeq xs !ns = vs xs where vs (XElem rt _ _ _ xs':xs) | rt == documentRootTag@@ -566,10 +571,11 @@ validateFile file schema = do sch <- readFile schema let ns = initialNS- (_,t) = schema2Type (materialize False (parseDocument sch)) ns+ (_,!t) = schema2Type (materialize False (parseDocument sch)) ns+ -- putStrLn (show t) doc <- readFile file let xs = materialize False (parseDocument doc)- n = ns{ defaultElementNS="default", schemas=("default",t):schemas ns }+ n = deepSeq t $ ns{ defaultElementNS="default", schemas=("default",t):schemas ns } case validateXSeq [xs] n of Failure ts -> error ("Failed to validate the file against the schema: "
src/Text/XML/HXQ/XQuery.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: 09/12/09+- Creation: 03/22/08, last update: 01/07/10 - - 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.@@ -14,6 +14,7 @@ --------------------------------------------------------------------------------------} {-# OPTIONS_HADDOCK prune #-}+{-# OPTIONS -cpp #-} -- | HXQ is a fast and space-efficient compiler from XQuery (the standard@@ -28,7 +29,9 @@ -- * The XQuery Compiler xq, xe, qx, -- * The XQuery Interpreter- xquery, eval,+ xquery, eval, + -- * The XQuery Command Line Interpreter+ commandLineInterpreter, -- * Validation using XML Schema validateFile, -- * The XQuery Compiler with Database Connectivity@@ -39,6 +42,7 @@ Path, Table(..), genSchema, shred, shredC, isSchema, printSchema, createIndex, -- * Other Database Functions connect, disconnect, commit, rollback, prepareSQL, executeSQL+ ) where import HXML(Name,AttList)@@ -48,10 +52,150 @@ import Text.XML.HXQ.Compiler import Text.XML.HXQ.Interpreter import Text.XML.HXQ.Types+import Text.XML.HXQ.Functions(systemFunctions,pathFunctions)+import List(sort)+import System.CPUTime(getCPUTime) +#if _BASE_3_+import qualified Control.Exception as C(try,catch,Exception)+type E = C.Exception+#else+import qualified Control.Exception as C(try,catch,SomeException)+type E = C.SomeException+#endif+++version = "0.19.0"++ -- | The XQuery interpreter as an XQuery function. eval :: XSeq -> IO XSeq eval x = case x of [ XText q ] -> xquery q _ -> error $ "The eval argument must be a string: " ++ show x+++parseEnv :: [String] -> [(String,String)]+parseEnv [] = [("o","Temp.hs")]+parseEnv ("-help":xs) = ("help",""):(parseEnv xs)+parseEnv ("-c":file:xs) = ("c",file):(parseEnv xs)+parseEnv ("-o":file:xs) = ("o",file):(parseEnv xs)+parseEnv ("-db":file:xs) = ("db",file):(parseEnv xs)+parseEnv ("-v":xs) = ("v",""):(parseEnv xs)+parseEnv ("-tp":xs) = ("tp",""):(parseEnv xs)+parseEnv ("-t":xs) = ("t",""):(parseEnv xs)+parseEnv ("-p":query:file:xs) = ("p","doc('"++file++"')"++query):(parseEnv xs)+parseEnv (('-':x):_) = error ("Unrecognized option -"++x++". Use -help.")+parseEnv (file:xs) = ("r",file):(parseEnv xs)+++noDBError = error "Missing Database Connection; use the option -db in xquery"+++-- | The XQuery command line interpreter used by the main program (@xquery@).+-- The program arguments may contain the following command line options:+-- +-- [@xquery-file@] Evaluate the XQuery code in @xquery-file@ using the interpreter+-- +-- [@-db database-name@] Use the relational schema @database-name@ during querying+-- +-- [@-c xquery-file@] Compile the XQuery code in @xquery-file@ into Haskell code+-- +-- [@-o haskell-file@] Set the Haskell file for @-c@ (default is @Temp.hs@)+-- +-- [@-p XPath-query xml-file@] Interpret the XPath query against the @xml-file@+-- +-- [@-v@] Print verbose information (the AST and the optimized plan)+-- +-- [@-t@] Print timing information+-- +-- [@-tp@] Print typing information (experimental)+-- +-- Without an @xquery-file@, it reads and evaluates the input using the HXQ interpreter.+-- The input may be a single XQuery or a @declare variable@ or a @declare function@ expression.+-- To write an XQuery in multiple lines, wrap it in @{ }@.+commandLineInterpreter :: [String] -- ^ program arguments+ -> IO ()+commandLineInterpreter arguments+ = let env = parseEnv arguments+ verbose = case lookup "v" env of Nothing -> False; _ -> True+ timing = case lookup "t" env of Nothing -> False; _ -> True+ typecheck = case lookup "tp" env of Nothing -> False; _ -> True+ putTime t = if timing then putStrLn $ "Evaluation time: "++show (div t (10^9))++" milliseconds" else return ()+ in case lookup "help" env of+ Just _ -> do putStrLn ("HXQ: XQuery Interpreter version "++version)+ putStrLn "The documentation is availabe at http://lambda.uta.edu/HXQ/"+ putStrLn "Command line options and files:"+ putStrLn " xquery-file evaluate the XQuery in xquery-file using the interpreter"+ putStrLn " -db database use the relational database during querying"+ putStrLn " -c xquery-file compile the XQuery in xquery-file into Haskell code"+ putStrLn " -o haskell-file set the Haskell file for -c (default is Temp.hs)"+ putStrLn " -p XPath-query xml-file interpret the XPath query against the xml-file"+ putStrLn " -v print verbose information (AST and optimized plan)"+ putStrLn " -t print timing information"+ putStrLn " -tp print typing information"+ putStrLn "Without an xquery-file, it reads and evaluates the input using the HXQ interpreter."+ putStrLn " The input may be an XQuery or a 'declare variable' or a 'declare function'."+ putStrLn " To write an XQuery in multiple lines, wrap it in {}."+ putStrLn $ "Functions (name/arity): " ++ (unwords $ sort $ map (\(f,c,_,_,_) -> f++"/"++show c) systemFunctions)+ putStrLn $ "Path Steps: " ++ (unwords $ map fst pathFunctions)+ putStrLn $ "Build-in Types: xs:anyAtomicType " ++ (unwords $ map fst buildInTypes)+ _ -> case lookup "c" env of+ Just file -> do query <- readFile file+ let qf = foldr (\c r -> if c=='\"' then '\\':c:r else c:r)+ "" (foldr1 (\a r -> a++" "++r) (lines query))+ db = case lookup "db" env of Just filepath -> filepath; _ -> ""+ pr = "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\nimport Text.XML.HXQ.XQuery\n\nmain = do "+ ++ (if db=="" then "res <- " else "db <- connect \""++db++"\"\n res <- ")+ ++ (if db=="" then "$(xq \"" else "$(xqdb \"")+ ++ qf ++ "\")"++(if db=="" then "" else " db")++"\n putXSeq res\n"+ Just ofile = lookup "o" env+ writeFile ofile pr+ _ -> case lookup "r" env of+ Just file -> case lookup "db" env of+ Just filepath -> do db <- connect filepath+ t1 <- getCPUTime+ query <- readFile file+ (result,_,_,_,_) <- xqueryE query [] [] initialNS [] db verbose typecheck+ putXSeq result+ t2 <- getCPUTime+ putTime (t2-t1)+ commit db+ _ -> do query <- readFile file+ t1 <- getCPUTime+ (result,_,_,_,_) <- xqueryE query [] [] initialNS [] noDBError verbose typecheck+ putXSeq result+ t2 <- getCPUTime+ putTime (t2-t1)+ _ -> case lookup "p" env of+ Just query -> do t1 <- getCPUTime+ (result,_,_,_,_) <- xqueryE query [] [] initialNS [] noDBError verbose typecheck+ putXSeq result+ t2 <- getCPUTime+ putTime (t2-t1)+ _ -> do putStrLn ("HXQ: XQuery Interpreter version "++version++". Use -help for help.")+ case lookup "db" env of+ Just filepath+ -> do db <- connect filepath+ evalInput (\s es fs ns vs -> C.catch+ (do t1 <- getCPUTime+ (result,nes,nfs,nns,nvs) <- xqueryE s es fs ns vs db verbose typecheck+ putXSeq result+ t2 <- getCPUTime+ putTime (t2-t1)+ commit db+ return (nes,nfs,nns,nvs))+ (\e -> do putStrLn (show (e::E))+ return (es,fs,ns,vs))) [] [] initialNS [] "> " []+ return ()+ _ -> do evalInput (\s es fs ns vs -> C.catch+ (do t1 <- getCPUTime+ (result,nes,nfs,nns,nvs) <- xqueryE s es fs ns vs noDBError verbose typecheck+ putXSeq result+ t2 <- getCPUTime+ putTime (t2-t1)+ return (nes,nfs,nns,nvs))+ (\e -> do putStrLn (show (e::E))+ return (es,fs,ns,vs))) [] [] initialNS [] "> " []+ return ()
src/Text/XML/HXQ/XTree.hs view
@@ -21,11 +21,13 @@ import System.IO import Char(isSpace)+import Data.List(foldl',isPrefixOf) import XMLParse(XMLEvent(..)) import HXML(Name,AttList) import Text.XML.HXQ.Parser(Ast(..)) import System.CPUTime -- import System.IO.Unsafe+import DeepSeq -- | Namespace prefix@@ -38,7 +40,7 @@ type LocalName = String -- | A qualified name has a namespace prefix, a URI, and a local name-data QName = QName { prefix :: Prefix, uri :: URI, localName :: LocalName }+data QName = QName { prefix :: !Prefix, uri :: !URI, localName :: !LocalName } instance Eq QName where (QName _ u1 ln1) == (QName _ u2 ln2)@@ -52,7 +54,11 @@ show (QName "" _ ln) = ln show (QName ns _ ln) = ns++(':':ln) +instance DeepSeq QName where+ deepSeq (QName p u ln) y+ = deepSeq p $ deepSeq u $ deepSeq ln y + -- | XML attributes are bindings from qualified names to values type Attributes = [(QName,String)] @@ -175,21 +181,36 @@ -- | An XQuery type data Type- = TVariable TVar -- ^ type variable (needed for polymorphic type inference)- | TBase QName -- ^ xs:integer, xs:string, ...- | TItem String -- ^ item(), node(), ...- | TNamed QName -- ^ reference to a user-defined type- | TElement String Type -- ^ element tag { t }- | TAttribute String Type -- ^ attribute name { t }+ = TVariable !TVar -- ^ type variable (needed for polymorphic type inference)+ | TBase !QName -- ^ xs:integer, xs:string, ...+ | TItem !String -- ^ item(), node(), ...+ | TNamed !QName -- ^ reference to a user-defined type+ | TElement !String !Type -- ^ element tag { t }+ | TAttribute !String !Type -- ^ attribute name { t } | TAny -- ^ any element or attribute content | TEmpty -- ^ ()- | TSequence Type Type -- ^ t1, t2- | TInterleaving Type Type -- ^ t1 & t2- | TChoice Type Type -- ^ t1 | t2- | TQualified Type TQualifier -- ^ t*, t+, or t?+ | TSequence !Type !Type -- ^ t1, t2+ | TInterleaving !Type !Type -- ^ t1 & t2+ | TChoice !Type !Type -- ^ t1 | t2+ | TQualified !Type !TQualifier -- ^ t*, t+, or t? deriving Eq +instance DeepSeq Type where+ deepSeq tp y+ = case tp of+ TVariable v -> deepSeq v y+ TBase n -> deepSeq n y+ TItem n -> deepSeq n y+ TNamed n -> deepSeq n y+ TElement n tag -> deepSeq n $ deepSeq tag y+ TAttribute n tag -> deepSeq n $ deepSeq tag y+ TSequence t1 t2 -> deepSeq t1 $ deepSeq t2 y+ TInterleaving t1 t2 -> deepSeq t1 $ deepSeq t2 y+ TChoice t1 t2 -> deepSeq t1 $ deepSeq t2 y+ TQualified tp q -> deepSeq tp $ deepSeq q y+ _ -> y + showsType :: Type -> Int -> String -> String showsType t prec acc = case t of@@ -242,31 +263,27 @@ tag :: String -> NS -> QName tag s ns- = if elem ':' s- then case span (/= ':') s of- (s1,_:s2) -> case lookup s1 (prefixes ns) of- Just u -> QName s1 u s2- Nothing -> error ("Undeclared element namespace: "++s1)- else QName "" (defaultElementNS ns) s-+ = case span (/= ':') s of+ (_,"") -> QName "" (defaultElementNS ns) s+ (s1,_:s2) -> case lookup s1 (prefixes ns) of+ Just u -> QName s1 u s2+ Nothing -> error ("Undeclared element namespace: "++s1) attributeTag s ns- = if elem ':' s- then case span (/= ':') s of- (s1,_:s2) -> case lookup s1 (prefixes ns) of- Just u -> QName s1 u s2- Nothing -> error ("Undeclared attribute namespace: "++s1)- else QName "" "" s+ = case span (/= ':') s of+ (_,"") -> QName "" "" s+ (s1,_:s2) -> case lookup s1 (prefixes ns) of+ Just u -> QName s1 u s2+ Nothing -> error ("Undeclared attribute namespace: "++s1) functionTag :: String -> NS -> QName functionTag s ns- = if elem ':' s- then case span (/= ':') s of- (s1,_:s2) -> case lookup s1 (prefixes ns) of- Just u -> QName s1 u s2- Nothing -> error ("Undeclared function namespace: "++s1)- else QName "" (defaultFunctionNS ns) s+ = case span (/= ':') s of+ (_,"") -> QName "" (defaultFunctionNS ns) s+ (s1,_:s2) -> case lookup s1 (prefixes ns) of+ Just u -> QName s1 u s2+ Nothing -> error ("Undeclared function namespace: "++s1) attributes :: AttList -> NS -> Attributes@@ -276,16 +293,17 @@ elementNamespaces :: AttList -> NS -> NS elementNamespaces atts ns- = ns { defaultElementNS = foldr (\(a,v) r -> case a of "xmlns" -> v; _ -> r) (defaultElementNS ns) atts,- prefixes = foldr (\(a,v) r -> case splitAt 6 a of- ("xmlns:",p)- -> case lookup p predefinedNamespaces of+ = ns { defaultElementNS = foldl' (\r (a,v) -> case a of "xmlns" -> v; _ -> r)+ (defaultElementNS ns) atts,+ prefixes = foldl' (\r (a,v) -> if isPrefixOf "xmlns:" a+ then let p = drop 6 a+ in case lookup p predefinedNamespaces of Just uri -> if uri == v then (p,v):r else error ("You cannot redefine the system namespace "++p) Nothing -> (p,v):r- _ -> r) (prefixes ns) atts }+ else r) (prefixes ns) atts } predefinedNamespaces :: NamespacePrefixes@@ -304,8 +322,8 @@ fnNamespace = let Just uri = lookup "fn" predefinedNamespaces in uri -initialNS = NS { defaultElementNS="", defaultFunctionNS=fnNamespace,- prefixes=predefinedNamespaces, schemas=[] }+initialNS = NS { defaultElementNS = "", defaultFunctionNS = fnNamespace,+ prefixes = predefinedNamespaces, schemas = [] } {--------------- Build an XTree from the XML stream ----------------------------}@@ -316,27 +334,16 @@ noParentError = XError "Undefined parent reference" -statistics = id-{- Collect statistics about the timing of I/O events-statistics n- = if mod n 1000 == 0- then unsafePerformIO (do t <- getCPUTime- putStr $ show (div n 1000)- putStrLn $ " " ++ show (div t (10^6))- return n)- else n--}-- -- Lazily materialize the SAX stream into a DOM tree without setting parent references. materializeWithoutParent :: Int -> Stream -> NS -> XTree materializeWithoutParent level stream ns = XElem documentRootTag [] 1 noParentError- (if level<=1+ (if level < 1 then [head (filter (\x -> case x of XElem _ _ _ _ _ -> True; _ -> False) ((\(x,_,_)->x) (ml "" stream 2 ns)))] else ((\(x,_,_)->x) (mdl stream 2 level [] ns)))- where md s@(x@(StartEvent n atts):xs) i level ls ns+ where md :: Stream -> Int -> Int -> Stream -> NS -> (XTree,Stream,Int,Stream)+ md s@(x@(StartEvent n atts):xs) i level ls ns | level == 0 = let f [] i ns = m s i ns f ((StartEvent n atts):ls) i ns@@ -352,11 +359,15 @@ md (_:xs) i level ls ns = md xs i level ls ns md [] _ _ _ _ = (XText "",[],0,[])++ mdl :: Stream -> Int -> Int -> Stream -> NS -> (XSeq,Stream,Int) mdl xs@(_:_) i level ls ns = let (e,xs',i',ls') = md xs i level ls ns (el,xs'',i'') = mdl xs' i' 0 ls' ns in (e:el,xs'',i'') mdl [] _ _ _ _ = ([],[],0)++ m :: Stream -> Int -> NS -> (XTree,Stream,Int) m ((TextEvent t):xs) i _ = (XText t,xs,i) m ((EmptyEvent n atts):xs) i ns = let ns' = elementNamespaces atts ns@@ -371,6 +382,8 @@ m ((ErrorEvent s):xs) i _ = (XError s,xs,i) m (_:xs) i _ = (XError "Unrecognized XML event",xs,i) m [] i _ = (XError "Unterminated element",[],i)++ ml :: String -> Stream -> Int -> NS -> (XSeq,Stream,Int) ml _ [] i _ = ([],[],i) ml tag ((EndEvent n):xs) i ns | n==tag = ([],xs,i)@@ -387,10 +400,11 @@ materializeWithParent :: Int -> Stream -> NS -> XTree materializeWithParent level stream ns = root where root = XElem documentRootTag [] 1 (XError "Trying to access the root parent")- (if level<=1- then [head (filter (\x -> case x of XElem _ _ _ _ _ -> True; _ -> False)- ((\(x,_,_)->x) (ml "" stream 2 root ns)))]- else ((\(x,_,_)->x) (mdl stream 2 level root [] ns)))+ (if level < 1+ then [head (filter (\x -> case x of XElem _ _ _ _ _ -> True; _ -> False)+ ((\(x,_,_)->x) (ml "" stream 2 root ns)))]+ else ((\(x,_,_)->x) (mdl stream 2 level root [] ns)))+ md :: Stream -> Int -> Int -> XTree -> Stream -> NS -> (XTree,Stream,Int,Stream) md s@(x@(StartEvent n atts):xs) i level p ls ns | level == 0 = let f [] i p ns = m s i p ns@@ -408,11 +422,15 @@ md (_:xs) i level p ls ns = md xs i level p ls ns md [] _ _ _ _ _ = (XText "",[],0,[])++ mdl :: Stream -> Int -> Int -> XTree -> Stream -> NS -> (XSeq,Stream,Int) mdl xs@(_:_) i level p ls ns = let (e,xs',i',ls') = md xs i level p ls ns (el,xs'',i'') = mdl xs' i' 0 p ls' ns in (e:el,xs'',i'') mdl [] _ _ _ _ _ = ([],[],0)++ m :: Stream -> Int -> XTree -> NS -> (XTree,Stream,Int) m ((TextEvent t):xs) i _ _ = (XText t,xs,i) m ((EmptyEvent n atts):xs) i p ns = let ns' = elementNamespaces atts ns@@ -428,6 +446,8 @@ m ((ErrorEvent s):xs) i _ _ = (XError s,xs,i) m (_:xs) i _ _ = (XError "unrecognized XML event",xs,i) m [] i _ _ = (XError "unbalanced tags",[],i)++ ml :: String -> Stream -> Int -> XTree -> NS -> (XSeq,Stream,Int) ml _ [] i _ _ = ([],[],i) ml tag ((EndEvent n):xs) i _ _ | n==tag = ([],xs,i)@@ -439,7 +459,7 @@ -- It looks at the first maxStreamingUnitSize events in the stream to determine--- the minimum nesting depth. If this minimum depth is greater than 1, then+-- the minimum nesting depth. If this minimum depth is greater than 0, then -- the stream will be chopped into a list of XML elements at this depth level, -- where each XML element corresponds to at most maxStreamingUnitSize events. -- Otherwise, the cache requirenments would be the size of the largest root child@@ -451,7 +471,7 @@ ((StartEvent n _):xs) -> ((docLevel xs $! i-1) $! level+1) minLevel ((EndEvent n):xs)- -> ((docLevel xs $! i-1) $! level-1) $! min minLevel $! (level-1)+ -> ((docLevel xs $! i-1) $! level-1) $! min minLevel (level-1) (_:xs) -> (docLevel xs $! i-1) level minLevel _ -> 0
+ src/XQueryParser.y view
@@ -0,0 +1,793 @@+{-------------------------------------------------------------------------------------+-+- An XQuery parser+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 02/15/08, last update: 01/07/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.+-+--------------------------------------------------------------------------------------}++{+module Text.XML.HXQ.Parser(Ast(..),scan,parse,call,concatenateAll,ppAst) where+import Char+}++%name parse+%tokentype { Token }+%error { parseError }++%token+ 'return' { RETURN }+ 'some' { SOME }+ 'every' { EVERY }+ 'if' { IF }+ 'then' { THEN }+ 'else' { ELSE }+ '[' { LB }+ ']' { RB }+ '(' { LP }+ ')' { RP }+ '{' { LSB }+ '}' { RSB }+ 'to' { TO }+ '+' { PLUS }+ '-' { MINUS }+ '*' { TIMES }+ 'div' { DIV }+ 'idiv' { IDIV }+ 'mod' { MOD }+ '=' { TEQ }+ '!=' { TNE }+ '<' { TLT }+ '<=' { TLE }+ '>' { TGT }+ '>=' { TGE }+ '<<' { PRE }+ '>>' { POST }+ 'is' { IS }+ 'eq' { SEQ }+ 'ne' { SNE }+ 'lt' { SLT }+ 'le' { SLE }+ 'gt' { SGT }+ 'ge' { SGE }+ 'and' { AND }+ 'or' { OR }+ 'not' { NOT }+ 'union' { UNION }+ 'intersect' { INTERSECT }+ 'except' { EXCEPT }+ 'for' { FOR }+ 'let' { LET }+ 'in' { IN }+ 'as' { AS }+ ',' { COMMA }+ ':=' { ASSIGN }+ 'where' { WHERE }+ 'order' { ORDER }+ 'by' { BY }+ 'ascending' { ASCENDING }+ 'descending' { DESCENDING }+ 'element' { ELEMENT }+ 'attribute' { ATTRIBUTE }+ '</' { STAG }+ '/>' { ETAG }+ 'satisfies' { SATISFIES }+ '@' { ATSIGN }+ '/' { SLASH }+ 'QName' { QName $$ }+ 'declare' { DECLARE }+ 'function' { FUNCTION }+ 'variable' { VARIABLE }+ 'view' { VIEW }+ 'at' { AT }+ '..' { DOTS }+ '.' { DOT }+ ';' { SEMI }+ ':' { COLON }+ 'insert' { INSERT }+ 'delete' { DELETE }+ 'replace' { REPLACE }+ 'type' { TYPE }+ 'into' { INTO }+ 'from' { FROM}+ 'with' { WITH }+ 'instance' { INSTANCE }+ 'of' { OF }+ '?' { QMARK }+ 'cast' { CAST }+ 'castable' { CASTABLE }+ 'case' { CASE }+ 'default' { DEFAULT }+ 'typeswitch' { TYPESWITCH }+ 'import' { IMPORT }+ 'namespace' { NAMESPACE }+ 'schema' { SCHEMA }+ 'validate' { VALIDATE }+ 'Variable' { Variable $$ }+ 'XMLtext' { XMLtext $$ }+ 'Integer' { TInteger $$ }+ 'Double' { TFloat $$ }+ 'String' { TString $$ }+ 'EOF' { TokenEOF }+++%nonassoc 'for' 'let' 'satisfies' 'return' 'typeswitch'+%nonassoc 'with' 'from' 'into' 'instance' 'cast' 'castable' 'case' 'default'+%nonassoc 'else'+%left 'intersect' 'union' 'except'+%right 'or'+%right 'and'+%nonassoc 'not'+%left 'to'+%left '=' '<' '>' '<=' '>=' '!=' '>>' '<<' 'is' 'eq' 'ne' 'lt' 'le' 'gt' 'ge'+%left '+' '-'+%left '*' 'div' 'idiv' 'mod'+%nonassoc UMINUS+++%%+main :: { [ Ast ] }+main : prog 'EOF' { $1 }++prog :: { [ Ast ] }+prog : def { [$1] }+ | def 'XMLtext' { [$1] }+ | prog ';' def { $1++[$3] }+ | prog ';' def 'XMLtext' { $1++[$3] }++def :: { Ast }+def : expr { $1 }+ | 'declare' 'variable' var ':=' expr { Ast "variable" [$3,Avar "any",$5] }+ | 'declare' 'variable' var 'as' type+ ':=' expr { Ast "variable" [$3,$5,$7] }+ | 'declare' 'function' qname+ '(' opt_params ')' '{' expr '}' { if (null $5)+ then parseError [TError ("Nullary functions are not supported: "++$3)]+ else Ast "function" ([Avar $3,$8,Avar "any"]++mkPairs $5) }+ | 'declare' 'function' qname+ '(' opt_params ')' 'as' type+ '{' expr '}' { if (null $5)+ then parseError [TError ("Nullary functions are not supported: "++$3)]+ else Ast "function" ([Avar $3,$10,$8]++mkPairs $5) }+ | 'declare' 'view' qname+ '(' opt_params ')' '{' expr '}' { if (null $5)+ then parseError [TError ("Nullary views are not supported: "++$3)]+ else Ast "view" ([Avar $3,$8]++map fst $5) }+ | 'function' qname '(' opt_params ')'+ 'as' type { Ast "signature" ([Avar $2,$7]++map snd $4) }+ | 'declare' 'element' qname+ 'of' 'type' type { Ast "element" [Avar $3,$6] }+ | 'declare' 'type' qname '=' type { Ast "type" [Avar $3,$5] }+ | 'import' 'schema' prefix+ string opt_slist { Ast "import" ($3:$4:$5) }+ | 'declare' prefix string { Ast "schema" [$2,$3] }++prefix :: { Ast }+prefix : 'namespace' 'QName' '=' { Avar $2 }+ | 'default' 'element' 'namespace' { Avar "default-element" }+ | 'default' 'function' 'namespace' { Avar "default-function" }+ | { Avar "" }++opt_slist :: { [ Ast ] }+opt_slist : 'at' string slist { $2:$3 }+ | { [] }++slist :: { [ Ast ] }+slist : ',' string slist { $3++[$2] }+ | { [] }++qname :: { String }+qname : 'QName' { $1 }+ | 'QName' ':' 'QName' { $1++":"++$3 }++opt_params :: { [ (Ast,Ast) ] }+opt_params : params { $1 }+ | { [] }++params :: { [ (Ast,Ast) ] }+params : var { [($1,Avar "any")] }+ | var 'as' type { [($1,$3)] }+ | params ',' var { $1++[($3,Avar "any")] }+ | params ',' var 'as' type { $1++[($3,$5)] }++type :: { Ast }+type : qname %prec 'case' { Avar $1 }+ | qname '+' { Ast "+" [Avar $1] }+ | qname '*' { Ast "*" [Avar $1] }+ | qname '?' { Ast "?" [Avar $1] }+ | sequence_type %prec 'case' { $1 }+ | sequence_type '+' { Ast "+" [$1] }+ | sequence_type '*' { Ast "*" [$1] }+ | sequence_type '?' { Ast "?" [$1] }++sequence_type :: { Ast }+sequence_type : 'element' '(' ')' { Ast "element" [] }+ | 'attribute' '(' ')' { Ast "attribute" [] }+ | qname '(' ')' { Ast $1 [] }+ | 'element' '(' typeparams ')' { Ast "element" $3 }+ | 'attribute' '(' typeparams ')' { Ast "attribute" $3 }++typeparams :: { [ Ast ] }+ : '*' { [Avar "*"] }+ | qname { [Avar $1] }+ | '*' ',' qname { [Avar "*",Avar $3] }+ | qname ',' qname { [Avar $1,Avar $3] }+ | '*' ',' qname '?' { [Avar "*",Ast "?" [Avar $3]] }+ | qname ',' qname '?' { [Avar $1,Ast "?" [Avar $3]] }++var :: { Ast }+var : 'Variable' { Avar $1 }++expr :: { Ast }+expr : clauses opt_where opt_order+ 'return' expr { (snd $3) ($1 ($2 ((fst $3) $5))) }+ | 'some' for_bindings+ 'satisfies' expr { call "some" [$2 $4] }+ | 'every' for_bindings + 'satisfies' expr { call "not" [call "some" [$2 (call "not" [$4])]] }+ | 'if' expr 'then' expr 'else' expr { Ast "if" [$2,$4,$6] }+ | full_path { $1 }+ | element { $1 }+ | computed { $1 }+ | expr 'to' expr { call "to" [$1,$3] }+ | expr '+' expr { call "+" [$1,$3] }+ | expr '-' expr { call "-" [$1,$3] }+ | expr '*' expr { call "*" [$1,$3] }+ | expr 'div' expr { call "div" [$1,$3] }+ | expr 'idiv' expr { call "idiv" [$1,$3] }+ | expr 'mod' expr { call "mod" [$1,$3] }+ | expr '=' expr { call "=" [$1,$3] }+ | expr '!=' expr { call "!=" [$1,$3] }+ | expr '<' expr { call "<" [$1,$3] }+ | expr '<=' expr { call "<=" [$1,$3] }+ | expr '>' expr { call ">" [$1,$3] }+ | expr '>=' expr { call ">=" [$1,$3] }+ | expr '<<' expr { call "<<" [$1,$3] }+ | expr '>>' expr { call ">>" [$1,$3] }+ | expr 'is' expr { call "is" [$1,$3] }+ | expr 'eq' expr { call "eq" [$1,$3] }+ | expr 'ne' expr { call "ne" [$1,$3] }+ | expr 'lt' expr { call "lt" [$1,$3] }+ | expr 'le' expr { call "le" [$1,$3] }+ | expr 'gt' expr { call "gt" [$1,$3] }+ | expr 'ge' expr { call "ge" [$1,$3] }+ | expr 'and' expr { call "and" [$1,$3] }+ | expr 'or' expr { call "or" [$1,$3] }+ | expr 'not' expr { call "not" [$1,$3] }+ | expr 'union' expr { call "union" [$1,$3] }+ | expr 'intersect' expr { call "intersect" [$1,$3] }+ | expr 'except' expr { call "except" [$1,$3] }+ | expr 'instance' 'of' type { call "instance-of" [$1,Ast "type" [$4]] }+ | expr 'cast' 'as' type { call "cast-as" [$1,Ast "type" [$4]] }+ | expr 'castable' 'as' type { call "castable-as" [$1,Ast "type" [$4]] }+ | 'typeswitch' '(' expr ')' typecases { let v = "_tc" in Ast "let" [Avar v,$3,$5 v] }+ | '+' expr %prec UMINUS { call "uplus" [$2] }+ | '-' expr %prec UMINUS { call "uminus" [$2] }+ | 'not' expr %prec UMINUS { call "not" [$2] }+ | string { $1 }+ | 'Integer' { Aint $1 }+ | 'Double' { Afloat $1 }+ | 'validate' '{' expr '}' { Ast "validate" [$3] }+ | 'insert' expr 'into' expr { Ast "insert" [$2,Ast "destination" [$4]] }+ | 'delete' 'from' expr { Ast "delete" [$3] }+ | 'replace' expr 'with' expr { Ast "replace" [$2,$4] }++expl :: { [ Ast ] }+expl : expr { [$1] }+ | expl ',' expr { $1++[$3] }++clauses :: { Ast -> Ast }+clauses : 'for' for_bindings { $2 }+ | 'let' let_bindings { $2 }+ | clauses 'for' for_bindings { $1 . $3 }+ | clauses 'let' let_bindings { $1 . $3 }++for_bindings :: { Ast -> Ast }+for_bindings : var 'in' expr { \x -> Ast "for" [$1,Avar "$",$3,x] }+ | var 'at' var 'in' expr { \x -> Ast "for" [$1,$3,$5,x] }+ | for_bindings ',' var 'in' expr { \x -> $1(Ast "for" [$3,Avar "$",$5,x]) }+ | for_bindings ',' var 'at' var+ 'in' expr { \x -> $1(Ast "for" [$3,$5,$7,x]) }++let_bindings :: { Ast -> Ast }+let_bindings : var ':=' expr { \x -> Ast "let" [$1,$3,x] }+ | let_bindings ','+ var ':=' expr { \x -> $1(Ast "let" [$3,$5,x]) }++opt_where :: { Ast -> Ast }+opt_where : 'where' expr { \x -> Ast "predicate" [$2,x] }+ | {- empty -} { id }++opt_order :: { ( Ast -> Ast, Ast -> Ast ) }+opt_order : 'order' 'by' order_list { (\x -> Ast "sortTuple" (x:(fst $3)),+ \x -> Ast "sort" (x:(snd $3))) }+ | {- empty -} { (id,id) }++order_list :: { ( [ Ast ], [ Ast ] ) }+order_list : expr mode { ([$1],[$2]) }+ | order_list ',' expr mode { ((fst $1)++[$3],(snd $1)++[$4]) }++mode :: { Ast }+mode : 'ascending' { Avar "ascending" }+ | 'descending' { Avar "descending" }+ | {- empty -} { Avar "ascending" }++computed :: { Ast }+computed : 'element' '(' qname ')' { call "element" [Avar $3] }+ | 'attribute' '(' qname ')' { call "attribute" [Avar $3] }++element :: { Ast }+element : stag '>' content '</' qname '>' { if head $1 == Astring $5+ then Ast "element_construction" ($1++[Ast "append" $3])+ else parseError [TError ("Unmatched tags in element construction: "+ ++(show (head $1))++" '"++$5++"'")] }+ | stag '>' '</' qname '>' { if head $1 == Astring $4+ then Ast "element_construction" ($1++[Ast "append" []])+ else parseError [TError ("Unmatched tags in element construction: "+ ++(show (head $1))++" '"++$4++"'")] }+ | stag '/>' { Ast "element_construction" ($1++[Ast "append" []]) }+ | 'element' '{' expr '}' '{' expl '}' { Ast "element_construction" [$3,Ast "attributes" [],concatenateAll $6] }+ | 'attribute' '{' expr '}''{' expl '}'{ Ast "attribute_construction" [$3,concatenateAll $6] }+ | 'element' qname '{' expl '}' { Ast "element_construction" [Astring $2,Ast "attributes" [],concatenateAll $4] }+ | 'attribute' qname '{' expl '}' { Ast "attribute_construction" [Astring $2,concatenateAll $4] }++stag :: { [ Ast ] }+stag : '<' qname { [Astring $2,Ast "attributes" []] }+ | '<' qname attributes { [Astring $2,Ast "attributes" $3] }++content :: { [ Ast ] }+content : '{' expl '}' { [concatenateAll $2] }+ | 'String' { [Astring $1] }+ | 'XMLtext' { [Astring $1] }+ | element { [$1] }+ | content '{' expl '}' { $1++[concatenateAll $3] }+ | content 'String' { $1++[Astring $2] }+ | content 'XMLtext' { $1++[Astring $2] }+ | content element { $1++[$2] }++string :: { Ast }+string : stringc { if length $1 == 0 then Astring ""+ else if length $1 == 1 then head $1 else Ast "append" $1 }++stringc :: { [Ast] }+stringc : 'String' { if $1=="" then [] else [Astring $1] }+ | '{' expl '}' { [concatAll $2] }+ | stringc 'String' { if $2=="" then $1 else $1++[Astring $2] }+ | stringc '{' expl '}' { $1++[concatAll $3] }++attributes :: { [ Ast ] }+attributes : qname '=' string { [Ast "pair" [Astring $1,$3]] }+ | attributes qname '=' string { $1++[Ast "pair" [Astring $2,$4]] }++full_path :: { Ast }+full_path : simple_step predicates { $1 "child" (Avar ".") $2 }+ | '@' simple_step predicates { $2 "attribute" (Avar ".") $3 }+ | simple_step predicates path { $3 ($1 "child" (Avar ".") $2) }+ | '@' simple_step predicates path { $4 ($2 "attribute" (Avar ".") $3) }++path :: { Ast -> Ast }+path : step { $1 }+ | path step { $2 . $1 }++step :: { Ast -> Ast }+step : '/' simple_step predicates { \e -> $2 "child" e $3 }+ | '/' '@' simple_step predicates { \e -> $3 "attribute" e $4 }+ | '/' '/' simple_step predicates { \e -> $3 "descendant" e $4 }+ | '/' '/' '@' simple_step predicates { \e -> $4 "attribute-descendant" e $5 }+ | '/' '..' { \e -> Ast "step" [Avar "parent",Astring "*",e] }++predicates :: { [ Ast ] }+predicates : predicates '[' expr ']' { $1 ++ [$3] }+ | {- empty -} { [] }++simple_step :: { String -> Ast -> [ Ast ] -> Ast }+simple_step : primary_expr { \t e ps -> if null ps+ then $1 t e+ else Ast "filter" ($1 t e:ps) }+ | '*' { \t e ps -> Ast "step" ((Avar t):(Astring "*"):e:ps) }+ | qname { \t e ps -> if elem $1 path_steps+ then parseError [TError ("Axis "++$1++" is missing a node step")]+ else Ast "step" ((Avar t):(Astring $1):e:ps) }+ | 'QName' ':' ':' qname { \t e ps -> if elem $1 path_steps+ then if t == "child"+ then Ast "step" ((Avar $1):(Astring $4):e:ps)+ else parseError [TError ("The navigation step must be /"++$1++"::"++$4)]+ else parseError [TError ("Not a valid axis name: "++$1)] }+ | 'QName' ':' ':' '*' { \t e ps -> if elem $1 path_steps+ then if t == "child"+ then Ast "step" ((Avar $1):(Astring "*"):e:ps)+ else parseError [TError ("The navigation step must be /"++$1++"::*")]+ else parseError [TError ("Not a valid axis name: "++$1)] }++primary_expr :: { String -> Ast -> Ast }+primary_expr : var { \_ _ -> $1 }+ | '.' { \_ e -> e }+ | '(' expl ')' { \t e -> if e == Avar "."+ then concatenateAll $2+ else Ast "context" [e,Astring t,concatenateAll $2] }+ | '(' ')' { \_ _ -> call "empty" [] }+ | qname '(' expl ')' { \t e -> if e == Avar "."+ then call $1 $3+ else Ast "context" [e,Astring t,call $1 $3] }+ | qname '(' ')' { \_ e -> if elem $1 ["last","position","true","false","empty","select"]+ then call $1 []+ else call $1 [e] }++typecases :: { String -> Ast }+typecases : 'case' type 'return' expr+ 'default' 'return' expr { \v -> Ast "if" [call "instance-of" [Avar v,Ast "type" [$2]],$4,$7] }+ | 'case' type 'return' expr typecases { \v -> Ast "if" [call "instance-of" [Avar v,Ast "type" [$2]],$4,$5 v] }+++{++-- Abstract Syntax Tree for XQueries+data Ast = Ast String [Ast]+ | Avar String+ | Aint Int+ | Afloat Double+ | Astring String+ deriving Eq+++instance Show Ast+ where show (Ast s []) = s ++ "()"+ show (Ast s (x:xs)) = s ++ "(" ++ show x+ ++ foldr (\a r -> ","++show a++r) "" xs+ ++ ")"+ show (Avar s) = s+ show (Aint n) = show n+ show (Afloat n) = show n+ show (Astring s) = "\'" ++ s ++ "\'"+++screenSize = 80::Int++prettyAst :: Ast -> Int -> (String,Int)+prettyAst (Avar s) p = (s,(length s)+p)+prettyAst (Aint n) p = let s = show n in (s,(length s)+p)+prettyAst (Afloat n) p = let s = show n in (s,(length s)+p)+prettyAst (Astring s) p = ("\'" ++ s ++ "\'",(length s)+p+2)+prettyAst (Ast s args) p+ = let (ps,np) = prettyArgs args+ in (s++"("++ps++")",np+1)+ where prettyArgs [] = ("",p+1)+ prettyArgs xs = let ss = show (head xs) ++ foldr (\a r -> ","++show a++r) "" (tail xs)+ np = (length s)+p+1+ in if (length ss)+p < screenSize+ then (ss,(length ss)+p)+ else let ds = map (\x -> let (s,ep) = prettyAst x np+ in (s ++ ",\n" ++ space np,ep)) (init xs)+ (ls,lp) = prettyAst (last xs) np+ in (concatMap fst ds ++ ls,lp)+ space n = replicate n ' '+++ppAst :: Ast -> String+ppAst e = let (s,_) = prettyAst e 0 in s+++call :: String -> [Ast] -> Ast+call name args = Ast "call" ((Avar name):args)+++concatenateAll :: [Ast] -> Ast+concatenateAll [x] = x+concatenateAll (x:xs) = foldl (\a r -> call "concatenate" [a,r]) x xs+concatenateAll _ = call "empty" []+++concatAll :: [Ast] -> Ast+concatAll [x] = call "string" [x]+concatAll (x:xs) = foldl (\a r -> call "concatenate" [call "string" [a],r]) x xs+concatAll _ = call "empty" []+++mkPairs = map (\(x,y) -> Ast "pair" [x,y])+++path_steps = ["child", "descendant", "attribute", "self", "descendant-or-self", "following-sibling", "following",+ "attribute-descendant", "parent", "ancestor", "preceding-sibling", "preceding", "ancestor-or-self" ]+++data Token+ = RETURN | SOME | EVERY | IF | THEN | ELSE | LB | RB | LP | RP | LSB | RSB+ | TO | PLUS | MINUS | TIMES | DIV | IDIV | MOD | AS | QMARK+ | TEQ | TNE | TLT | TLE | TGT | TGE | SEQ | SNE | SLT | SLE | SGT | SGE+ | AND | OR | NOT | UNION | INTERSECT | EXCEPT | FOR | LET | IN | COMMA+ | ASSIGN | WHERE | ORDER | BY | ASCENDING | DESCENDING | ELEMENT+ | ATTRIBUTE | STAG | ETAG | SATISFIES | ATSIGN | SLASH | DECLARE | SEMI | COLON+ | FUNCTION | VARIABLE | VIEW | AT | DOT | DOTS | TokenEOF | PRE | POST | IS+ | INSERT | INTO | DELETE | FROM | REPLACE | TYPE | WITH | INSTANCE | OF+ | CAST | CASTABLE | CASE | DEFAULT | TYPESWITCH | IMPORT | NAMESPACE | SCHEMA | VALIDATE+ | QName String | Variable String | XMLtext String | TInteger Int+ | TFloat Double | TString String | TError String+ deriving Eq+++instance Show Token+ where show (QName s) = "QName("++s++")"+ show (Variable s) = "Variable("++s++")"+ show (XMLtext s) = "XMLtext("++s++")"+ show (TInteger n) = "Integer("++(show n)++")"+ show (TFloat n) = "Double("++(show n)++")"+ show (TString s) = "String("++s++")"+ show (TError s) = "'"++s++"'"+ show t = case filter (\(n,_) -> n==t) tokenList of+ (_,b):_ -> b+ _ -> "Illegal token"+++printToken (QName s) = s+printToken (Variable s) = "$"++s+printToken (XMLtext s) = "'"++s++"'"+printToken (TInteger n) = show n+printToken (TFloat n) = show n+printToken (TString s) = "\""++s++"\""+printToken (TError s) = "error("++s++")"+printToken t = case filter (\(n,_) -> n==t) tokenList of+ (_,b):_ -> b+ _ -> "Illegal token"+++tokenList :: [(Token,String)]+tokenList = [(TokenEOF,"EOF"),(RETURN,"return"),(SOME,"some"),(EVERY,"every"),(IF,"if"),(THEN,"then"),(ELSE,"else"),+ (LB,"["),(RB,"]"),(LP,"("),(RP,")"),(LSB,"{"),(RSB,"}"),(QMARK,"?"),+ (TO,"to"),(PLUS,"+"),(MINUS,"-"),(TIMES,"*"),(DIV,"div"),(IDIV,"idiv"),(MOD,"mod"),+ (TEQ,"="),(TNE,"!="),(TLT,"<"),(TLE,"<="),(TGT,">"),(TGE,">="),(PRE,"<<"),(POST,">>"),+ (IS,"is"),(SEQ,"eq"),(SNE,"ne"),(SLT,"lt"),(SLE,"le"),(SGT,"gt"),(SGE,"ge"),(AND,"and"),+ (OR,"or"),(NOT,"not"),(UNION,"|"),(INTERSECT,"intersect"),(EXCEPT,"except"),+ (FOR,"for"),(LET,"let"),(IN,"in"),(AS,"as"),(COMMA,"','"),(ASSIGN,":="),(WHERE,"where"),(ORDER,"order"),+ (BY,"by"),(ASCENDING,"ascending"),(DESCENDING,"descending"),(ELEMENT,"element"),+ (ATTRIBUTE,"attribute"),(STAG,"</"),(ETAG,"/>"),(SATISFIES,"satisfies"),(ATSIGN,"@"),+ (SLASH,"/"),(DECLARE,"declare"),(FUNCTION,"function"),(VARIABLE,"variable"),(VIEW,"view"),+ (INSERT,"insert"),(INTO,"into"),(DELETE,"delete"),(FROM,"from"),(REPLACE,"replace"),(WITH,"with"),+ (TYPE,"type"),(AT,"at"),(DOTS,".."),(DOT,"."),(SEMI,";"),(COLON,":"),(INSTANCE,"instance"),(OF,"of"),+ (CAST,"cast"),(CASTABLE,"castable"),(CASE,"case"),(DEFAULT,"default"),(TYPESWITCH,"typeswitch"),+ (VALIDATE,"validate")]+++parseError tk = error (case tk of+ ((TError s):_) -> "Parse error: "++s+ (TokenEOF:_) -> "Parse error: Unexpected end of file"+ _ -> "Parse error: "++(foldr (\a r -> (printToken a)++" "++r) "" (init (take 11 tk))))+++scan :: String -> [Token]+scan cs = lexer cs ""+++xmlText :: String -> [Token]+xmlText "" = []+xmlText text = [XMLtext text]+++-- scans XML syntax and returns an XMLtext token with the text+xml :: String -> String -> String -> [Token]+xml ('{':cs) text n = (xmlText text)++(LSB : lexer cs ('{':n))+xml ('<':'/':cs) text n = (xmlText text)++(STAG : lexer cs ('<':'/':n))+xml ('<':'!':'-':cs) text n = xmlComment cs (text++"<!-") n+xml ('<':'?':cs) text n = xmlComment cs (text++"<?") n+xml ('<':cs) text n = (xmlText text)++(TLT : lexer cs ('<':n))+xml ('(':':':cs) text n = xqComment cs text n+xml (c:cs) text n = xml cs (text++[c]) n+xml [] text _ = xmlText text+++xqComment :: String -> String -> String -> [Token]+xqComment (':':')':cs) text n = xml cs text n+xqComment (_:cs) text n = xqComment cs text n+xqComment [] text _ = xmlText text+++xmlComment :: String -> String -> String -> [Token]+xmlComment ('-':'!':'>':cs) text n = xml cs (text++"-!>") n+xmlComment ('?':'>':cs) text n = xml cs (text++"?>") n+xmlComment (c:cs) text n = xmlComment cs (text++[c]) n+xmlComment [] text _ = xmlText text+++isQN :: Char -> Bool+isQN c = elem c "_-." || isDigit c || isAlpha c+++isVar :: Char -> Bool+isVar c = elem c "_-." || isDigit c || isAlpha c+++inXML :: String -> Bool+inXML ('>':'<':_) = True+inXML _ = False+++-- the XQuery scanner+lexer :: String -> String -> [Token]+lexer [] "" = [ TokenEOF ]+lexer [] _ = [ TError "Unexpected end of input" ]+lexer (' ':'>':' ':cs) n = TGT : lexer cs n+lexer (c:cs) n+ | isSpace c = lexer cs n+ | isAlpha c || c=='_' = lexVar (c:cs) n+ | isDigit c = lexNum (c:cs) n+lexer ('$':c:cs) n | isAlpha c+ = let (var,rest) = span isVar (c:cs)+ in (Variable var) : lexer rest n+lexer (':':'=':cs) n = ASSIGN : lexer cs n+lexer ('<':'/':cs) n = STAG : lexer cs ('<':'/':n)+lexer ('<':'=':cs) n = TLE : lexer cs n+lexer ('>':'=':cs) n = TGE : lexer cs n+lexer ('<':'<':cs) n = PRE : lexer cs n+lexer ('>':'>':cs) n = POST : lexer cs n+lexer ('/':'>':cs) m = case m of+ '<':n -> ETAG : (if inXML n then xml cs "" n else lexer cs n)+ _ -> [ TError "Unexpected token: '/>'" ]+lexer ('(':':':cs) n = lexComment cs n+lexer ('<':'!':'-':cs) n = lexXmlComment cs "<!-" n+lexer ('<':'?':cs) n = lexXmlComment cs "<?" n+lexer ('.':'.':cs) n = DOTS : lexer cs n+lexer ('.':cs) n = DOT : lexer cs n+lexer ('!':'=':cs) n = TNE : lexer cs n+lexer ('\'':cs) n = lexString cs "" ('\'':n)+lexer ('\"':cs) n = lexString cs "" ('\"': n)+lexer ('[':cs) n = LB : lexer cs n+lexer (']':cs) n = RB : lexer cs n+lexer ('(':cs) n = LP : lexer cs n+lexer (')':cs) n = RP : lexer cs n+lexer ('}':cs) m = case m of+ '{':'\"':n -> RSB : lexString cs "" ('\"':n)+ '{':'\'':n -> RSB : lexString cs "" ('\'':n)+ '{':n -> RSB : (if inXML n then xml cs "" n else lexer cs n)+ _ -> [ TError "Unexpected token: '}'" ]+lexer ('+':cs) n = PLUS : lexer cs n+lexer ('-':cs) n = MINUS : lexer cs n+lexer ('*':cs) n = TIMES : lexer cs n+lexer ('=':cs) n = TEQ : lexer cs n+lexer ('<':c:cs) n = TLT : (lexer (c:cs) (if isAlpha c then ('<':n) else n))+lexer ('>':cs) m = case m of+ '<':'/':'>':'<':n -> TGT : (if inXML n then xml cs "" n else lexer cs n)+ '<':n -> TGT : xml cs "" ('>':m) + _ -> TGT : lexer cs m+lexer (',':cs) n = COMMA : lexer cs n+lexer ('@':cs) n = ATSIGN : lexer cs n+lexer ('?':cs) n = QMARK : lexer cs n+lexer ('/':cs) n = SLASH : lexer cs n+lexer ('{':cs) n = LSB : lexer cs ('{':n)+lexer ('|':cs) n = UNION : lexer cs n+lexer (';':cs) n = SEMI : lexer cs n+lexer (':':cs) n = COLON : lexer cs n+lexer (c:cs) n = TError ("Illegal character: '"++[c,'\'']) : lexer cs n+++lexExp :: String -> (String,String)+lexExp (e:cs)+ | e == 'e' || e == 'E'+ = case cs of+ '+':rest -> span isDigit rest+ '-':rest -> let (s,rest1) = span isDigit rest+ in ('-':s,rest1)+ rest -> span isDigit rest+lexExp cs = ("",cs)+++lexNum :: String -> String -> [Token]+lexNum cs n+ = let (si,rest) = span isDigit cs+ in case rest of+ '.':rest1+ -> let (sd,rest2) = span isDigit rest1+ in case lexExp rest2 of+ ("",_) -> (TFloat (read $ si ++ "." ++ sd)) : lexer rest2 n+ (exp,rest3) -> (TFloat (read $ si ++ "." ++ sd ++ "e" ++ exp)) : lexer rest3 n+ _ -> case lexExp rest of+ ("",_) -> (TInteger (read si)) : lexer rest n+ (exp,rest3) -> (TFloat (read $ si ++ "e" ++ exp)) : lexer rest3 n+++lexString :: String -> String -> String -> [Token]+lexString ('\"':cs) s m = case m of+ '\"':n -> (TString s) : (lexer cs n)+ _ -> lexString cs (s++"\"") m+lexString ('\'':cs) s m = case m of+ '\'':n -> (TString s) : (lexer cs n)+ _ -> lexString cs (s++"\'") m+-- a string in an attribute value must evaluate between {}+lexString ('{':cs) s (c:'<':n) = (TString s) : LSB : (lexer cs ('{':c:'<':n))+lexString ('\\':'n':cs) s n = lexString cs (s++['\n']) n+lexString ('\\':'r':cs) s n = lexString cs (s++['\r']) n+lexString (c:cs) s n = lexString cs (s++[c]) n+lexString [] s n = [ TError "End of input while in string" ]+++lexComment :: String -> String -> [Token]+lexComment (':':')':cs) n = lexer cs n+lexComment (_:cs) n = lexComment cs n+lexComment [] n = [ TError "End of input while in comment" ]+++lexXmlComment :: String -> String -> String -> [Token]+lexXmlComment ('-':'!':'>':cs) text n = (xmlText (text++"-!>"))++(lexer cs n)+lexXmlComment ('?':'>':cs) text n = (xmlText (text++"?>"))++(lexer cs n)+lexXmlComment (c:cs) text n = lexXmlComment cs (text++[c]) n+lexXmlComment [] text _ = xmlText text+++lexVar :: String -> String -> [Token]+lexVar cs n =+ let (nm,rest) = span isQN cs+ token = case nm of+ "return" -> RETURN+ "some" -> SOME+ "every" -> EVERY+ "if" -> IF+ "then" -> THEN+ "else" -> ELSE+ "to" -> TO+ "div" -> DIV+ "idiv" -> IDIV+ "mod" -> MOD+ "and" -> AND+ "or" -> OR+ "not" -> NOT+ "union" -> UNION+ "intersect" -> INTERSECT+ "except" -> EXCEPT+ "for" -> FOR+ "let" -> LET+ "in" -> IN+ "as" -> AS+ "where" -> WHERE+ "order" -> ORDER+ "by" -> BY+ "ascending" -> ASCENDING+ "descending" -> DESCENDING+ "element" -> ELEMENT+ "attribute" -> ATTRIBUTE+ "satisfies" -> SATISFIES+ "declare" -> DECLARE+ "function" -> FUNCTION+ "variable" -> VARIABLE+ "namespace" -> NAMESPACE+ "view" -> VIEW+ "at" -> AT+ "eq" -> SEQ+ "ne" -> SNE+ "lt" -> SLT+ "le" -> SLE+ "gt" -> SGT+ "ge" -> SGE+ "is" -> IS+ "insert" -> INSERT+ "into" -> INTO+ "delete" -> DELETE+ "from" -> FROM+ "replace" -> REPLACE+ "type" -> TYPE+ "with" -> WITH+ "instance" -> INSTANCE+ "of" -> OF+ "cast" -> CAST+ "castable" -> CASTABLE+ "case" -> CASE+ "default" -> DEFAULT+ "typeswitch" -> TYPESWITCH+ "schema" -> SCHEMA+ "import" -> IMPORT+ "validate" -> VALIDATE+ var -> QName var+ in case token of+ QName v1 -> case rest of+ ':':':':'*':rest2 -> [QName v1,COLON,COLON,TIMES] ++ lexer rest2 n+ ':':':':rest2 -> let (v2,rest3) = span isQN rest2+ in [QName v1,COLON,COLON,QName v2] ++ lexer rest3 n+ ':':rest2 -> let (v2,rest3) = span isQN rest2+ in [QName v1,COLON,QName v2] ++ lexer rest3 n+ _ -> QName v1 : lexer rest n+ x -> x : lexer rest n+}
src/hxml-0.2/LLParsing.hs view
@@ -1,5 +1,4 @@ {-# OPTIONS -fno-warn-missing-signatures #-}-{-# OPTIONS -fglasgow-exts #-} ---------------------------------------------------------------------------- -- -- Module : HXML.LLParsing
src/withDB/Text/XML/HXQ/DB.hs view
@@ -25,6 +25,7 @@ import Char(isSpace,isDigit,toLower) import List(zip) import Data.List(foldl')+import Control.Monad(foldM) import System.IO import Database.HDBC import Text.XML.HXQ.XTree@@ -213,7 +214,9 @@ deriveSchema file prefix ignored = do doc <- readFile file let ts = parseDocument doc- [SSnode _ _ _ _ _ _ [t]] = getSS ts 0 ignored [SSnode "root" 1 1 1 False 0 []]+ tt = getSS ts 0 ignored [SSnode "root" 1 1 1 False 0 []]+ -- putStrLn (show tt)+ let [SSnode _ _ _ _ _ _ [t]] = tt nt@(SSnode m i j l b len s) = fixSS t -- putStrLn (show nt) return $! (head (schema (SSnode m i 2 l b len s) prefix []))@@ -257,12 +260,15 @@ stmt <- handleSqlError (prepare db "select summary from HXQCatalog where name = ?") _ <- handleSqlError (execute stmt [SqlString name]) result <- handleSqlError (fetchAllRowsAL stmt)+{- ans <- if (length result == 0) then return True else do putStr $ "Schema "++name++" already exists. Do you want to replace it? [y/n] " hFlush stdout line <- getLine return $ line == "y"+-}+ ans <- return True if ans && length result > 0 then do let [[(_,s)]] = result summary = (read (dbString s))::Table@@ -801,13 +807,13 @@ removeTuples :: Connection -> String -> Table -> Integer -> IO () removeTuples db schema (Table n _ _ ts) parent- = do stmt <- handleSqlError (prepare db ("select id from "++n++" where parent = ?"))+ = do stmt <- handleSqlError (prepare db ("select _id from "++n++" where parent = ?")) handleSqlError (execute stmt [SqlInteger parent]) result <- fetchAllRowsAL stmt case result of [[(_,ids)]] -> do let id = read (dbString ids)- handleSqlError (run db ("delete from "++n++" where id = ?") [SqlInteger id])+ handleSqlError (run db ("delete from "++n++" where _id = ?") [SqlInteger id]) mapM (\t -> removeTuples db schema t id) ts return () _ -> return ()@@ -827,12 +833,12 @@ = do let [schema,tableName,attrName] = words tnm if tableName /= attrName then mapM (\c -> handleSqlError (run db ("update "++tableName++" set "++c- ++" = NULL where id = ?")+ ++" = NULL where _id = ?") [SqlInteger (toInteger id)])) (getColumns x) else do table <- findSchema db schema let [Table n _ _ ts] = getDestinationTable table tableName- handleSqlError (run db ("delete from "++n++" where id = ?")+ handleSqlError (run db ("delete from "++n++" where _id = ?") [SqlInteger (toInteger id)]) mapM (\t -> removeTuples db schema t (toInteger id)) ts return [0]@@ -843,17 +849,22 @@ replaceDB :: Connection -> XSeq -> XSeq -> IO XSeq replaceDB db dest with+ = foldM (\r x -> do s <- replaceDBsingle db x with; return (s++r)) [] dest+++replaceDBsingle :: Connection -> XTree -> XSeq -> IO XSeq+replaceDBsingle db dest with = case dest of- [d@(XElem tag ((QName _ _ "_table",tnm):_) id parent cs)]+ d@(XElem tag ((QName _ _ "_table",tnm):_) id parent cs) -> do let [schema,tableName,attrName] = words tnm update x = do handleSqlError (run db ("update "++tableName++" set "++attrName- ++" = ? where id = ?")+ ++" = ? where _id = ?") [SqlString (show x),SqlInteger (toInteger id)]) return [] table <- findSchema db schema if tableName == attrName then let [dest@(Table _ _ _ ts)] = getDestinationTable table tableName- in do handleSqlError (run db ("delete from "++tableName++" where id = ?")+ in do handleSqlError (run db ("delete from "++tableName++" where _id = ?") [SqlInteger (toInteger id)]) mapM (\t -> removeTuples db schema t (toInteger id)) ts insertChildren db schema dest with id@@ -879,4 +890,3 @@ [] -> return [] _ -> dbError db ("The replace source must be a singleton value: "++show with) return []- _ -> dbError db ("The replace destination must be a single persistent XML element: "++show dest)
+ tests/Test1.hs view
@@ -0,0 +1,41 @@+{--------------------------------------------------------------+-+- A main program to test the XQuery processor+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 07/24/2008+-+---------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}+++module Main where++import Text.XML.HXQ.XQuery+++f(d,s) = $(xq "<student dept='{$d/text()}'>{$s//firstname/text(),$s//lastname/text()}</student>")++main = do a <- $(xq " for $s in doc('data/cs.xml')//gradstudent \+ \ order by $s/gpa descending, $s//lastname \+ \ return <student>{$s//firstname/text(), \+ \ $s//lastname/text(), \+ \ $s/gpa/text()}</student> ")+ putXSeq a+ let query name = $(xq " doc('data/cs.xml')//gradstudent[.//lastname = $name]//firstname ")+ b <- query $(xe " 'Galanis' ")+ putXSeq b+ c <- $(xq " <good-students>{ \+ \ let $d := doc('data/cs.xml') \+ \ for $s in $d//gradstudent \+ \ where $s/gpa = 4.0 \+ \ return f($d//deptname,$s) \+ \ }</good-students> ")+ putXSeq c+ d <- $(xq " let $d := doc('data/cs.xml')//gradstudent \+ \ return ($d/../deptname,count($d)) ")+ putXSeq d+ putStrLn "Type an XQuery:"+ iquery <- getLine -- read an XQuery from input+ e <- xquery iquery -- evaluate it using the XQuery interpreter+ putXSeq e
+ tests/Test2.hs view
@@ -0,0 +1,24 @@+{--------------------------------------------------------------+-+- Testing the XQuery compiler on a large file+- Download dblp.xml.gz from http://dblp.uni-trier.de/xml/+- and uncompress it in the data directory.+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 12/10/2008+-+---------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module Main where++import Text.XML.HXQ.XQuery++main = do a <- $(xq "<result>{ \+ \ for $x at $i in doc('data/dblp.xml')//inproceedings \+ \ where $x/author = 'Leonidas Fegaras' \+ \ return <paper>{ $i, $x/booktitle/text(), \+ \ ':', $x/title/text() \+ \ }</paper> \+ \ }</result> ")+ putXSeq a
+ tests/Test2a.hs view
@@ -0,0 +1,24 @@+{--------------------------------------------------------------+-+- Testing the XQuery compiler on a large file+- Download dblp.xml.gz from http://dblp.uni-trier.de/xml/+- and uncompress it in the data directory.+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 12/14/2008+-+---------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++module Main where++import Text.XML.HXQ.XQuery++main = do a <- [$qx| <result>{+ for $x at $i in doc('data/dblp.xml')//inproceedings+ where $x/author = 'Leonidas Fegaras'+ return <paper>{ $i, $x/booktitle/text(),+ ':', $x/title/text()+ }</paper>+ }</result> |]+ putXSeq a
+ tests/TestDB.hs view
@@ -0,0 +1,25 @@+{--------------------------------------------------------------+-+- A main program to test XQuery connected to a Sqlite database+- To create the database load the file data/company.sql in sqlite3+-+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 07/24/2008+-+---------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module Main where++import Text.XML.HXQ.XQuery+++main = do db <- connect "hxq"+ e <- $(xqdb (" for $r in sql(' select e.fname, d.dname \+ \ from employee e, department d \+ \ where e.dno = d.dnumber \+ \ and e.lname = ? ', \+ \ 'English') \+ \ return <result>{$r/fname,$r/dname}</result> ")) db+ putXSeq e
+ tests/TestDB2.hs view
@@ -0,0 +1,21 @@+{--------------------------------------------------------------+-+- A main program to test XML shredding and publishing+-+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 07/24/2008+-+---------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module Main where++import Text.XML.HXQ.XQuery+++main = do db <- connect "hxq"+ res <- $(xqdb (" for $s in publish('hxq','c')//gradstudent \+ \ where $s//lastname='Galanis' \+ \ return $s//gpa ")) db+ putXSeq res
+ tests/TestDBLP.hs view
@@ -0,0 +1,35 @@+{--------------------------------------------------------------+-+- Creating the DBLP database+- Download dblp.xml.gz from http://dblp.uni-trier.de/xml/+- and uncompress it in the data directory.+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 02/01/2009+-+---------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module Main where++import Text.XML.HXQ.XQuery+import System.IO+++main = do db <- connect "hxq"+ exists <- isSchema db "d"+ ans <- if exists+ then do putStr $ "The DBLP database already exists. Do you want to rebuild it? [y/n] "+ hFlush stdout+ line <- getLine+ return $ line == "y"+ else return True+ if ans+ then do putStrLn "Generating the relational schema for the DBPL database using hybrid inlining."+ -- ignore the HTML tags <i>, <sub>, <sup>, and <tt>+ genSchema db "data/dblp.xml" "d" ["i","sub","sup","tt"]+ putStrLn "Populating the DBPL database (will insert about 5M tuples)."+ shred db "data/dblp.xml" "d"+ putStrLn "Creating an index on author name."+ createIndex db "d" "author"+ else return ()
+ tests/TestDBa.hs view
@@ -0,0 +1,26 @@+{--------------------------------------------------------------+-+- A main program to test XQuery connected to a Sqlite database+- To create the database load the file data/company.sql in sqlite3+-+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 12/14/2008+-+---------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++module Main where++import Text.XML.HXQ.XQuery+++main = do _db <- connect "hxq"+ e <- [$qx| for $r in sql(' select e.fname, d.dname+ from employee e, department d+ where e.dno = d.dnumber+ and e.lname = ? ',+ 'English')+ return <result>{$r/fname,$r/dname}</result> |]+ putXSeq e
+ tests/TestXMark.hs view
@@ -0,0 +1,22 @@+{--------------------------------------------------------------+-+- Test the XQuery processor using the XMark benchmark+- Dowmload and compile XMark from+- http://monetdb.cwi.nl/xml/index.html+- Then use parameter -f 10 to create 1.1GB test file xdata.xml+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 03/29/2009+-+---------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}+++module Main where++import Text.XML.HXQ.XQuery++main = do a <- $(xq " for $m in doc('data/xdata.xml')//europe//mail \+ \ where $m/date='08/06/1999' \+ \ return <mail>from: {$m/child::from/text()}, to: {$m/child::to/text()}</mail> ")+ putXSeq a
+ tests/Validate.hs view
@@ -0,0 +1,20 @@+{--------------------------------------------------------------+-+- A main program to validate dblp.xml using dblp.xsd+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 09/09/2009+-+---------------------------------------------------------------}+++{-# LANGUAGE TemplateHaskell #-}++module Main where++import Text.XML.HXQ.XQuery+++main = do a <- validateFile "data/dblp.xml" "data/dblp.xsd"+ -- a <- $(xq "import schema default element namespace 'dblp' at 'data/dblp.xsd'; \+ -- \ (validate {doc('data/dblp.xml')})//inproceedings[2] ")+ putStrLn $ show a
+ xquery.hs view
@@ -0,0 +1,15 @@+{--------------------------------------------------------------+-+- The XQuery command line interpreter+- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)+- Date: 01/08/2010+-+---------------------------------------------------------------}++module Main where++import Text.XML.HXQ.XQuery+import System.Environment(getArgs)++main = do arguments <- getArgs+ commandLineInterpreter arguments