HXQ 0.8.5.1 → 0.9.0
raw patch · 61 files changed
+7311/−6373 lines, 61 files
Files
- HXQ-unstable.hs +0/−94
- HXQ.cabal +49/−13
- Main.hs +10/−12
- Makefile +15/−13
- Text/XML/HXQ/Compiler.hs +0/−834
- Text/XML/HXQ/DB.hs +0/−503
- Text/XML/HXQ/DBConnect.hs +0/−26
- Text/XML/HXQ/Interpreter.hs +0/−406
- Text/XML/HXQ/Optimizer.hs +0/−517
- Text/XML/HXQ/Parser.hs +0/−2153
- Text/XML/HXQ/XQuery.hs +0/−43
- Text/XML/HXQ/XTree.hs +0/−147
- XQueryParser.y +60/−35
- compile +2/−2
- compile.bat +11/−0
- data/a.xml +29/−0
- data/c.xml +25/−0
- data/test-results.txt +211/−0
- data/test.xq +234/−0
- data/testdb.xq +31/−0
- hxml-0.2/00-LICENSE.txt +0/−22
- hxml-0.2/00-README.txt +0/−57
- hxml-0.2/AssocList.hs +0/−56
- hxml-0.2/DTD.hs +0/−218
- hxml-0.2/ETree.hs +0/−44
- hxml-0.2/HXML.hs +0/−38
- hxml-0.2/LLParsing.hs +0/−110
- hxml-0.2/Misc.hs +0/−62
- hxml-0.2/PrintXML.hs +0/−91
- hxml-0.2/Tree.hs +0/−73
- hxml-0.2/TreeBuild.hs +0/−69
- hxml-0.2/XML.hs +0/−102
- hxml-0.2/XMLParse.hs +0/−278
- hxml-0.2/XMLScanner.hs +0/−270
- index.html +129/−85
- src/Text/XML/HXQ/Compiler.hs +509/−0
- src/Text/XML/HXQ/Functions.hs +447/−0
- src/Text/XML/HXQ/Interpreter.hs +401/−0
- src/Text/XML/HXQ/Optimizer.hs +687/−0
- src/Text/XML/HXQ/Parser.hs +2240/−0
- src/Text/XML/HXQ/XQuery.hs +42/−0
- src/Text/XML/HXQ/XTree.hs +147/−0
- src/hxml-0.2/00-LICENSE.txt +22/−0
- src/hxml-0.2/00-README.txt +57/−0
- src/hxml-0.2/AssocList.hs +56/−0
- src/hxml-0.2/DTD.hs +218/−0
- src/hxml-0.2/ETree.hs +44/−0
- src/hxml-0.2/HXML.hs +38/−0
- src/hxml-0.2/LLParsing.hs +110/−0
- src/hxml-0.2/Misc.hs +62/−0
- src/hxml-0.2/PrintXML.hs +91/−0
- src/hxml-0.2/Tree.hs +73/−0
- src/hxml-0.2/TreeBuild.hs +69/−0
- src/hxml-0.2/XML.hs +102/−0
- src/hxml-0.2/XMLParse.hs +278/−0
- src/hxml-0.2/XMLScanner.hs +270/−0
- src/noDB/Text/XML/HXQ/OptionalDB.hs +68/−0
- src/readline/System/Console/Readline.hs +10/−0
- src/withDB/Text/XML/HXQ/DB.hs +414/−0
- src/withDB/Text/XML/HXQ/DBConnect.hs +26/−0
- src/withDB/Text/XML/HXQ/OptionalDB.hs +24/−0
− HXQ-unstable.hs
@@ -1,94 +0,0 @@-{------------------------------------------------------------------ The main program of the XQuery Compiler-- **** UNSTABLE *****-- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 07/24/2008------------------------------------------------------------------}--module Main where--import GHC-import DynFlags-import Packages-import PackageConfig-import System.IO-import Text.XML.HXQ.XQuery-import System.Environment-import qualified Control.Exception-import Text.XML.HXQ.Compiler(functions)-import Text.XML.HXQ.Interpreter(evalInput)---version = "0.8.5"-default_system_path = "/usr/local/lib/ghc-6.8.3"-default_hxq_path = "./"---parseEnv :: [String] -> [(String,String)]-parseEnv [] = [("hxq",default_hxq_path),("ghc",default_system_path),("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 ("-p":query:file:xs) = ("p","doc('"++file++"')"++query):(parseEnv xs)-parseEnv ("-h":path:xs) = ("hxq",path):(parseEnv xs)-parseEnv ("-l":path:xs) = ("ghc",path):(parseEnv xs)-parseEnv (('-':x):_) = error ("Unrecognized option -"++x++". Use -help.")-parseEnv (file:xs) = ("r",file):(parseEnv xs)---main = do putStrLn ("HXQ: XQuery Compiler version "++version)- senv <- getArgs- let env = parseEnv senv- Just system_path = lookup "ghc" env- Just hxq_path = lookup "hxq" env- case lookup "help" env of- Just _ -> do putStrLn "Command line options and files:"- putStrLn "xquery-file compile and run the XQuery in xquery-file"- 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 compile and run the XPath query against the xml-file"- putStrLn ("-h path set the HXQ installation directory (default is "++default_hxq_path++")")- putStrLn ("-l path set the GHC installation directory (default is "++default_system_path++")")- putStrLn ("Functions: "++(foldr (\(f,_,_) r -> f++" "++r) "" functions))- _ -> case lookup "c" env of- Just file -> do query <- readFile file- let qf = map (\c -> if c=='\"' then '\'' else c)- (foldr1 (\a r -> a++" "++r) (lines query))- pr = "{-# OPTIONS_GHC -fth #-}\nmodule Main where\nimport Text.XML.HXQ.XQuery\n\nmain = do res <- $(xq \""- ++ qf ++ "\")\n putXSeq res\n"- Just ofile = lookup "o" env- writeFile ofile pr- _ -> do session <- newSession (Just system_path)- dflags0 <- getSessionDynFlags session- (dflags1,b) <- parseDynamicFlags dflags0 ["-fglasgow-exts", "-O2", "-fth", "-fobject-code",- --"-package HXQ", "-package ghc"]- "-i"++hxq_path++"Text/XML/HXQ/:"++hxq_path++"hxml-0.2"]- (dflags2, _) <- initPackages dflags1- setSessionDynFlags session dflags2- --load session LoadAllTargets- let preludeModule = mkModule (stringToPackageId "base") (mkModuleName "Prelude")- --xqueryModule = mkModule (stringToPackageId "HXQ") (mkModuleName "XQuery")- setContext session [] [preludeModule]- t <- guessTarget (hxq_path++"Main.hs") Nothing- addTarget session t- f <- getSessionDynFlags session- sf <- defaultCleanupHandler f (load session LoadAllTargets)- --ff <- load session (LoadDependenciesOf (mkModuleName "XQuery"))- case lookup "r" env of- Just file -> do q <- readFile file- let qf = map (\c -> if c=='\"' then '\'' else c)- (foldr1 (\a r -> a++" "++r) (lines q))- query = "do result <- $(XQuery.xq \""++qf++"\"); XQuery.putXSeq result"- _ <- runStmt session query SingleStep- return ()- _ -> case lookup "p" env of- Just query -> do _ <- runStmt session ("do result <- $(Text.XML.HXQ.XQuery.xq \""++query- ++"\"); Text.XML.HXQ.XQuery.putXSeq result") SingleStep- return ()- _ -> do putStrLn "To write an XQuery in multiple lines, wrap it in {}"- evalInput (\s vs fs -> let query = "do result <- $(Text.XML.HXQ.XQuery.xq \""++s++"\");"- ++"Text.XML.HXQ.XQuery.putXSeq result"- in Control.Exception.catch (do runStmt session query SingleStep; return (vs,fs))- (\e -> do putStrLn (show e); return (vs,fs))) [] []
HXQ.cabal view
@@ -1,12 +1,13 @@ Cabal-Version: >= 1.2 Name: HXQ-Version: 0.8.5.1+Version: 0.9.0 Synopsis: A Compiler from XQuery to Haskell Description: HXQ is a fast and space-efficient compiler from XQuery (the standard query language for XML) to embedded Haskell code. The translation is based on Haskell templates. It also provides an interpreter for- evaluating XQueries from input and database connectivity using HDBC.+ evaluating XQueries from input and an optional database connectivity+ using HDBC and SQLite3. Category: XML Build-type: Simple License-file: LICENSE@@ -17,36 +18,71 @@ Maintainer: fegaras@cse.uta.edu Homepage: http://lambda.uta.edu/HXQ/ Extra-Source-Files:+ src/noDB/Text/XML/HXQ/OptionalDB.hs+ src/withDB/Text/XML/HXQ/DB.hs+ src/withDB/Text/XML/HXQ/DBConnect.hs+ src/withDB/Text/XML/HXQ/OptionalDB.hs+ src/readline/System/Console/Readline.hs Makefile- HXQ-unstable.hs XQueryParser.y Test1.hs Test2.hs TestDB.hs TestDB2.hs compile+ compile.bat data-files: index.html data/cs.xml+ data/a.xml+ data/c.xml data/q1.xq data/q2.xq data/q3.xq data/dblp.xq data/dblp2.xq+ data/test.xq+ data/test-results.txt+ data/testdb.xq data/company.sql- hxml-0.2/00-LICENSE.txt- hxml-0.2/00-README.txt+ src/hxml-0.2/00-LICENSE.txt+ src/hxml-0.2/00-README.txt +Flag db+ Description: provides database connectivity using HDBC and HDBC-sqlite3.+ Default: False+ Library Exposed-Modules: Text.XML.HXQ.XQuery- Other-Modules: Text.XML.HXQ.XTree, Text.XML.HXQ.Compiler, Text.XML.HXQ.Interpreter, Text.XML.HXQ.Parser,- Text.XML.HXQ.Optimizer, Text.XML.HXQ.DB, Text.XML.HXQ.DBConnect,- HXML, DTD, LLParsing, TreeBuild, XMLParse, ETree, Misc, Tree,- XMLScanner, AssocList, PrintXML, XML- hs-source-dirs: . hxml-0.2- Build-Depends: base, haskell98, array, readline, template-haskell, mtl, HDBC < 1.1.5, HDBC-sqlite3+ Other-Modules: Text.XML.HXQ.XTree, Text.XML.HXQ.Functions, Text.XML.HXQ.Compiler,+ Text.XML.HXQ.Interpreter, Text.XML.HXQ.Parser, Text.XML.HXQ.Optimizer,+ Text.XML.HXQ.OptionalDB, HXML, DTD, LLParsing, TreeBuild, XMLParse,+ ETree, Misc, Tree, XMLScanner, AssocList, PrintXML, XML+ hs-source-dirs: . src src/hxml-0.2+ Build-Depends: base, haskell98, array, template-haskell, mtl+ if os(windows)+ hs-source-dirs: src/readline+ Other-Modules: System.Console.Readline+ else+ Build-Depends: readline+ if flag(db)+ Other-Modules: Text.XML.HXQ.DB, Text.XML.HXQ.DBConnect+ Build-Depends: HDBC < 1.1.5, HDBC-sqlite3+ hs-source-dirs: src/withDB+ else+ hs-source-dirs: src/noDB Executable xquery Main-is: Main.hs- hs-source-dirs: . hxml-0.2- Build-Depends: base, haskell98, array, readline, template-haskell, mtl, HDBC < 1.1.5, HDBC-sqlite3+ hs-source-dirs: . src src/hxml-0.2+ Build-Depends: base, haskell98, array, template-haskell, mtl+ if os(windows)+ hs-source-dirs: src/readline+ Other-Modules: System.Console.Readline+ else+ Build-Depends: readline+ if flag(db)+ Build-Depends: HDBC < 1.1.5, HDBC-sqlite3+ hs-source-dirs: src/withDB+ else+ hs-source-dirs: src/noDB
Main.hs view
@@ -2,7 +2,7 @@ - - The main program of the XQuery interpreter - Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 07/24/2008+- Date: 08/14/2008 - ---------------------------------------------------------------} @@ -11,11 +11,11 @@ import System.Environment import qualified Control.Exception-import Text.XML.HXQ.Compiler(functions)+import Text.XML.HXQ.Functions(functions) import Text.XML.HXQ.Interpreter(evalInput,xqueryE) import Text.XML.HXQ.XQuery -version = "0.8.5"+version = "0.9.0" parseEnv :: [String] -> [(String,String)]@@ -30,6 +30,9 @@ parseEnv (file:xs) = ("r",file):(parseEnv xs) +noDBerror _ = error "Missing Database Connection"++ main = do senv <- getArgs let env = parseEnv senv Just system_path = lookup "ghc" env@@ -61,29 +64,24 @@ Just file -> case lookup "db" env of Just filepath -> do db <- connect filepath result <- xfileDB file db- disconnect db putXSeq result _ -> do query <- readFile file- (result,_,_) <- xqueryE query [] [] (\sql -> return []) verbose+ (result,_,_) <- xqueryE query [] [] noDBerror verbose putXSeq result _ -> case lookup "p" env of- Just query -> do (result,_,_) <- xqueryE query [] [] (\sql -> return []) verbose+ Just query -> do (result,_,_) <- xqueryE query [] [] noDBerror verbose putXSeq result _ -> do putStrLn ("HXQ: XQuery Interpreter version "++version++". Use -help for help.") case lookup "db" env of Just filepath -> do db <- connect filepath evalInput (\s vs fs-> Control.Exception.catch- (do (result,nvs,nfs) <- xqueryE s vs fs- (\sql -> do stmt <- prepareSQL db sql- return [XStmt stmt]) verbose+ (do (result,nvs,nfs) <- xqueryE s vs fs (prepareSQL db) verbose putXSeq result return (nvs,nfs)) (\e -> do putStrLn (show e); return (vs,fs))) [] []- disconnect db _ -> evalInput (\s vs fs-> Control.Exception.catch- (do (result,nvs,nfs) <- xqueryE s vs fs- (\_ -> error "Missing Database Connection") verbose+ (do (result,nvs,nfs) <- xqueryE s vs fs noDBerror verbose putXSeq result return (nvs,nfs)) (\e -> do putStrLn (show e); return (vs,fs))) [] []
Makefile view
@@ -1,45 +1,47 @@-hxml = hxml-0.2-hxq = Text/XML/HXQ-options = -O2-parser = $(hxq)/Parser.hs+parser = src/Text/XML/HXQ/Parser.hs+ghc = ghc -O2 -isrc -isrc/hxml-0.2 -isrc/withDB+src = * src/hxml-0.2/* src/noDB/Text/XML/HXQ/* src/withDB/Text/XML/HXQ/* src/readline/System/Console/* src/Text/XML/HXQ/* # xquery interpreter all: $(parser) Main.hs- ghc $(options) -i$(hxml) --make Main.hs -o xquery+ $(ghc) --make Main.hs -o xquery # on-the-fly compiler: unstable; use xquery instead hxqc: $(parser) HXQ-unstable.hs- ghc $(options) -i$(hxml) -optl-s -package ghc --make HXQ-unstable.hs -o hxqc+ $(ghc) -optl-s -package ghc --make HXQ-unstable.hs -o hxqc # generate the XQuery parser using happy $(parser): XQueryParser.y happy -g -a -c -o $(parser) XQueryParser.y test1: $(parser) Test1.hs- ghc $(options) -i$(hxml) --make Test1.hs -o a.out+ $(ghc) --make Test1.hs -o a.out ./a.out test2: $(parser) Test2.hs- ghc $(options) -i$(hxml) --make Test2.hs -o a.out+ $(ghc) --make Test2.hs -o a.out time ./a.out +RTS -H20m test3: $(parser) TestDB.hs- ghc $(options) -i$(hxml) --make TestDB.hs -o a.out+ $(ghc) --make TestDB.hs -o a.out ./a.out test4: $(parser) TestDB2.hs- ghc $(options) -i$(hxml) --make TestDB2.hs -o a.out+ $(ghc) --make TestDB2.hs -o a.out ./a.out # run in the ghci interpreter and load HXQ ghci: $(parser)- ghci -fth -i$(hxml) Main.hs+ ghci -fth -isrc -isrc/hxml-0.2 -isrc/withDB Main.hs # create the cabal distribution cabal: $(parser)- runhaskell Setup.lhs configure --ghc --user --prefix=$(HOME)+ runhaskell Setup.lhs configure --ghc -fdb --user --prefix=$(HOME) runhaskell Setup.lhs build runhaskell Setup.lhs sdist clean:- /bin/rm -f *~ data/*~ $(hxq)/*~ *.o *.hi $(hxq)/*.o $(hxq)/*.hi $(hxml)/*.o $(hxml)/*.hi $(parser) xquery hxqc Temp.hs a.out+ /bin/rm -f xquery hxqc Temp.hs a.out $(addsuffix .hi,$(src)) $(addsuffix .o,$(src))++distclean: clean+ runhaskell Setup.lhs clean
− Text/XML/HXQ/Compiler.hs
@@ -1,834 +0,0 @@-{----------------------------------------------------------------------------------------- A Compiler from XQuery to Haskell-- Programmer: Leonidas Fegaras-- Email: fegaras@cse.uta.edu-- Web: http://lambda.uta.edu/-- Creation: 02/15/08, last update: 07/24/08-- -- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.-- This material is provided as is, with absolutely no warranty expressed or implied.-- Any use is at your own risk. Permission is hereby granted to use or copy this program-- for any purpose, provided the above notices are retained on all copies.-----------------------------------------------------------------------------------------}---{-# OPTIONS_GHC -fth -fbang-patterns #-}--module Text.XML.HXQ.Compiler where--import Data.List-import Control.Monad-import Char(isDigit,toLower)-import List(sortBy)-import Language.Haskell.TH-import XMLParse(parseDocument)-import HXML(AttList)-import Text.XML.HXQ.Parser-import Text.XML.HXQ.XTree-import Text.XML.HXQ.Optimizer-import Text.XML.HXQ.DB---{--------------- XPath Steps ---------------------------------------------------------}---current_step :: Tag -> XTree -> XSeq-current_step m x- = case x of- XElem k _ _ _ _ | (k==m || m=="*") -> [x]- _ -> []----- XPath step /tag or /*-child_step :: Tag -> XTree -> XSeq-child_step m x- = case x of- XElem _ _ _ _ bs- -> foldr (\b s -> case b of- XElem k _ _ _ _ | (k==m || m=="*") -> b:s- _ -> s) [] bs- _ -> []----- XPath step //tag or //*-descendant_step :: Tag -> XTree -> XSeq-descendant_step m (x@(XElem t _ _ _ cs))- | m==t || m=="*"- = x:(concatMap (descendant_step m) cs)-descendant_step m (XElem t _ _ _ cs) = concatMap (descendant_step m) cs-descendant_step m _ = []----- It's like //* but has tagged children, which are derived statically--- After examing 100 children it gives up: this avoids space leaks-descendant_any_with_tagged_children :: [Tag] -> XTree -> XSeq-descendant_any_with_tagged_children tags (x@(XElem t _ _ _ cs))- | all (\tag -> foldr (\b s -> case b of- (XElem k _ _ _ _) -> s || k == tag- _ -> s) False cs100) tags- = x:(concatMap (descendant_any_with_tagged_children tags) cs)- where cs100 = take 100 cs-descendant_any_with_tagged_children tags (XElem t _ _ _ cs)- = concatMap (descendant_any_with_tagged_children tags) cs-descendant_any_with_tagged_children tags _ = []----- XPath step /@attr or /@*-attribute_step :: Tag -> XTree -> XSeq-attribute_step m x- = case x of- (XElem _ al _ _ _) -> foldr (\(k,v) s -> if k==m || m=="*"- then (XText v):s- else s) [] al- _ -> []----- XPath step //@attr or //@*-attribute_descendant_step :: Tag -> XTree -> XSeq-attribute_descendant_step m (x@(XElem _ al _ _ cs))- = foldr (\(k,v) s -> if k==m || m=="*"- then (XText v):s- else s)- (concatMap (attribute_descendant_step m) cs) al-attribute_descendant_step m _ = []----- NOT USED: XPath step /..-parent_step :: Tag -> XTree -> XSeq-parent_step _ (XElem _ _ _ p _) = [p]-parent_step _ e = error ("Cannot derive the parent of "++show e)---{------------ Functions --------------------------------------------------------------}----- find the value of a variable in an association list-findV var env- = case filter (\(n,_) -> n==var) env of- (_,b):_ -> b- _ -> error ("Undefined variable: "++var)---- is the variable defined in the association list?-memV var env- = case filter (\(n,_) -> n==var) env of- (_,b):_ -> True- _ -> False----- like foldr but with an index-foldir :: (a -> Int -> b -> b) -> b -> [a] -> Int -> b-foldir c n [] i = n-foldir c n (x:xs) i = c x i (foldir c n xs (i+1))---trueXT = XBool True-falseXT = XBool False---readNum :: String -> Maybe XTree-readNum cs = case span isDigit cs of- (n,[]) -> Just (XInt (read n))- (n,'.':rest) -> case span isDigit rest of- (k,[]) -> Just (XFloat (read (n++('.':k))))- _ -> Nothing- _ -> Nothing---text :: XSeq -> XSeq-text xs = foldr (\x r -> case x of- XElem _ _ _ _ zs- -> (filter (\a -> case a of XText _ -> True; XInt _ -> True;- XFloat _ -> True; XBool _ -> True; _ -> False) zs)++r- XText _ -> x:r- XInt _ -> x:r- XFloat _ -> x:r- XBool _ -> x:r- _ -> r) [] xs---toString :: XSeq -> [String]-toString xs = map (\x -> case x of - XText t -> t- XInt n -> show n- XFloat n -> show n- XBool n -> show n)- (text xs)----- concatenate text with no padding (for element content)-appendText :: [XSeq] -> XSeq-appendText [] = []-appendText [x] = x-appendText (x:xs) = x++[XNoPad]++appendText xs---toNum :: XSeq -> XSeq-toNum xs = foldr (\x r -> case x of- XInt n -> x:r- XFloat n -> x:r- XText s -> case readNum s of- Just t -> t:r- _ -> r- _ -> r) [] (text xs)---toFloat :: XTree -> Float-toFloat (XText s) = case readNum s of- Just (XInt n) -> fromIntegral n- Just (XFloat n) -> n- _ -> error("Cannot convert to a float: "++s)-toFloat (XInt n) = fromIntegral n-toFloat (XFloat n) = n-toFloat x = error("Cannot convert to a float: "++(show x))---mean :: (Fractional t) => [t] -> t-mean = uncurry (/) . foldl' (\(!s, !n) x -> (s+x, n+1)) (0,0.0)---contains :: String -> String -> Bool-contains text word- = let len = length word- c xs | ((take len xs) == word) = True- c (_:xs) = c xs- c _ = False- in c text---distinct :: Eq a => [a] -> [a]-distinct = foldl (\r a -> if elem a r then r else r++[a]) []---arithmetic :: (Float -> Float -> Float) -> XTree -> XTree -> XTree-arithmetic op (XInt n) (XInt m) = XInt (round (op (fromIntegral n) (fromIntegral m)))-arithmetic op (XFloat n) (XFloat m) = XFloat (op n m)-arithmetic op (XFloat n) (XInt m) = XFloat (op n (fromIntegral m))-arithmetic op (XInt n) (XFloat m) = XFloat (op (fromIntegral n) m)---compareXTrees :: XTree -> XTree -> Ordering-compareXTrees (XElem _ _ _ _ _) _ = EQ-compareXTrees _ (XElem _ _ _ _ _) = EQ-compareXTrees (XInt n) (XInt m) = compare n m-compareXTrees (XFloat n) (XInt m) = compare n (fromIntegral m)-compareXTrees (XInt n) (XFloat m) = compare (fromIntegral n) m-compareXTrees (XFloat n) (XFloat m) = compare n m-compareXTrees (XText n) (XText m) = compare n m-compareXTrees x y = compare (toFloat x) (toFloat y)---strictCompareOne [XInt n] [XInt m] = compare n m-strictCompareOne [XFloat n] [XFloat m] = compare n m-strictCompareOne [XFloat n] [XInt m] = compare n (fromIntegral m)-strictCompareOne [XInt n] [XFloat m] = compare (fromIntegral n) m-strictCompareOne [XText n] [XText m] = compare n m-strictCompareOne x y = error ("Illegal operands in strict comparison: "++(show x)++" "++(show y))--strictCompare :: XSeq -> XSeq -> Ordering-strictCompare [XElem _ _ _ _ x] [XElem _ _ _ _ y] = strictCompareOne x y-strictCompare x [XElem _ _ _ _ y] = strictCompareOne x y-strictCompare [XElem _ _ _ _ x] y = strictCompareOne x y-strictCompare x y = strictCompareOne x y--compareXSeqs :: Bool -> XSeq -> XSeq -> Ordering-compareXSeqs ord xs ys- = let comps = [ compareXTrees x y | x <- xs, y <- ys ]- in if ord- then if all (\x -> x == LT) comps- then LT- else if all (\x -> x == GT) comps- then GT- else EQ- else if all (\x -> x == LT) comps- then GT- else if all (\x -> x == GT) comps- then LT- else EQ---conditionTest :: XSeq -> Bool-conditionTest [] = False-conditionTest [XText ""] = False-conditionTest [XInt 0] = False-conditionTest [XBool False] = False-conditionTest _ = True----- XPath steps-paths :: [(Tag,Q Exp)]-paths = [ ( "current_step", [| current_step |] ),- ( "child_step", [| child_step |] ),- ( "descendant_step", [| descendant_step |] ),- ( "attribute_step", [| attribute_step |] ),- ( "attribute_descendant_step", [| attribute_descendant_step |] ),- ( "parent_step", [| parent_step |] )- ]---type Function = [Q Exp] -> Q Exp---- System functions: they can also be defined as Haskell functions of type (XSeq,...,XSeq) -> XSeq--- but here we make sure they are unfolded and fused with the rest of the query-functions :: [(Tag,Int,Function)]-functions = [ ( "=", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y == EQ ] |] ),- ( "!=", 2, \[xs,ys] -> [| if null [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y == EQ ]- then [trueXT]- else [falseXT] |] ),- ( ">", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y == GT ] |] ),- ( "<", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y == LT ] |] ),- ( ">=", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y `elem` [GT,EQ] ] |] ),- ( "<=", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y `elem` [LT,EQ] ] |] ),- ( "eq", 2, \[xs,ys] -> [| if strictCompare $xs $ys == EQ then [trueXT] else [falseXT] |] ),- ( "neq", 2, \[xs,ys] -> [| if strictCompare $xs $ys /= EQ then [trueXT] else [falseXT] |] ),- ( "lt", 2, \[xs,ys] -> [| if strictCompare $xs $ys == LT then [trueXT] else [falseXT] |] ),- ( "gt", 2, \[xs,ys] -> [| if strictCompare $xs $ys == GT then [trueXT] else [falseXT] |] ),- ( "le", 2, \[xs,ys] -> [| if strictCompare $xs $ys `elem` [LT,EQ] then [trueXT] else [falseXT] |] ),- ( "ge", 2, \[xs,ys] -> [| if strictCompare $xs $ys `elem` [GT,EQ] then [trueXT] else [falseXT] |] ),- ( "<<", 2, \[xs,ys] -> [| [ trueXT | XElem _ _ ox _ _ <- $xs, XElem _ _ oy _ _ <- $ys, ox < oy ] |] ),- ( ">>", 2, \[xs,ys] -> [| [ trueXT | XElem _ _ ox _ _ <- $xs, XElem _ _ oy _ _ <- $ys, ox > oy ] |] ),- ( "is", 2, \[xs,ys] -> [| [ trueXT | XElem _ _ ox _ _ <- $xs, XElem _ _ oy _ _ <- $ys, ox == oy ] |] ),- ( "+", 2, \[xs,ys] -> [| [ arithmetic (+) x y | x <- toNum $xs, y <- toNum $ys ] |] ),- ( "-", 2, \[xs,ys] -> [| [ arithmetic (-) x y | x <- toNum $xs, y <- toNum $ys ] |] ),- ( "*", 2, \[xs,ys] -> [| [ arithmetic (*) x y | x <- toNum $xs, y <- toNum $ys ] |] ),- ( "div", 2, \[xs,ys] -> [| [ arithmetic (/) x y | x <- toNum $xs, y <- toNum $ys ] |] ),- ( "idiv", 2, \[xs,ys] -> [| [ XInt (div x y) | (XInt x) <- toNum $xs, (XInt y) <- toNum $ys ] |] ),- ( "mod", 2, \[xs,ys] -> [| [ XInt (mod x y) | (XInt x) <- toNum $xs, (XInt y) <- toNum $ys ] |] ),- ( "uplus", 1, \[xs] -> [| [ x | x <- toNum $xs ] |] ),- ( "uminus", 1, \[xs] -> [| [ case x of XInt n -> XInt (-n); XFloat n -> XFloat (-n) | x <- toNum $xs ] |] ),- ( "and", 2, \[xs,ys] -> [| if (conditionTest $xs) && (conditionTest $ys) then [trueXT] else [falseXT] |] ),- ( "or", 2, \[xs,ys] -> [| if (conditionTest $xs) || (conditionTest $ys) then [trueXT] else [falseXT] |] ),- ( "not", 1, \[xs] -> [| if (conditionTest $xs) then [falseXT] else [trueXT] |] ),- ( "some", 1, \[xs] -> [| if (conditionTest $xs) then [trueXT] else [falseXT] |] ),- ( "count", 1, \[xs] -> [| [ XInt (length $xs) ] |] ),- ( "sum", 1, \[xs] -> [| [ XFloat (sum [ toFloat x | x <- toNum $xs ]) ] |] ),- ( "avg", 1, \[xs] -> [| [ XFloat (mean [ toFloat x | x <- toNum $xs ]) ] |] ),- ( "min", 1, \[xs] -> [| [ XFloat (minimum [ toFloat x | x <- toNum $xs ]) ] |] ),- ( "max", 1, \[xs] -> [| [ XFloat (maximum [ toFloat x | x <- toNum $xs ]) ] |] ),- ( "to", 2, \[xs,ys] -> [| [ XInt i | XInt n <- toNum $xs, XInt m <- toNum $ys, i <- [n..m] ] |] ),- ( "text", 1, \[xs] -> [| text $xs |] ),- ( "string", 1, \[xs] -> [| text $xs |] ),- ( "data", 1, \[xs] -> [| text $xs |] ),- ( "node", 1, \[xs] -> [| [ w | w@(XElem _ _ _ _ _) <- $xs ] |] ),- ( "exists", 1, \[xs] -> [| [ XBool (not (null $xs)) ] |] ),- ( "empty", 0, \[] -> [| [] |] ),- ( "true", 0, \[] -> [| [trueXT] |] ),- ( "false", 0, \[] -> [| [] |] ),- ( "if", 3, \[cs,ts,es] -> [| if conditionTest $cs then $ts else $es |] ),- ( "element", 2, \[tags,xs] -> [| [ x | tag <- toString $tags, x@(XElem t _ _ _ _) <- $xs, (t==tag || tag=="*") ] |] ),- ( "attribute", 2, \[tags,xs] -> [| [ z | tag <- toString $tags, x <- $xs, z <- attribute_step tag x ] |] ),- ( "name", 1, \[xs] -> [| [ XText tag | XElem tag _ _ _ _ <- $xs ] |] ),- ( "contains", 2, \[xs,text] -> [| [ trueXT | x <- toString $xs, t <- toString $text, contains x t ] |] ),- ( "substring", 3, \[xs,n1,n2] -> [| [ XText (take m2 (drop (m1-1) x)) | x <- toString $xs,- XInt m1 <- toNum $n1, XInt m2 <- toNum $n2 ] |] ),- ( "concatenate", 2, \[xs,ys] -> [| $xs ++ $ys |] ),- ( "distinct-values", 1, \[xs] -> [| distinct $xs |] ),- ( "union", 2, \[xs,ys] -> [| distinct ($xs ++ $ys) |] ),- ( "intersect", 2, \[xs,ys] -> [| filter (\x -> elem x $ys) $xs |] ),- ( "except", 2, \[xs,ys] -> [| filter (\x -> not (elem x $ys)) $xs |] ),- ( "reverse", 1, \[xs] -> [| reverse $xs |] )- ]----- functions to be used by the interpreter--- when evaluated, it gives [(String,Int,[XSeq]->XSeq)]-iFunctions :: Q Exp-iFunctions = foldr (\(fname,len,f) r- -> let vars = map (\i -> mkName ("v_"++(show i))) [1..len]- entry = tupE [litE (StringL fname),litE (IntegerL (toInteger len)),- lamE [listP (map varP vars)] (f (map varE vars))]- in [| $entry : $r |]) [| [] |] functions----- XPath steps to be used by the interpreter--- when evaluated, it gives [(String,Tag->XTree->XSeq)]-pFunctions = foldr (\(pname,p) r -> let pn = litE (StringL pname) in [| ($pn,$p) : $r |]) [| [] |] paths----- make a function call-callF :: Tag -> Function-callF fname args = case filter (\(n,_,_) -> n == fname || ("fn:"++n)==fname) functions of- (_,len,f):_ -> if (length args) == len- then f args- else error ("wrong number of arguments in function call: " ++ fname)- _ -> -- otherwise, it must be a Haskell function of type (XSeq,...,XSeq) -> XSeq- let itp = case args of- [] -> [t| () |]- [_] -> [t| XSeq |]- _ -> foldr (\_ r -> appT r [t| XSeq |]) (appT (tupleT (length args)) [t| XSeq |])- (tail args)- fn = sigE (varE (mkName fname))- (appT (appT arrowT itp) [t| XSeq |])- in appE fn (tupE args)---{------------ Compiler ---------------------------------------------------------------}---undef1 = [| error "Undefined XQuery context (.)" |]-undef2 = [| error "Undefined position()" |]-undef3 = [| error "Undefined last()" |]----- does the expression contain a last()?-containsLast :: Ast -> Bool-containsLast (Ast "call" [Avar "last"]) = True-containsLast (Ast f _) | elem f ["let","for","predicate"] = False-containsLast (Ast "step" _) = False-containsLast (Ast _ args) = or (map containsLast args)-containsLast _ = False----- calculate the maximum position value used in a predicate, if there is one-maxPosition :: Ast -> Ast -> Int-maxPosition position e- = case e of- Ast "call" [Avar f,p,Aint n]- | f `elem` ["=","<","<=","eq","lt","le"] && p == position- -> n- Ast "call" [Avar f,Aint n,p]- | f `elem` ["=",">",">=","eq","gt","ge"] && p == position- -> n- Ast "let" [Avar x,source,body]- -> if position == Avar x- then 0 else minp (maxPosition position source) (maxPosition position body)- Ast "for" [Avar x,Avar i,source,body]- -> if position == Avar x || position == Avar i- then 0 else minp (maxPosition position source) (maxPosition position body)- Ast "predicate" [pred,body]- -> minp (maxPosition position pred) (maxPosition position body)- Ast "call" [Avar "and",x,y]- -> minp (maxPosition position x) (maxPosition position y)- Ast "call" [Avar "or",x,y]- -> max (maxPosition position x) (maxPosition position y)- _ -> 0- where minp x y = if x == 0 then y else if y == 0 then x else min x y---pathPosition = Ast "call" [Avar "position"]---parent_error = error "constructed elements have no parent"----- extract the QName-qName :: XSeq -> Tag-qName [XText s] = s-qName e = error ("Invalid QName: "++(show e))----- Each XPath predicate must calculate position() and last() from its input XSeq--- if last() is used, then the evaluation is blocking (need to store the whole input XSeq)-compilePredicates :: [Ast] -> Q Exp -> Bool -> Q Exp-compilePredicates [] xs _ = xs-compilePredicates ((Aint n):preds) xs _ -- shortcut that improves laziness- = compilePredicates preds- [| [ $xs !! $(litE (IntegerL (toInteger (n-1)))) ] |] True-compilePredicates (pred:preds) xs True -- top-k like- | maxPosition pathPosition pred > 0- = compilePredicates (pred:preds)- [| take $(litE (IntegerL (toInteger (maxPosition pathPosition pred)))) $xs |] False-compilePredicates (pred:preds) xs _- | containsLast pred -- blocking: use only when last() is used in the predicate- = compilePredicates preds- [| let bl = $xs- len = length bl- in foldir (\x i r -> if case $(compile pred [| x |] [| [XInt i] |] [| [XInt len] |] "") of- [XInt k] -> k == i -- indexing- b -> conditionTest b- then x:r else r) [] bl 1 |] True-compilePredicates (pred:preds) xs _- = compilePredicates preds- [| foldir (\x i r -> if case $(compile pred [| x |] [| [XInt i] |] undef3 "") of- [XInt k] -> k == i -- indexing- b -> conditionTest b- then x:r else r) [] $xs 1 |] True----- Compile the AST e into Haskell code--- context: context node (XPath .)--- position: the element position in the parent sequence (XPath position())--- last: the length of the parent sequence (XPath last())--- effective_axis: the XPath axis in /axis::tag(exp)--- (eg, the effective axis of //(A | B) is "descendant_step"-compile :: Ast -> Q Exp -> Q Exp -> Q Exp -> String -> Q Exp-compile e context position last effective_axis- = case e of- Avar "." -> [| [ $context :: XTree ] |]- Avar v -> let x = varE (mkName v)- in [| $x :: XSeq |]- Aint n -> let x = litE (IntegerL (toInteger n))- in [| [ XInt $x ] |]- Afloat n -> let x = litE (RationalL (toRational n))- in [| [ XFloat $x ] |]- Astring s -> let x = litE (StringL s)- in [| [ XText $x ] |]- Ast "context" [v,Astring dp,body]- -> [| foldr (\x r -> $(compile body [| x |] position last dp)++r)- [] $(compile v context position last effective_axis) |]- Ast "call" [Avar "position"]- -> position- Ast "call" [Avar "last"]- -> last- Ast "child_step" [tag, Avar "."]- | effective_axis /= ""- -> compile (Ast effective_axis [tag, Avar "."]) context position last ""- Ast "step" ((Ast "descendant_any" (body:tags)):predicates)- -> let bc = compile body context position last effective_axis- ts = listE (map (\(Avar tag) -> litE (stringL tag)) tags)- in [| foldr (\x r -> $(compilePredicates predicates [| descendant_any_with_tagged_children $ts x |] True)++r)- [] $bc |]- Ast "step" ((Ast path_step [Astring tag,body]):predicates)- | memV path_step paths- -> let bc = compile body context position last effective_axis- tc = litE (stringL tag)- in [| foldr (\x r -> $(compilePredicates predicates [| $(findV path_step paths) $tc x |] True)++r)- [] $bc |]- Ast "descendant_any" (body:tags)- -> let bc = compile body context position last effective_axis- ts = listE (map (\(Avar tag) -> litE (stringL tag)) tags)- in [| foldr (\x r -> (descendant_any_with_tagged_children $ts x)++r) [] $bc |]- Ast path_step [Astring tag,body]- | memV path_step paths- -> let bc = compile body context position last effective_axis- tc = litE (stringL tag)- in [| foldr (\x r -> ($(findV path_step paths) $tc x)++r) [] $bc |]- Ast "step" (exp:predicates)- -> compilePredicates predicates (compile exp context position last effective_axis) True- Ast "predicate" [condition,body]- -> compilePredicates [condition] (compile body context position last effective_axis) True- Ast "append" args- -> [| appendText $(listE (map (\x -> compile x context position last effective_axis) args)) |]- Ast "call" ((Avar f):args)- -> callF f (map (\x -> compile x context position last effective_axis) args)- Ast "construction" [Astring tag,Ast "attributes" [],body]- -> let ct = litE (StringL tag)- bc = compile body context position last effective_axis- in [| [ XElem $ct [] 0 parent_error $bc ] |]- Ast "construction" [tag,Ast "attributes" al,body]- -> let alc = foldr (\(Ast "pair" [a,v]) r- -> let ac = compile a context position last effective_axis- vc = compile v context position last effective_axis- in [| (qName $ac,showXS $vc) : $r |]) [| [] |] al- ct = compile tag context position last effective_axis- bc = compile body context position last effective_axis- in [| [ XElem (qName $ct) $alc 0 parent_error $bc ] |]- Ast "let" [Avar var,source,body]- -> do s <- compile source context position last effective_axis- b <- compile body context position last effective_axis- return (AppE (LamE [VarP (mkName var)] b) s)- Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index- -> let b = compile body [| head $(varE (mkName var)) |] undef2 undef3 ""- f = lamE [varP (mkName var)] [| \r -> $b ++ r |]- s = compile source context position last effective_axis- in [| foldr (\x -> $f [x]) [] $s |]- Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index- -> let b = compile body [| head $(varE (mkName var)) |]- [| $(varE (mkName ivar)) |] undef3 ""- f = lamE [varP (mkName var)] (lamE [varP (mkName ivar)] [| \r -> $b ++ r |])- p = maxPosition (Avar ivar) body- ns = if p > 0 -- there is a top-k like restriction- then Ast "step" [source,Ast "call" [Avar "<=",pathPosition,Aint p]]- else source- s = compile ns context position last effective_axis- in [| foldir (\x i -> $f [x] [XInt i]) [] $s 1 |]- Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting- -> let res = foldl (\r a -> let ac = compile a context position last effective_axis- in [| $r++[text $ac] |] )- [| [ $(compile exp context position last effective_axis) ] |] orderBys- in [| [ $res ] |]- Ast "sort" (exp:ordList) -- blocking- -> let ce = compile exp context position last effective_axis- ordering = foldr (\(Avar ord) r- -> let asc = if ord == "ascending"- then [| True |]- else [| False |]- in [| \(x:xs) (y:ys) -> case compareXSeqs $asc x y of- EQ -> $r xs ys- o -> o |])- [| \xs ys -> EQ |] ordList- in [| concatMap head (sortBy (\(_:xs) (_:ys) -> $ordering xs ys) ($ce::[[XSeq]])) |]- _ -> error ("Illegal XQuery: "++(show e))----- The monadic compilePredicates that propagates IO state-compilePredicatesM :: [Ast] -> Q Exp -> Bool -> Q Exp-compilePredicatesM [] xs _- = [| return $xs |]-compilePredicatesM ((Aint n):preds) xs _ -- shortcut that improves laziness- = compilePredicatesM preds- [| [ $xs !! $(litE (IntegerL (toInteger (n-1)))) ] |] True-compilePredicatesM (pred:preds) xs True -- top-k like- | maxPosition pathPosition pred > 0- = compilePredicatesM (pred:preds)- [| take $(litE (IntegerL (toInteger (maxPosition pathPosition pred)))) $xs |] False-compilePredicatesM (pred:preds) xs _- | containsLast pred -- blocking: use only when last() is used in the predicate- = [| do let bl = $xs- last = length bl- vs <- foldir (\x i r -> do vs <- $(compileM pred [| x |] [| [XInt i] |] [| [XInt last] |] "")- s <- r- return (if case vs of- [XInt k] -> k == i -- indexing- b -> conditionTest b- then x:s else s))- (return []) $xs 1- $(compilePredicatesM preds [| vs |] True) |]-compilePredicatesM (pred:preds) xs _- = [| do vs <- foldir (\x i r -> do vs <- $(compileM pred [| x |] [| [XInt i] |] undef3 "")- s <- r- return (if case vs of- [XInt k] -> k == i -- indexing- b -> conditionTest b- then x:s else s))- (return []) $xs 1- $(compilePredicatesM preds [| vs |] True) |]----- The monadic XQuery compiler; it is like compile but has plumbing to propagate IO state-compileM :: Ast -> Q Exp -> Q Exp -> Q Exp -> String -> Q Exp-compileM e context position last effective_axis- = case e of- Avar "." -> [| return [ $context :: XTree ] |]- Avar v -> let x = varE (mkName v)- in [| return ($x :: XSeq) |]- Aint n -> let x = litE (IntegerL (toInteger n))- in [| return [ XInt $x ] |]- Afloat n -> let x = litE (RationalL (toRational n))- in [| return [ XFloat $x ] |]- Astring s -> let x = litE (StringL s)- in [| return [ XText $x ] |]- -- for non-IO XQuery, use the regular compile- Ast "nonIO" [u] -> [| return $(compile u context position last effective_axis) |]- Ast "context" [v,Astring dp,body]- -> [| do vs <- $(compileM v context position last effective_axis)- foldr (\x r -> (liftM2 (++)) $(compileM body [| x |] position last dp) r)- (return []) vs |]- Ast "call" [Avar "position"]- -> [| return $position |]- Ast "call" [Avar "last"]- -> [| return $last |]- Ast "child_step" [tag, Avar "."]- | effective_axis /= ""- -> compileM (Ast effective_axis [tag, Avar "."]) context position last ""- Ast "step" ((Ast "descendant_any" (body:tags)):predicates)- -> let bc = compileM body context position last effective_axis- ts = listE (map (\(Avar tag) -> litE (stringL tag)) tags)- in [| do vs <- $bc- foldr (\x r -> (liftM2 (++)) $(compilePredicatesM predicates- [| descendant_any_with_tagged_children $ts x |] True) r)- (return []) vs |]- Ast "step" ((Ast path_step [Astring tag,body]):predicates)- | memV path_step paths- -> let bc = compileM body context position last effective_axis- tc = litE (stringL tag)- in [| do vs <- $bc- foldr (\x r -> (liftM2 (++)) $(compilePredicatesM predicates- [| $(findV path_step paths) $tc x |] True) r)- (return []) vs |]- Ast "descendant_any" (body:tags)- -> let bc = compileM body context position last effective_axis- ts = listE (map (\(Avar tag) -> litE (stringL tag)) tags)- in [| do vs <- $bc- return (foldr (\x r -> (descendant_any_with_tagged_children $ts x)++r) [] vs) |]- Ast path_step [Astring tag,body]- | memV path_step paths- -> let bc = compileM body context position last effective_axis- tc = litE (stringL tag)- in [| do vs <- $bc- return (foldr (\x r -> ($(findV path_step paths) $tc x)++r) [] vs) |]- Ast "step" (exp:predicates)- -> [| do vs <- $(compileM exp context position last effective_axis)- $(compilePredicatesM predicates [| vs |] True) |]- Ast "predicate" [condition,body]- -> [| do vs <- $(compileM body context position last effective_axis)- $(compilePredicatesM [condition] [| vs |] True) |]- Ast "executeSQL" [Avar stmt,args]- -> [| do as <- $(compileM args context position last effective_axis)- $(varE (mkName "executeSQL")) $(varE (mkName stmt)) as |]- Ast "append" args- -> let binds = zipWith (\i x -> (mkName ("x"++(show i)),x)) [1..(length args)] args- in foldr (\(n,x) r -> [| $(compileM x context position last effective_axis) >>= $(lamE [varP n] r) |])- [| return (appendText $(listE (map (\(n,_) -> varE n) binds))) |] binds- Ast "call" ((Avar f):args)- -> let binds = zipWith (\i x -> (mkName ("x"++(show i)),x)) [1..(length args)] args- in foldr (\(n,x) r -> [| $(compileM x context position last effective_axis) >>= $(lamE [varP n] r) |])- [| return $(callF f (map (\(n,_) -> varE n) binds)) |] binds- Ast "construction" [Astring tag,Ast "attributes" [],body]- -> let ct = litE (StringL tag)- bc = compileM body context position last effective_axis- in [| do b <- $bc- return [ XElem $ct [] 0 parent_error b ] |]- Ast "construction" [tag,Ast "attributes" al,body]- -> let alc = foldr (\(Ast "pair" [a,v]) r- -> [| do ac <- $(compileM a context position last effective_axis)- vc <- $(compileM v context position last effective_axis)- s <- $r- return ((qName ac,showXS vc):s) |]) [| return [] |] al- ct = compileM tag context position last effective_axis- bc = compileM body context position last effective_axis- in [| do a <- $alc- c <- $ct- b <- $bc- return [ XElem (qName c) a 0 parent_error b ] |]- Ast "let" [Avar var,source,body]- -> [| $(compileM source context position last effective_axis)- >>= $(lamE [varP (mkName var)] (compileM body context position last effective_axis)) |]- Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index- -> let b = compileM body [| head $(varE (mkName var)) |] undef2 undef3 ""- f = lamE [varP (mkName var)] [| (liftM2 (++)) $b |]- s = compileM source context position last effective_axis- in [| do vs <- $s- foldr (\x -> $f [x]) (return []) vs |]- Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index- -> let b = compileM body [| head $(varE (mkName var)) |]- [| $(varE (mkName ivar)) |] undef3 ""- f = lamE [varP (mkName var)] (lamE [varP (mkName ivar)] [| (liftM2 (++)) $b |])- p = maxPosition (Avar ivar) body- ns = if p > 0 -- there is a top-k like restriction- then Ast "step" [source,Ast "call" [Avar "<=",pathPosition,Aint p]]- else source- s = compileM ns context position last effective_axis- in [| do vs <- $s- foldir (\x i -> $f [x] [XInt i]) (return []) vs 1 |]- Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting- -> let vs = compileM exp context position last effective_axis- res = foldl (\r a -> [| do ac <- $(compileM a context position last effective_axis)- s <- $r- return (s++[text ac]) |] )- [| do v <- $vs; return [ v ] |] orderBys- in [| return $res |]- Ast "sort" (exp:ordList) -- blocking- -> let ce = compileM exp context position last effective_axis- ordering = foldr (\(Avar ord) r- -> let asc = if ord == "ascending"- then [| True |]- else [| False |]- in [| \(x:xs) (y:ys) -> case compareXSeqs $asc x y of- EQ -> $r xs ys- o -> o |])- [| \xs ys -> EQ |] ordList- in [| do c <- $ce- return (concatMap head (sortBy (\(_:xs) (_:ys) -> $ordering xs ys) (c::[[XSeq]]))) |]- _ -> error ("Illegal XQuery: "++(show e))----- functions that need IO interaction (document reader, DB access, etc)-ioSources :: [ String ]-ioSources = ["executeSQL","doc","fn:doc","sql","fn:sql","publish","fn:publish"]----- collect all input documents and assign them a unique number-pullIOSources :: Ast -> Int -> (Ast, Int, [(String, Ast)])-pullIOSources query count- = case query of- Ast "call" [Avar nm,file]- | elem nm ["doc","fn:doc"]- -> (Avar ("_doc"++(show count)), count+1, [("_doc"++(show count),file)])- Ast "call" [Avar nm,sql]- | elem nm ["sql","fn:sql"]- -> (Ast "executeSQL" [Avar ("_sql"++(show count)),Ast "call" [Avar "empty"]], count+1,- [("_sql"++(show count),Ast "prepareSQL" [sql])])- Ast "call" [Avar nm,sql,args]- | elem nm ["sql","fn:sql"]- -> (Ast "executeSQL" [Avar ("_sql"++(show count)),args], count+1,- [("_sql"++(show count),Ast "prepareSQL" [sql])])- Ast n args- -> let (s,c,ns) = foldr (\a r c -> let (e,c1,n1) = pullIOSources a c- (s,c2,n2) = r c1- in (e:s,c2,union n1 n2))- (\c -> ([],c,[])) args count- in (Ast n s,c,ns)- _ -> (query,count,[])- where union xs ((n,s):ys) = (n,foldr(\(m,d) r -> if s==d then Avar m else r) s xs):(union xs ys)- union xs [] = xs----- true if there is no need to lift to the IO monad-noIO :: Ast -> Bool-noIO (Ast nm _) | elem nm ioSources = False-noIO (Ast n args) = all noIO args-noIO _ = True---liftIOSources :: Ast -> (Ast, [(String, Ast)])-liftIOSources query- = let (ast,_,ns) = pullIOSources query 0- f x = case x of- Ast nm _ | elem nm ["attributes"] -> x- Ast _ _ | noIO x -> Ast "nonIO" [x]- _ -> case x of- Ast "call" ((Avar nm):args)- -> Ast "call" ((Avar nm):(map f args))- Ast n args -> Ast n (map f args)- _ -> x- in (f ast,ns)----- optimize and compile an AST (unlifted)-compileAst :: Ast -> Q Exp-compileAst ast = compile (optimize ast) undef1 undef2 undef3 ""----- optimize and compile an AST (IO lifted)-compileAstM :: Ast -> Q Exp-compileAstM ast = compileM (optimize ast) undef1 undef2 undef3 ""----- compile an XQuery AST that reads XML documents-compileQuery :: [Ast] -> Q Exp-compileQuery ((Ast "function" ((Avar f):b:args)):xs)- = let lvars = case args of- [Astring a] -> [varP (mkName a)]- _ -> [tupP (map (\(Avar a) -> varP (mkName a)) args)]- in letE [valD (varP (mkName f)) (normalB (lamE lvars (compileAst b))) []]- (compileQuery xs)-compileQuery ((Ast "variable" [Avar v,u]):xs)- = letE [valD (varP (mkName v)) (normalB (compileAst u)) []]- (compileQuery xs)-compileQuery [query]- = let (ast,ns) = liftIOSources (optimize query)- code = compileM ast undef1 undef2 undef3 ""- in foldl (\r (n,e) -> let d = lamE [varP (mkName n)] r- in case e of- Avar m -> [| $d $(varE (mkName m)) |]- Ast "prepareSQL" [Astring sql]- -> [| ($(varE (mkName "prepareSQL"))- $(varE (mkName "_db"))- $(litE (StringL sql))) >>= $d |]- _ -> [| do let [XText f] = $(compileAst e)- doc <- readFile f- $d [materialize (parseDocument doc)] |])- [| $code |] ns----- Debugging: display the AST and the Haskell code of an input XQuery-cq :: String -> IO ()-cq query = do putStrLn "Abstract Syntax Tree:"- let ast = parse (scan query)- putStrLn (show ast)- let opt = optimize (last ast)- putStrLn "Optimized AST:"- putStrLn (show opt)- --putStrLn "Haskell Code:"- --let code = compileQuery ast- --runQ code >>= putStrLn.pprint----- | Run an XQuery expression that does not read XML documents.--- When evaluated, it returns XSeq.-xe :: String -> Q Exp-xe query = compileAst (last (parse (scan query)))----- | Run an XQuery that reads XML documents.--- When evaluated, it returns IO XSeq.-xq :: String -> Q Exp-xq query = compileQuery (parse (scan query))----- | Run an XQuery that reads XML documents and queries databases.--- When evaluated, it returns (IConnection conn) => conn -> IO XSeq.-xqdb :: String -> Q Exp-xqdb query = lamE [varP (mkName "_db")] (compileQuery (parse (scan query)))
− Text/XML/HXQ/DB.hs
@@ -1,503 +0,0 @@-{----------------------------------------------------------------------------------------- Database connectivity using HDBC-- Programmer: Leonidas Fegaras-- Email: fegaras@cse.uta.edu-- Web: http://lambda.uta.edu/-- Creation: 05/12/08, last update: 07/24/08-- -- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.-- This material is provided as is, with absolutely no warranty expressed or implied.-- Any use is at your own risk. Permission is hereby granted to use or copy this program-- for any purpose, provided the above notices are retained on all copies.-----------------------------------------------------------------------------------------}---module Text.XML.HXQ.DB where--import System.IO.Unsafe-import Char(isSpace,toLower)-import Control.Monad.State-import Database.HDBC-import Text.XML.HXQ.DBConnect-import Text.XML.HXQ.XTree-import XMLParse(XMLEvent(..),parseDocument)-import HXML(AttList)-import Text.XML.HXQ.Parser---sql2xml :: SqlValue -> XTree-sql2xml value =- case value of- SqlString s -> XText s- SqlByteString bs -> XText (show bs)- SqlWord32 n -> XInt (fromEnum n)- SqlWord64 n -> XInt (fromEnum n)- SqlInt32 n -> XText (show n)- SqlInt64 n -> XText (show n)- SqlInteger n -> XInt (fromEnum n)- SqlChar c -> XText [c]- SqlBool b -> XBool b- SqlDouble n -> XText (show n)- SqlRational n -> XText (show n)- SqlEpochTime n -> XText (show n)- SqlTimeDiff n -> XText (show n)- SqlNull -> XText ""---xml2sql :: XTree -> SqlValue-xml2sql e =- case e of- XText s -> SqlString s- XInt n -> SqlInteger (toInteger n)- XFloat n -> SqlString (show n)- XBool n -> SqlBool n- XElem n _ _ _ [x] -> xml2sql x- _ -> error ("Cannot convert "++show e++" into sql")---perror = error "constructed elements have no parent"---executeSQL :: Statement -> XSeq -> IO XSeq-executeSQL stmt args- = do n <- handleSqlError (execute stmt (map xml2sql args))- result <- handleSqlError (fetchAllRowsAL stmt)- return (map (\x -> XElem "row" [] 0 perror (map (\(s,v) -> XElem s [] 0 perror [sql2xml v]) x)) result)---prepareSQL :: (IConnection conn) => conn -> String -> IO Statement-prepareSQL db sql = handleSqlError (prepare db sql)---{------------------------------------------------------------------------------------------ extract the structural summary of an XML file that contains statistics-----------------------------------------------------------------------------------------}----- structural summary: tag id max# hasText children-data SSnode = SSnode String !Int !Int !Int !Bool [SSnode]- deriving (Eq,Show)---insertSS :: String -> [SSnode] -> State Int (Int,SSnode,[SSnode])-insertSS tag ((SSnode n i j l b ts):s)- | n == tag- = return (i,SSnode n i j (l+1) b ts,s)-insertSS tag (x:xs)- = do (i,t,ts) <- insertSS tag xs- return (i,t,x:ts)-insertSS tag []- = do count <- get- put (count+1)- return (count+1,SSnode tag (count+1) 1 1 False [],[])---insSS :: String -> [SSnode] -> State Int [SSnode]-insSS tag ns = do (k,t,s) <- insertSS tag ns- return (t:s)---getSS :: [XMLEvent] -> [SSnode] -> State Int [SSnode]-getSS ((EmptyEvent n atts):xs) rs- = getSS ((StartEvent n atts):(EndEvent n):xs) rs-getSS ((StartEvent n atts):xs) ((SSnode m i j l b ns):rs)- = do (k,SSnode m' i' j' l' b' ks,ts) <- insertSS n ns- as <- foldM (\r (a,_) -> insSS ('@':a) r) ks atts- getSS xs (reset(SSnode m' i' j' l' b' as):(SSnode m i j l b ts):rs)- where r (SSnode m i j _ b ts) = SSnode m i j 0 b ts- reset (SSnode m i j l b ts) = SSnode m i j l b (map r ts)-getSS ((EndEvent n):xs) (t:(SSnode m i j l b ns):rs)- = getSS xs ((SSnode m i j l b (set t:ns):rs))- where s (SSnode m i j l b ts) = SSnode m i (max j l) 0 b ts- set (SSnode m i j l b ts) = SSnode m i j l b (map s ts)-getSS ((TextEvent t):xs) ((SSnode m i j l False ns):rs)- | any (not . isSpace) t- = getSS xs ((SSnode m i j l True ns):rs)-getSS (_:xs) rs = getSS xs rs-getSS [] rs = return rs---{------------------------------------------------------------------------------------------ Derive a good relational schema based on the structural summary (using hybrid inlining)-----------------------------------------------------------------------------------------}---type Path = [Tag]---data Table = Table String Path Bool [Table]- | Column String Path- deriving (Show,Read)---printPath :: Path -> String-printPath [] = ""-printPath [p] = p-printPath (p:ps) = printPath ps++"/"++p---pathCons p ps = if p=="root" then ps else p:ps---schema :: SSnode -> String -> [String] -> [Table]-schema (SSnode n i _ (-1) _ ts) prefix path- = [ Table (prefix++show i) (pathCons n path) True- ((reverse (concatMap (\t -> schema t prefix []) ts))- ++[ Column "value" [] ]) ]-schema (SSnode n i j _ _ []) prefix path- | j == 1 || head n == '@'- = [ Column (prefix++show i) (pathCons n path) ]-schema (SSnode n i 1 _ _ ts) prefix path- = concatMap (\t -> schema t prefix (pathCons n path)) ts-schema (SSnode n i _ _ b ts) prefix path- = [ Table (prefix++show i) (pathCons n path) False- ((reverse (concatMap (\t -> schema t prefix []) ts))- ++(if b && all (\(SSnode x _ _ _ _ _)-> head x == '@') ts- then [ Column "value" [] ] else [])) ]---fixSS :: SSnode -> SSnode-fixSS (SSnode n i j l True ts)- | any (\(SSnode x _ _ _ _ _)-> head x /= '@') ts- = SSnode n i j (-1) True (filter (\(SSnode x _ _ _ _ _)-> head x == '@') ts)-fixSS (SSnode n i j l b ts)- = SSnode n i j l b (map fixSS ts)---deriveSchema :: String -> String -> IO Table-deriveSchema file prefix- = do doc <- readFile file- let ts = parseDocument doc- d = getSS ts [SSnode "root" 1 1 1 False []]- [SSnode _ _ _ _ _ [t]] = evalState d 1- nt@(SSnode m i j l b s) = fixSS t- return (Table prefix [] False (reverse (schema (SSnode m i 2 l b s) prefix [])))---relationalSchema :: Table -> String -> [String]-relationalSchema (Table n path b ts) parent- = ("create table "++n++" ( /* "++printPath path- ++(if b then " (mixed content)" else "")++" */\n"- ++n++"_id int,\n"- ++(if parent /= "" then (n++"_parent int references "++parent++"("++parent++"_id),\n") else "")- ++(concat [ m++" varchar, /* "++printPath p++" */\n" | Column m p <- ts ])- ++"primary key ("++n++"_id))\n")- :[ s | t@(Table _ _ _ _) <- ts, s <- relationalSchema t n ]---getTableNames :: Table -> [String]-getTableNames (Table n _ _ ts) = n:(concatMap getTableNames ts)-getTableNames _ = []---initializeDB :: (IConnection conn) => conn -> IO ()-initializeDB db- = do tables <- getTables db- if elem "HXQCatalog" tables- then return ()- else do let s = "create table HXQCatalog ( name varchar primary key, path varchar, summary varchar )"- handleSqlError (run db s [])- commit db---createSchema :: (IConnection conn) => conn -> String -> String -> IO Table-createSchema db file name- = do initializeDB db- stmt <- handleSqlError (prepare db "select summary from HXQCatalog where name = ?")- _ <- handleSqlError (execute stmt [SqlString name])- result <- handleSqlError (fetchAllRowsAL stmt)- if length result > 0- then do let [[(_,SqlString s)]] = result- summary = (read s)::Table- tables = getTableNames summary- _ <- mapM (\t -> handleSqlError (run db ("drop table if exists "++t) [])) tables- _ <- handleSqlError (run db "delete from HXQCatalog where name = ?" [SqlString name])- commit db- else return ()- t <- deriveSchema file name- let schema = relationalSchema t ""- -- mapM putStrLn schema- _ <- handleSqlError (run db "insert into HXQCatalog values (?,?,?)"- [SqlString name, SqlString file, SqlString (show t)])- _ <- mapM (\s -> handleSqlError (run db s [])) schema- commit db- return t---findSchema :: (IConnection conn) => conn -> String -> IO Table-findSchema db name- = do initializeDB db- stmt <- handleSqlError (prepare db "select summary from HXQCatalog where name = ?")- _ <- handleSqlError (execute stmt [SqlString name])- result <- handleSqlError (fetchAllRowsAL stmt)- if length result == 1- then let [[(_,SqlString s)]] = result- in return ((read s)::Table)- else error ("Schema "++name++" doesn't exist")---{------------------------------------------------------------------------------------------ Populate the database from the XML file and its derived structural summary-----------------------------------------------------------------------------------------}---findPath :: [Table] -> [String] -> Int -> Maybe (Int,Table)-findPath (t@(Table _ p _ s):ts) path _ | p == path = Just ((length s)-1,t)-findPath (t@(Column _ p):ts) path n | p == path = Just (n,t)-findPath ((Table _ _ _ _):ts) path n = findPath ts path n-findPath (_:ts) path n = findPath ts path (n+1)-findPath [] _ _ = Nothing---populate :: [XMLEvent] -> [Table] -> Int -> [[String]] -> [(Int,String)]-populate ((EmptyEvent tag atts):xs) ts n ps- = populate ((StartEvent tag atts):(EndEvent tag):xs) ts n ps-populate (x@(StartEvent tag atts):xs) ((t@(Table n path _ s)):ts) _ (p:ps)- = case findPath s (tag:p) 0 of- Just (n,nt@(Table m _ True as))- -> (-1,m):(popAtts atts as ++ showXTree xs 1 "")- where showXTree ((EmptyEvent tag atts):xs) i s- = showXTree xs i (s++"<"++tag++showAL atts++"/>")- showXTree ((StartEvent tag atts):xs) i s- = showXTree xs (i+1) (s++"<"++tag++showAL atts++">")- showXTree ((EndEvent tag):xs) i s- = if i==1 then (n,s):(-2,m):(populate xs (t:ts) n (p:ps))- else showXTree xs (i-1) (s++"</"++tag++">")- showXTree ((TextEvent text):xs) i s = showXTree xs i (s++text)- showXTree (_:xs) i s = showXTree xs i s- Just (n,nt@(Table m _ _ as))- -> (-1,m):((popAtts atts as)++(populate xs (nt:t:ts) n ([]:p:ps)))- Just (n,nt)- -> populate xs (nt:t:ts) n ((tag:p):ps)- Nothing -> populate xs (t:ts) 0 ((tag:p):ps)- where popAtts ((a,v):as) ks- = let Just(m,_) = findPath ks ['@':a] 0- in (m,v):(popAtts as ks)- popAtts [] _ = []-populate ((EndEvent tag):xs) ((t@(Table n path _ s)):ts) _ ([]:ps)- = (-2,n):populate xs ts 0 ps-populate ((EndEvent tag):xs) ((Column m path):ts) n (p:ps)- = populate xs ts 0 (tail p:ps)-populate ((EndEvent text):xs) ts _ (p:ps)- = populate xs ts 0 (tail p:ps)-populate ((TextEvent text):xs) ts n ps- | any (not . isSpace) text- = (n,text):populate xs ts n ps-populate (x:xs) ts n ps- = populate xs ts n ps-populate [] ts n ps = []---insert :: (IConnection conn) => conn -> [(Int,String)] -> [(String,Int,Statement)] -> IO ()-insert db xs stmts = let (s,_,_,_) = m xs 0 0 in s- where m ((-1,m):xs) i p = let (s,el,xs',i') = ml xs (i+1) i- in (s >> insertTuple m el i p,[],xs',i')- m ((k,m):xs) i p = (return (),[(k,m)],xs,i)- ml [] i p = (return (),[],[],i)- ml ((-2,m):xs) i p = (return (),[],xs,i)- ml xs i p = let (s,el,xs',i') = m xs i p- (s',el',xs'',i'') = ml xs' i' p- in (s >> s',el++el',xs'',i'')- find x xs = foldr (\(a,v) r -> if x==a then v else r) "\NUL" xs- insertTuple m e i p- = let (len,stmt) = foldr (\(a,l,s) r -> if m==a then (l,s) else r) (error "") stmts- tuple = map (\c -> find c e) [0..len]- lift x = if x=="\NUL" then SqlNull else SqlString x- in do _ <- handleSqlError (execute stmt- (if i==0- then SqlInteger i:(map lift tuple)- else SqlInteger i:SqlInteger p:(map lift tuple)))- if mod i 100 == 99 then commit db else return ()- return ()----- | Store an XML document into the database under the given name.-shred :: (IConnection conn) => conn -> String -> String -> IO ()-shred db file name- = do let prefix = map toLower name- let tableStmt (Table n _ _ ts)- = do let len = length[ 1 | Column _ _ <- ts]-1- stmt <- handleSqlError (prepare db ("insert into "++n++" values ("- ++(if n==prefix then "" else "?,")++"?"- ++(concatMap (\_ -> ",?") [0..len])++")"))- l <- mapM tableStmt ts- return ((n,len,stmt):(concat l))- tableStmt _ = return []- t <- createSchema db file prefix- stmts <- tableStmt t- doc <- readFile file- let ts = parseDocument doc- let ic = (-1,prefix):(populate ts [t] 0 [[]] ++ [(-2,prefix)])- insert db ic stmts- commit db- return ()----- | Create a secondary index on tagname for the shredded document under the given name..-createIndex :: (IConnection conn) => conn -> String -> String -> IO ()-createIndex db name tagname- = do let prefix = map toLower name- table <- findSchema db name- let indexes = getIndexes "" table- _ <- if null indexes- then error ("there is no tagname: "++tagname)- else mapM (\(t,c) -> do stmt <- handleSqlError (prepare db ("create index "++t++"_"++c++" on "++t++" ("++c++")"))- handleSqlError (execute stmt [])) indexes- commit db- return ()- where getIndexes _ (Table n _ _ ts) = concatMap (getIndexes n) ts- getIndexes table (Column n path) | (head path)==tagname = [(table,n)]- getIndexes _ _ = []---{------------------------------------------------------------------------------------------------------- Convert XQuery to SQL-----------------------------------------------------------------------------------------------------}---publishES :: [String] -> [String] -> String-publishES (p:ps) xs- | head p == '@'- = "attribute "++(tail p)++" {"++publishES ps xs++"}"-publishES (p:ps) xs- = "<"++p++">{"++publishES ps xs++"}</"++p++">"-publishES [] [x] = x-publishES [] (x:xs) = x++","++publishES [] xs---publishS :: Table -> String -> String-publishS (Table n path b ts) "error"- = "for $"++n++" in SQL(select(),from($"++n++"),true()) return "- ++publishES (reverse path) (map (\t -> publishS t n) ts)-publishS (Table n path b ts) parent- = "for $"++n++" in SQL(select(),from($"++n++"),$"++n++"/"++n++"_parent eq $"- ++parent++"/"++parent++"_id) return "- ++publishES (reverse path) (map (\t -> publishS t n) ts)-publishS (Column n path) parent- = publishES (reverse path) ["$"++parent++"/"++n++"/text()"]---publishTable :: Table -> String-publishTable table = "<root>{" ++ publishS table "error" ++ "}</root>"---sqlComparisson = [("=","="),("eq","="),("<=","<="),(">=",">="),("!=","!="),(">",">"),- ("<","<"),("ne","!="),("gt",">"),("lt","<"),("ge",">="),("le","<=")]--sqlBoolean = [("and","and"),("or","or")]----- Is this an SQL predicate?-sqlPredicate :: [String] -> Ast -> Bool-sqlPredicate tables e- = case e of- Ast "child_step" [Astring c,Avar v]- -> elem v tables- Ast "construction" [_,_,Ast "append" [x]]- -> sqlPredicate tables x- Ast "call" [Avar "text",x]- -> sqlPredicate tables x- Ast "call" [Avar cmp,x,y]- | any (\(f,_) -> f==cmp) sqlComparisson- -> (sqlExpr x) && (sqlExpr y)- Ast "call" [Avar cmp,x,y]- | any (\(f,_) -> f==cmp) sqlBoolean- -> (sqlPredicate tables x) && (sqlPredicate tables y)- _ -> False- where sqlExpr e- = case e of- Astring s -> True- Aint n -> True- Ast "child_step" [Astring c,Avar v]- -> elem v tables- Ast "construction" [_,_,Ast "append" [x]]- -> sqlExpr x- Ast "call" [Avar "text",x]- -> sqlExpr x- _ -> False----- Convert a predicate AST to an SQL predicate that uses the tables-predToSQL :: [String] -> Ast -> (String,[Ast])-predToSQL tables e- = case e of- Ast "child_step" [Astring c,Avar v]- -> if elem v tables- then ("",[])- else error ("Cannot convert to an SQL predicate: "++show e)- Ast "construction" [_,_,Ast "append" [x]]- -> predToSQL tables x- Ast "call" [Avar "text",x]- -> predToSQL tables x- Ast "call" [Avar cmp,x,y]- | any (\(f,_) -> f==cmp) sqlComparisson- -> let (nx,vx) = expToSQL tables x- (ny,vy) = expToSQL tables y- in if nx == ""- then (ny,vx)- else if ny == ""- then (nx,vy)- else (nx ++ " " ++ snd (head (filter (\(f,_) -> f==cmp) sqlComparisson)) ++ " " ++ ny,vx++vy)- Ast "call" [Avar cmp,x,y]- | any (\(f,_) -> f==cmp) sqlBoolean- -> let (nx,vx) = predToSQL tables x- (ny,vy) = predToSQL tables y- in if nx == ""- then (ny,vy)- else if ny == ""- then (nx,vx)- else (nx ++ " " ++ snd (head (filter (\(f,_) -> f==cmp) sqlBoolean)) ++ " " ++ ny,vx++vy)- _ -> error ("Cannot convert to an SQL predicate: "++show e)- where expToSQL tables e- = case e of- Astring s -> ("\'"++s++"\'",[])- Aint n -> (show n,[])- Ast "child_step" [Astring c,Avar v]- -> if elem v tables- then (v++"."++c,[])- else ("?",[e])- Ast "construction" [_,_,Ast "append" [x]]- -> expToSQL tables x- Ast "call" [Avar "text",x]- -> expToSQL tables x- _ -> ("?",[e])----- Convert an AST to an SQL query-makeSQL :: [Ast] -> Ast -> [Ast] -> (String,[Ast])-makeSQL tables pred cols- = let tnames = [ x | Avar x <- tables ]- ts = combine tnames- cs = combine [ x | Avar x <- cols ]- vars (Ast n args) = concatMap vars args- vars (Avar v) | not (elem v tnames) = [v]- vars _ = []- combine [] = ""- combine [x] = x- combine (x:xs) = x++", "++combine xs- in if pred == Ast "call" [Avar "true"]- then (if null cs- then "select * from "++ts- else "select "++cs++" from "++ts,[])- else let (p,args) = predToSQL tnames pred- in (if null cs- then "select * from "++ts++" where "++p- else "select "++cs++" from "++ts++" where "++p,args)---{-# NOINLINE publishXmlDoc #-}--- get an XML document stored in a relational database-publishXmlDoc :: FilePath -> String -> Ast-publishXmlDoc filepath name- = let query = unsafePerformIO (publishWrapper filepath name)- [ast] = parse (scan query)- in ast- where publishWrapper filepath name- = do let prefix = map toLower name- db <- connect filepath- table <- findSchema db prefix- let query = publishTable table- -- disconnect db- return query
− Text/XML/HXQ/DBConnect.hs
@@ -1,26 +0,0 @@-{----------------------------------------------------------------------------------------- HDBC driver. Currently, Sqlite3.-- Programmer: Leonidas Fegaras-- Email: fegaras@cse.uta.edu-- Web: http://lambda.uta.edu/-- Creation: 05/30/08, last update: 07/24/08-- -- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.-- This material is provided as is, with absolutely no warranty expressed or implied.-- Any use is at your own risk. Permission is hereby granted to use or copy this program-- for any purpose, provided the above notices are retained on all copies.-----------------------------------------------------------------------------------------}---module Text.XML.HXQ.DBConnect where---import Database.HDBC.Sqlite3------ | Connect to the relational database in filepath using the HDBC Sqlite3 driver-connect :: FilePath -> IO Connection-connect filepath = connectSqlite3 filepath
− Text/XML/HXQ/Interpreter.hs
@@ -1,406 +0,0 @@-{----------------------------------------------------------------------------------------- The XQuery Interpreter-- Programmer: Leonidas Fegaras-- Email: fegaras@cse.uta.edu-- Web: http://lambda.uta.edu/-- Creation: 03/22/08, last update: 07/24/08-- -- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.-- This material is provided as is, with absolutely no warranty expressed or implied.-- Any use is at your own risk. Permission is hereby granted to use or copy this program-- for any purpose, provided the above notices are retained on all copies.-----------------------------------------------------------------------------------------}---{-# OPTIONS_GHC -fth -fglasgow-exts #-}---module Text.XML.HXQ.Interpreter where--import Control.Monad-import List(sortBy)-import XMLParse(parseDocument)-import System.Console.Readline-import Database.HDBC-import Text.XML.HXQ.Parser-import Text.XML.HXQ.XTree-import Text.XML.HXQ.Optimizer-import Text.XML.HXQ.Compiler-import Text.XML.HXQ.DB----- system functions (=, concat, etc)-systemFunctions :: [(String,Int,[XSeq]->XSeq)]-systemFunctions = $(iFunctions)----- XPath step functions (child, descendant, etc)-pathFunctions :: [(String,Tag->XTree->XSeq)]-pathFunctions = $(pFunctions)----- run-time bindings of FLOWR variables-type Environment = [(String,XSeq)]----- a user-defined function is (fname,parameters,body)-type Functions = [(String,[String],Ast)]---undefv1 = error "Undefined XQuery context (.)"-undefv2 = error "Undefined position()"-undefv3 = error "Undefined last()"------ Each XPath predicate must calculate position() and last() from its input XSeq--- if last() is used, then the evaluation is blocking (need to store the whole input XSeq)-applyPredicates :: [Ast] -> XSeq -> Bool -> Environment -> Functions -> XSeq-applyPredicates [] xs _ _ _ = xs-applyPredicates ((Aint n):preds) xs _ env fncs -- shortcut that improves laziness- = applyPredicates preds [xs !! (n-1)] True env fncs-applyPredicates (pred:preds) xs True env fncs -- top-k like- | maxPosition pathPosition pred > 0- = applyPredicates (pred:preds) (take (maxPosition pathPosition pred) xs) False env fncs-applyPredicates (pred:preds) xs _ env fncs- | containsLast pred -- blocking: use only when last() is used in the predicate- = let last = length xs- in applyPredicates preds- (foldir (\x i r -> case eval pred x i last "" env fncs of- [XInt k] -> if k == i then x:r else r -- indexing- b -> if conditionTest b then x:r else r) [] xs 1) True env fncs-applyPredicates (pred:preds) xs _ env fncs- = applyPredicates preds- (foldir (\x i r -> case eval pred x i undefv3 "" env fncs of- [XInt k] -> if k == i then x:r else r -- indexing- b -> if conditionTest b then x:r else r) [] xs 1) True env fncs----- The XQuery interpreter--- context: context node (XPath .)--- position: the element position in the parent sequence (XPath position())--- last: the length of the parent sequence (XPath last())--- effective_axis: the XPath axis in /axis::tag(exp)--- (eg, the effective axis of //(A | B) is "descendant_step"--- env: contains FLOWR variable bindings--- fncs: user-defined functions-eval :: Ast -> XTree -> Int -> Int -> String -> Environment -> Functions -> XSeq-eval e context position last effective_axis env fncs- = case e of- Avar "." -> [ context ]- Avar v -> findV v env- Aint n -> [ XInt n ]- Afloat n -> [ XFloat n ]- Astring s -> [ XText s ]- Ast "context" [v,Astring dp,body]- -> foldr (\x r -> (eval body x position last dp env fncs)++r)- [] (eval v context position last effective_axis env fncs)- Ast "call" [Avar "position"] -> [XInt position]- Ast "call" [Avar "last"] -> [XInt last]- Ast "child_step" [tag, Avar "."]- | effective_axis /= ""- -> eval (Ast effective_axis [tag, Avar "."]) context position last "" env fncs- Ast "step" ((Ast "descendant_any" (body:tags)):predicates)- -> let ts = map (\(Avar tag) -> tag) tags- in foldr (\x r -> (applyPredicates predicates (descendant_any_with_tagged_children ts x) True env fncs)++r)- [] (eval body context position last effective_axis env fncs)- Ast "step" ((Ast path_step [Astring tag,body]):predicates)- | memV path_step pathFunctions- -> foldr (\x r -> (applyPredicates predicates ((findV path_step pathFunctions) tag x) True env fncs)++r)- [] (eval body context position last effective_axis env fncs)- Ast "descendant_any" (body:tags)- -> let ts = map (\(Avar tag) -> tag) tags- in foldr (\x r -> (descendant_any_with_tagged_children ts x)++r)- [] (eval body context position last effective_axis env fncs)- Ast path_step [Astring tag,body]- | memV path_step pathFunctions- -> foldr (\x r -> ((findV path_step pathFunctions) tag x)++r)- [] (eval body context position last effective_axis env fncs)- Ast "step" (exp:predicates)- -> applyPredicates predicates (eval exp context position last effective_axis env fncs) True env fncs- Ast "predicate" [condition,body]- -> applyPredicates [condition] (eval body context position last effective_axis env fncs) True env fncs- Ast "append" args- -> appendText (map (\x -> eval x context position last effective_axis env fncs) args)- Ast "call" ((Avar fname):args)- -> case filter (\(n,_,_) -> n == fname || ("fn:"++n) == fname) systemFunctions of- [(_,len,f)] -> if (length args) == len- then f (map (\x -> eval x context position last effective_axis env fncs) args)- else error ("Wrong number of arguments in system call: "++fname)- _ -> case filter (\(n,_,_) -> n == fname) fncs of- (_,params,body):_ -> if (length params) == (length args)- then eval body context undefv2 undefv3 ""- ((zipWith (\p a -> (p,eval a context position last effective_axis env fncs))- params args)++env) fncs- else error ("Wrong number of arguments in function call: "++fname)- _ -> error ("Undefined function: "++fname)- Ast "construction" [Astring tag,Ast "attributes" [],body]- -> [ XElem tag [] 0 parent_error (eval body context position last effective_axis env fncs) ]- Ast "construction" [tag,Ast "attributes" al,body]- -> let alc = map (\(Ast "pair" [a,v])- -> let ac = eval a context position last effective_axis env fncs- vc = eval v context position last effective_axis env fncs- in (qName ac,showXS vc)) al- ct = eval tag context position last effective_axis env fncs- bc = eval body context position last effective_axis env fncs- in [ XElem (qName ct) alc 0 parent_error bc ]- Ast "let" [Avar var,source,body]- -> eval body context position last effective_axis- ((var,eval source context position last effective_axis env fncs):env) fncs- Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index- -> foldr (\a r -> (eval body a undefv2 undefv3 "" ((var,[a]):env) fncs)++r)- [] (eval source context position last effective_axis env fncs)- Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index- -> let p = maxPosition (Avar ivar) body- ns = if p > 0 -- there is a top-k like restriction- then Ast "step" [source,Ast "call" [Avar "<=",pathPosition,Aint p]]- else source - in foldir (\a i r -> (eval body a i undefv3 "" ((var,[a]):(ivar,[XInt i]):env) fncs)++r)- [] (eval ns context position last effective_axis env fncs) 1- Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting- -> [ XElem "" [] 0 parent_error- (foldl (\r a -> r++[XElem "" [] 0 parent_error (text (eval a context position last effective_axis env fncs))])- [XElem "" [] 0 parent_error (eval exp context position last effective_axis env fncs)] orderBys) ]- Ast "sort" (exp:ordList) -- blocking- -> let ce = map (\(XElem _ _ _ _ xs) -> map (\(XElem _ _ _ _ ys) -> ys) xs)- (eval exp context position last effective_axis env fncs)- ordering = foldr (\(Avar ord) r (x:xs) (y:ys)- -> case compareXSeqs (ord == "ascending") x y of- EQ -> r xs ys- o -> o)- (\xs ys -> EQ) ordList- in concatMap head (sortBy (\(_:xs) (_:ys) -> ordering xs ys) ce)- _ -> error ("Illegal XQuery: "++(show e))----- The monadic applyPredicates that propagates IO state-applyPredicatesM :: [Ast] -> XSeq -> Bool -> Environment -> Functions -> IO XSeq-applyPredicatesM [] xs _ _ _ = return xs-applyPredicatesM ((Aint n):preds) xs _ env fncs -- shortcut that improves laziness- = applyPredicatesM preds [xs !! (n-1)] True env fncs-applyPredicatesM (pred:preds) xs True env fncs -- top-k like- | maxPosition pathPosition pred > 0- = applyPredicatesM (pred:preds) (take (maxPosition pathPosition pred) xs) False env fncs-applyPredicatesM (pred:preds) xs _ env fncs- | containsLast pred -- blocking: use only when last() is used in the predicate- = do let last = length xs- vs <- foldir (\x i r -> do vs <- evalM pred x i last "" env fncs- s <- r- return (if case vs of- [XInt k] -> k == i -- indexing- b -> conditionTest b- then x:s else s))- (return []) xs 1- applyPredicatesM preds vs True env fncs-applyPredicatesM (pred:preds) xs _ env fncs- = do vs <- foldir (\x i r -> do vs <- evalM pred x i undefv3 "" env fncs- s <- r- return (if case vs of- [XInt k] -> k == i -- indexing- b -> conditionTest b- then x:s else s))- (return []) xs 1- applyPredicatesM preds vs True env fncs----- The monadic XQuery interpreter; it is like eval but has plumbing to propagate IO state-evalM :: Ast -> XTree -> Int -> Int -> String -> Environment -> Functions -> IO XSeq-evalM e context position last effective_axis env fncs- = case e of- Avar "." -> return [ context ]- Avar v -> return (findV v env)- Aint n -> return [ XInt n ]- Afloat n -> return [ XFloat n ]- Astring s -> return [ XText s ]- -- for non-IO XQuery, use the regular eval- Ast "nonIO" [u] -> return (eval u context position last effective_axis env fncs)- Ast "context" [v,Astring dp,body]- -> do vs <- evalM v context position last effective_axis env fncs- foldr (\x r -> (liftM2 (++)) (evalM body x position last dp env fncs) r)- (return []) vs- Ast "call" [Avar "position"] -> return [XInt position]- Ast "call" [Avar "last"] -> return [XInt last]- Ast "child_step" [tag, Avar "."]- | effective_axis /= ""- -> evalM (Ast effective_axis [tag, Avar "."]) context position last "" env fncs- Ast "step" ((Ast "descendant_any" (body:tags)):predicates)- -> do vs <- evalM body context position last effective_axis env fncs- let ts = map (\(Avar tag) -> tag) tags- foldr (\x r -> (liftM2 (++)) (applyPredicatesM predicates (descendant_any_with_tagged_children ts x) True env fncs) r)- (return []) vs- Ast "step" ((Ast path_step [Astring tag,body]):predicates)- | memV path_step pathFunctions- -> do vs <- evalM body context position last effective_axis env fncs- foldr (\x r -> (liftM2 (++)) (applyPredicatesM predicates ((findV path_step pathFunctions) tag x) True env fncs) r)- (return []) vs- Ast "descendant_any" (body:tags)- -> do vs <- evalM body context position last effective_axis env fncs- let ts = map (\(Avar tag) -> tag) tags- return (foldr (\x r -> (descendant_any_with_tagged_children ts x)++r) [] vs)- Ast path_step [Astring tag,body]- | memV path_step pathFunctions- -> do vs <- evalM body context position last effective_axis env fncs- return (foldr (\x r -> ((findV path_step pathFunctions) tag x)++r) [] vs)- Ast "step" (exp:predicates)- -> do vs <- evalM exp context position last effective_axis env fncs- applyPredicatesM predicates vs True env fncs- Ast "predicate" [condition,body]- -> do vs <- evalM body context position last effective_axis env fncs- applyPredicatesM [condition] vs True env fncs- Ast "executeSQL" [Avar var,args]- -> do as <- evalM args context position last effective_axis env fncs- let [XStmt stmt] = findV var env- executeSQL stmt as- Ast "call" [Avar nm,c,t,e] -- this is the only lazy function- | elem nm ["if","fn:if"]- -> do ce <- evalM c context position last effective_axis env fncs- evalM (if conditionTest ce then t else e) context position last effective_axis env fncs- Ast "append" args- -> (liftM appendText) (mapM (\x -> evalM x context position last effective_axis env fncs) args)- Ast "call" ((Avar fname):args) -- Note: strict function application- -> case filter (\(n,_,_) -> n == fname || ("fn:"++n) == fname) systemFunctions of- [(_,len,f)] -> if (length args) == len- then (liftM f) (mapM (\x -> evalM x context position last effective_axis env fncs) args)- else error ("Wrong number of arguments in system call: "++fname)- _ -> case filter (\(n,_,_) -> n == fname) fncs of- (_,params,body):_ -> if (length params) == (length args)- then do vs <- mapM (\a -> evalM a context position last effective_axis env fncs) args- evalM body context undefv2 undefv3 ""- ((zipWith (\p a -> (p,a)) params vs)++env) fncs- else error ("Wrong number of arguments in function call: "++fname)- _ -> error ("Undefined function: "++fname)- Ast "construction" [Astring tag,Ast "attributes" [],body]- -> do b <- evalM body context position last effective_axis env fncs- return [ XElem tag [] 0 parent_error b ]- Ast "construction" [tag,Ast "attributes" al,body]- -> do alc <- mapM (\(Ast "pair" [a,v])- -> do ac <- evalM a context position last effective_axis env fncs- vc <- evalM v context position last effective_axis env fncs- return (qName ac,showXS vc)) al- ct <- evalM tag context position last effective_axis env fncs- bc <- evalM body context position last effective_axis env fncs- return [ XElem (qName ct) alc 0 parent_error bc ]- Ast "let" [Avar var,source,body]- -> do s <- evalM source context position last effective_axis env fncs- evalM body context position last effective_axis ((var,s):env) fncs- Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index- -> do vs <- evalM source context position last effective_axis env fncs- foldr (\a r -> (liftM2 (++)) (evalM body a undefv2 undefv3 "" ((var,[a]):env) fncs) r)- (return []) vs- Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index- -> do let p = maxPosition (Avar ivar) body- ns = if p > 0 -- there is a top-k like restriction- then Ast "step" [source,Ast "call" [Avar "<=",pathPosition,Aint p]]- else source - vs <- evalM ns context position last effective_axis env fncs- foldir (\a i r -> (liftM2 (++)) (evalM body a i undefv3 "" ((var,[a]):(ivar,[XInt i]):env) fncs) r)- (return []) vs 1- Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting- -> do vs <- evalM exp context position last effective_axis env fncs- os <- mapM (\a -> evalM a context position last effective_axis env fncs) orderBys- return [ XElem "" [] 0 parent_error (foldl (\r a -> r++[XElem "" [] 0 parent_error (text a)])- [XElem "" [] 0 parent_error vs] os) ]- Ast "sort" (exp:ordList) -- blocking- -> do vs <- evalM exp context position last effective_axis env fncs- let ce = map (\(XElem _ _ _ _ xs) -> map (\(XElem _ _ _ _ ys) -> ys) xs) vs- ordering = foldr (\(Avar ord) r (x:xs) (y:ys)- -> case compareXSeqs (ord == "ascending") x y of- EQ -> r xs ys- o -> o)- (\xs ys -> EQ) ordList- return (concatMap head (sortBy (\(_:xs) (_:ys) -> ordering xs ys) ce))- _ -> error ("Illegal XQuery: "++(show e))----- evaluate from input continuously-evalInput :: (String -> Environment -> Functions -> IO(Environment,Functions)) -> Environment -> Functions -> IO ()-evalInput eval vs fs- = do let oneline prompt = do line <- readline prompt- case line of- Nothing -> return "quit"- Just t -> if t == ""- then oneline prompt- else return t- readlines x = do line <- oneline ": "- if last line == '}'- then return (x++" "++(init line))- else if line == "quit"- then return line- else readlines (x++" "++line)- line <- oneline "> "- stmt <- if head line == '{'- then if last line == '}'- then return (init (tail line))- else readlines (tail line)- else return line- if stmt == "quit"- then putStrLn "Bye!"- else do addHistory stmt- (nvs,nfs) <- eval (map (\c -> if c=='\"' then '\'' else c) stmt) vs fs- evalInput eval nvs nfs---xqueryE :: String -> Environment -> Functions -> (String -> IO XSeq) -> Bool -> IO (XSeq,Environment,Functions)-xqueryE query variables functions dbmapper verbose- = do let asts = parse (scan query)- fncs = foldr (\e r -> case e of- Ast "function" ((Avar f):b:args) -> (f,map (\(Avar v) -> v) args,optimize b):r- _ -> r) functions asts- vars <- foldl (\r e -> case e of- Ast "variable" [Avar v,u]- -> do s <- r- uv <- evalM (optimize u) undefv1 undefv2 undefv3 "" s fncs- return ((v,uv):s)- _ -> r) (return variables) asts- let exprp e = case e of Ast f _ | elem f ["function","variable"] -> True; _ -> False- exps = concatenateAll (dropWhile exprp asts)- opt_exps = optimize exps- (ast,ns) = liftIOSources opt_exps- if verbose- then do putStrLn "Abstract Syntax Tree (AST):"- putStrLn (ppAst exps)- putStrLn "Optimized AST:"- putStrLn (ppAst opt_exps)- putStrLn "Result:"- else return ()- env <- foldr (\(n,s) r -> case s of- Avar m -> do env <- r- return ((n,findV m env):env)- Ast "prepareSQL" [Astring sql]- -> do env <- r- t <- dbmapper sql- return ((n,t):env)- Astring file -> do doc <- readFile file- env <- r- return ((n,[materialize (parseDocument doc)]):env))- (return []) ns- e <- evalM ast undefv1 undefv2 undefv3 "" (env++vars) fncs- return (e,vars,fncs)----- | Evaluate the XQuery using the interpreter.-xquery :: String -> IO XSeq-xquery query = do (u,_,_) <- xqueryE query [] [] (\sql -> return []) False- return u----- | Read an XQuery from a file and run it using the interpreter.-xfile :: String -> IO XSeq-xfile file = do query <- readFile file- xquery query----- | Evaluate the XQuery with database connectivity using the interpreter.-xqueryDB :: (IConnection conn) => String -> conn -> IO XSeq-xqueryDB query db = do (u,_,_) <- xqueryE query [] []- (\sql -> do stmt <- prepareSQL db sql- return [XStmt stmt]) False- return u----- | Read an XQuery with database connectivity from a file and run it using the interpreter.-xfileDB :: (IConnection conn) => String -> conn -> IO XSeq-xfileDB file db = do query <- readFile file- xqueryDB query db
− Text/XML/HXQ/Optimizer.hs
@@ -1,517 +0,0 @@-{----------------------------------------------------------------------------------------- Preprocess abstract syntax trees, remove backward steps and optimize-- Programmer: Leonidas Fegaras-- Email: fegaras@cse.uta.edu-- Web: http://lambda.uta.edu/-- Creation: 05/01/08, last update: 07/24/08-- -- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.-- This material is provided as is, with absolutely no warranty expressed or implied.-- Any use is at your own risk. Permission is hereby granted to use or copy this program-- for any purpose, provided the above notices are retained on all copies.-----------------------------------------------------------------------------------------}---module Text.XML.HXQ.Optimizer(optimize) where--import Control.Monad-import Char(toLower)-import HXML(AttList)-import Text.XML.HXQ.Parser-import Text.XML.HXQ.XTree-import Text.XML.HXQ.DB----paths = [ "current_step", "child_step", "descendant_step", "attribute_step", "attribute_descendant_step" ]---distinct :: Eq a => [a] -> [a]-distinct = foldl (\r a -> if elem a r then r else r++[a]) []----- collect attribute constructions inside element constructions-collect_attributes :: Ast -> (Ast,[Ast])-collect_attributes (Ast "attribute_construction" [attr,value])- = (Ast "call" [Avar "empty"],[Ast "pair" [attr,value]])-collect_attributes (Ast "call" [Avar "concatenate",x,y])- = let (cx,ax) = collect_attributes x- (cy,ay) = collect_attributes y- in (Ast "call" [Avar "concatenate",cx,cy],ax++ay)-collect_attributes (Ast "append" es)- = let (s,a) = foldr (\e (r,ar) -> let (cx,ax) = collect_attributes e in (cx:r,ax++ar)) ([],[]) es- in (Ast "append" s,a)-collect_attributes (Ast "step" (e:es))- = let (ce,ae) = collect_attributes e- in (Ast "step" (ce:es),ae)-collect_attributes e = (e,[])----- does the expression contain a $var/.. ?-parentOfVar :: Ast -> String -> Bool-parentOfVar (Ast "step" [Ast "parent_step" [Ast "step" [Avar x]]]) var = x == var-parentOfVar (Ast "let" [Avar v,s,_]) var | var == v = parentOfVar s var-parentOfVar (Ast "for" [Avar v,Avar i,s,_]) var | var == v || var == i = parentOfVar s var-parentOfVar (Ast _ args) var = or (map (\x -> parentOfVar x var) args)-parentOfVar _ _ = False----- replace $var/.. with $nvar-replaceParentOfVar :: Ast -> String -> String -> Ast-replaceParentOfVar (Ast "step" [Ast "parent_step" [Ast "step" [Avar x]]]) var nvar- | x == var- = Avar nvar-replaceParentOfVar (Ast "let" [Avar v,s,b]) var nvar | var == v- = Ast "let" [Avar v,replaceParentOfVar s var nvar,b]-replaceParentOfVar (Ast "for" [Avar v,Avar i,s,b]) var nvar | var == v || var == i- = Ast "for" [Avar v,Avar i,replaceParentOfVar s var nvar,b]-replaceParentOfVar (Ast f args) var nvar- = Ast f (map (\x -> replaceParentOfVar x var nvar) args)-replaceParentOfVar e _ _ = e----- 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]]-removeParent :: Ast -> (Ast,Ast,Bool,Ast)-removeParent (Ast "predicate" [c,x])- = let (nx,cond,childp,tag) = removeParent x- in (Ast "predicate" [c,nx],cond,childp,tag)-removeParent (Ast "step" ((Ast "child_step" [tag,x]):preds))- = (Ast "step" ((Ast "child_step" [tag,Avar "."]):preds),x,True,tag)-removeParent (Ast "step" ((Ast "descendant_step" [tag,x]):preds))- = (Ast "step" ((Ast "child_step" [tag,Avar "."]):preds),- Ast "step" [Ast "descendant_step" [Astring "*",x]],True,tag)-removeParent (Ast "step" ((Ast "attribute_step" [tag,x]):preds))- = (Ast "step" ((Ast "attribute_step" [tag,Avar "."]):preds),x,False,tag)-removeParent (Ast "step" ((Ast "descendant_attribute_step" [tag,x]):preds))- = (Ast "step" ((Ast "attribute_step" [tag,Avar "."]):preds),- Ast "step" ((Ast "descendant_step" [Astring "*",x]):preds),False,tag)-removeParent (Ast "step" (x:xs))- = let (nx,cond,childp,tag) = removeParent x- in (Ast "step" (nx:xs),cond,childp,tag)-removeParent e = error ("Cannot remove this parent step "++(show e))---tagged_children :: String -> Ast -> [Tag]-tagged_children context (Ast "step" ((Ast "child_step" [Astring tag,Avar "."]):_))- | context == "."- = [tag]-tagged_children context (Ast "step" ((Ast "child_step" [Astring tag,Ast "step" ((Avar v):_)]):_))- | v == context- = [tag]-tagged_children _ (Ast "step" ((Ast "descendant_any" _):_)) = []-tagged_children _ (Ast "step" ((Ast step _):_))- | elem step paths = []-tagged_children context (Ast _ xs) = concatMap (tagged_children context) xs-tagged_children _ _ = []---empty = Ast "call" [Avar "empty"]---simplify :: Ast -> Ast--- must be done bottom-up: /../..-simplify (Ast "step" [Ast "parent_step" [Ast "step" [Ast "parent_step" x]]])- = let nx = simplify (Ast "step" [Ast "parent_step" x])- in simplify (Ast "step" [Ast "parent_step" [nx]])--- get rid of a parent step-simplify (Ast "step" [Ast "parent_step" [x]])- = let (cond,nx,_,_) = removeParent x- in Ast "predicate" [simplify cond,simplify nx]--- remove $var/.. in a let-FLWOR-simplify (Ast "let" [Avar var,source,body])- | parentOfVar body var- = let (cond,nx,childp,tag) = removeParent source- in simplify (Ast "let" [Avar (var++"_parent"),Ast "predicate" [cond,nx],- Ast "let" [Avar var,- Ast "step" [ Ast (if childp- then "child_step"- else "attribute_step")- [tag,Avar (var++"_parent")] ],- replaceParentOfVar body var (var++"_parent")]])--- remove $var/.. from a for-FLWOR-simplify (Ast "for" [Avar var,Avar "$",source,body])- | parentOfVar body var- = let (cond,nx,childp,tag) = removeParent source- in simplify (Ast "for" [Avar (var++"_parent"),Avar "$",Ast "predicate" [cond,nx],- Ast "for" [Avar var,Avar "$",- Ast "step" [ Ast (if childp- then "child_step"- else "attribute_step")- [tag,Avar (var++"_parent")] ],- replaceParentOfVar body var (var++"_parent")]])--- pull out attributes from a general element construction-simplify (Ast "element_construction" [tag,Ast "attributes" as,content])- = let (nc,attrs) = collect_attributes content- in simplify (Ast "construction" [tag,Ast "attributes" (as++attrs),nc])--- if //* collect all children tagnames to use descendant_any_with_tagged_children-simplify (Ast "for" [Avar var,i,Ast "step" [Ast "step" ((Ast "descendant_step" [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))- tags = map Avar ctags- in simplify (Ast "for" [Avar var,i,Ast "step" [Ast "step" ((Ast "descendant_any" (path:tags)):preds)],body])-simplify (Ast "step" ((Ast "child_step" [Astring tag,Ast "step" ((Ast "descendant_step" [Astring "*",path]):preds)]):preds2))- = let ctags = distinct(tag:(concatMap (tagged_children ".") preds))- tags = map Avar ctags- in simplify (Ast "step" ((Ast "child_step" [Astring tag,Ast "step" ((Ast "descendant_any" (path:tags)):preds)]):preds2))-simplify (Ast "step" ((Ast "descendant_step" [Astring "*",path]):preds))- | any (not . null . (tagged_children ".")) preds- = let ctags = distinct (concatMap (tagged_children ".") preds)- tags = map Avar ctags- in simplify (Ast "step" ((Ast "descendant_any" (path:tags)):preds))--- expand the wrapper of a stored document-simplify (Ast "call" [Avar "publish",Astring dbpath,Astring name])- = simplify (publishXmlDoc dbpath name)--- default-simplify (Ast n args) = Ast n (map simplify args)-simplify e = e---taggedElement :: [Ast] -> String -> Maybe [Ast]-taggedElement (e@(Ast "construction" [Astring ctag,_,x]):xs) tag- | ctag == tag || tag == "*"- = case taggedElement xs tag of- Nothing -> Nothing- Just s -> Just (e:s)-taggedElement ((Ast "construction" [_,_,_]):xs) tag- = taggedElement xs tag-taggedElement ((Ast "call" [Avar "concatenate",x,y]):xs) tag- = case (taggedElement (x:xs) tag,taggedElement (y:xs) tag) of- (Just tx,Just ty) -> Just (tx++ty)- _ -> Nothing-taggedElement ((Astring _):xs) tag- = taggedElement xs tag-taggedElement ((Aint _):xs) tag- = taggedElement xs tag-taggedElement (e:xs) tag = Nothing-taggedElement [] _ = Just []---findAttr :: String -> [Ast] -> Ast-findAttr tag ((Ast "pair" [Astring a,v]):_) | a==tag || tag=="*" = v-findAttr tag (_:xs) = findAttr tag xs-findAttr _ [] = empty---andAll :: [Ast] -> Ast-andAll [x] = x-andAll (x:xs) = foldl (\a r -> call "and" [a,r]) x xs---occursContext :: Ast -> Int-occursContext e- = case e of- Avar "." -> 1- Ast "let" _ -> 0- Ast "for" _ -> 0- Ast "call" [Avar "SQL",s,f,w]- -> occursContext w- Ast "descendant_any" (x:tags)- -> occursContext x- Ast step [tag,x]- | elem step paths- -> occursContext x- Ast n xs -> sum (map occursContext xs)- _ -> 0---substContext :: Ast -> Ast -> Ast-substContext e b- = case b of- Avar "." -> e- Ast "let" _ -> b- Ast "for" _ -> b- Ast "call" [Avar "SQL",s,f,w]- -> Ast "call" [Avar "SQL",s,f,substContext e w]- Ast "descendant_any" (x:tags)- -> Ast "descendant_any" ((substContext e x):tags)- Ast step [tag,x]- | elem step paths- -> Ast step [tag,substContext e x]- Ast n xs -> Ast n (map (substContext e) xs)- _ -> b---occurs :: String -> Ast -> Int-occurs v e- = case e of- Avar w | v==w -> 1- Ast "let" [Avar w,_,_] | v==w -> 0- Ast "for" [Avar w,Avar i,_,_] | v==w || v==i -> 0- Ast "call" [Avar "SQL",s,f,w]- -> occurs v w- Ast n xs -> sum (map (occurs v) xs)- _ -> 0---subst :: String -> Ast -> Ast -> Ast-subst v e b- = case b of- Avar w | v==w -> e- Ast "let" [Avar w,_,_] | v==w -> b- Ast "for" [Avar w,Avar i,_,_] | v==w || v==i -> b- Ast "call" [Avar "SQL",s,f,w]- -> Ast "call" [Avar "SQL",s,f,subst v e w]- Ast n xs -> Ast n (map (subst v e) xs)- _ -> b---dependsOnPosition :: Bool -> Ast -> Bool-dependsOnPosition contextp e- = case e of- Avar "." -> contextp- Ast "call" [Avar "position"] -> True- Ast "call" [Avar "last"] -> True- Ast "call" ((Avar "step"):x:_)- -> dependsOnPosition contextp x- Ast _ xs -> any (dependsOnPosition contextp) xs- _ -> False---wellFormedPredicate :: Bool -> Ast -> Bool-wellFormedPredicate contextp e- = case e of- Ast "call" ((Avar "step"):x:_)- -> not (dependsOnPosition contextp x)- Ast step xs- | elem step paths || step == "descendant_any"- -> not (any (dependsOnPosition contextp) xs)- Ast "construction" xs- -> not (any (dependsOnPosition contextp) xs)- Ast "call" [Avar "not",x]- -> not (dependsOnPosition contextp x)- Ast "call" [Avar cmp,x,y]- | any (\(f,_) -> f==cmp) (sqlComparisson++sqlBoolean)- -> not (dependsOnPosition contextp x)- && not (dependsOnPosition contextp y)- _ -> False---splitSqlPredicate :: [String] -> Ast -> Maybe(Ast,Ast)-splitSqlPredicate tables (Ast "call" [Avar "and",p1,p2])- = case (splitSqlPredicate tables p1,splitSqlPredicate tables p2) of- (Nothing,Nothing) -> Nothing- (Nothing,Just(pp1,pp2)) -> Just(pp1,Ast "call" [Avar "and",p1,pp2])- (Just(pp1,pp2),Nothing) -> Just(pp1,Ast "call" [Avar "and",p2,pp2])-splitSqlPredicate tables pred- | sqlPredicate tables pred- = Just(pred,Ast "call" [Avar "true"])-splitSqlPredicate tables pred = Nothing----- Normalization-normalize :: Ast -> Bool -> Int -> (Ast,Bool,Int)-normalize exp changed count- = case exp of- Ast "step" [x]- -> normalize x True count- Ast "step" (x:(Ast "call" [Avar "true"]):xs)- -> norm (Ast "step" (x:xs))- Ast "step" (x:(Ast "call" [Avar "false"]):xs)- -> (empty,True,count)- Ast "for" [v,i,Ast "call" [Avar "empty"],b]- -> (empty,True,count)- Ast "for" [v,i,s,Ast "call" [Avar "empty"]]- -> (empty,True,count)- Ast "descendant_any" ((Astring _):_)- -> (empty,True,count)- Ast "descendant_any" ((Aint _):_)- -> (empty,True,count)- Ast "descendant_any" ((Afloat _):_)- -> (empty,True,count)- Ast "descendant_any" ((Ast "call" [Avar "text",_]):_)- -> (empty,True,count)- Ast "descendant_any" ((Ast "call" [Avar "empty"]):_)- -> (empty,True,count)- Ast step [_,Astring _]- | elem step paths- -> (empty,True,count)- Ast step [_,Aint _]- | elem step paths- -> (empty,True,count)- Ast step [_,Afloat _]- | elem step paths- -> (empty,True,count)- Ast step [_,Ast "call" [Avar "text",_]]- | elem step paths- -> (empty,True,count)- Ast step [_,Ast "call" [Avar "empty"]]- | elem step paths- -> (empty,True,count)- Ast "call" [Avar "and",Ast "call" [Avar "true"],x]- -> norm x- Ast "call" [Avar "and",x,Ast "call" [Avar "true"]]- -> norm x- -- (x,()) -> x- Ast "call" [Avar "concatenate",x,Ast "call" [Avar "empty"]]- -> norm x- -- ((),x) -> x- Ast "call" [Avar "concatenate",Ast "call" [Avar "empty"],x]- -> norm x- -- for $v1 in (for $v2 in s2 return b2) return b1 --> for $v2 in s2, for $v1 in b2 return b1- Ast "for" [v1,i1,Ast "for" [v2,i2,s2,b2],b1]- -> norm (Ast "for" [v2,i2,s2,Ast "for" [v1,i1,b2,b1]])- -- (for $v in s return b)/tag --> for $v in s return b/tag --> - Ast "descendant_any" ((Ast "for" [v,i,s,b]):tags)- -> norm (Ast "for" [v,i,s,Ast "descendant_any" (b:tags)])- Ast step [tag,Ast "for" [v,i,s,b]]- | elem step paths- -> norm (Ast "for" [v,i,s,Ast step [tag,b]])- -- (x,y)/tag --> (x/tag,y/tag)- Ast "descendant_any" ((Ast "call" [Avar "concatenate",x,y]):tags)- -> norm (Ast "call" [Avar "concatenate",Ast "descendant_any" (x:tags),Ast "descendant_any" (y:tags)])- Ast step [tag,Ast "call" [Avar "concatenate",x,y]]- | elem step paths- -> norm (Ast "call" [Avar "concatenate",Ast step [tag,x],Ast step [tag,y]])- -- for $v in (x,y) return b --> (for $v in x return b,for $v in y return b)- Ast "for" [v,i@(Avar "$"),Ast "call" [Avar "concatenate",x,y],b]- -> norm (Ast "call" [Avar "concatenate",Ast "for" [v,i,x,b],Ast "for" [v,i,y,b]])- -- for $v in <a>...</a> return b --> b[$v/(<a>...</a>)]- Ast "for" [Avar v,Avar i,e,b]- | case e of Ast "construction" _ -> True; Ast _ _ -> False; _ -> True- -> norm (if i == "$"- then subst v e b- else subst v e (subst i (Aint 1) b))- --Ast "for" [Avar v,Avar i,Ast "predicate" [pred,e],b]- -- -> norm (Ast "for" [Avar v,Avar i,e,Ast "predicate" [pred,b]])- Ast "for" [Avar v,Avar i,Ast "predicate" [pred,e],b]- | occurs v pred == 0 && occurs i pred == 0 && occursContext pred == 0- -> norm (Ast "predicate" [pred,Ast "for" [Avar v,Avar i,e,b]])- -- unfold linear let- Ast "let" [Avar v,e,b]- | occurs v b < 2- -> norm (subst v e b)- -- (if c then t else e)/A --> if c then t/A else e/A- Ast "descendant_any" ((Ast "predicate" [c,e]):tags)- | wellFormedPredicate True c- -> norm (Ast "predicate" [c,Ast "descendant_any" (e:tags)])- Ast step [tag,Ast "predicate" [c,e]]- | elem step paths && wellFormedPredicate True c- -> norm (Ast "predicate" [c,Ast step [tag,e]])- -- if p doesn't depend on context: (e[p])/A --> (e/A)[p]- Ast "descendant_any" ((Ast "step" (x:xs@(_:_))):tags)- | all (wellFormedPredicate True) xs- -> norm (Ast "step" ((Ast "descendant_any" (x:tags)):xs))- Ast step [tag,Ast "step" (x:xs@(_:_))]- | elem step paths && all (wellFormedPredicate True) xs- -> norm (Ast "step" ((Ast step [tag,x]):xs))- -- normalize predicate- Ast "predicate" [pred,x]- | occursContext pred > 0- -> let v = "x"++show count- in normalize (Ast "for" [Avar v,Avar "$",x,Ast "predicate" [substContext (Avar v) pred,Avar v]]) True (count+1)- Ast "step" [x,pred]- | occursContext pred > 0- -> let v = "x"++show count- in normalize (Ast "for" [Avar v,Avar "$",x,Ast "predicate" [substContext (Avar v) pred,Avar v]]) True (count+1)- Ast "predicate" [p1,Ast "predicate" [p2,e]]- -> norm (Ast "predicate" [Ast "call" [Avar "and",p1,p2],e])- Ast "predicate" [Ast "call"[Avar "false"],x]- -> (empty,True,count)- Ast "predicate" [Ast "call"[Avar "true"],x]- -> (x,True,count)- Ast "predicate" [x,Ast "call"[Avar "empty"]]- -> (empty,True,count)- Ast "step" ((Ast "call" [Avar "empty"]):xs)- -> (empty,True,count)- -- promote well-formed predicates; but note: (x,y)[1] <> (x[1],y[1])- Ast "step" ((Ast "call" [Avar "concatenate",x,y]):xs)- | all (wellFormedPredicate False) xs- -> norm (Ast "call" [Avar "concatenate",Ast "step" (x:xs),Ast "step" (y:xs)])- Ast "predicate" [pred,Ast "for" [v,i,s,b]]- | wellFormedPredicate False pred- -> norm (Ast "for" [v,i,s,Ast "predicate" [pred,b]])- Ast "step" ((Ast "for" [v,i,s,b]):xs)- | all (wellFormedPredicate False) xs- -> norm (Ast "for" [v,i,s,Ast "predicate" [andAll xs,b]])- Ast "step" (e@(Ast "construction" [_,_,_]):xs)- -> if sum (map occursContext xs) > 0- then norm (Ast "predicate" [andAll (map (substContext e) xs),e])- else let (r,b,c) = foldr (\a (r,b,c) -> let (x,s,i) = normalize a b c in (x:r,s,i))- ([],changed,count) (e:xs)- in (Ast "step" r,b,c)- Ast "call" [Avar "=",x,y]- | x == empty || y == empty- -> (Ast "call"[Avar "true"],True,count)- -- (<ctag>...<tag>...</tag>...</ctag>)/tag --> ...<tag>...</tag>...- Ast "child_step" [Astring tag,Ast "construction" [_,_,Ast "append" x]]- | taggedElement x tag /= Nothing- -> case taggedElement x tag of- Just [] -> (empty,True,count)- Just s -> norm (concatenateAll s)- Ast "child_step" [Astring tag,Ast "construction" [_,_,Ast "append" x]]- -> norm (Ast "current_step" [Astring tag,concatenateAll x])- Ast "current_step" [Astring tag1,e@(Ast "construction" [Astring tag2,_,Ast "append" x])]- -> if tag1 == tag2 || tag1 == "*"- then norm e- else (empty,True,count)- -- (<tag>x</tag>)//tag --> (x,x//tag)- Ast "descendant_any" (z@(Ast "construction" [Astring ctag,_,Ast "append" x]):tags)- -> norm (Ast "call" [Avar "concatenate",z,Ast "descendant_any" ((concatenateAll x):tags)])- Ast "descendant_step" [Astring tag,z@(Ast "construction" [Astring ctag,_,Ast "append" x])]- -> norm (if tag == ctag || tag == "*"- then Ast "call" [Avar "concatenate",z,Ast "descendant_step" [Astring tag,concatenateAll x]]- else Ast "descendant_step" [Astring tag,concatenateAll x])- -- (<tag A=s>x</tag>)/@A --> s- Ast "attribute_step" [Astring tag,Ast "construction" [ctag,Ast "attributes" as,x]]- -> (findAttr tag as,True,count)- -- (<tag A=s>x</tag>)//@A --> (s,x//@A)- Ast "attribute_descendant_step" [Astring tag,Ast "construction" [ctag,Ast "attributes" as,Ast "append" x]]- -> norm (Ast "call" [Avar "concatenate",findAttr tag as,- Ast "attribute_descendant_step" [Astring tag,concatenateAll x]])- -- SQL folding- Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),Ast "call" ((Avar "from"):f1),pred1],- Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),Ast "call" ((Avar "from"):f2),pred2],b]]- | occurs v1 b == 0- -> norm (Ast "for" [Avar v2,Avar "$",- Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):(s1++s2)),- Ast "call" ((Avar "from"):(f1++f2)),Ast "call" [Avar "and",pred1,pred2]],- b])- Ast "for" [Avar v,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s),Ast "call" ((Avar "from"):tables),pred1],- Ast "predicate" [pred2,x]]- | splitSqlPredicate [ v | Avar v <- tables ] pred2 /= Nothing- -> let Just(pred3,pred4) = splitSqlPredicate [ v | Avar v <- tables ] pred2- in norm (Ast "for" [Avar v,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s),- Ast "call" ((Avar "from"):tables),Ast "call" [Avar "and",pred1,pred3]],- Ast "predicate" [pred4,x]])- Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),Ast "call" ((Avar "from"):f1),pred1],- Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),Ast "call" ((Avar "from"):f2),pred2],- Ast "predicate" [predd,b]]]- | occurs v1 b == 0 && splitSqlPredicate [ v | Avar v <- f1 ] predd /= Nothing- -> let Just(pred3,pred4) = splitSqlPredicate [ v | Avar v <- f1 ] predd- in norm (Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),- Ast "call" ((Avar "from"):f1),Ast "call" [Avar "and",pred1,pred3]],- Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),Ast "call" ((Avar "from"):f2),pred2],- Ast "predicate" [pred4,b]]])- -- default- Ast n args- -> let (r,b,c) = foldr (\a (r,b,c) -> let (x,s,i) = normalize a b c in (x:r,s,i))- ([],changed,count) args- in (Ast n r,b,c)- _ -> (exp,changed,count)- where norm e = normalize e True count---foldSQL :: Ast -> Ast-foldSQL e- = case e of- Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):cols),Ast "call" ((Avar "from"):tables),pred]- -> let (sql,args) = makeSQL tables pred cols- in Ast "call" [Avar "sql",Astring sql,concatenateAll args]- Ast n args -> Ast n (map foldSQL args)- _ -> e---optimizeLoop :: Ast -> Int -> (Ast,Int)-optimizeLoop e c = let (ne,b,c') = normalize e False c- in if b- then optimizeLoop ne c'- else (ne,c)---optimize :: Ast -> Ast-optimize e = foldSQL (fst (optimizeLoop (simplify e) 0))
− Text/XML/HXQ/Parser.hs
@@ -1,2153 +0,0 @@-{-# OPTIONS -fglasgow-exts -cpp #-}-module Text.XML.HXQ.Parser 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---- parser produced by Happy Version 1.17--newtype HappyAbsSyn = HappyAbsSyn HappyAny-#if __GLASGOW_HASKELL__ >= 607-type HappyAny = GHC.Exts.Any-#else-type HappyAny = forall a . a-#endif-happyIn4 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn4 x = unsafeCoerce# x-{-# INLINE happyIn4 #-}-happyOut4 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut4 x = unsafeCoerce# x-{-# INLINE happyOut4 #-}-happyIn5 :: (Ast) -> (HappyAbsSyn )-happyIn5 x = unsafeCoerce# x-{-# INLINE happyIn5 #-}-happyOut5 :: (HappyAbsSyn ) -> (Ast)-happyOut5 x = unsafeCoerce# x-{-# INLINE happyOut5 #-}-happyIn6 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn6 x = unsafeCoerce# x-{-# INLINE happyIn6 #-}-happyOut6 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut6 x = unsafeCoerce# x-{-# INLINE happyOut6 #-}-happyIn7 :: (Ast) -> (HappyAbsSyn )-happyIn7 x = unsafeCoerce# x-{-# INLINE happyIn7 #-}-happyOut7 :: (HappyAbsSyn ) -> (Ast)-happyOut7 x = unsafeCoerce# x-{-# INLINE happyOut7 #-}-happyIn8 :: (Ast) -> (HappyAbsSyn )-happyIn8 x = unsafeCoerce# x-{-# INLINE happyIn8 #-}-happyOut8 :: (HappyAbsSyn ) -> (Ast)-happyOut8 x = unsafeCoerce# x-{-# INLINE happyOut8 #-}-happyIn9 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn9 x = unsafeCoerce# x-{-# INLINE happyIn9 #-}-happyOut9 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut9 x = unsafeCoerce# x-{-# INLINE happyOut9 #-}-happyIn10 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn10 x = unsafeCoerce# x-{-# INLINE happyIn10 #-}-happyOut10 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut10 x = unsafeCoerce# x-{-# INLINE happyOut10 #-}-happyIn11 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn11 x = unsafeCoerce# x-{-# INLINE happyIn11 #-}-happyOut11 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut11 x = unsafeCoerce# x-{-# INLINE happyOut11 #-}-happyIn12 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn12 x = unsafeCoerce# x-{-# INLINE happyIn12 #-}-happyOut12 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut12 x = unsafeCoerce# x-{-# INLINE happyOut12 #-}-happyIn13 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn13 x = unsafeCoerce# x-{-# INLINE happyIn13 #-}-happyOut13 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut13 x = unsafeCoerce# x-{-# INLINE happyOut13 #-}-happyIn14 :: (( Ast -> Ast, Ast -> Ast )) -> (HappyAbsSyn )-happyIn14 x = unsafeCoerce# x-{-# INLINE happyIn14 #-}-happyOut14 :: (HappyAbsSyn ) -> (( Ast -> Ast, Ast -> Ast ))-happyOut14 x = unsafeCoerce# x-{-# INLINE happyOut14 #-}-happyIn15 :: (( [ Ast ], [ Ast ] )) -> (HappyAbsSyn )-happyIn15 x = unsafeCoerce# x-{-# INLINE happyIn15 #-}-happyOut15 :: (HappyAbsSyn ) -> (( [ Ast ], [ Ast ] ))-happyOut15 x = unsafeCoerce# x-{-# INLINE happyOut15 #-}-happyIn16 :: (Ast) -> (HappyAbsSyn )-happyIn16 x = unsafeCoerce# x-{-# INLINE happyIn16 #-}-happyOut16 :: (HappyAbsSyn ) -> (Ast)-happyOut16 x = unsafeCoerce# x-{-# INLINE happyOut16 #-}-happyIn17 :: (Ast) -> (HappyAbsSyn )-happyIn17 x = unsafeCoerce# x-{-# INLINE happyIn17 #-}-happyOut17 :: (HappyAbsSyn ) -> (Ast)-happyOut17 x = unsafeCoerce# x-{-# INLINE happyOut17 #-}-happyIn18 :: (Ast) -> (HappyAbsSyn )-happyIn18 x = unsafeCoerce# x-{-# INLINE happyIn18 #-}-happyOut18 :: (HappyAbsSyn ) -> (Ast)-happyOut18 x = unsafeCoerce# x-{-# INLINE happyOut18 #-}-happyIn19 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn19 x = unsafeCoerce# x-{-# INLINE happyIn19 #-}-happyOut19 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut19 x = unsafeCoerce# x-{-# INLINE happyOut19 #-}-happyIn20 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn20 x = unsafeCoerce# x-{-# INLINE happyIn20 #-}-happyOut20 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut20 x = unsafeCoerce# x-{-# INLINE happyOut20 #-}-happyIn21 :: (Ast) -> (HappyAbsSyn )-happyIn21 x = unsafeCoerce# x-{-# INLINE happyIn21 #-}-happyOut21 :: (HappyAbsSyn ) -> (Ast)-happyOut21 x = unsafeCoerce# x-{-# INLINE happyOut21 #-}-happyIn22 :: ([Ast]) -> (HappyAbsSyn )-happyIn22 x = unsafeCoerce# x-{-# INLINE happyIn22 #-}-happyOut22 :: (HappyAbsSyn ) -> ([Ast])-happyOut22 x = unsafeCoerce# x-{-# INLINE happyOut22 #-}-happyIn23 :: ([ Ast ]) -> (HappyAbsSyn )-happyIn23 x = unsafeCoerce# x-{-# INLINE happyIn23 #-}-happyOut23 :: (HappyAbsSyn ) -> ([ Ast ])-happyOut23 x = unsafeCoerce# x-{-# INLINE happyOut23 #-}-happyIn24 :: (Ast) -> (HappyAbsSyn )-happyIn24 x = unsafeCoerce# x-{-# INLINE happyIn24 #-}-happyOut24 :: (HappyAbsSyn ) -> (Ast)-happyOut24 x = unsafeCoerce# x-{-# INLINE happyOut24 #-}-happyIn25 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn25 x = unsafeCoerce# x-{-# INLINE happyIn25 #-}-happyOut25 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut25 x = unsafeCoerce# x-{-# INLINE happyOut25 #-}-happyIn26 :: (Ast -> Ast) -> (HappyAbsSyn )-happyIn26 x = unsafeCoerce# x-{-# INLINE happyIn26 #-}-happyOut26 :: (HappyAbsSyn ) -> (Ast -> Ast)-happyOut26 x = unsafeCoerce# x-{-# INLINE happyOut26 #-}-happyIn27 :: (String -> Ast -> [ Ast ]) -> (HappyAbsSyn )-happyIn27 x = unsafeCoerce# x-{-# INLINE happyIn27 #-}-happyOut27 :: (HappyAbsSyn ) -> (String -> Ast -> [ Ast ])-happyOut27 x = unsafeCoerce# x-{-# INLINE happyOut27 #-}-happyIn28 :: (String -> Ast -> Ast) -> (HappyAbsSyn )-happyIn28 x = unsafeCoerce# x-{-# INLINE happyIn28 #-}-happyOut28 :: (HappyAbsSyn ) -> (String -> Ast -> Ast)-happyOut28 x = unsafeCoerce# x-{-# INLINE happyOut28 #-}-happyIn29 :: (String -> Ast -> Ast) -> (HappyAbsSyn )-happyIn29 x = unsafeCoerce# x-{-# INLINE happyIn29 #-}-happyOut29 :: (HappyAbsSyn ) -> (String -> Ast -> Ast)-happyOut29 x = unsafeCoerce# x-{-# INLINE happyOut29 #-}-happyInTok :: Token -> (HappyAbsSyn )-happyInTok x = unsafeCoerce# x-{-# INLINE happyInTok #-}-happyOutTok :: (HappyAbsSyn ) -> Token-happyOutTok x = unsafeCoerce# x-{-# INLINE happyOutTok #-}---happyActOffsets :: HappyAddr-happyActOffsets = HappyA# "\xce\x00\xce\x00\x00\x00\x00\x00\x47\x02\x9c\x00\x00\x00\x00\x00\x40\x00\x00\x00\x06\x00\x00\x00\xfd\xff\x00\x00\x00\x00\x7e\x01\x7e\x01\x13\x01\x89\x00\x13\x01\x13\x01\x13\x01\x00\x00\x68\x01\x13\x01\x5f\x01\x5f\x01\x1c\x00\x17\x00\x63\x00\x97\x01\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\xff\x5c\x01\x00\x00\x44\x00\x64\x01\x5b\x01\xff\xff\xfd\xff\x43\x01\x13\x01\x71\x01\x41\x01\x13\x01\x6f\x01\x4c\x01\x4b\x01\xec\xff\x2a\x01\x00\x00\x3c\x01\x00\x00\x00\x00\x47\x02\x64\x00\x10\x00\x00\x00\x73\x01\x3a\x00\x38\x00\x1b\x01\x00\x00\x13\x01\x28\x00\x13\x01\x00\x00\x16\x00\x00\x00\x23\x01\x0f\x01\x0f\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x13\x01\x63\x02\x63\x02\x63\x02\x95\x02\x63\x02\x7c\x02\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x1c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x08\x01\x08\x01\x56\x08\x47\x02\x24\x01\x22\x01\x4e\x01\x14\x01\x00\x00\xfa\xff\x13\x01\x01\x00\xfb\xff\x12\x01\x00\x00\x00\x00\x59\x00\x3a\x01\x63\x00\x62\x00\x00\x00\xb7\x01\x00\x00\xf9\x00\x13\x01\x13\x01\x13\x01\x00\x00\x13\x01\x00\x00\x00\x01\x25\x01\x13\x01\xf4\x00\xf4\x00\x13\x01\x13\x01\x2b\x02\x29\x01\x13\x01\x0e\x02\x27\x01\xef\x00\x0e\x00\x00\x00\x03\x01\x1e\x01\xe3\x00\x00\x00\x0c\x00\x13\x01\x00\x00\x00\x00\x1a\x01\x57\x00\x00\x00\x19\x01\x51\x00\x47\x02\xf0\x00\xe6\x00\x47\x02\xfc\xff\xfb\x00\x47\x02\x96\x01\x47\x02\x47\x02\xe8\xff\x00\x00\xf8\x00\x63\x00\xf8\x00\x00\x00\xf5\x00\x4f\x00\x00\x00\x13\x01\xc2\x00\x00\x00\x00\x00\x13\x01\x13\x01\x47\x02\x4d\x01\xdb\x00\xd9\x00\x49\x00\x00\x00\x00\x00\xe7\x00\x13\x01\xa1\x00\x13\x01\xfc\xff\x00\x00\x13\x01\x13\x01\x00\x00\x13\x01\x00\x00\x13\x01\x47\x02\x08\x00\x00\x00\xcf\x00\x13\x01\xca\x00\x85\x00\x24\x00\x12\x00\x47\x02\x47\x02\x00\x00\x47\x02\x97\x00\x47\x02\x00\x00\x00\x00\x13\x01\x00\x00\x00\x00\x00\x00\x4d\x01\x13\x01\x00\x00\x00\x00\x00\x00\x13\x01\xf1\x01\x00\x00\xd4\x01\x47\x02\x00\x00\x00\x00\x00\x00"#--happyGotoOffsets :: HappyAddr-happyGotoOffsets = HappyA# "\xa7\x00\x31\x01\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x01\x00\x00\x00\x00\xd8\x00\xd1\x00\x4a\x08\x9e\x03\x87\x03\x33\x08\x1c\x08\x00\x00\x00\x00\x05\x08\xc1\x00\x7f\x00\x00\x00\x00\x00\xf3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xec\x00\x00\x00\xb4\x00\x70\x03\xdf\x00\x00\x00\xee\x07\x00\x00\x00\x00\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x99\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x90\x00\x00\x00\xc0\x07\xd3\x00\x59\x03\x00\x00\x0d\x00\x00\x00\x9f\x00\x8e\x00\x71\x00\xa9\x07\x92\x07\x7b\x07\x64\x07\x4d\x07\x36\x07\x1f\x07\x08\x07\xf1\x06\xda\x06\xc3\x06\xac\x06\x95\x06\x7e\x06\x67\x06\x50\x06\x39\x06\x22\x06\x0b\x06\xf4\x05\xdd\x05\xc6\x05\xaf\x05\x98\x05\x81\x05\x6a\x05\x53\x05\x3c\x05\x25\x05\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\x92\x00\x42\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x00\xc9\x00\x00\x00\x00\x00\x00\x00\x9b\x00\x0e\x05\xf7\x04\xe0\x04\x00\x00\xc9\x04\x00\x00\x00\x00\x00\x00\xb2\x04\x93\x00\x77\x00\x9b\x04\x2b\x03\x00\x00\x00\x00\x14\x03\x00\x00\x00\x00\xf5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8c\x00\x84\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x02\x00\x00\x00\x00\x00\x00\xe6\x02\x6d\x04\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x04\x20\x00\x3f\x04\x4d\x00\x00\x00\x28\x04\x11\x04\x00\x00\xcf\x02\x00\x00\xb8\x02\x00\x00\x00\x00\x00\x00\x00\x00\xfa\x03\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x03\x00\x00\x00\x00\x00\x00\x1f\x00\xcc\x03\x00\x00\x00\x00\x00\x00\xb5\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--happyDefActions :: HappyAddr-happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x8b\xff\xfa\xff\xbd\xff\xed\xff\xee\xff\x00\x00\xcd\xff\xa2\xff\xef\xff\x9b\xff\x90\xff\x8e\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8c\xff\x00\x00\x8a\xff\xf4\xff\xcc\xff\xcb\xff\xa1\xff\x00\x00\xfe\xff\xfd\xff\x00\x00\x00\x00\x00\x00\x00\x00\x9a\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\xff\x00\x00\xc8\xff\xce\xff\xac\xff\xcf\xff\xd0\xff\xca\xff\x00\x00\x00\x00\x88\xff\x00\x00\x00\x00\x00\x00\x99\xff\x97\xff\x00\x00\x00\x00\x00\x00\x9f\xff\x00\x00\xb1\xff\xbb\xff\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\xd1\xff\xd2\xff\xd3\xff\xd4\xff\xd5\xff\xd6\xff\xd7\xff\xd8\xff\xd9\xff\xda\xff\xdb\xff\xdc\xff\xdd\xff\xde\xff\xdf\xff\xe0\xff\xe1\xff\xe2\xff\xe3\xff\xe4\xff\xe5\xff\xe6\xff\xe7\xff\xe8\xff\xe9\xff\xea\xff\xeb\xff\xec\xff\xbe\xff\xc5\xff\xc6\xff\x00\x00\x00\x00\xa7\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\xff\xa9\xff\x00\x00\x95\xff\x00\x00\x00\x00\x91\xff\x00\x00\x96\xff\x00\x00\x00\x00\x00\x00\x00\x00\x89\xff\x00\x00\xa0\xff\xab\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\xff\x00\x00\x86\xff\x00\x00\x00\x00\xfc\xff\xfb\xff\x00\x00\x00\x00\x87\xff\xb4\xff\x00\x00\x00\x00\xb5\xff\x00\x00\x00\x00\xc0\xff\x00\x00\x00\x00\xc4\xff\x00\x00\x00\x00\xc9\xff\x00\x00\xf1\xff\xf2\xff\x00\x00\x8f\xff\x93\xff\x00\x00\x94\xff\x9e\xff\x00\x00\x00\x00\xa3\xff\x00\x00\x00\x00\xa4\xff\xa5\xff\x00\x00\x00\x00\xf3\xff\xb6\xff\xbc\xff\x00\x00\x00\x00\xaa\xff\xb2\xff\x92\xff\x00\x00\x00\x00\x00\x00\x00\x00\x9d\xff\x00\x00\x00\x00\xae\xff\x00\x00\xad\xff\x00\x00\xf9\xff\x00\x00\xf6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\xff\xc3\xff\x9c\xff\xf0\xff\x00\x00\xc2\xff\xa6\xff\xb3\xff\x00\x00\xba\xff\xb8\xff\xb7\xff\xb6\xff\x00\x00\xb0\xff\xaf\xff\xf5\xff\x00\x00\x00\x00\xf7\xff\x00\x00\xc1\xff\xb9\xff\xf8\xff"#--happyCheck :: HappyAddr-happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x04\x00\x07\x00\x0b\x00\x0b\x00\x0b\x00\x09\x00\x0a\x00\x0b\x00\x16\x00\x0b\x00\x0e\x00\x0f\x00\x10\x00\x16\x00\x0b\x00\x0a\x00\x2b\x00\x03\x00\x16\x00\x0a\x00\x2b\x00\x0a\x00\x41\x00\x0a\x00\x0e\x00\x0f\x00\x10\x00\x0c\x00\x47\x00\x09\x00\x0b\x00\x0b\x00\x03\x00\x25\x00\x09\x00\x3e\x00\x0b\x00\x29\x00\x2a\x00\x3e\x00\x0c\x00\x16\x00\x33\x00\x34\x00\x35\x00\x0c\x00\x09\x00\x33\x00\x34\x00\x2c\x00\x3a\x00\x39\x00\x38\x00\x10\x00\x3a\x00\x2c\x00\x3a\x00\x2c\x00\x43\x00\x2c\x00\x40\x00\x46\x00\x42\x00\x46\x00\x44\x00\x45\x00\x46\x00\x02\x00\x03\x00\x04\x00\x33\x00\x34\x00\x35\x00\x46\x00\x09\x00\x42\x00\x0b\x00\x2c\x00\x3a\x00\x0e\x00\x0f\x00\x10\x00\x0c\x00\x3a\x00\x0c\x00\x18\x00\x43\x00\x16\x00\x0c\x00\x46\x00\x0c\x00\x11\x00\x12\x00\x38\x00\x39\x00\x3a\x00\x0c\x00\x2c\x00\x0c\x00\x2c\x00\x3f\x00\x40\x00\x25\x00\x42\x00\x09\x00\x09\x00\x29\x00\x2a\x00\x37\x00\x0c\x00\x37\x00\x10\x00\x10\x00\x03\x00\x2c\x00\x36\x00\x33\x00\x34\x00\x08\x00\x03\x00\x2c\x00\x38\x00\x2c\x00\x3a\x00\x3b\x00\x11\x00\x12\x00\x03\x00\x2c\x00\x40\x00\x2c\x00\x42\x00\x08\x00\x44\x00\x45\x00\x46\x00\x02\x00\x03\x00\x04\x00\x02\x00\x03\x00\x2c\x00\x03\x00\x09\x00\x0a\x00\x0b\x00\x07\x00\x03\x00\x0e\x00\x0f\x00\x10\x00\x38\x00\x03\x00\x3a\x00\x3a\x00\x03\x00\x16\x00\x0e\x00\x0f\x00\x40\x00\x40\x00\x42\x00\x42\x00\x16\x00\x00\x00\x01\x00\x0a\x00\x03\x00\x04\x00\x13\x00\x06\x00\x25\x00\x17\x00\x18\x00\x19\x00\x29\x00\x2a\x00\x0d\x00\x0e\x00\x0f\x00\x03\x00\x11\x00\x12\x00\x09\x00\x14\x00\x33\x00\x34\x00\x17\x00\x18\x00\x19\x00\x38\x00\x2b\x00\x3a\x00\x03\x00\x29\x00\x2a\x00\x42\x00\x07\x00\x40\x00\x2e\x00\x42\x00\x03\x00\x44\x00\x45\x00\x46\x00\x02\x00\x03\x00\x04\x00\x03\x00\x03\x00\x0b\x00\x03\x00\x09\x00\x07\x00\x0b\x00\x0b\x00\x03\x00\x0e\x00\x0f\x00\x10\x00\x07\x00\x17\x00\x18\x00\x19\x00\x42\x00\x16\x00\x3c\x00\x3d\x00\x17\x00\x18\x00\x19\x00\x17\x00\x18\x00\x19\x00\x01\x00\x07\x00\x03\x00\x04\x00\x18\x00\x06\x00\x25\x00\x15\x00\x16\x00\x03\x00\x29\x00\x2a\x00\x0d\x00\x0e\x00\x0f\x00\x3a\x00\x11\x00\x12\x00\x07\x00\x14\x00\x33\x00\x34\x00\x17\x00\x18\x00\x19\x00\x38\x00\x2c\x00\x3a\x00\x3b\x00\x17\x00\x18\x00\x19\x00\x18\x00\x40\x00\x14\x00\x42\x00\x2b\x00\x44\x00\x45\x00\x46\x00\x02\x00\x03\x00\x04\x00\x10\x00\x11\x00\x12\x00\x13\x00\x09\x00\x2d\x00\x0b\x00\x15\x00\x16\x00\x0e\x00\x0f\x00\x10\x00\x0b\x00\x0b\x00\x43\x00\x09\x00\x39\x00\x16\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x2d\x00\x0a\x00\x01\x00\x0a\x00\x03\x00\x04\x00\x42\x00\x06\x00\x25\x00\x14\x00\x3a\x00\x42\x00\x29\x00\x2a\x00\x0d\x00\x0e\x00\x0f\x00\x07\x00\x11\x00\x12\x00\x30\x00\x14\x00\x33\x00\x34\x00\x17\x00\x18\x00\x19\x00\x38\x00\x3a\x00\x3a\x00\x2c\x00\x01\x00\x2c\x00\x42\x00\x2f\x00\x40\x00\x39\x00\x42\x00\x2c\x00\x44\x00\x45\x00\x46\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x3a\x00\x2c\x00\x05\x00\x2d\x00\x0b\x00\x3a\x00\x0b\x00\x3a\x00\x31\x00\x32\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x06\x00\x42\x00\x3a\x00\x43\x00\x09\x00\x42\x00\x3a\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x08\x00\x42\x00\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\xff\xff\x25\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xff\xff\xff\xff\x25\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x03\x00\x04\x00\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\xff\xff\xff\xff\x17\x00\x18\x00\x19\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--happyTable :: HappyAddr-happyTable = HappyA# "\x00\x00\x10\x00\x11\x00\x12\x00\x45\x00\xd1\x00\x2f\x00\x14\x00\x13\x00\xb0\x00\x14\x00\x99\x00\x32\x00\x15\x00\x16\x00\x17\x00\x18\x00\x47\x00\xef\x00\xdf\x00\x02\x01\x18\x00\xed\x00\xa4\x00\xb7\x00\x29\x00\x9f\x00\x8b\x00\x08\x00\x8c\x00\x01\x01\xff\xff\x2e\x00\x8e\x00\x2f\x00\xf6\x00\x19\x00\x31\x00\xe0\x00\x32\x00\x1a\x00\x1b\x00\xa5\x00\x08\x01\x18\x00\x8f\x00\x90\x00\xd2\x00\x02\x01\x13\x00\x1c\x00\x1d\x00\xf0\x00\x30\x00\x46\x00\x1e\x00\x17\x00\x1f\x00\xa0\x00\x33\x00\xa0\x00\xd3\x00\xa0\x00\x21\x00\xd4\x00\x22\x00\x25\x00\x23\x00\x24\x00\x25\x00\x10\x00\x11\x00\x12\x00\x8f\x00\x90\x00\x91\x00\x48\x00\x13\x00\x22\x00\x14\x00\xa0\x00\x30\x00\x15\x00\x16\x00\x17\x00\xf9\x00\x33\x00\xfb\x00\x49\x00\x92\x00\x18\x00\xdc\x00\x93\x00\xe6\x00\xf4\x00\x0a\x00\x96\x00\x97\x00\x1f\x00\xe8\x00\x9b\x00\xcd\x00\x9b\x00\x98\x00\x21\x00\x19\x00\x22\x00\x13\x00\x13\x00\x1a\x00\x1b\x00\x9c\x00\xa1\x00\x9d\x00\x17\x00\x17\x00\x33\x00\xa0\x00\x4a\x00\x1c\x00\x1d\x00\x87\x00\xbe\x00\xa0\x00\x1e\x00\xa0\x00\x1f\x00\x20\x00\xe2\x00\x0a\x00\x33\x00\xa0\x00\x21\x00\xa0\x00\x22\x00\x34\x00\x23\x00\x24\x00\x25\x00\x10\x00\x11\x00\x12\x00\xea\x00\xeb\x00\xa0\x00\x35\x00\x13\x00\x3f\x00\x14\x00\x88\x00\xbf\x00\x15\x00\x16\x00\x17\x00\xcb\x00\x03\x00\x1f\x00\x1f\x00\xc7\x00\x18\x00\xcf\x00\x08\x00\x21\x00\x21\x00\x22\x00\x22\x00\x99\x00\x25\x00\x26\x00\x89\x00\x03\x00\x04\x00\xa1\x00\x05\x00\x19\x00\xdd\x00\x0d\x00\x0e\x00\x1a\x00\x1b\x00\x06\x00\x07\x00\x08\x00\xb0\x00\x09\x00\x0a\x00\x4a\x00\x0b\x00\x1c\x00\x1d\x00\x0c\x00\x0d\x00\x0e\x00\x1e\x00\x00\x01\x1f\x00\x35\x00\x4c\x00\x4d\x00\x22\x00\x36\x00\x21\x00\x4e\x00\x22\x00\x03\x00\x23\x00\x24\x00\x25\x00\x10\x00\x11\x00\x12\x00\x03\x00\x35\x00\x04\x01\x03\x00\x13\x00\x40\x00\x14\x00\xee\x00\x35\x00\x15\x00\x16\x00\x17\x00\x41\x00\xc9\x00\x0d\x00\x0e\x00\x22\x00\x18\x00\x2a\x00\x2b\x00\xcb\x00\x0d\x00\x0e\x00\x94\x00\x0d\x00\x0e\x00\xb2\x00\x45\x00\x03\x00\x04\x00\xfa\x00\x05\x00\x19\x00\xad\x00\x43\x00\x03\x00\x1a\x00\x1b\x00\x06\x00\x07\x00\x08\x00\xda\x00\x09\x00\x0a\x00\x45\x00\x0b\x00\x1c\x00\x1d\x00\x0c\x00\x0d\x00\x0e\x00\x1e\x00\xfb\x00\x1f\x00\x20\x00\x2c\x00\x0d\x00\x0e\x00\xdd\x00\x21\x00\xe2\x00\x22\x00\xe4\x00\x23\x00\x24\x00\x25\x00\x10\x00\x11\x00\x12\x00\x52\x00\x53\x00\x54\x00\x55\x00\x13\x00\xe5\x00\x14\x00\x42\x00\x43\x00\x15\x00\x16\x00\x17\x00\xe7\x00\xe9\x00\xb4\x00\xb5\x00\x46\x00\x18\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\xb6\x00\xb8\x00\x02\x00\xbb\x00\x03\x00\x04\x00\x22\x00\x05\x00\x19\x00\xc2\x00\xc3\x00\x22\x00\x1a\x00\x1b\x00\x06\x00\x07\x00\x08\x00\x45\x00\x09\x00\x0a\x00\xd5\x00\x0b\x00\x1c\x00\x1d\x00\x0c\x00\x0d\x00\x0e\x00\x1e\x00\xce\x00\x1f\x00\x9b\x00\xd6\x00\xa6\x00\x22\x00\x8b\x00\x21\x00\x46\x00\x22\x00\x9b\x00\x23\x00\x24\x00\x25\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\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\xa3\x00\xa6\x00\x9e\x00\xa7\x00\xa8\x00\xaa\x00\xab\x00\xad\x00\xfd\x00\xfe\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\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\xe1\x00\x22\x00\xb2\x00\x28\x00\x2c\x00\x22\x00\x39\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\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\xc9\x00\x22\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\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\x0a\x01\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\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\x06\x01\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\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\xb9\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\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\xbc\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\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\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\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\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x00\x00\x67\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x00\x00\x00\x00\x03\x00\x3b\x00\xf0\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3b\x00\xf1\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xd7\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3b\x00\xda\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3b\x00\xb9\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3b\x00\xbc\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3b\x00\xce\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3b\x00\x93\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3b\x00\xae\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3b\x00\x3c\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3b\x00\x3d\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x06\x01\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x07\x01\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xfe\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x04\x01\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xf2\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xf3\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xf5\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xf7\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xd6\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xe9\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xbd\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xc0\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xc3\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xc4\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xc5\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xc6\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x6a\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x6b\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x6c\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x6d\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x6e\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x6f\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x70\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x71\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x72\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x73\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x74\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x75\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x76\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x77\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x78\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x79\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x7a\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x7b\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x7c\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x7d\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x7e\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x7f\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x80\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x81\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x82\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x83\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x84\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x85\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x86\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x98\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xa8\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\xab\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x37\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x39\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3a\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x03\x00\x3f\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\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, 121) [- (1 , happyReduce_1),- (2 , happyReduce_2),- (3 , happyReduce_3),- (4 , happyReduce_4),- (5 , happyReduce_5),- (6 , happyReduce_6),- (7 , happyReduce_7),- (8 , happyReduce_8),- (9 , happyReduce_9),- (10 , happyReduce_10),- (11 , happyReduce_11),- (12 , happyReduce_12),- (13 , happyReduce_13),- (14 , happyReduce_14),- (15 , happyReduce_15),- (16 , happyReduce_16),- (17 , happyReduce_17),- (18 , happyReduce_18),- (19 , happyReduce_19),- (20 , happyReduce_20),- (21 , happyReduce_21),- (22 , happyReduce_22),- (23 , happyReduce_23),- (24 , happyReduce_24),- (25 , happyReduce_25),- (26 , happyReduce_26),- (27 , happyReduce_27),- (28 , happyReduce_28),- (29 , happyReduce_29),- (30 , happyReduce_30),- (31 , happyReduce_31),- (32 , happyReduce_32),- (33 , happyReduce_33),- (34 , happyReduce_34),- (35 , happyReduce_35),- (36 , happyReduce_36),- (37 , happyReduce_37),- (38 , happyReduce_38),- (39 , happyReduce_39),- (40 , happyReduce_40),- (41 , happyReduce_41),- (42 , happyReduce_42),- (43 , happyReduce_43),- (44 , happyReduce_44),- (45 , happyReduce_45),- (46 , happyReduce_46),- (47 , happyReduce_47),- (48 , happyReduce_48),- (49 , happyReduce_49),- (50 , happyReduce_50),- (51 , happyReduce_51),- (52 , happyReduce_52),- (53 , happyReduce_53),- (54 , happyReduce_54),- (55 , happyReduce_55),- (56 , happyReduce_56),- (57 , happyReduce_57),- (58 , happyReduce_58),- (59 , happyReduce_59),- (60 , happyReduce_60),- (61 , happyReduce_61),- (62 , happyReduce_62),- (63 , happyReduce_63),- (64 , happyReduce_64),- (65 , happyReduce_65),- (66 , happyReduce_66),- (67 , happyReduce_67),- (68 , happyReduce_68),- (69 , happyReduce_69),- (70 , happyReduce_70),- (71 , happyReduce_71),- (72 , happyReduce_72),- (73 , happyReduce_73),- (74 , happyReduce_74),- (75 , happyReduce_75),- (76 , happyReduce_76),- (77 , happyReduce_77),- (78 , happyReduce_78),- (79 , happyReduce_79),- (80 , happyReduce_80),- (81 , happyReduce_81),- (82 , happyReduce_82),- (83 , happyReduce_83),- (84 , happyReduce_84),- (85 , happyReduce_85),- (86 , happyReduce_86),- (87 , happyReduce_87),- (88 , happyReduce_88),- (89 , happyReduce_89),- (90 , happyReduce_90),- (91 , happyReduce_91),- (92 , happyReduce_92),- (93 , happyReduce_93),- (94 , happyReduce_94),- (95 , happyReduce_95),- (96 , happyReduce_96),- (97 , happyReduce_97),- (98 , happyReduce_98),- (99 , happyReduce_99),- (100 , happyReduce_100),- (101 , happyReduce_101),- (102 , happyReduce_102),- (103 , happyReduce_103),- (104 , happyReduce_104),- (105 , happyReduce_105),- (106 , happyReduce_106),- (107 , happyReduce_107),- (108 , happyReduce_108),- (109 , happyReduce_109),- (110 , happyReduce_110),- (111 , happyReduce_111),- (112 , happyReduce_112),- (113 , happyReduce_113),- (114 , happyReduce_114),- (115 , happyReduce_115),- (116 , happyReduce_116),- (117 , happyReduce_117),- (118 , happyReduce_118),- (119 , happyReduce_119),- (120 , happyReduce_120),- (121 , happyReduce_121)- ]--happy_n_terms = 72 :: Int-happy_n_nonterms = 26 :: Int--happyReduce_1 = happySpecReduce_1 0# happyReduction_1-happyReduction_1 happy_x_1- = case happyOut5 happy_x_1 of { happy_var_1 -> - happyIn4- ([happy_var_1]- )}--happyReduce_2 = happySpecReduce_2 0# happyReduction_2-happyReduction_2 happy_x_2- happy_x_1- = case happyOut5 happy_x_1 of { happy_var_1 -> - happyIn4- ([happy_var_1]- )}--happyReduce_3 = happySpecReduce_3 0# happyReduction_3-happyReduction_3 happy_x_3- happy_x_2- happy_x_1- = case happyOut4 happy_x_1 of { happy_var_1 -> - case happyOut5 happy_x_3 of { happy_var_3 -> - happyIn4- (happy_var_1++[happy_var_3]- )}}--happyReduce_4 = happyReduce 4# 0# happyReduction_4-happyReduction_4 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut4 happy_x_1 of { happy_var_1 -> - case happyOut5 happy_x_3 of { happy_var_3 -> - happyIn4- (happy_var_1++[happy_var_3]- ) `HappyStk` happyRest}}--happyReduce_5 = happySpecReduce_1 1# happyReduction_5-happyReduction_5 happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - happyIn5- (happy_var_1- )}--happyReduce_6 = happyReduce 5# 1# happyReduction_6-happyReduction_6 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut7 happy_x_3 of { happy_var_3 -> - case happyOut8 happy_x_5 of { happy_var_5 -> - happyIn5- (Ast "variable" [happy_var_3,happy_var_5]- ) `HappyStk` happyRest}}--happyReduce_7 = happyReduce 9# 1# happyReduction_7-happyReduction_7 (happy_x_9 `HappyStk`- happy_x_8 `HappyStk`- happy_x_7 `HappyStk`- happy_x_6 `HappyStk`- happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOutTok happy_x_3 of { (QName happy_var_3) -> - case happyOut6 happy_x_5 of { happy_var_5 -> - case happyOut8 happy_x_8 of { happy_var_8 -> - happyIn5- (Ast "function" ([Avar happy_var_3,happy_var_8]++happy_var_5)- ) `HappyStk` happyRest}}}--happyReduce_8 = happyReduce 8# 1# happyReduction_8-happyReduction_8 (happy_x_8 `HappyStk`- happy_x_7 `HappyStk`- happy_x_6 `HappyStk`- happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOutTok happy_x_3 of { (QName happy_var_3) -> - case happyOut8 happy_x_7 of { happy_var_7 -> - happyIn5- (Ast "function" [Avar happy_var_3,happy_var_7]- ) `HappyStk` happyRest}}--happyReduce_9 = happySpecReduce_1 2# happyReduction_9-happyReduction_9 happy_x_1- = case happyOut7 happy_x_1 of { happy_var_1 -> - happyIn6- ([happy_var_1]- )}--happyReduce_10 = happySpecReduce_3 2# happyReduction_10-happyReduction_10 happy_x_3- happy_x_2- happy_x_1- = case happyOut6 happy_x_1 of { happy_var_1 -> - case happyOut7 happy_x_3 of { happy_var_3 -> - happyIn6- (happy_var_1++[happy_var_3]- )}}--happyReduce_11 = happySpecReduce_1 3# happyReduction_11-happyReduction_11 happy_x_1- = case happyOutTok happy_x_1 of { (Variable happy_var_1) -> - happyIn7- (Avar happy_var_1- )}--happyReduce_12 = happyReduce 5# 4# happyReduction_12-happyReduction_12 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut10 happy_x_1 of { happy_var_1 -> - case happyOut13 happy_x_2 of { happy_var_2 -> - case happyOut14 happy_x_3 of { happy_var_3 -> - case happyOut8 happy_x_5 of { happy_var_5 -> - happyIn8- ((snd happy_var_3) (happy_var_1 (happy_var_2 ((fst happy_var_3) happy_var_5)))- ) `HappyStk` happyRest}}}}--happyReduce_13 = happyReduce 4# 4# happyReduction_13-happyReduction_13 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut11 happy_x_2 of { happy_var_2 -> - case happyOut8 happy_x_4 of { happy_var_4 -> - happyIn8- (call "some" [happy_var_2 happy_var_4]- ) `HappyStk` happyRest}}--happyReduce_14 = happyReduce 4# 4# happyReduction_14-happyReduction_14 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut11 happy_x_2 of { happy_var_2 -> - case happyOut8 happy_x_4 of { happy_var_4 -> - happyIn8- (call "not" [call "some" [happy_var_2 (call "not" [happy_var_4])]]- ) `HappyStk` happyRest}}--happyReduce_15 = happyReduce 6# 4# happyReduction_15-happyReduction_15 (happy_x_6 `HappyStk`- happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut8 happy_x_2 of { happy_var_2 -> - case happyOut8 happy_x_4 of { happy_var_4 -> - case happyOut8 happy_x_6 of { happy_var_6 -> - happyIn8- (call "if" [happy_var_2,happy_var_4,happy_var_6]- ) `HappyStk` happyRest}}}--happyReduce_16 = happySpecReduce_1 4# happyReduction_16-happyReduction_16 happy_x_1- = case happyOut24 happy_x_1 of { happy_var_1 -> - happyIn8- (happy_var_1- )}--happyReduce_17 = happySpecReduce_1 4# happyReduction_17-happyReduction_17 happy_x_1- = case happyOut18 happy_x_1 of { happy_var_1 -> - happyIn8- (happy_var_1- )}--happyReduce_18 = happySpecReduce_1 4# happyReduction_18-happyReduction_18 happy_x_1- = case happyOut17 happy_x_1 of { happy_var_1 -> - happyIn8- (happy_var_1- )}--happyReduce_19 = happySpecReduce_3 4# happyReduction_19-happyReduction_19 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "to" [happy_var_1,happy_var_3]- )}}--happyReduce_20 = happySpecReduce_3 4# happyReduction_20-happyReduction_20 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "+" [happy_var_1,happy_var_3]- )}}--happyReduce_21 = happySpecReduce_3 4# happyReduction_21-happyReduction_21 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "-" [happy_var_1,happy_var_3]- )}}--happyReduce_22 = happySpecReduce_3 4# happyReduction_22-happyReduction_22 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "*" [happy_var_1,happy_var_3]- )}}--happyReduce_23 = happySpecReduce_3 4# happyReduction_23-happyReduction_23 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "div" [happy_var_1,happy_var_3]- )}}--happyReduce_24 = happySpecReduce_3 4# happyReduction_24-happyReduction_24 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "idiv" [happy_var_1,happy_var_3]- )}}--happyReduce_25 = happySpecReduce_3 4# happyReduction_25-happyReduction_25 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "mod" [happy_var_1,happy_var_3]- )}}--happyReduce_26 = happySpecReduce_3 4# happyReduction_26-happyReduction_26 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "=" [happy_var_1,happy_var_3]- )}}--happyReduce_27 = happySpecReduce_3 4# happyReduction_27-happyReduction_27 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "!=" [happy_var_1,happy_var_3]- )}}--happyReduce_28 = happySpecReduce_3 4# happyReduction_28-happyReduction_28 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "<" [happy_var_1,happy_var_3]- )}}--happyReduce_29 = happySpecReduce_3 4# happyReduction_29-happyReduction_29 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "<=" [happy_var_1,happy_var_3]- )}}--happyReduce_30 = happySpecReduce_3 4# happyReduction_30-happyReduction_30 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call ">" [happy_var_1,happy_var_3]- )}}--happyReduce_31 = happySpecReduce_3 4# happyReduction_31-happyReduction_31 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call ">=" [happy_var_1,happy_var_3]- )}}--happyReduce_32 = happySpecReduce_3 4# happyReduction_32-happyReduction_32 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "<<" [happy_var_1,happy_var_3]- )}}--happyReduce_33 = happySpecReduce_3 4# happyReduction_33-happyReduction_33 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call ">>" [happy_var_1,happy_var_3]- )}}--happyReduce_34 = happySpecReduce_3 4# happyReduction_34-happyReduction_34 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "is" [happy_var_1,happy_var_3]- )}}--happyReduce_35 = happySpecReduce_3 4# happyReduction_35-happyReduction_35 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "eq" [happy_var_1,happy_var_3]- )}}--happyReduce_36 = happySpecReduce_3 4# happyReduction_36-happyReduction_36 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "ne" [happy_var_1,happy_var_3]- )}}--happyReduce_37 = happySpecReduce_3 4# happyReduction_37-happyReduction_37 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "lt" [happy_var_1,happy_var_3]- )}}--happyReduce_38 = happySpecReduce_3 4# happyReduction_38-happyReduction_38 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "le" [happy_var_1,happy_var_3]- )}}--happyReduce_39 = happySpecReduce_3 4# happyReduction_39-happyReduction_39 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "gt" [happy_var_1,happy_var_3]- )}}--happyReduce_40 = happySpecReduce_3 4# happyReduction_40-happyReduction_40 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "ge" [happy_var_1,happy_var_3]- )}}--happyReduce_41 = happySpecReduce_3 4# happyReduction_41-happyReduction_41 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "and" [happy_var_1,happy_var_3]- )}}--happyReduce_42 = happySpecReduce_3 4# happyReduction_42-happyReduction_42 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "or" [happy_var_1,happy_var_3]- )}}--happyReduce_43 = happySpecReduce_3 4# happyReduction_43-happyReduction_43 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "not" [happy_var_1,happy_var_3]- )}}--happyReduce_44 = happySpecReduce_3 4# happyReduction_44-happyReduction_44 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "union" [happy_var_1,happy_var_3]- )}}--happyReduce_45 = happySpecReduce_3 4# happyReduction_45-happyReduction_45 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "intersect" [happy_var_1,happy_var_3]- )}}--happyReduce_46 = happySpecReduce_3 4# happyReduction_46-happyReduction_46 happy_x_3- happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn8- (call "except" [happy_var_1,happy_var_3]- )}}--happyReduce_47 = happySpecReduce_2 4# happyReduction_47-happyReduction_47 happy_x_2- happy_x_1- = case happyOut8 happy_x_2 of { happy_var_2 -> - happyIn8- (call "uplus" [happy_var_2]- )}--happyReduce_48 = happySpecReduce_2 4# happyReduction_48-happyReduction_48 happy_x_2- happy_x_1- = case happyOut8 happy_x_2 of { happy_var_2 -> - happyIn8- (call "uminus" [happy_var_2]- )}--happyReduce_49 = happySpecReduce_2 4# happyReduction_49-happyReduction_49 happy_x_2- happy_x_1- = case happyOut8 happy_x_2 of { happy_var_2 -> - happyIn8- (call "not" [happy_var_2]- )}--happyReduce_50 = happySpecReduce_1 4# happyReduction_50-happyReduction_50 happy_x_1- = case happyOut21 happy_x_1 of { happy_var_1 -> - happyIn8- (happy_var_1- )}--happyReduce_51 = happySpecReduce_1 4# happyReduction_51-happyReduction_51 happy_x_1- = case happyOutTok happy_x_1 of { (TInteger happy_var_1) -> - happyIn8- (Aint happy_var_1- )}--happyReduce_52 = happySpecReduce_1 4# happyReduction_52-happyReduction_52 happy_x_1- = case happyOutTok happy_x_1 of { (TFloat happy_var_1) -> - happyIn8- (Afloat happy_var_1- )}--happyReduce_53 = happySpecReduce_1 5# happyReduction_53-happyReduction_53 happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - happyIn9- ([happy_var_1]- )}--happyReduce_54 = happySpecReduce_3 5# happyReduction_54-happyReduction_54 happy_x_3- happy_x_2- happy_x_1- = case happyOut9 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn9- (happy_var_1++[happy_var_3]- )}}--happyReduce_55 = happySpecReduce_2 6# happyReduction_55-happyReduction_55 happy_x_2- happy_x_1- = case happyOut11 happy_x_2 of { happy_var_2 -> - happyIn10- (happy_var_2- )}--happyReduce_56 = happySpecReduce_2 6# happyReduction_56-happyReduction_56 happy_x_2- happy_x_1- = case happyOut12 happy_x_2 of { happy_var_2 -> - happyIn10- (happy_var_2- )}--happyReduce_57 = happySpecReduce_3 6# happyReduction_57-happyReduction_57 happy_x_3- happy_x_2- happy_x_1- = case happyOut10 happy_x_1 of { happy_var_1 -> - case happyOut11 happy_x_3 of { happy_var_3 -> - happyIn10- (happy_var_1 . happy_var_3- )}}--happyReduce_58 = happySpecReduce_3 6# happyReduction_58-happyReduction_58 happy_x_3- happy_x_2- happy_x_1- = case happyOut10 happy_x_1 of { happy_var_1 -> - case happyOut12 happy_x_3 of { happy_var_3 -> - happyIn10- (happy_var_1 . happy_var_3- )}}--happyReduce_59 = happySpecReduce_3 7# happyReduction_59-happyReduction_59 happy_x_3- happy_x_2- happy_x_1- = case happyOut7 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn11- (\x -> Ast "for" [happy_var_1,Avar "$",happy_var_3,x]- )}}--happyReduce_60 = happyReduce 5# 7# happyReduction_60-happyReduction_60 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut7 happy_x_1 of { happy_var_1 -> - case happyOut7 happy_x_3 of { happy_var_3 -> - case happyOut8 happy_x_5 of { happy_var_5 -> - happyIn11- (\x -> Ast "for" [happy_var_1,happy_var_3,happy_var_5,x]- ) `HappyStk` happyRest}}}--happyReduce_61 = happyReduce 5# 7# happyReduction_61-happyReduction_61 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut11 happy_x_1 of { happy_var_1 -> - case happyOut7 happy_x_3 of { happy_var_3 -> - case happyOut8 happy_x_5 of { happy_var_5 -> - happyIn11- (\x -> happy_var_1(Ast "for" [happy_var_3,Avar "$",happy_var_5,x])- ) `HappyStk` happyRest}}}--happyReduce_62 = happyReduce 7# 7# happyReduction_62-happyReduction_62 (happy_x_7 `HappyStk`- happy_x_6 `HappyStk`- happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut11 happy_x_1 of { happy_var_1 -> - case happyOut7 happy_x_3 of { happy_var_3 -> - case happyOut7 happy_x_5 of { happy_var_5 -> - case happyOut8 happy_x_7 of { happy_var_7 -> - happyIn11- (\x -> happy_var_1(Ast "for" [happy_var_3,happy_var_5,happy_var_7,x])- ) `HappyStk` happyRest}}}}--happyReduce_63 = happySpecReduce_3 8# happyReduction_63-happyReduction_63 happy_x_3- happy_x_2- happy_x_1- = case happyOut7 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn12- (\x -> Ast "let" [happy_var_1,happy_var_3,x]- )}}--happyReduce_64 = happyReduce 5# 8# happyReduction_64-happyReduction_64 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut12 happy_x_1 of { happy_var_1 -> - case happyOut7 happy_x_3 of { happy_var_3 -> - case happyOut8 happy_x_5 of { happy_var_5 -> - happyIn12- (\x -> happy_var_1(Ast "let" [happy_var_3,happy_var_5,x])- ) `HappyStk` happyRest}}}--happyReduce_65 = happySpecReduce_2 9# happyReduction_65-happyReduction_65 happy_x_2- happy_x_1- = case happyOut8 happy_x_2 of { happy_var_2 -> - happyIn13- (\x -> Ast "predicate" [happy_var_2,x]- )}--happyReduce_66 = happySpecReduce_0 9# happyReduction_66-happyReduction_66 = happyIn13- (id- )--happyReduce_67 = happySpecReduce_3 10# happyReduction_67-happyReduction_67 happy_x_3- happy_x_2- happy_x_1- = case happyOut15 happy_x_3 of { happy_var_3 -> - happyIn14- ((\x -> Ast "sortTuple" (x:(fst happy_var_3)),- \x -> Ast "sort" (x:(snd happy_var_3)))- )}--happyReduce_68 = happySpecReduce_0 10# happyReduction_68-happyReduction_68 = happyIn14- ((id,id)- )--happyReduce_69 = happySpecReduce_2 11# happyReduction_69-happyReduction_69 happy_x_2- happy_x_1- = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut16 happy_x_2 of { happy_var_2 -> - happyIn15- (([happy_var_1],[happy_var_2])- )}}--happyReduce_70 = happyReduce 4# 11# happyReduction_70-happyReduction_70 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - case happyOut16 happy_x_4 of { happy_var_4 -> - happyIn15- (((fst happy_var_1)++[happy_var_3],(snd happy_var_1)++[happy_var_4])- ) `HappyStk` happyRest}}}--happyReduce_71 = happySpecReduce_1 12# happyReduction_71-happyReduction_71 happy_x_1- = happyIn16- (Avar "ascending"- )--happyReduce_72 = happySpecReduce_1 12# happyReduction_72-happyReduction_72 happy_x_1- = happyIn16- (Avar "descending"- )--happyReduce_73 = happySpecReduce_0 12# happyReduction_73-happyReduction_73 = happyIn16- (Avar "ascending"- )--happyReduce_74 = happyReduce 4# 13# happyReduction_74-happyReduction_74 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOutTok happy_x_3 of { (QName happy_var_3) -> - happyIn17- (call "element" [Avar happy_var_3]- ) `HappyStk` happyRest}--happyReduce_75 = happyReduce 4# 13# happyReduction_75-happyReduction_75 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOutTok happy_x_3 of { (QName happy_var_3) -> - happyIn17- (call "attribute" [Avar happy_var_3]- ) `HappyStk` happyRest}--happyReduce_76 = happyReduce 6# 14# happyReduction_76-happyReduction_76 (happy_x_6 `HappyStk`- happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut19 happy_x_1 of { happy_var_1 -> - case happyOut20 happy_x_3 of { happy_var_3 -> - case happyOutTok happy_x_5 of { (QName happy_var_5) -> - happyIn18- (if head happy_var_1 == Astring happy_var_5- then Ast "element_construction" (happy_var_1++[Ast "append" happy_var_3])- else parseError [TError ("Unmatched tags in element construction: "- ++(show (head happy_var_1))++" '"++happy_var_5++"'")]- ) `HappyStk` happyRest}}}--happyReduce_77 = happyReduce 5# 14# happyReduction_77-happyReduction_77 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut19 happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_4 of { (QName happy_var_4) -> - happyIn18- (if head happy_var_1 == Astring happy_var_4- then Ast "element_construction" (happy_var_1++[Ast "append" []])- else parseError [TError ("Unmatched tags in element construction: "- ++(show (head happy_var_1))++" '"++happy_var_4++"'")]- ) `HappyStk` happyRest}}--happyReduce_78 = happySpecReduce_2 14# happyReduction_78-happyReduction_78 happy_x_2- happy_x_1- = case happyOut19 happy_x_1 of { happy_var_1 -> - happyIn18- (Ast "element_construction" (happy_var_1++[Ast "append" []])- )}--happyReduce_79 = happyReduce 7# 14# happyReduction_79-happyReduction_79 (happy_x_7 `HappyStk`- happy_x_6 `HappyStk`- happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut8 happy_x_3 of { happy_var_3 -> - case happyOut9 happy_x_6 of { happy_var_6 -> - happyIn18- (Ast "element_construction" [happy_var_3,Ast "attributes" [],concatenateAll happy_var_6]- ) `HappyStk` happyRest}}--happyReduce_80 = happyReduce 7# 14# happyReduction_80-happyReduction_80 (happy_x_7 `HappyStk`- happy_x_6 `HappyStk`- happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut8 happy_x_3 of { happy_var_3 -> - case happyOut9 happy_x_6 of { happy_var_6 -> - happyIn18- (Ast "attribute_construction" [happy_var_3,concatenateAll happy_var_6]- ) `HappyStk` happyRest}}--happyReduce_81 = happyReduce 5# 14# happyReduction_81-happyReduction_81 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOutTok happy_x_2 of { (QName happy_var_2) -> - case happyOut9 happy_x_4 of { happy_var_4 -> - happyIn18- (Ast "element_construction" [Astring happy_var_2,Ast "attributes" [],concatenateAll happy_var_4]- ) `HappyStk` happyRest}}--happyReduce_82 = happyReduce 5# 14# happyReduction_82-happyReduction_82 (happy_x_5 `HappyStk`- happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOutTok happy_x_2 of { (QName happy_var_2) -> - case happyOut9 happy_x_4 of { happy_var_4 -> - happyIn18- (Ast "attribute_construction" [Astring happy_var_2,concatenateAll happy_var_4]- ) `HappyStk` happyRest}}--happyReduce_83 = happySpecReduce_2 15# happyReduction_83-happyReduction_83 happy_x_2- happy_x_1- = case happyOutTok happy_x_2 of { (QName happy_var_2) -> - happyIn19- ([Astring happy_var_2,Ast "attributes" []]- )}--happyReduce_84 = happySpecReduce_3 15# happyReduction_84-happyReduction_84 happy_x_3- happy_x_2- happy_x_1- = case happyOutTok happy_x_2 of { (QName happy_var_2) -> - case happyOut23 happy_x_3 of { happy_var_3 -> - happyIn19- ([Astring happy_var_2,Ast "attributes" happy_var_3]- )}}--happyReduce_85 = happySpecReduce_3 16# happyReduction_85-happyReduction_85 happy_x_3- happy_x_2- happy_x_1- = case happyOut9 happy_x_2 of { happy_var_2 -> - happyIn20- ([concatenateAll happy_var_2]- )}--happyReduce_86 = happySpecReduce_1 16# happyReduction_86-happyReduction_86 happy_x_1- = case happyOutTok happy_x_1 of { (TString happy_var_1) -> - happyIn20- ([Astring happy_var_1]- )}--happyReduce_87 = happySpecReduce_1 16# happyReduction_87-happyReduction_87 happy_x_1- = case happyOutTok happy_x_1 of { (XMLtext happy_var_1) -> - happyIn20- ([Astring happy_var_1]- )}--happyReduce_88 = happySpecReduce_1 16# happyReduction_88-happyReduction_88 happy_x_1- = case happyOut18 happy_x_1 of { happy_var_1 -> - happyIn20- ([happy_var_1]- )}--happyReduce_89 = happyReduce 4# 16# happyReduction_89-happyReduction_89 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut20 happy_x_1 of { happy_var_1 -> - case happyOut9 happy_x_3 of { happy_var_3 -> - happyIn20- (happy_var_1++[concatenateAll happy_var_3]- ) `HappyStk` happyRest}}--happyReduce_90 = happySpecReduce_2 16# happyReduction_90-happyReduction_90 happy_x_2- happy_x_1- = case happyOut20 happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { (TString happy_var_2) -> - happyIn20- (happy_var_1++[Astring happy_var_2]- )}}--happyReduce_91 = happySpecReduce_2 16# happyReduction_91-happyReduction_91 happy_x_2- happy_x_1- = case happyOut20 happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { (XMLtext happy_var_2) -> - happyIn20- (happy_var_1++[Astring happy_var_2]- )}}--happyReduce_92 = happySpecReduce_2 16# happyReduction_92-happyReduction_92 happy_x_2- happy_x_1- = case happyOut20 happy_x_1 of { happy_var_1 -> - case happyOut18 happy_x_2 of { happy_var_2 -> - happyIn20- (happy_var_1++[happy_var_2]- )}}--happyReduce_93 = happySpecReduce_1 17# happyReduction_93-happyReduction_93 happy_x_1- = case happyOut22 happy_x_1 of { happy_var_1 -> - happyIn21- (if length happy_var_1 == 1 then head happy_var_1 else Ast "append" happy_var_1- )}--happyReduce_94 = happySpecReduce_1 18# happyReduction_94-happyReduction_94 happy_x_1- = case happyOutTok happy_x_1 of { (TString happy_var_1) -> - happyIn22- (if happy_var_1=="" then [] else [Astring happy_var_1]- )}--happyReduce_95 = happySpecReduce_3 18# happyReduction_95-happyReduction_95 happy_x_3- happy_x_2- happy_x_1- = case happyOut9 happy_x_2 of { happy_var_2 -> - happyIn22- ([concatenateAll happy_var_2]- )}--happyReduce_96 = happySpecReduce_2 18# happyReduction_96-happyReduction_96 happy_x_2- happy_x_1- = case happyOut22 happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { (TString happy_var_2) -> - happyIn22- (if happy_var_2=="" then happy_var_1 else happy_var_1++[Astring happy_var_2]- )}}--happyReduce_97 = happyReduce 4# 18# happyReduction_97-happyReduction_97 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut22 happy_x_1 of { happy_var_1 -> - case happyOut9 happy_x_3 of { happy_var_3 -> - happyIn22- (happy_var_1++[concatenateAll happy_var_3]- ) `HappyStk` happyRest}}--happyReduce_98 = happySpecReduce_3 19# happyReduction_98-happyReduction_98 happy_x_3- happy_x_2- happy_x_1- = case happyOutTok happy_x_1 of { (QName happy_var_1) -> - case happyOut21 happy_x_3 of { happy_var_3 -> - happyIn23- ([Ast "pair" [Astring happy_var_1,happy_var_3]]- )}}--happyReduce_99 = happyReduce 4# 19# happyReduction_99-happyReduction_99 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut23 happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { (QName happy_var_2) -> - case happyOut21 happy_x_4 of { happy_var_4 -> - happyIn23- (happy_var_1++[Ast "pair" [Astring happy_var_2,happy_var_4]]- ) `HappyStk` happyRest}}}--happyReduce_100 = happySpecReduce_1 20# happyReduction_100-happyReduction_100 happy_x_1- = case happyOut27 happy_x_1 of { happy_var_1 -> - happyIn24- (Ast "step" (happy_var_1 "child_step" (Avar "."))- )}--happyReduce_101 = happySpecReduce_2 20# happyReduction_101-happyReduction_101 happy_x_2- happy_x_1- = case happyOut27 happy_x_2 of { happy_var_2 -> - happyIn24- (Ast "step" (happy_var_2 "attribute_step" (Avar "."))- )}--happyReduce_102 = happySpecReduce_2 20# happyReduction_102-happyReduction_102 happy_x_2- happy_x_1- = case happyOut27 happy_x_1 of { happy_var_1 -> - case happyOut25 happy_x_2 of { happy_var_2 -> - happyIn24- (Ast "step" [happy_var_2 (Ast "step" (happy_var_1 "child_step" (Avar ".")))]- )}}--happyReduce_103 = happySpecReduce_3 20# happyReduction_103-happyReduction_103 happy_x_3- happy_x_2- happy_x_1- = case happyOut27 happy_x_2 of { happy_var_2 -> - case happyOut25 happy_x_3 of { happy_var_3 -> - happyIn24- (Ast "step" (map happy_var_3 (happy_var_2 "attribute_step" (Avar ".")))- )}}--happyReduce_104 = happySpecReduce_1 21# happyReduction_104-happyReduction_104 happy_x_1- = case happyOut26 happy_x_1 of { happy_var_1 -> - happyIn25- (happy_var_1- )}--happyReduce_105 = happySpecReduce_2 21# happyReduction_105-happyReduction_105 happy_x_2- happy_x_1- = case happyOut25 happy_x_1 of { happy_var_1 -> - case happyOut26 happy_x_2 of { happy_var_2 -> - happyIn25- (happy_var_2 . happy_var_1- )}}--happyReduce_106 = happySpecReduce_2 22# happyReduction_106-happyReduction_106 happy_x_2- happy_x_1- = case happyOut27 happy_x_2 of { happy_var_2 -> - happyIn26- (\e -> Ast "step" (happy_var_2 "child_step" e)- )}--happyReduce_107 = happySpecReduce_3 22# happyReduction_107-happyReduction_107 happy_x_3- happy_x_2- happy_x_1- = case happyOut27 happy_x_3 of { happy_var_3 -> - happyIn26- (\e -> Ast "step" (happy_var_3 "attribute_step" e)- )}--happyReduce_108 = happySpecReduce_3 22# happyReduction_108-happyReduction_108 happy_x_3- happy_x_2- happy_x_1- = case happyOut27 happy_x_3 of { happy_var_3 -> - happyIn26- (\e -> Ast "step" (happy_var_3 "descendant_step" e)- )}--happyReduce_109 = happyReduce 4# 22# happyReduction_109-happyReduction_109 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut27 happy_x_4 of { happy_var_4 -> - happyIn26- (\e -> Ast "step" (happy_var_4 "attribute_descendant_step" e)- ) `HappyStk` happyRest}--happyReduce_110 = happySpecReduce_2 22# happyReduction_110-happyReduction_110 happy_x_2- happy_x_1- = happyIn26- (\e -> Ast "step" [Ast "parent_step" [e]]- )--happyReduce_111 = happySpecReduce_1 23# happyReduction_111-happyReduction_111 happy_x_1- = case happyOut28 happy_x_1 of { happy_var_1 -> - happyIn27- (\t e -> [happy_var_1 t e]- )}--happyReduce_112 = happyReduce 4# 23# happyReduction_112-happyReduction_112 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOut27 happy_x_1 of { happy_var_1 -> - case happyOut8 happy_x_3 of { happy_var_3 -> - happyIn27- (\t e -> (happy_var_1 t e)++[happy_var_3]- ) `HappyStk` happyRest}}--happyReduce_113 = happySpecReduce_1 24# happyReduction_113-happyReduction_113 happy_x_1- = case happyOut29 happy_x_1 of { happy_var_1 -> - happyIn28- (\t e -> happy_var_1 t e- )}--happyReduce_114 = happySpecReduce_1 24# happyReduction_114-happyReduction_114 happy_x_1- = happyIn28- (\t e -> Ast t [Astring "*",e]- )--happyReduce_115 = happySpecReduce_1 24# happyReduction_115-happyReduction_115 happy_x_1- = case happyOutTok happy_x_1 of { (QName happy_var_1) -> - happyIn28- (\t e -> Ast t [Astring happy_var_1,e]- )}--happyReduce_116 = happySpecReduce_1 25# happyReduction_116-happyReduction_116 happy_x_1- = case happyOut7 happy_x_1 of { happy_var_1 -> - happyIn29- (\_ _ -> happy_var_1- )}--happyReduce_117 = happySpecReduce_1 25# happyReduction_117-happyReduction_117 happy_x_1- = happyIn29- (\_ e -> e- )--happyReduce_118 = happySpecReduce_3 25# happyReduction_118-happyReduction_118 happy_x_3- happy_x_2- happy_x_1- = case happyOut9 happy_x_2 of { happy_var_2 -> - happyIn29- (\t e -> if e == Avar "."- then concatenateAll happy_var_2- else Ast "context" [e,Astring t,concatenateAll happy_var_2]- )}--happyReduce_119 = happySpecReduce_2 25# happyReduction_119-happyReduction_119 happy_x_2- happy_x_1- = happyIn29- (\_ _ -> call "empty" []- )--happyReduce_120 = happyReduce 4# 25# happyReduction_120-happyReduction_120 (happy_x_4 `HappyStk`- happy_x_3 `HappyStk`- happy_x_2 `HappyStk`- happy_x_1 `HappyStk`- happyRest)- = case happyOutTok happy_x_1 of { (QName happy_var_1) -> - case happyOut9 happy_x_3 of { happy_var_3 -> - happyIn29- (\t e -> if e == Avar "."- then call happy_var_1 happy_var_3- else Ast "context" [e,Astring t,call happy_var_1 happy_var_3]- ) `HappyStk` happyRest}}--happyReduce_121 = happySpecReduce_3 25# happyReduction_121-happyReduction_121 happy_x_3- happy_x_2- happy_x_1- = case happyOutTok happy_x_1 of { (QName happy_var_1) -> - happyIn29- (\_ e -> call happy_var_1 (if e == Avar "." then [] else [e])- )}--happyNewToken action sts stk [] =- happyDoAction 71# notHappyAtAll action sts stk []--happyNewToken action sts stk (tk:tks) =- let cont i = happyDoAction i tk action sts stk tks in- case tk of {- RETURN -> cont 1#;- SOME -> cont 2#;- EVERY -> cont 3#;- IF -> cont 4#;- THEN -> cont 5#;- ELSE -> cont 6#;- LB -> cont 7#;- RB -> cont 8#;- LP -> cont 9#;- RP -> cont 10#;- LSB -> cont 11#;- RSB -> cont 12#;- TO -> cont 13#;- PLUS -> cont 14#;- MINUS -> cont 15#;- TIMES -> cont 16#;- DIV -> cont 17#;- IDIV -> cont 18#;- MOD -> cont 19#;- TEQ -> cont 20#;- TNE -> cont 21#;- TLT -> cont 22#;- TLE -> cont 23#;- TGT -> cont 24#;- TGE -> cont 25#;- PRE -> cont 26#;- POST -> cont 27#;- IS -> cont 28#;- SEQ -> cont 29#;- SNE -> cont 30#;- SLT -> cont 31#;- SLE -> cont 32#;- SGT -> cont 33#;- SGE -> cont 34#;- AND -> cont 35#;- OR -> cont 36#;- NOT -> cont 37#;- UNION -> cont 38#;- INTERSECT -> cont 39#;- EXCEPT -> cont 40#;- FOR -> cont 41#;- LET -> cont 42#;- IN -> cont 43#;- COMMA -> cont 44#;- ASSIGN -> cont 45#;- WHERE -> cont 46#;- ORDER -> cont 47#;- BY -> cont 48#;- ASCENDING -> cont 49#;- DESCENDING -> cont 50#;- ELEMENT -> cont 51#;- ATTRIBUTE -> cont 52#;- STAG -> cont 53#;- ETAG -> cont 54#;- SATISFIES -> cont 55#;- ATSIGN -> cont 56#;- SLASH -> cont 57#;- QName happy_dollar_dollar -> cont 58#;- DECLARE -> cont 59#;- FUNCTION -> cont 60#;- VARIABLE -> cont 61#;- AT -> cont 62#;- DOTS -> cont 63#;- DOT -> cont 64#;- SEMI -> cont 65#;- Variable happy_dollar_dollar -> cont 66#;- XMLtext happy_dollar_dollar -> cont 67#;- TInteger happy_dollar_dollar -> cont 68#;- TFloat happy_dollar_dollar -> cont 69#;- TString happy_dollar_dollar -> cont 70#;- _ -> happyError' (tk:tks)- }--happyError_ tk tks = happyError' (tk:tks)--newtype HappyIdentity a = HappyIdentity a-happyIdentity = HappyIdentity-happyRunIdentity (HappyIdentity a) = a--instance Monad HappyIdentity where- return = HappyIdentity- (HappyIdentity p) >>= q = q p--happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b-happyThen = (>>=)-happyReturn :: () => a -> HappyIdentity a-happyReturn = (return)-happyThen1 m k tks = (>>=) m (\a -> k a tks)-happyReturn1 :: () => a -> b -> HappyIdentity a-happyReturn1 = \a tks -> (return) a-happyError' :: () => [Token] -> HappyIdentity a-happyError' = HappyIdentity . parseError--parse tks = happyRunIdentity happySomeParser where- happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x))--happySeq = happyDontSeq----- Abstract Syntax Tree for XQueries-data Ast = Ast String [Ast]- | Avar String- | Aint Int- | Afloat Float- | 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" []---data Token- = RETURN | SOME | EVERY | IF | THEN | ELSE | LB | RB | LP | RP | LSB | RSB- | TO | PLUS | MINUS | TIMES | DIV | IDIV | MOD- | 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- | FUNCTION | VARIABLE |AT | DOT | DOTS | TokenEOF | PRE | POST | IS- | QName String | Variable String | XMLtext String | TInteger Int- | TFloat Float | 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"---tokenList :: [(Token,String)]-tokenList = [(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"),(SEQ,"eq"),(SNE,"ne"),(SLT,"lt"),(SLE,"le"),(SGT,"gt"),(SGE,"ge"),(AND,"and"),- (OR,"or"),(NOT,"not"),(UNION,"union"),(INTERSECT,"intersect"),(EXCEPT,"except"),- (FOR,"for"),(LET,"let"),(IN,"in"),(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"),- (AT,"at"),(DOTS,".."),(DOT,"."),(SEMI,";")]---parseError tk = error (case tk of- ((TError s):_) -> "Parse error: "++s- _ -> "Parse error: "++(foldr (\a r -> (show a)++" "++r) "" (take 20 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 = (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 (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 [] "" = []-lexer [] _ = [ TError "Unexpected end of input" ]-lexer (' ':'>':' ':cs) n = TGT : lexer cs n-lexer (c:cs) n- | isSpace c = lexer cs n- | isAlpha 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 = 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 = 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 (c:cs) n = TError ("Illegal character: '"++[c,'\'']) : lexer cs n---lexNum :: String -> String -> [Token]-lexNum cs n = if null rest || head rest /= '.'- then TInteger (read k) : lexer rest n- else let (m,rest2) = span isDigit (tail rest)- val::Float = read (k++('.':m))- in case rest2 of- ('e':rest3) -> let (exp,rest4) = span isDigit rest3- in (TFloat (val*10^(read exp))) : lexer rest4 n- _ -> (TFloat val) : lexer rest2 n- where (k,rest) = span isDigit cs---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-lexString ('{':cs) s n = (TString s) : LSB : (lexer cs ('{':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 (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- in (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- "where" -> WHERE- "order" -> ORDER- "by" -> BY- "ascending" -> ASCENDING- "descending" -> DESCENDING- "element" -> ELEMENT- "attribute" -> ATTRIBUTE- "satisfies" -> SATISFIES- "declare" -> DECLARE- "function" -> FUNCTION- "variable" -> VARIABLE- "at" -> AT- "eq" -> SEQ- "ne" -> SNE- "lt" -> SLT- "le" -> SLE- "gt" -> SGT- "ge" -> SGE- "is" -> IS- var -> QName var- ) : lexer rest n-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command line>" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}--- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp --{-# LINE 28 "templates/GenericTemplate.hs" #-}---data Happy_IntList = HappyCons Int# Happy_IntList------{-# LINE 49 "templates/GenericTemplate.hs" #-}--{-# LINE 59 "templates/GenericTemplate.hs" #-}--{-# LINE 68 "templates/GenericTemplate.hs" #-}--infixr 9 `HappyStk`-data HappyStk a = HappyStk a (HappyStk a)---------------------------------------------------------------------------------- starting the parse--happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll---------------------------------------------------------------------------------- Accepting the parse---- If the current token is 0#, it means we've just accepted a partial--- parse (a %partial parser). We must ignore the saved token on the top of--- the stack in this case.-happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =- happyReturn1 ans-happyAccept j tk st sts (HappyStk ans _) = - (happyTcHack j (happyTcHack st)) (happyReturn1 ans)---------------------------------------------------------------------------------- Arrays only: do the next action----happyDoAction i tk st- = {- nothing -}--- case action of- 0# -> {- nothing -}- happyFail i tk st- -1# -> {- nothing -}- happyAccept i tk st- n | (n <# (0# :: Int#)) -> {- nothing -}-- (happyReduceArr ! rule) i tk st- where rule = (I# ((negateInt# ((n +# (1# :: 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)- else False- action | check = indexShortOffAddr happyTable off_i- | otherwise = indexShortOffAddr happyDefActions st--{-# LINE 127 "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- 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#------data HappyAddr = HappyA# Addr#------------------------------------------------------------------------------------- HappyState data type (not arrays)--{-# LINE 170 "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--- trace "shifting the error token" $- happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)--happyShift new_state i tk st sts stk =- happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)---- happyReduce is specialised for the common cases.--happySpecReduce_0 i fn 0# tk st sts stk- = happyFail 0# tk st sts stk-happySpecReduce_0 nt fn j tk st@((action)) sts stk- = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)--happySpecReduce_1 i fn 0# tk st sts stk- = happyFail 0# tk st sts stk-happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')- = let r = fn v1 in- happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))--happySpecReduce_2 i fn 0# tk st sts stk- = happyFail 0# tk st sts stk-happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')- = let r = fn v1 v2 in- happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))--happySpecReduce_3 i fn 0# tk st sts stk- = happyFail 0# tk st sts stk-happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')- = let r = fn v1 v2 v3 in- happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))--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- 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)--happyMonadReduce k nt fn 0# tk st sts stk- = 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))- 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))- drop_stk = happyDropStk k stk-- off = indexShortOffAddr happyGotoOffsets st1- off_i = (off +# nt)- new_state = indexShortOffAddr happyTable off_i-----happyDrop 0# l = l-happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t--happyDropStk 0# l = l-happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs---------------------------------------------------------------------------------- Moving to a new state after a reduction---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------------------------------------------------------------------------------------- Error recovery (0# is the error token)---- parse error if we are in recovery and we fail again-happyFail 0# tk old_st _ stk =--- trace "failing" $ - happyError_ tk--{- We don't need state discarding for our restricted implementation of- "error". In fact, it can cause some bogus parses, so I've disabled it- for now --SDM---- discard a state-happyFail 0# tk old_st (HappyCons ((action)) (sts)) - (saved_tok `HappyStk` _ `HappyStk` stk) =--- trace ("discarding state, depth " ++ show (length stk)) $- happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))--}---- Enter error recovery: generate an error token,--- 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)---- Internal happy errors:--notHappyAtAll = error "Internal Happy error\n"---------------------------------------------------------------------------------- Hack to get the typechecker to accept our action functions---happyTcHack :: Int# -> a -> a-happyTcHack x y = y-{-# INLINE happyTcHack #-}----------------------------------------------------------------------------------- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq--- otherwise it emits--- happySeq = happyDontSeq--happyDoSeq, happyDontSeq :: a -> b -> b-happyDoSeq a b = a `seq` b-happyDontSeq a b = b---------------------------------------------------------------------------------- Don't inline any functions from the template. GHC has a nasty habit--- of deciding to inline happyGoto everywhere, which increases the size of--- the generated parser quite a bit.---{-# NOINLINE happyDoAction #-}-{-# NOINLINE happyTable #-}-{-# NOINLINE happyCheck #-}-{-# NOINLINE happyActOffsets #-}-{-# NOINLINE happyGotoOffsets #-}-{-# NOINLINE happyDefActions #-}--{-# NOINLINE happyShift #-}-{-# NOINLINE happySpecReduce_0 #-}-{-# NOINLINE happySpecReduce_1 #-}-{-# NOINLINE happySpecReduce_2 #-}-{-# NOINLINE happySpecReduce_3 #-}-{-# NOINLINE happyReduce #-}-{-# NOINLINE happyMonadReduce #-}-{-# NOINLINE happyGoto #-}-{-# NOINLINE happyFail #-}---- end of Happy Template.
− Text/XML/HXQ/XQuery.hs
@@ -1,43 +0,0 @@-{----------------------------------------------------------------------------------------- The XQuery Compiler and Interpreter-- Programmer: Leonidas Fegaras-- Email: fegaras@cse.uta.edu-- Web: http://lambda.uta.edu/-- Creation: 03/22/08, last update: 07/24/08-- -- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.-- This material is provided as is, with absolutely no warranty expressed or implied.-- Any use is at your own risk. Permission is hereby granted to use or copy this program-- for any purpose, provided the above notices are retained on all copies.-----------------------------------------------------------------------------------------}----- | HXQ is a fast and space-efficient compiler from XQuery (the standard--- query language for XML) to embedded Haskell code. The translation is--- based on Haskell templates. It also provides an interpreter for--- evaluating ad-hoc XQueries read from input or from files and database connectivity using HDBC.--- For more information, look at <http://lambda.uta.edu/HXQ/>.-module Text.XML.HXQ.XQuery (- -- * The XML Data Representation- XTree(..), XSeq, Tag, AttList, putXSeq,- -- * The XQuery Compiler- xq, xe,- -- * The XQuery Interpreter- xquery, xfile,- -- * The XQuery Compiler with Database Connectivity- xqdb, connect, disconnect, prepareSQL, executeSQL,- -- * The XQuery Interpreter with Database Connectivity- xqueryDB, xfileDB,- -- * Shredding and Publishing XML Documents Using a Relational Database- shred, createIndex- ) where--import HXML(AttList)-import Text.XML.HXQ.XTree-import Text.XML.HXQ.Compiler-import Text.XML.HXQ.Interpreter-import Text.XML.HXQ.DB-import Text.XML.HXQ.DBConnect-import Database.HDBC(disconnect)
− Text/XML/HXQ/XTree.hs
@@ -1,147 +0,0 @@-{----------------------------------------------------------------------------------------- XML Trees (represented as rose trees)-- Programmer: Leonidas Fegaras-- Email: fegaras@cse.uta.edu-- Web: http://lambda.uta.edu/-- Creation: 05/01/08, last update: 07/24/08-- -- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.-- This material is provided as is, with absolutely no warranty expressed or implied.-- Any use is at your own risk. Permission is hereby granted to use or copy this program-- for any purpose, provided the above notices are retained on all copies.-----------------------------------------------------------------------------------------}---{-# OPTIONS_GHC -funbox-strict-fields #-}---module Text.XML.HXQ.XTree where--import System.IO-import XMLParse(XMLEvent(..))-import HXML(AttList)-import Text.XML.HXQ.Parser(Ast(..))-import Database.HDBC(Statement)---instance Eq Statement where x == y = False---type Tag = String----- | Rose tree representation of XML data.--- The Int in XElem is the preorder numbering used for the document order of nodes.-data XTree = XElem !Tag !AttList !Int XTree [XTree] -- ^ an XML tree node (element)- | XText !String -- ^ an XML tree leaf (PCDATA)- | XInt !Int -- ^ an XML tree leaf (int)- | XFloat !Float -- ^ an XML tree leaf (float)- | XBool !Bool -- ^ an XML tree leaf (boolean)- | XPI Tag String -- ^ processing instruction- | XGERef Tag -- ^ general entity reference- | XComment String -- ^ comment- | XError String -- ^ error report- | XStmt Statement -- ^ used internally to wrap an SQL statement- | XNoPad -- ^ marker for no padding in XSeq- deriving Eq---type XSeq = [XTree]---showAL :: AttList -> String-showAL = foldr (\(a,v) r -> " "++a++"=\""++v++"\""++r) []--showXT :: XTree -> Bool -> String-showXT e pad- = case e of- XElem tag al _ _ [] -> "<"++tag++showAL al++"/>"- XElem tag al _ _ xs -> "<"++tag++showAL al++">"++showXS xs++"</"++tag++">"- XText text -> p++text- XInt n -> p++show n- XFloat n -> p++show n- XBool v -> p++if v then "true" else "false"- XComment s -> "<!--"++s++"-->"- XPI n s -> "<?"++n++" "++s++">"- XError s -> error s- _ -> ""- where p = if pad then " " else ""--showXS :: XSeq -> String-showXS [] = ""-showXS (x:xs) = showXT x False ++ sXS xs- where sXS (XNoPad:x:xs) = (showXT x False) ++ sXS xs- sXS (x:xs) = (showXT x True) ++ sXS xs- sXS _ = ""--instance Show XTree where- show t = showXT t False----- | Print the XQuery result (which is a sequence of XML fragments) without buffering.-putXSeq :: XSeq -> IO ()-putXSeq xs = hSetBuffering stdout NoBuffering >> putStrLn (showXS xs)----{--------------- Build the rose tree from the XML stream ----------------------------}---type Stream = [XMLEvent]--noParentError = error "parent references are not supported yet"---- lazily materialize the SAX stream into a DOM tree-materializeWithoutParent :: Stream -> XTree-materializeWithoutParent stream- = XElem "document" [] 1 noParentError- [head (filter (\x -> case x of XElem _ _ _ _ _ -> True; _ -> False)- ((\(x,_,_)->x) (ml stream 2)))]- where m ((TextEvent t):xs) i = (XText t,xs,i)- m ((EmptyEvent n atts):xs) i = (XElem n atts i noParentError [],xs,i+1)- m ((StartEvent n atts):xs) i- = let (el,xs',i') = ml xs (i+1)- in (XElem n atts i noParentError el,xs',i')- m ((PIEvent n s):xs) i = (XPI n s,xs,i)- m ((CommentEvent s):xs) i = (XComment s,xs,i)- m ((GERefEvent n):xs) i = (XGERef n,xs,i)- 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 [] i = ([],[],i)- ml ((EndEvent n):xs) i = ([],xs,i)- ml xs i = let (e,xs',i') = m xs i- (el,xs'',i'') = ml xs' i'- in (e:el,xs'',i'')----- lazily materialize the SAX stream into a DOM tree that contains parent references--- Not used because it has space leaks for large documents-materializeWithParent :: Stream -> XTree-materializeWithParent stream = root- where root = XElem "document" [] 1 (error "Trying to access the root parent")- [head (filter (\x -> case x of XElem _ _ _ _ _ -> True; _ -> False)- ((\(x,_,_)->x) (ml stream 2 root)))]- m ((TextEvent t):xs) i _ = (XText t,xs,i)- m ((EmptyEvent n atts):xs) i p = (XElem n atts i p [],xs,i+1)- m ((StartEvent n atts):xs) i p- = let (el,xs',i') = ml xs (i+1) node- node = XElem n atts i p el- in (node,xs',i')- m ((PIEvent n s):xs) i _ = (XPI n s,xs,i)- m ((CommentEvent s):xs) i _ = (XComment s,xs,i)- m ((GERefEvent n):xs) i _ = (XGERef n,xs,i)- 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 [] i _ = ([],[],i)- ml ((EndEvent n):xs) i _ = ([],xs,i)- ml xs i p = let (e,xs',i') = m xs i p- (el,xs'',i'') = ml xs' i' p- in (e:el,xs'',i'')---materialize :: Stream -> XTree-materialize = materializeWithoutParent
XQueryParser.y view
@@ -4,7 +4,7 @@ - Programmer: Leonidas Fegaras - Email: fegaras@cse.uta.edu - Web: http://lambda.uta.edu/-- Creation: 02/15/08, last update: 07/24/08+- Creation: 02/15/08, last update: 08/12/08 - - Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved. - This material is provided as is, with absolutely no warranty expressed or implied.@@ -88,6 +88,7 @@ '..' { DOTS } '.' { DOT } ';' { SEMI }+ ':' { COLON } 'Variable' { Variable $$ } 'XMLtext' { XMLtext $$ } 'Integer' { TInteger $$ }@@ -118,16 +119,19 @@ def :: { Ast } def : expr { $1 } | 'declare' 'variable' var ':=' expr { Ast "variable" [$3,$5] }- | 'declare' 'function' 'QName'+ | 'declare' 'function' qname '(' params ')' '{' expr '}' { Ast "function" ([Avar $3,$8]++$5) }- | 'declare' 'function' 'QName'+ | 'declare' 'function' qname '(' ')' '{' expr '}' { Ast "function" [Avar $3,$7] } +qname :: { String }+qname : 'QName' { $1 }+ | 'QName' ':' 'QName' { $1++":"++$3 }+ params :: { [ Ast ] } params : var { [$1] } | params ',' var { $1++[$3] } - var :: { Ast } var : 'Variable' { Avar $1 } @@ -218,27 +222,27 @@ | {- empty -} { Avar "ascending" } computed :: { Ast }-computed : 'element' '(' 'QName' ')' { call "element" [Avar $3] }- | 'attribute' '(' 'QName' ')' { call "attribute" [Avar $3] }+computed : 'element' '(' qname ')' { call "element" [Avar $3] }+ | 'attribute' '(' qname ')' { call "attribute" [Avar $3] } element :: { Ast }-element : stag '>' content '</' 'QName' '>' { if head $1 == Astring $5+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+ | 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] }+ | '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] }+stag : '<' qname { [Astring $2,Ast "attributes" []] }+ | '<' qname attributes { [Astring $2,Ast "attributes" $3] } content :: { [ Ast ] } content : '{' expl '}' { [concatenateAll $2] }@@ -260,34 +264,48 @@ | stringc '{' expl '}' { $1++[concatenateAll $3] } attributes :: { [ Ast ] }-attributes : 'QName' '=' string { [Ast "pair" [Astring $1,$3]] }- | attributes 'QName' '=' string { $1++[Ast "pair" [Astring $2,$4]] }+attributes : qname '=' string { [Ast "pair" [Astring $1,$3]] }+ | attributes qname '=' string { $1++[Ast "pair" [Astring $2,$4]] } full_path :: { Ast }-full_path : predicate_step { Ast "step" ($1 "child_step" (Avar ".")) }- | '@' predicate_step { Ast "step" ($2 "attribute_step" (Avar ".")) }- | predicate_step path { Ast "step" [$2 (Ast "step" ($1 "child_step" (Avar ".")))] }- | '@' predicate_step path { Ast "step" (map $3 ($2 "attribute_step" (Avar "."))) }+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 : '/' predicate_step { \e -> Ast "step" ($2 "child_step" e) }- | '/' '@' predicate_step { \e -> Ast "step" ($3 "attribute_step" e) }- | '/' '/' predicate_step { \e -> Ast "step" ($3 "descendant_step" e) }- | '/' '/' '@' predicate_step { \e -> Ast "step" ($4 "attribute_descendant_step" e) }- | '/' '..' { \e -> Ast "step" [Ast "parent_step" [e]] }+step : '/' simple_step predicates { \e -> $2 "child" e $3 }+ | '/' '@' simple_step predicates { \e -> $3 "attribute" e $4 }+ | '/' '/' simple_step predicates { \e -> $3 "descendant-or-self" e $4 }+ | '/' '/' '@' simple_step predicates { \e -> $4 "attribute-descendant" e $5 }+ | '/' '..' { \e -> Ast "step" [Avar "parent",Astring "*",e] } -predicate_step :: { String -> Ast -> [ Ast ] }-predicate_step : simple_step { \t e -> [$1 t e] }- | predicate_step '[' expr ']' { \t e -> ($1 t e)++[$3] }+predicates :: { [ Ast ] }+predicates : predicates '[' expr ']' { $1 ++ [$3] }+ | {- empty -} { [] } -simple_step :: { String -> Ast -> Ast }-simple_step : primary_expr { \t e -> $1 t e }- | '*' { \t e -> Ast t [Astring "*",e] }- | 'QName' { \t e -> Ast t [Astring $1,e] }+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 }@@ -296,10 +314,10 @@ then concatenateAll $2 else Ast "context" [e,Astring t,concatenateAll $2] } | '(' ')' { \_ _ -> call "empty" [] }- | 'QName' '(' expl ')' { \t e -> if e == Avar "."+ | qname '(' expl ')' { \t e -> if e == Avar "." then call $1 $3 else Ast "context" [e,Astring t,call $1 $3] }- | 'QName' '(' ')' { \_ e -> call $1 (if e == Avar "." then [] else [e]) }+ | qname '(' ')' { \_ e -> call $1 (if e == Avar "." then [] else [e]) } { @@ -359,13 +377,17 @@ concatenateAll _ = call "empty" [] +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 | 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+ | ATTRIBUTE | STAG | ETAG | SATISFIES | ATSIGN | SLASH | DECLARE | SEMI | COLON | FUNCTION | VARIABLE |AT | DOT | DOTS | TokenEOF | PRE | POST | IS | QName String | Variable String | XMLtext String | TInteger Int | TFloat Float | TString String | TError String@@ -396,7 +418,7 @@ (BY,"by"),(ASCENDING,"ascending"),(DESCENDING,"descending"),(ELEMENT,"element"), (ATTRIBUTE,"attribute"),(STAG,"</"),(ETAG,"/>"),(SATISFIES,"satisfies"),(ATSIGN,"@"), (SLASH,"/"),(DECLARE,"declare"),(FUNCTION,"function"),(VARIABLE,"variable"),- (AT,"at"),(DOTS,".."),(DOT,"."),(SEMI,";")]+ (AT,"at"),(DOTS,".."),(DOT,"."),(SEMI,";"),(COLON,":")] parseError tk = error (case tk of@@ -437,7 +459,7 @@ isQN :: Char -> Bool-isQN c = elem c "_:-" || isDigit c || isAlpha c+isQN c = elem c "_-" || isDigit c || isAlpha c isVar :: Char -> Bool@@ -501,6 +523,7 @@ 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 @@ -524,6 +547,8 @@ '\'':n -> (TString s) : (lexer cs n) _ -> lexString cs (s++"\'") m lexString ('{':cs) s n = (TString s) : LSB : (lexer cs ('{':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" ]
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 -ihxml-0.2 --make Temp.hs -o $file+ghc -O2 --make Temp.hs -o $file
+ compile.bat view
@@ -0,0 +1,11 @@+rem -- compile an XQuery file+rem usage: compile xquery-file object-file++@echo off++xquery -c %1+set FILE="%2"+if "%2"=="" goto Exit+set FILE="a.out"+:Exit+ghc -O2 --make Temp.hs -o %FILE%
+ data/a.xml view
@@ -0,0 +1,29 @@+<a>+ <b>+ <d>K1</d>+ <c>test1</c>+ <c>test12</c>+ <c>test13</c>+ </b>+ <b>+ <d>K2</d>+ <c>test2</c>+ </b>+ <b>+ <d>K3</d>+ <c>test3</c>+ </b>+ <b>+ <d>K4</d>+ <c>test4</c>+ </b>+ <b>+ <d>K5</d>+ <c>test5</c>+ </b>+ <b>+ <d>K6</d>+ <c>test6</c>+ <c>test22</c>+ </b>+</a>
+ data/c.xml view
@@ -0,0 +1,25 @@+<a x="aa" y="bb cc">+<n>title</n>+ <b>+ <d>1</d>+ <c v="aa">test1</c>+ </b>+ <b>+ <d>2</d>+ <c>test2</c>+ </b>+ <b>+ <d>3</d>+ <c>test3</c>+ </b>+ <b>+ <d>4</d>+ <c>test4</c>+ <e><x><y>NN</y>AA</x>BB<x>CC</x></e>+ </b>+ <b>+ <d>5</d>+ <c>test5</c>+ <e><x><y>N</y>A</x>B<x>C</x></e>+ </b>+ </a>
+ data/test-results.txt view
@@ -0,0 +1,211 @@+Query 1:+10+ Query 2:+100+ Query 3:+1 2 3+ Query 4:+1 2 3+ Query 5:+4 5 6 7 8 9+ Query 6:+<a>12<b>4 4518</b></a>+ Query 7:+<a x="12 534"/>+ Query 8:+100+ Query 9:+5050.0+ Query 10:+50.5+ Query 11:+true+ Query 12:+ + Query 13:+6+ Query 14:+<z><a>1</a><a>2</a><a>3</a></z>+ Query 15:+3 4+ Query 20:+5 6 6 7 7 8+ Query 21:+<a>1 4</a><a>1 5</a><a>2 4</a><a>2 5</a><a>3 4</a><a>3 5</a>+ Query 24:+<b>1</b><b>2</b>+ Query 24.1:+<b>1</b>+ Query 25:+<a><b>2</b></a>+ Query 27:+<a>11 12 23 24</a>+ Query 28:+<a>1 2</a>+ Query 29:+58+ Query 30:+29+ Query 31:+1+ Query 32:+3628800+ Query 33:+<a>1</a><a>2</a><a>3</a>+ Query 34:+aa+ Query 35:+aa bb cc+ Query 36:+aa bb cc aa+ Query 37:+<b>+ <d>K6</d> + <c>test6</c> + <c>test22</c> + </b>+ Query 38:+<d>4</d><d>5</d>+ Query 39:+<n>title</n>+ Query 40:+<c>test4</c><c>test5</c>+ Query 40.1:+<c v="aa">test1</c><c>test2</c><c>test3</c><c>test4</c><c>test5</c>+ Query 41:+<d>K3</d>+ Query 42:+<b>+ <d>K3</d> + <c>test3</c> + </b>+ Query 43:+<b>+ <d>K3</d> + <c>test3</c> + </b>+ Query 44:+test1 test12 test13+ Query 45:+<c>test3</c>+ Query 46:+<c>test3</c>+ Query 47:+<c>test3</c>+ Query 48:+<d>K3</d><c>test3</c>+ Query 49:+<d>K3</d>+ Query 50:+<c>test3</c>+ Query 51:+<b>+ <d>K3</d> + <c>test3</c> + </b><d>K3</d><c>test3</c>+ Query 52:+<b>+ <d>4</d> + <c>test4</c> + <e><x><y>NN</y> AA</x> BB<x>CC</x></e> + </b><d>4</d><c>test4</c><e><x><y>NN</y> AA</x> BB<x>CC</x></e><x><y>NN</y> AA</x><y>NN</y><x>CC</x>+ Query 53:+<c>test1</c><c>test12</c><c>test13</c><c>test2</c><c>test3</c><c>test4</c><c>test5</c><c>test6</c><c>test22</c>+ Query 54:+<c>test1</c><c>test12</c><c>test13</c><d>K1</d><c>test2</c><d>K2</d><c>test3</c><d>K3</d><c>test4</c><d>K4</d><c>test5</c><d>K5</d><c>test6</c><c>test22</c><d>K6</d>+ Query 55:+<c v="aa">test1</c><c>test2</c><c>test3</c><c>test4</c><c>test5</c>+ Query 56:+<b>+ <d>K3</d> + <c>test3</c> + </b>+ Query 57:+<b>+ <d>K6</d> + <c>test6</c> + <c>test22</c> + </b>+ Query 58:+<d>K3</d><d>K3</d>+ Query 59:+<d>K3</d> @+ Query 60:+<d>K3</d> @+ Query 61:+4+ Query 62:+4+ Query 63:+<a><c>test1</c><c>test12</c><c>test13</c><c>test2</c><c>test3</c><c>test4</c><c>test5</c><c>test6</c><c>test22</c> 1 2 3</a>+ Query 64:+<result><d>K3</d></result>+ Query 65:+<k><d>K1</d><c>test1</c><d>K1</d></k><k><d>K1</d><c>test12</c><d>K1</d></k><k><d>K1</d><c>test13</c><d>K1</d></k><k><d>K2</d><c>test2</c><d>K2</d></k><k><d>K3</d><c>test3</c><d>K3</d></k><k><d>K4</d><c>test4</c><d>K4</d></k><k><d>K5</d><c>test5</c><d>K5</d></k><k><d>K6</d><c>test6</c><d>K6</d></k><k><d>K6</d><c>test22</c><d>K6</d></k>+ Query 66:+<k><c>test1</c><d>K1</d></k><k><c>test12</c><d>K1</d></k><k><c>test13</c><d>K1</d></k><k><c>test2</c><d>K2</d></k><k><c>test3</c><d>K3</d></k><k><c>test4</c><d>K4</d></k><k><c>test5</c><d>K5</d></k><k><c>test6</c><d>K6</d></k><k><c>test22</c><d>K6</d></k>+ Query 67:+<result><a><c>test1</c><c>test12</c><c>test13</c><d>K1</d></a><a><c>test2</c><d>K2</d></a><a><c>test3</c><d>K3</d></a><a><c>test4</c><d>K4</d></a><a><c>test5</c><d>K5</d></a><a><c>test6</c><c>test22</c><d>K6</d></a></result>+ Query 68:+<c>test5</c>+ Query 69:+<a><c>test3</c> test3</a>+ Query 70:+<a>test3 K3</a>+ Query 71:+true+ Query 72:+false+ Query 73:+2 2 3 4 4 4 6 6 7 8+ Query 74:+test1 test12 test13 test2 test3 test4 test5 test6 test22+ Query 75:+test6 test22 test5 test4 test3 test2 test1 test12 test13+ Query 76:+3 1 1 1 1 2+ Query 77:+<d>K2</d> 1<d>K3</d> 1<d>K4</d> 1<d>K5</d> 1<d>K6</d> 2<d>K1</d> 3+ Query 78:+1 1 1 2 1 3 1 4 1 5 2 1 2 2 2 3 2 4 2 5 3 1 3 2 3 3 3 4 3 5 4 1 4 2 4 3 4 4 4 5 5 1 5 2 5 3 5 4 5 5 + Query 80:+<gpa>3.5</gpa>+ Query 81:+Ashraf Aboulnaga 4.0 + Anastasia Ailamaki 4.0 + Jim Basney 4.0 + Neoklis Polyzotis 4.0 + Sridhar Reddy 4.0 + Kevin Beyer 4.0 + Adam Butts 4.0 + Todd Bezenek 4.0 + Gregory Deych 4.0 + Fan Yang 4.0 + Donko Donjerkovic 4.0 + Glenn Fung 4.0 + Andrew Glew 4.0 + Anurag Gupta 4.0 + Jussara Almeida 3.5 + Leonidas Galanis 3.5 + Chee-Yong Chan 3.5 + Richard Chang 3.5 + Mark Dreyfuss 3.5 + Paul Finley 3.5 + David Finton 3.5 + James Gast 3.5 ++ Query 82:+<a>1 2</a>+ Query 83:+<d>K2</d>+ Query 84:+<c>test3</c>+ Query 85:+<result><b>+ <d>K2</d> + <c>test2</c> + </b><b>+ <d>K2</d> + <c>test2</c> + </b></result>+
+ data/test.xq view
@@ -0,0 +1,234 @@+(:---------------------------------------------------------------++Various XQueries tests. There results are in test-results.txt++----------------------------------------------------------------:)++declare function q ($n,$q) { "Query {$n}:\n{$q}\n" }+;+q(1,(1 to 100)[10])+;+q(2,(1 to 100)[last()])+;+q(3,(1 to 100)[position()<4])+;+q(4,(1 to 100)[.<4])+;+q(5,(1 to 100)[.>3 and .<10])+;+q(6,<a>{1}2<b>{3+1,4}5{6*3}</b></a>)+;+q(7,<a x="1{2,5}3{3+1}"/>)+;+q(8,count(1 to 100))+;+q(9,sum(1 to 100))+;+q(10,avg(1 to 100))+;+q(11,contains("abcde","cd"))+;+q(12,contains("abcde","ce"))+;+q(13,if 1<2 then if 3>4 then 5 else 6 else 7)+;+q(14,<z>{for $a in (1,2,3) return <a>{$a}</a>}</z>)+;+q(15,for $v in (1,2,3,4) where not($v < 3) return $v)+;+q(20,for $x in (1,2,3), $y in (4,5) return $x+$y)+;+q(21,for $x in (1,2,3), $y in (4,5) return <a>{$x,$y}</a>)+;+q(24,(<A><a><b>1</b></a><a><b>2</b></a></A>)/a/b)+;+q(24.1,(<a><b>1</b></a>)//b[.=1])+;+q(25,(<A><a><b>1</b></a><a><b>2</b></a></A>)//*[b="2"])+;+q(27,<a>{+ for $a in (1,2) return $a+10,+ for $b in (3,4) return $b+20+}</a>)+;+declare function f ($x,$y) { <a>{$x,$y}</a> };+q(28,f(1,2))+;+declare function g ($x,$y) { $x*$y };+declare function f ($x,$y) { $x+$y };+q(29,g(f(5,g(6,f(3,1))),2))+;+declare function f ($x,$y) { $x+$y*2 };+declare function g ($x,$y) { f($x,$y)*3-f($y,$x) };+q(30,g(4,5))+;+declare function fact ($n) { if $n <= 1 then 1 else $n*fact($n-1) };+q(31,fact(1))+;+q(32,fact(10))+;+declare function f ($x) { for $v in $x return <a>{$v}</a> };+q(33,f((1,2,3)))+;+q(34,doc("data/c.xml")/a/@x)+;+q(35,doc("data/c.xml")/a/@*)+;+q(36,doc("data/c.xml")//@*)+;+q(37,doc("data/a.xml")/a/b[d = "K6"])+;+q(38,doc("data/c.xml")/a/b[e]/d)+;+q(39,doc("data/c.xml")/a[b/e]/n)+;+q(40,doc("data/c.xml")/a/b[e and d]/c)+;+q(40.1,doc("data/c.xml")/a/b[f | d]/c)+;+q(41,(doc("data/a.xml")/a/*/d)[3])+;+q(42,doc("data/a.xml")/a/b[c="test3"])+;+q(43,doc("data/a.xml")/a/b[d="K3"])+;+q(44,doc("data/a.xml")/a/*[d="K1"]/c/text())+;+q(45,doc("data/a.xml")/a/b[c="test3"][d="K3"]/c)+;+q(46,doc("data/a.xml")/a/b[c="test3" and d="K3"]/c)+;+q(47,doc("data/a.xml")/a/b[c!="test5" and d="K3"]/c)+;+q(48,doc("data/a.xml")/a/b[d="K3"][c="test3"]/*)+;+q(49,doc("data/a.xml")//*[d="K3"]/d)+;+q(50,doc("data/a.xml")//*[d="K3"]/c)+;+q(51,doc("data/a.xml")/a/b[d="K3"]//*)+;+q(52,doc("data/c.xml")//b[d="4"]//*)+;+q(53,for $x in doc("data/a.xml")/a/b/c return $x)+;+q(54,for $x in doc("data/a.xml")/a/b return ($x/c,$x/d))+;+q(55,doc("data/c.xml")/a/b/e/../c)+;+q(56,doc("data/a.xml")/a/b[d="K3"]/c/..)+;+q(57,doc("data/a.xml")/a/b/d[. = "K6"]/..)+;+q(58,for $v in doc("data/a.xml")/a/b+ where $v/d="K3"+ return ($v/d,$v/d))+;+q(59,for $x in doc("data/a.xml")/a/b+ where $x/c = "test3"+ return ($x/d,"@"))+;+q(60,for $x in doc("data/a.xml")/a/b[c = "test3"]+ return ($x/d,"@"))+;+q(61,for $x in doc("data/c.xml")/a/b+ where $x/c = "test3"+ return $x/d+1)+;+q(62,for $x in doc("data/c.xml")/a/b[c = "test3"]+ return $x/d+1)+;+q(63,<a>{+ for $x in doc("data/a.xml")/a/b+ return $x/c,+ for $a in (1,2,3) return $a+}</a>)+;+q(64,<result>{+ for $x in doc("data/a.xml")/a/b+ where $x/c = "test3"+ return $x/d+}</result>)+;+q(65,for $v in doc("data/a.xml")/a/b,+ $w in $v/c,+ $z in $v/d+return <k>{$v/d,$w,$z}</k>)+;+q(66,for $v in doc("data/a.xml")/a/b,+ $w in $v/c,+ $z in $v/d+return <k>{$w,$z}</k>)+;+q(67,<result>{+ for $v in doc("data/a.xml")/a/b+ return <a>{$v/c,$v/d}</a>+}</result>)+;+q(68,for $v in doc("data/a.xml")/a/b+ where $v/d="K5" and $v/c="test5"+ return $v/c)+;+q(69,for $v in doc("data/a.xml")/a/b+ where $v/d="K3"+ return <a>{ $v/c, for $w in $v/c return $w/text() }</a> )+;+q(70,for $v in doc("data/a.xml")/a/b+ where $v/d="K3"+ return <a>{ for $w in $v/c return $w/text(),+ for $w in $v/d return $w/text() + }</a> )+;+q(71,some $v in doc("data/a.xml")/a/b+ satisfies $v/d="K3" and $v/c="test5")+;+q(72,every $v in doc("data/a.xml")/a/b+ satisfies $v/d="K3" or $v/c="test5")+;+q(73,for $v in (3,2,6,4,7,8,2,4,6,4)+ order by $v+ return $v)+;+q(74,for $v in doc("data/a.xml")/a/b+ order by $v/d+ return $v/c/text())+;+q(75,for $v in doc("data/a.xml")/a/b+ order by $v/d descending, $v/c+ return $v/c/text())+;+q(76,for $v in doc("data/a.xml")/a/b+ return count($v/c))+;+q(77,for $v in doc("data/a.xml")/a/b+ order by count($v/c)+ return ($v/d,count($v/c)))+;+q(78,for $v in doc("data/c.xml")/a/b/d+ for $w in doc("data/c.xml")/a/b/d+ return ($v/text(),$w/text()," "))+;+q(80,for $s in doc("data/cs.xml")//gradstudent+ where $s//firstname="Leonidas"+ return $s/gpa)+;+q(81,for $s in doc("data/cs.xml")//gradstudent+ order by $s/gpa descending+ return ($s//firstname/text()," ",$s//lastname/text()," ",$s/gpa/text(),"\n"))+;+declare function f ($x,$y) { <a>{$x,$y}</a> };+q(82,f(1,2))+;+q(83,for $v in doc("data/a.xml")/a/b+ where some $w in $v/c+ satisfies $w="test2"+ return $v/d)+;+q(84,let $x := doc("data/a.xml")/a/b,+ $y := "K3"+ return $x[d = $y]/c)+;+q(85,(for $v in doc("data/a.xml")/a/b+ for $w in doc("data/a.xml")/a/b+ where $v/d=$w/d+ return <result>{$v,$w}</result>)[2])
+ data/testdb.xq view
@@ -0,0 +1,31 @@+(:---------------------------------------------------------------++Various XQueries that test database connectivity++----------------------------------------------------------------:)++declare function q ($n,$q) { "Query {$n}:\n{$q}\n" }+;+q(0,sql("select e.fname, e.lname from employee e, department d where e.dno=d.dnumber and d.dname=?","Research"))+;+q(1,publish('myDB','c')//gradstudent[.//lastname='Galanis']/gpa)+;+q(2,for $s in publish('myDB','c')//gradstudent where $s//lastname='Galanis' return $s//gpa)+;+q(3,publish('myDB','c')//department[deptname]//gradstudent[.//lastname='Galanis']/gpa)+;+q(4,publish('myDB','c')//department[deptname='Computer Sciences']//gradstudent[.//lastname='Galanis']/gpa)+;+q(5,publish('myDB','c')//department/*[.//lastname='Galanis']/gpa)+;+q(6,publish('myDB','c')//*[.//lastname='Galanis']/gpa)+;+q(7,publish('myDB','c')//department[deptname]/deptname)+;+q(8,publish('myDB','c')//gradstudent[.//lastname='Galanis']/../deptname)+;+q(9,for $s in publish('myDB','c')/department/gradstudent return $s/../deptname)+;+q(10,publish('myDB','s')//article[.//author='David Maier']//title)+;+q(11,publish('myDB','s')//article[.//author='David Maier'][initPage=35]/title)
− hxml-0.2/00-LICENSE.txt
@@ -1,22 +0,0 @@-LICENSE ("MIT-style")--Copyright (C) 2000, 2001, Joe English--Permission is hereby granted to use, copy, modify, distribute,-and license this software and its documentation for any purpose, provided-that existing copyright notices are retained in all copies and that this-notice is included in any distributions. No written agreement,-license, or royalty fee is required for any of the authorized uses.-Modifications to this software may be copyrighted by their authors-and need not follow the licensing terms described here, provided that-the new terms are clearly indicated on the first page of each file where-they apply.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT-SHALL THE AUTHORS OF THIS SOFTWARE BE LIABLE TO ANY PARTY FOR-DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES-ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION.--
− hxml-0.2/00-README.txt
@@ -1,57 +0,0 @@--$Id: 00-README.txt,v 1.3 2003/08/01 19:59:00 joe Exp $--5 Mar 2002--Announcing HXML version 0.2, a non-validating XML parser written in Haskell.--HXML is available at:-- <URL: http://www.flightlab.com/~joe/hxml >--The current version is 0.2, and is pre-beta quality.--HXML has been tested with GHC 6.0, GHC 5.02, NHC 1.10, and -various versions of Hugs 98.--Please contact Joe English <jenglish@flightlab.com> with-any questions, comments, or bug reports.--* * * KNOWN BUGS-- + The XML declaration is ignored.- + Unicode support is only as good as that provided- by the Haskell system (i.e., typically not very).- + Does not do any well-formedness or validity checks.- + Under Hugs 98 only, suffers a serious space fault.- + Does not support XML Namespaces.--* * * USAGE--Documentation in XML format is available in the 'doc' subdirectory,-along with a Haskell program which converts it into HTML.-Run 'make html' in that directory to build the HTML docs-with Hugs. doc/mkSite.hs also serves as an example of how-to use the library.--* * * INSTALLATION--Installation instructions depend on the Haskell system.-For Hugs, put the sources somewhere in the Hugs search path.-For NHC, just use 'hmake'.--For GHC, copy Makefile.dist to Makefile, edit as desired, and run- make library- make profiled-library ;# optional-Next, edit the file "hxml.conf.in" and replace @INSTDIR@-with the installation directory (i.e., wherever you extracted-the distribution). Finally, run- ghc-pkg --add hxml.conf.in-If all goes well, you may then use 'ghc -package hxml' to access-the library.--At some point, I'll add proper 'configure ; make ; make install' support.-Recommended procedures for doing this are still (Aug 2003) being hashed out-on various mailing lists.--* * * END.
− hxml-0.2/AssocList.hs
@@ -1,56 +0,0 @@----------------------------------------------------------------------------------- Module : AssocList.hs--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : provisional--- Portability : portable------ CVS : $Id: AssocList.hs,v 1.5 2002/10/12 01:58:56 joe Exp $-------------------------------------------------------------------------------------- Quick hack; need a stub FiniteMap implementation-----module AssocList - ( FM, unsafeLookup, lookupM, lookupWithDefault, empty- , insert , insertWith- ) where--import Prelude -- hiding (null,map,foldr,foldl,foldr1,foldl1,filter)--type FM k a = [(k,a)]--lookupM :: (Eq k) => FM k a -> k -> Maybe a-lookupM = flip Prelude.lookup--lookupWithDefault :: (Eq key) => FM key elt -> elt -> key -> elt-lookupWithDefault m d = maybe d id . lookupM m--unsafeLookup :: (Eq a) => FM a b -> a -> b-unsafeLookup m = maybe (error "Error: Not found") id . lookupM m--insertWith :: (Eq k) => (a -> a -> a) -> k -> a -> FM k a -> FM k a-insertWith _ key elt [] = [(key,elt)]-insertWith c key elt ((k,e):l)- | k == key = (k,c e elt):l- | otherwise = (k,e):insertWith c key elt l--insert :: (Eq k) => k -> a -> FM k a -> FM k a-insert = insertWith (\_old new -> new)--{---- GHC 'data' library convention:-addToFM_C :: (elt -> elt -> elt) -> FM key elt -> key -> elt -> FM key elt-addToFM :: FM key elt -> key -> elt -> FM key elt-lookupFM :: FM key elt -> key -> Maybe elt-lookupWithDefaultFM :: FM key elt -> elt -> key -> elt--}--empty :: FM a b-empty = []---- EOF --
− hxml-0.2/DTD.hs
@@ -1,218 +0,0 @@----------------------------------------------------------------------------------- Module : HXML.DTD--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : provisional--- Portability : portable------ CVS : $Id: DTD.hs,v 1.6 2002/10/12 01:58:57 joe Exp $-------------------------------------------------------------------------------------- | Data types for SGML and XML document type definitions.--- This is based on the SGML property set found in the DSSSL spec,--- section 9.6.------ History:--- [23 Jan 2000], taken from earlier work, [4 Jan 1997]-----module DTD where--import XML-import qualified AssocList as FM--type GI = Name -- generic identifier (element type name)-type DCN = Name -- data content notation name ---- | Content expression, parameterized over type of primitive tokens-data CE a =- Prim a -- ^ Primitive content token- | Rep (CE a) -- ^ Zero or more, '*' occurrence indicator- | Opt (CE a) -- ^ Optional, '?' occurrence indicator- | Plus (CE a) -- ^ One or more, '+' occurrence indicator- | Seq [(CE a)] -- ^ Sequence, ',' connector- | Or [(CE a)] -- ^ Alternation, '|' connector- | And [(CE a)] -- ^ Permutation, '&' connector- deriving Eq--data PrimitiveToken =- PCDATA -- ^ Parsed character data- | ELEMENT GI -- ^ Element- deriving Eq--type ModelGroup = CE PrimitiveToken-data CONTYPE = -- (element) content type- DC_EMPTY -- ^ declared content (also: CDATA, RCDATA in SGML)- | DC_ANY -- ^ "ANY"- | DC_MODELGRP ModelGroup- deriving Show--data ELEMTYPE = ELEMTYPE { -- element type definition- gi :: GI, -- ^ generic identifier- contype :: CONTYPE, -- ^ content type- omissibility:: (Bool,Bool), -- ^ omitstrt+omitend- inclusions :: [GI],- exclusions :: [GI] } deriving Show---- Missing: attdefs, srmap(nm); all from DTGABS--data ATT_TYPE = -- (dcltype/decl value type)- ATcdata- | ATentity- | ATentities- | ATid- | ATidref- | ATidrefs- | ATnmtoken -- %%% or name/number/nutoken- | ATnmtokens -- %%% or names/numbers/nutokens- | ATnotation [DCN] -- List of notation names- | ATenumerated [Name] -- nmtkgrp / name token group- deriving Show--data ATT_DV = -- attribute default value (dflttype/default value type)- ADVfixed String -- "#FIXED ..."- | ADVrequired -- "#REQUIRED"- | ADVimplied -- "#IMPLIED"- | ADVdefault String -- "..."- -- SGML only:- | ADVcurrent -- "#CURRENT"- | ADVconref -- "#CONREF"- deriving Show--data ATTDEF = ATTDEF { -- attribute definition- att_name :: Name,- att_type :: ATT_TYPE,- att_dv :: ATT_DV } deriving Show--type ATTSPEC = (Name,String) -- (attasgn/attribute assignment)----- --- Entities:-----type ExternalID = (Maybe PUBID, Maybe SYSID)-type PUBID = String-type SYSID = String--data ENTTYPE = -- entity type- ETtext -- SGML text entity- | ETcdata- | ETsdata- | ETndata- | ETsubdoc- | ETpi -- processing instruction entity--data EntityText =- EN_INTERNAL String -- entity.text/replacement text - | EN_EXTERNAL ExternalID -- entity.extid/external identifier- deriving Show--data Entity = Entity {- ename :: Name, -- name- etype :: ENTTYPE, -- enttype/entity type- etext :: EntityText, -- see above- edcn :: Maybe DCN, -- notname/notation name- eatts :: [ATTSPEC] -- atts/attributes-}--type EntityMap = FM.FM Name EntityText-predefinedEntities :: EntityMap-predefinedEntities = foldr (uncurry FM.insert) FM.empty predefinedGEs- where- (==>) = \a b -> (a,EN_INTERNAL b)- predefinedGEs = [- "lt" ==> "<",- "amp" ==> "&",- "gt" ==> ">",- "apos" ==> "'",- "quot" ==> "\"" ]--- --- Utility routine, used by scanner:-----expandInternalEntity :: EntityMap -> Name -> Maybe String-expandInternalEntity entities name = - case FM.lookupM entities name of- Just (EN_INTERNAL text) -> Just text- _ -> Nothing------- DTDS:----data DTD = DTD {- elements :: FM.FM Name ELEMTYPE, -- elemtps / element types- attlists :: FM.FM Name [ATTDEF], -- elemtype.attdefs- genents :: FM.FM Name EntityText, -- general entities- parments :: FM.FM Name EntityText, -- parameter entities- notations:: [DCN], -- nots/notations- dtdname :: Name -- name (document type name)-} deriving Show--emptyDTD :: DTD-emptyDTD = DTD {- elements = FM.empty,- attlists = FM.empty,- genents = predefinedEntities,- parments = FM.empty,- dtdname = "",- notations= []-} --declareParameterEntity,declareGeneralEntity :: Name -> EntityText -> DTD -> DTD-declareParameterEntity name entityText dtd =- dtd { parments = FM.insertWith keepOld name entityText (parments dtd) }- where keepOld old _new = old-declareGeneralEntity name entityText dtd =- dtd { genents = FM.insertWith keepOld name entityText (genents dtd) }- where keepOld old _new = old---- %%% DEAL WITH DUPLICATE DEFINITIONS HERE:-declareElements :: [GI] -> (Bool,Bool) -> CONTYPE -> ([GI],[GI]) -> DTD -> DTD-declareElements elementNames omissibility contentDefinition (incl,excl) dtd =- dtd { elements = foldl mkElement (elements dtd) elementNames }- where mkElement fm gi = FM.insert gi el fm where - el = ELEMTYPE {- gi = gi,- contype = contentDefinition,- omissibility = omissibility,- inclusions = incl,- exclusions = excl- }---- %%% DEAL WITH DUPLICATES:-declareAttlist :: [GI] -> [ATTDEF] -> DTD -> DTD-declareAttlist elementNames attdefs dtd =- dtd { attlists = foldl addAttdefs (attlists dtd) elementNames }- where addAttdefs fm gi = FM.insert gi attdefs fm--declareNotation :: DCN -> ExternalID -> DTD -> DTD-declareNotation dcn _unused dtd =- dtd { notations = dcn : notations dtd }---- Need srmaps::Dict[SRASSOC]+usemaps::Dict{-GI-}srmap(nm)|elemtype.srmap(nm)--- notation: name, extid, attdefs--instance Show PrimitiveToken where- showsPrec _ PCDATA = showString "#PCDATA"- showsPrec _ (ELEMENT gi) = showString gi--instance (Show prim) => Show (CE prim) where- showsPrec _ mg = pp mg where- pp (Prim p) = shows p- pp (Rep x) = shows x . showString "*"- pp (Opt x) = shows x . showString "?"- pp (Plus x) = shows x . showString "+"- pp (Seq x) = showgroup ", " x- pp (Or x) = showgroup " | " x- pp (And x) = showgroup " & " x- showgroup delim l = showString "(" . showl l . showString ")" where- showl [x] = shows x- showl (x:xs) = shows x . showString delim . showl xs- showl [] = showString "-- ERROR: empty model group! --"---- EOF --
− hxml-0.2/ETree.hs
@@ -1,44 +0,0 @@----------------------------------------------------------------------------------- Module : HXML.ETree--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable------ CVS : $Id: ETree.hs,v 1.3 2002/10/12 01:58:57 joe Exp $-------------------------------------------------------------------------------------- 11 Mar 2002------ Simplified XML representation with only the essential Infoset properties.-----module ETree(ETree, xmlToETree, etreeToXML) where--import XML-import Tree--data ETree- = Element Name AttList [ETree]- | Text String- deriving Show--xmlToETree :: XML -> ETree-xmlToETree = maybe fallback id . foldTree etree mcons [] where- etree (TXNode txt) _ = Just $ Text txt- etree (ELNode gi atts) c = Just $ Element gi atts c- etree RTNode (c:_) = Just c- etree _ _ = Nothing- mcons = maybe id (:)- fallback = Text "Error: ill-formed XML input"--etreeToXML :: ETree -> XML-etreeToXML = anaTree psi where- psi (Text txt) = (TXNode txt,[])- psi (Element gi atts content) = (ELNode gi atts,content)---- EOF --
− hxml-0.2/HXML.hs
@@ -1,38 +0,0 @@----------------------------------------------------------------------------------- Module : HXML--- Copyright : (C) 2001-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable------ Created : 1 Nov 2001--- CVS : $Id: HXML.hs,v 1.5 2002/10/12 01:58:57 joe Exp $-------------------------------------------------------------------------------------- | Package module for HXML -- just reexports all the public modules.-----module HXML - ( module XML- , module Tree- , module PrintXML- , module ETree-- , parseXML- ) where--import XML-import XMLParse-import Tree-import TreeBuild-import PrintXML-import ETree--parseXML :: String -> Tree XMLNode-parseXML = buildTree . parseDocument---- EOF --
− hxml-0.2/LLParsing.hs
@@ -1,110 +0,0 @@-{-# OPTIONS -fno-warn-missing-signatures #-}-{-# OPTIONS -fglasgow-exts #-}----------------------------------------------------------------------------------- Module : HXML.LLParsing--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable (wants rank-2 polymorphism but can live without it)------ CVS : $Id: LLParsing.hs,v 1.6 2002/10/12 01:58:57 joe Exp $-------------------------------------------------------------------------------------- 20 Jan 2000--- Simple, non-backtracking, no-lookahead parser combinators.--- Use with caution!-----module LLParsing- ( pTest , pCheck , pSym , pSucceed- ,(<|>),(<*>),(<$>),(<^>),(<$),(<*),(*>),(<?>),(<**>)- , pMaybe , pFoldr , pList , pSome , pChainr , pChainl, pTry- , pRun- ) where--infixl 3 <|>-infixl 4 <*>, <$>, <^>, <?>, <$, <*, *>, <**>--{- <H98> -}--- Use this for Haskell 98:-newtype P p = P p-{- </H98> -}--{- <H98EXT> -}-{---- Use this if the system supports rank-2 polymorphism:-newtype Parser sym res = P (forall a .- (res -> [sym] -> a) -- ok continuation- -> ([sym] -> a) -- failure continuation- -> ([sym] -> a) -- error continuation- -> [sym] -- input- -> a) -- result--pTest :: (a -> Bool) -> Parser a a-pCheck :: (a -> Maybe b) -> Parser a b-pSym :: (Eq a) => a -> Parser a a-pSucceed:: b -> Parser a b-(<|>) :: Parser a b -> Parser a b -> Parser a b -- union-(<*>) :: Parser a (b->c) -> Parser a b -> Parser a c -- sequence-(<$>) :: (b->c) -> Parser a b -> Parser a c -- application-(<$ ) :: c -> Parser a b -> Parser a c -- application, dropr-(<^>) :: Parser a b -> Parser a c -> Parser a (b,c) -- sequence-(<* ) :: Parser a b -> Parser a c -> Parser a b -- sequence, dropr-( *>) :: Parser a b -> Parser a c -> Parser a c -- sequence, dropl-(<?>) :: Parser a b -> b -> Parser a b -- optional-(<**>) :: Parser s b -> Parser s (b->a) -> Parser s a -- postfix application-pMaybe :: Parser s a -> Parser s (Maybe a)-pFoldr :: (a->b->b) -> b -> Parser s a -> Parser s b-pList :: Parser a b -> Parser a [b]-pSome :: Parser a b -> Parser a [b]-pChainr :: Parser a (b -> b -> b) -> Parser a b -> Parser a b-pChainl :: Parser a (b -> b -> b) -> Parser a b -> Parser a b-pRun :: Parser a b -> [a] -> Maybe (b,[a])--}-{- </H98EXT> -}--pTest pred = P (ptest pred)- where- ptest _p _o f _e [] = f []- ptest p ok f _e l@(c:cs)- | p c = ok c cs- | otherwise = f l--pSym a = pTest (a==)-pCheck cmf = P (pcheck cmf) where- pcheck _mf _ok f _e [] = f []- pcheck mf ok f _e cs@(c:s) = case (mf c) of- Just x -> ok x s- Nothing -> f cs--pTry (P pa) = P (\ok f _e i -> pa ok f (\ _i' -> f i) i)--pSucceed a = P (\ok _f _e -> ok a)-(P pa) <|> (P pb) = P (\ok f e -> pa ok (pb ok f e) e)-(P pa) <*> (P pb) = P (\ok f e -> pa (\a -> pb (ok . a) e e) f e)-(P pa) <?> a = P (\ok _f -> pa ok (ok a))-(P pa) <^> (P pb) = P (\ok f e -> pa (\a->pb(\b->ok (a,b)) e e) f e)-f <$> (P pb) = P (\ok -> pb (ok . f))-f <$ (P pb) = P (\ok -> pb (ok . const f))-pa <* pb = curry fst <$> pa <*> pb-pa *> pb = curry snd <$> pa <*> pb-pa <**> pb = (\x f -> f x) <$> pa <*> pb--pMaybe p = Just <$> p <|> pSucceed Nothing-pFoldr op e p = loop where loop = (op <$> p <*> loop) <?> e-pList = pFoldr (:) []-pSome p = (:) <$> p <*> pList p-pChainr op p = loop- where loop = p <**> ((flip <$> op <*> loop) <?> id)-pChainl op p = foldl ap <$> p <*> pList (flip <$> op <*> p)- where ap x f = f x--pRun (P p) = p just2 fail fail where- just2 x y = Just (x,y)- fail = const Nothing---- EOF --
− hxml-0.2/Misc.hs
@@ -1,62 +0,0 @@----------------------------------------------------------------------------------- Module : HXML.Misc--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable------ CVS : $Id: Misc.hs,v 1.8 2002/10/12 01:58:58 joe Exp $-------------------------------------------------------------------------------------- 21 Jan 2000--- Miscellaneous combinators that I find useful---- -module Misc where--errNYI :: String -> a-errNYI msg = error ("Not Yet Implemented: " ++ msg)---- Kleisli composition:-o :: (Monad m) => (b -> m c) -> (a -> m b) -> (a -> m c)-f `o` g = \x -> g x >>= f---- Some useful anamorphisms:-maybeStar, maybePlus :: (a -> Maybe a) -> a -> [a]-maybeStar f a = a : maybe [] (maybeStar f) (f a)-maybePlus f a = maybe [] (maybeStar f) (f a)---- Used to be in Haskell Prelude:-done :: Monad m => m ()-done = return ()---- H98: found in module Monad:-liftM2 :: (Monad m) => (b->c->d) -> m b -> m c -> m d-liftM2 op x y = x >>= \a -> y >>= \b -> return (op a b)---- H98: found in module Maybe:-maybeToList :: Maybe a -> [a]-maybeToList Nothing = []-maybeToList (Just a) = [a]---- ... other stuff-{- Removed by Leonidas Fegaras because it classes with the profiler-instance Monad ((->) s) where -- Reader Monad- return = const- f >>= g = \x -> g (f x) x--}--lift :: (b->c->d) -> (a->b) -> (a->c) -> (a->d)-lift f g h x = f (g x) (h x)--pair :: a -> b -> (a,b)-pair x y = (x,y)--wrap :: a -> [a]-wrap x = [x]---- EOF --
− hxml-0.2/PrintXML.hs
@@ -1,91 +0,0 @@----------------------------------------------------------------------------------- Module : HXML.PrintXML--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable------ CVS : $Id: PrintXML.hs,v 1.5 2002/10/12 01:58:58 joe Exp $----------------------------------------------------------------------------------module PrintXML - ( printXML, showXML- , printEvent, showEvent, showEvents, printEvents- ) where--import XML-import Tree-import TreeBuild-import XMLParse (XMLEvent(..))--printXML :: XML -> IO ()-printXML = printEvents . serializeTree--showXML :: XML -> String-showXML t = pp t [] where- pp (Tree nd children) k = case nd of- RTNode -> ppl children k- TXNode txt -> textEscape txt k- PINode tgt [] -> "<?" ++ tgt ++ "?>" ++ k- PINode tgt val -> "<?" ++ tgt ++ " " ++ val ++ "?>" ++ k- CXNode txt -> "<!--" ++ txt ++ "-->" ++ k- ENNode ename -> "&" ++ ename ++ ";" ++ k- ELNode gi attlist ->- let atts = showAttlist attlist- in case children of- [] -> "<" ++ gi ++ atts ++ "/>" ++ k- _ -> "<" ++ gi ++ atts ++ ">"- ++ ppl children ("</" ++ gi ++ "\n>" ++ k)- ppl [] k = k- ppl (x:xs) k = pp x (ppl xs k)--showEvent :: XMLEvent -> String-printEvent :: XMLEvent -> IO ()-showEvents :: [XMLEvent] -> String-printEvents :: [XMLEvent] -> IO ()--showEvents = concatMap showEvent-printEvent = putStr . showEvent-printEvents = mapM_ printEvent--showEvent (StartEvent gi atts) = "<" ++ gi ++ showAttlist atts ++ ">"-showEvent (EmptyEvent gi atts) = "<" ++ gi ++ showAttlist atts ++ "/>"-showEvent (EndEvent gi) = "</" ++ gi ++ "\n>"-showEvent (TextEvent txt) = textEscape txt []-showEvent (PIEvent tgt []) = "<?" ++ tgt ++ "?>"-showEvent (PIEvent tgt val) = "<?" ++ tgt ++ " " ++ val ++ "?>"-showEvent (GERefEvent name) = "&" ++ name ++ ";"-showEvent (CommentEvent txt) = "<--" ++ txt ++ "-->"-showEvent (ErrorEvent txt) = error txt--showAttlist :: [(Name,String)] -> String-showAttlist attlist = concat [' ':patt nm val | (nm,val) <- attlist]- where- vi = "="- patt nm val = nm ++ vi ++ "\"" ++ attvalEscape val "\""--textEscape, attvalEscape :: String -> ShowS--textEscape [] k = k-textEscape (c:cs) k =- case c of- '<' -> "<" ++ textEscape cs k- '>' -> ">" ++ textEscape cs k- '&' -> "&" ++ textEscape cs k- _ -> c : textEscape cs k--attvalEscape [] k = k-attvalEscape (c:cs) k =- case c of- '<' -> "<" ++ attvalEscape cs k- '>' -> ">" ++ attvalEscape cs k- '&' -> "&" ++ attvalEscape cs k- '\'' -> "'" ++ attvalEscape cs k- '\"' -> """ ++ attvalEscape cs k- _ -> c : attvalEscape cs k---- EOF --
− hxml-0.2/Tree.hs
@@ -1,73 +0,0 @@----------------------------------------------------------------------------------- Module : HXML.Tree--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable------ CVS : $Id: Tree.hs,v 1.9 2002/10/12 01:58:58 joe Exp $-------------------------------------------------------------------------------------- 7 Jan 2000-----module Tree where--data Tree a = Tree a [Tree a]- deriving Show------- Projections:----treeRoot :: Tree a -> a-treeChildren :: Tree a -> [Tree a]-treeRoot (Tree a _) = a-treeChildren (Tree _ c) = c--leafNode :: a -> Tree a-leafNode x = Tree x []---- preorderTree (Tree a c) = a : concatMap preorderTree c--- preorderTree = cataTree(\(x,bs) -> x : concat bs)-preorderTree :: Tree a -> [a]-preorderTree t = traverse t [] where- traverse (Tree a c) k = a : travlist c k- travlist (c:cs) k = traverse c (travlist cs k)- travlist [] k = k---- The usual polytypic routines:--mapTree :: (a -> b) -> Tree a -> Tree b-mapTree f (Tree a c) = Tree (f a) (map (mapTree f) c)--instance Functor Tree where fmap = mapTree---- type TreeF a b = (a, [b])-cataTree :: ((a, [b]) -> b) -> Tree a -> b -- (TreeF a b -> b) -> Tree a -> b-anaTree :: (b -> (a, [b])) -> b -> Tree a -- (b -> TreeF a b) -> b -> Tree a-cataTree f (Tree a c) = f (a,map (cataTree f) c)-anaTree g b = let (a,bs) = g b in Tree a (map (anaTree g) bs)---- A friendlier variant of cataTree:----foldTree :: (a -> b -> c) -> (c -> b -> b) -> b -> Tree a -> c-foldTree tree cons nil (Tree a c)- = tree a (foldr cons nil (map (foldTree tree cons nil) c))---- Downwards accumulation:----scanTree :: (a -> b -> a) -> a -> Tree b -> Tree a-scanTree op a (Tree b children)- = let a' = a `op` b in Tree a' (map (scanTree op a') children)---- A variant:----accumTree :: (a -> b -> (c, a)) -> a -> Tree b -> Tree c-accumTree op a (Tree b children)- = let (c,a') = a `op` b in Tree c (map (accumTree op a') children)---- EOF --
− hxml-0.2/TreeBuild.hs
@@ -1,69 +0,0 @@----------------------------------------------------------------------------------- Module : HXML.TreeBuild--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable------ CVS : $Id: TreeBuild.hs,v 1.7 2002/10/12 01:58:58 joe Exp $-------------------------------------------------------------------------------------- 30 Jan 2000-----module TreeBuild (buildTree, constructTree, serializeTree) where--import XMLParse-import XML-import Tree------- TODO: add basic error-checks: matching end-tags, ensure input exhausted------ %%% There is apparently a space leak here, but I can't find it.--- %%% Update 28 Feb 2000: There is a leak, but it's fixed--- %%% by a well-known GC implementation technique. Hugs 98 happens--- %%% not to implement this technique, but STG Hugs (and most other--- %%% Haskell systems) do implement it.--- %%% Thanks to Simon Peyton-Jones, Malcolm Wallace, Colin Runcinman--- %%% Mark Jones, and others for investigating this.--buildTree :: [XMLEvent] -> Tree XMLNode-buildTree = constructTree Tree (:) []--constructTree :: (XMLNode -> f -> t) -> (t -> f -> f) -> f -> [XMLEvent] -> t-constructTree tree cons nil events = let- pair x y = (x,y)- addNode nd children es = addTree (tree nd children) es- addLeaf nd es = addTree (tree nd nil) es- addTree t es = let (s,es') = build es in pair (cons t s) es'- build [] = pair nil []- build (e:es) = case e of- StartEvent gi atts -> let (c,es') = build es - in addNode (ELNode gi atts) c es'- EndEvent _ -> pair nil es- EmptyEvent gi atts -> addLeaf (ELNode gi atts) es- TextEvent s -> addLeaf (TXNode s) es- PIEvent tgt val -> addLeaf (PINode tgt val) es- CommentEvent txt -> addLeaf (CXNode txt) es- GERefEvent name -> addLeaf (ENNode name) es- ErrorEvent s -> error s -- %%% deal with this- in tree RTNode (fst (build events))--serializeTree :: Tree XMLNode -> [XMLEvent]-serializeTree tree = sn tree [] where- sn (Tree node content) k = case node of- RTNode -> sl content k- ELNode gi atts -> StartEvent gi atts : sl content (EndEvent gi : k)- TXNode txt -> TextEvent txt : k- PINode tgt val -> PIEvent tgt val : k- CXNode txt -> CommentEvent txt : k- ENNode name -> GERefEvent name : k- sl [] k = k- sl (x:xs) k = sn x (sl xs k)---- EOF --
− hxml-0.2/XML.hs
@@ -1,102 +0,0 @@----------------------------------------------------------------------------------- Module : HXML.XML--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable------ CVS : $Id: XML.hs,v 1.9 2002/10/12 01:58:59 joe Exp $-------------------------------------------------------------------------------------- 16 Jan 2000--- Basic XML data types-----module XML- ( XMLNode(..)- , Name, XML, AttList- , stringValue, nodeName- , xAttlist, xAttval- , attributes, attval- , xELNode, xTXNode, xPINode- ) where--import Tree--type Name = String -- %%% XMLNS makes this more complex-type GI = Name -- generic identifier, element type name-type AttList = [(Name,String)] -- attribute list-type XML = Tree XMLNode--data XMLNode =- RTNode -- root node- | ELNode GI AttList -- element node: GI, attributes- | TXNode String -- text node- | PINode Name String -- processing instruction (target,value)- | CXNode String -- comment node- | ENNode Name -- general entity reference-- -- XPath also defines:- -- ATNodeP Name String -- attribute node- -- NSNodeP Name {- prefix-} String {-URI-} -- namespace node- deriving Show--stringValue :: XML -> String -- [XPATH, 5]-stringValue nd@(Tree d _) = case d of- RTNode -> concat [sv | TXNode sv <- preorderTree nd] -- [XPATH 5.1]- ELNode _ _ -> concat [sv | TXNode sv <- preorderTree nd] -- [XPATH 5.2]- TXNode s -> s -- [XPATH 5.7]- PINode _ v -> v -- [XPATH 5.5]- CXNode s -> s -- [XPATH 5.6]- ENNode _ -> "" -- [not defined in XPATH]- -- ATNodeP _ v -> v -- [XPATH 5.3]- -- NSNodeP _ uri -> uri -- [XPATH 5.4]---- %%% need to fix this to account for [XMLNS]-nodeName :: XMLNode -> Maybe Name -- [XPATH, 5; "expanded-name"]-nodeName nd = case nd of- ELNode gi _ -> Just gi -- %%% Check [XMLNS]- PINode tgt _-> Just tgt -- [XPATH 5.5], pi target, null URI- ENNode name -> Just name -- [not defined in XPATH]- --ATNodeP n _-> Just n -- %%% Check [XMLNS]- --NSNodeP p _-> Just p -- [XPATH 5.4], ns prefix, null URI- RTNode -> Nothing -- [XPATH 5.1]- TXNode _ -> Nothing -- [XPATH 5.7]- CXNode _ -> Nothing -- [XPATH 5.6]------- Accessors:----xAttlist :: XMLNode -> AttList-xAttlist (ELNode _ attlist) = attlist-xAttlist _ = []--xAttval :: Name -> XMLNode -> Maybe String-xAttval name = lookup name . xAttlist--xELNode :: (Name -> AttList -> a) -> XMLNode -> Maybe a-xTXNode :: (String -> a) -> XMLNode -> Maybe a-xPINode :: (String -> String -> a) -> XMLNode -> Maybe a--xELNode f (ELNode gi atts) = Just (f gi atts)-xELNode _ _ = Nothing-xTXNode f (TXNode txt) = Just (f txt)-xTXNode _ _ = Nothing-xPINode f (PINode tgt val) = Just (f tgt val)-xPINode _ _ = Nothing------- Tree -----attributes :: XML -> AttList-attributes = xAttlist . treeRoot--attval :: Name -> XML -> Maybe String-attval name = xAttval name . treeRoot---- EOF --
− hxml-0.2/XMLParse.hs
@@ -1,278 +0,0 @@-{-# OPTIONS -fno-warn-missing-signatures #-}----------------------------------------------------------------------------------- Module : XMLParse--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable------ CVS : $Id: XMLParse.hs,v 1.9 2002/10/12 01:58:59 joe Exp $-------------------------------------------------------------------------------------- started 23 Jan 2000------ TODO: expand parameter entity references in DTD and parameter literals--- TODO: implement marked sections in DTD-----module XMLParse- ( XMLEvent(..)- , parseInstance, parseDTD, parseDocument- ) where--import XMLScanner-import LLParsing-import XML-import DTD-import Misc-import List(unfoldr)--parseInstance :: String -> [XMLEvent]--newtype UNPARSED = UNPARSED String -- Unparsed literal- deriving Show--replaceGERefs (UNPARSED s) = expandReferences DTD.predefinedEntities s-replacePERefs (UNPARSED s) = s -- %%% FIX-attributeValueLiteral = replaceGERefs <$> pLiteral-parameterLiteral = replacePERefs <$> pLiteral-systemLiteral = unparsed <$> pLiteral- where unparsed (UNPARSED s) = s---- External interface:--data XMLEvent =- StartEvent Name [(Name,String)] -- start-tag (gi, attspecs)- | EmptyEvent Name [(Name,String)] -- empty element tag (gi,attspecs)- | EndEvent Name -- end-tag (gi)- | TextEvent String -- character data (text)- | PIEvent Name String -- processing instruction (tgt value)- | GERefEvent Name -- general entity reference (ename)- | CommentEvent String -- comment- | ErrorEvent String -- error report- deriving (Read,Show)---- Too strict: parseInstance = fmap fst . pRun (pList instanceItem) . pcdataMode-parseInstance = unfoldr (pRun instanceItem) . pcdataMode-parseDTD = foldl (\a b->b a) emptyDTD . unfoldr (pRun dtdItem) . markupMode--parseDocument text = - case pRun prolog (pcdataMode text) of- Just (_, rest) -> unfoldr (pRun instanceItem) rest- Nothing -> [ErrorEvent "Error parsing prolog"] -- can't happen.---- Interface to scanner:--pDelim d = pTest (==d)-pKeyword kw = pTest (\d->case d of NAME n -> n == kw; _ -> False)-rniName kw = pTest (\d->case d of RNINAME n -> n == kw; _ -> False)-pName = pCheck (\d->case d of NAME n -> Just n ; _ -> Nothing)-pGEREF = pCheck (\d->case d of GEREF n -> Just n ; _ -> Nothing)-pPEREF = pCheck (\d->case d of PEREF n -> Just n ; _ -> Nothing)-pLiteral = pCheck literal where- literal (LITERAL s) = Just (UNPARSED s)- literal _ = Nothing-pCDATA = pCheck cdata where- cdata (CDATA txt) = Just txt- cdata (WS ws) = Just ws- cdata _ = Nothing---- Main grammar:---- dtdItem :: Parser Delimiter (DTD -> DTD)-dtdItem =- dtdDeclaration- <|> const id <$> processingInstruction -- %%% REPORT THESE- <|> const id <$> sgmlCommentDeclaration- <|> const id <$> pPEREF -- %%% FIX--dtdDeclaration =- pDelim MDO *> (- pKeyword "ELEMENT" *> elementDeclaration- <|> pKeyword "ATTLIST" *> attlistDeclaration- <|> pKeyword "ENTITY" *> entityDeclaration- <|> pKeyword "NOTATION" *> notationDeclaration- ) <* pDelim MDC--prolog =- pair <$> (ws *> pMaybe xmlDeclaration) <*> (ws *> pMaybe doctypeDeclaration)--ws = () <$ pList (pTest (\d -> case d of WS _ -> True ; _ -> False))--xmlDeclaration = processingInstruction--doctypeDeclaration = - pDelim MDO *> pKeyword "DOCTYPE" *> doctype <* pDelim MDC-doctype =- () <$ pName <* externalIdentifier {-pMaybe internalSubset-}------- Common constructs:-----elementNames =- wrap <$> pName <|> nameGroup-nameGroup =- (:) <$ pDelim GRPO <*> pName <*>- ( (:) <$ pDelim SEQ <*> pName <*> pList (pDelim SEQ *> pName)- <|> (:) <$ pDelim OR <*> pName <*> pList (pDelim OR *> pName)- <|> (:) <$ pDelim AND <*> pName <*> pList (pDelim AND *> pName)- <|> pSucceed []- ) <* pDelim GRPC--externalIdentifier =- pair Nothing- <$ pKeyword "SYSTEM" <*> pMaybe systemLiteral- <|> pair <$ pKeyword "PUBLIC"- <*> (Just <$> systemLiteral) <*> pMaybe systemLiteral- <|> pSucceed (Nothing,Nothing) -- implicit identifier---- This works for XML:-xmlCommentDeclaration =- pDelim MDOCOM *> pcdata <* pDelim COM <* pDelim MDC- where pcdata = pFoldr (++) [] pCDATA---- This works for SGML:-sgmlCommentDeclaration =- (++) <$ pDelim MDOCOM <*> (pcdata <* pDelim COM) <*> comments <* pDelim MDC- where pcdata = pFoldr (++) [] pCDATA- comments = pFoldr (++) [] (pDelim COM *> pcdata <* pDelim COM)--processingInstruction =- makePI . concat <$ pDelim PIO <*> pList pCDATA <* pDelim PIC where - makePI string =- let (pitgt, rest) = span isNMCHAR string- pival = dropWhile isSEPCHAR rest- in (pitgt,pival)------- Instance items:-----instanceItem =- pTag- <|> TextEvent <$> pCDATA -- also: WSEvent- <|> GERefEvent <$> pGEREF- <|> uncurry PIEvent <$> processingInstruction- <|> CommentEvent <$> xmlCommentDeclaration--pTag =- startEvent <$ pDelim STAGO <*> pName <*> attributes <*> tagc- <|> EndEvent <$ pDelim ETAGO <*> pName <* pDelim TAGC- where- attributes = pList (pName <* pDelim VI <^> attributeValue)- tagc = StartEvent <$ pDelim TAGC - <|> EmptyEvent <$ pDelim EETAGC- startEvent name atts closing = closing name atts--attributeValue = -- XML: attributeValueLiteral only- attributeValueLiteral <|> pName------- <!ELEMENT ...> declarations----elementDeclaration =- declareElements- <$> elementNames <*> omissibility <*> contentDefinition <*> exceptions- where- omissibility =- (pair <$> dashoro <*> dashoro) <?> (False,False)- dashoro =- (True <$ pKeyword "O" <|> False <$ pDelim MINUS)- exceptions = -- NOTE ambiguity- pair <$> (pDelim MINUS *> nameGroup <?> [])- <*> (pDelim PLUS *> nameGroup <?> [])--contentDefinition = -- in SGML: "declared content-or-content-model-w/oexc"- DC_EMPTY <$ pKeyword "EMPTY"- <|> DC_ANY <$ pKeyword "ANY"- <|> DC_MODELGRP <$> contentModel--contentModel =- ( Prim . ELEMENT <$> pName- <|> Prim PCDATA <$ rniName "#PCDATA"- <|> pDelim GRPO *> contentModel <**>- ( mk Seq <$> pSome (pDelim SEQ *> contentModel)- <|> mk And <$> pSome (pDelim AND *> contentModel)- <|> mk Or <$> pSome (pDelim OR *> contentModel)- <|> pSucceed id ) <* pDelim GRPC- ) <**> occurrenceIndicator- where mk f l a = f (a:l)--occurrenceIndicator =- Plus <$ pDelim PLUS- <|> Rep <$ pDelim REP- <|> Opt <$ pDelim OPT- <|> pSucceed id------- <!ATTLIST ...> declarations:------ Also need: <!ATTLIST #NOTATION ... > , <!ATTLIST #ANY ...>----attlistDeclaration =- declareAttlist <$> elementNames <*> pList attributeDefinition--attributeDefinition =- ATTDEF <$> pName <*> declaredValue <*> defaultValue-declaredValue =- ATcdata <$ pKeyword "CDATA"- <|> ATid <$ pKeyword "ID"- <|> ATidref <$ pKeyword "IDREF"- <|> ATidrefs <$ pKeyword "IDREFS"- <|> ATentity <$ pKeyword "ENTITY"- <|> ATentities <$ pKeyword "ENTITIES"- <|> ATnmtoken <$ pKeyword "NMTOKEN"- <|> ATnmtokens <$ pKeyword "NMTOKENS"- <|> ATnotation <$ pKeyword "NOTATION" <*> nameGroup- <|> ATenumerated <$> nameGroup- -- SGML only: (NB: currently ignore distinction between these)- <|> ATnmtoken <$ pKeyword "NAME"- <|> ATnmtoken <$ pKeyword "NUMBER"- <|> ATnmtoken <$ pKeyword "NUTOKEN"- <|> ATnmtokens <$ pKeyword "NAMES"- <|> ATnmtokens <$ pKeyword "NUMBERS"- <|> ATnmtokens <$ pKeyword "NUTOKENS"-defaultValue = -- SGML: also #CURRENT, #CONREF- ADVimplied <$ rniName "#IMPLIED"- <|> ADVrequired <$ rniName "#REQUIRED"- <|> ADVfixed <$ rniName "#FIXED" <*> attributeValue- <|> ADVdefault <$> attributeValue- -- SGML only:- <|> ADVcurrent <$ rniName "#CURRENT"- <|> ADVconref <$ rniName "#CONREF"---- Entity declarations:--- %%% In SGML grammar there are a few more restrictions--entityDeclaration =- declareParameterEntity <$ pDelim PERO <*> pName <*> entityText- <|> declareGeneralEntity <$> pName <*> entityText---- @@@ Discards entity type, DCN, and data attributes-entityText =- EN_INTERNAL <$> parameterLiteral- <|> EN_EXTERNAL <$> externalIdentifier <* entityType where- entityType =- ETsubdoc <$ pKeyword "SUBDOC"- <|> csndata <* pName <* dataAttributes- dataAttributes =- pDelim DSO- *> pList (pair <$> pName <* pDelim VI <*> attributeValue)- <* pDelim DSC- csndata = - ETcdata <$ pKeyword "CDATA" - <|> ETsdata <$ pKeyword "SDATA"- <|> ETndata <$ pKeyword "NDATA"--notationDeclaration =- declareNotation <$> pName <*> externalIdentifier---- SGML: also need SHORTREF, USEMAP(1) in DTDs;--- LINKTYPE in prolog; USEMAP(2), USELINK in instance.---- EOF --
− hxml-0.2/XMLScanner.hs
@@ -1,270 +0,0 @@----------------------------------------------------------------------------------- Module : XMLScanner--- Copyright : (C) 2000-2002 Joe English. Freely redistributable.--- License : "MIT-style"------ Author : Joe English <jenglish@flightlab.com>--- Stability : experimental--- Portability : portable------ CVS : $Id: XMLScanner.hs,v 1.9 2002/10/12 01:58:59 joe Exp $-------------------------------------------------------------------------------------- 9 Jan 2000------- doesn't check as many errors as it ought to...--module XMLScanner- ( Delimiter(..)- , pcdataMode, markupMode- , isNMCHAR, isSEPCHAR- , expandReferences- ) where--import XML -- for "Name"-import Char--import qualified DTD--isSEPCHAR, isNMCHAR, isNMSTART :: Char -> Bool--isSEPCHAR = isSpace-isNMCHAR c = isAlphaNum c || c `elem` ".-_:" -- 2.3 prodn 4---isNMSTART c = isAlpha c || c `elem` "_:" -- 2.3 prodn 5-isNMSTART c = isAlphaNum c || c `elem` "_:" -- for NUTOKEN, NMTOKEN attvals---- Utility:------ doSpan pred k f g s = k (f x) (g y) where (x,y) = span pred s----doSpan :: (a -> Bool) -> (b -> c -> d) -> ([a] -> b) -> ([a] -> c) -> [a] -> d-doSpan pred k f g = sp f where- sp f' [] = k (f' []) (g [])- sp f' s@(c:cs)- | pred c = sp (f' . (c:)) cs- | otherwise = k (f' []) (g s)--drop1 :: [a] -> [a] -- drop1 == drop 1; safe version of tail-drop1 [] = []-drop1 (_:xs) = xs--data Delimiter =- -- character data mode:- WS String -- whitespace- | CDATA String -- character data- | GEREF Name -- general entity reference- | STAGO -- start tag open, "<"- | ETAGO -- end tag open, "</"-- -- Markup mode and character data mode:- | MDO -- markup declaration open, "<!"- | MDOCOM -- MDO + COM delimiter-in-context, "<!--"- | MDODSO -- MDO + DSO delimiter-in-context, "<!["- | PIO -- processing instruction open, "<?"- | PIC -- processing instruction close, "?>" (">" in SGML)-- -- Errors:- | LEXERR String -- lexical error- | REST String -- rest of input-- -- Markup mode:- | NAME Name -- name- | RNINAME Name -- name prefixed with RNI (#)- | PEREF Name -- parameter entity reference- | LITERAL String -- attribute value literal or parameter literal-- | TAGC -- tag close, ">"- | VI -- value indicator, "="- | EETAGC -- empty element tag close (XML), "/>"-- | MDC -- markup declaration close, ">"- | DSO -- declaration subset open, "["- | DSC -- declaration subset close, "]"- | MSC -- DSC+MDC, delimiter-in-context, "]]>"- | COM -- comment, "--"- | GRPO -- group open, "("- | GRPC -- group close, ")"- | AND -- and connector, "&"- | OR -- or connector, "|"- | SEQ -- seq connector, ","- | OPT -- opt occurrence indicator, "?"- | REP -- rep occurrence indicator, "*"- | PLUS -- plus occurrence indicator, inclusion, "+"- | MINUS -- exclusion, omission flag, "-"- | PERO -- parameter entity reference open, "%"- -- ALSO:- -- Shortref -- short reference string (SGML only)- -- NET -- null end-tag (SGML only)- -- RNI -- reserved name indicator, "#"- -- LIT -- literal, """- -- LITA -- alternative literal, "'"- -- CRO -- character reference open, "&#"- -- HCRO -- hex character reference open, "&#X" (new in XML)- -- ERO -- entity reference open, "&"- -- REFC -- reference close, ";"- deriving (Eq, Show)--pcdataMode, tagMode, markupMode :: String -> [Delimiter]---- [STAGO, ETAGO, NET, CRO, ERO, MDO, MDOCOM, MDODSO, PIO, MSC]-pcdataMode [] = []-pcdataMode ('<':s) = case s of- '!':'-':'-':r -> MDOCOM : comMode pcdataMode r- '!':'[':r -> {- MDODSO : -} msMode r- '!':r -> MDO : markupMode r- '/':r -> ETAGO : tagMode r- '?':r -> PIO : piMode pcdataMode r- ']':']':'>':r -> MSC : pcdataMode r- r -> STAGO : tagMode r-pcdataMode ('&':'#':s) = doSpan (';'/=) (:) mkCREF (pcdataMode . drop1) s- where mkCREF = CDATA . return . chr . stringToInt 10-pcdataMode ('&':s) =- case span isNMCHAR s of- (ename,';':r) -> GEREF ename : pcdataMode r- (junk,r) -> LEXERR ("Bad entity reference " ++ junk)- : pcdataMode r-pcdataMode ('>':r) = LEXERR "Warning: %%% SKIPPING UNESCAPED '>'":pcdataMode r-pcdataMode (c:s)- | isSEPCHAR c = doSpan isSEPCHAR (:) (WS . (c:)) pcdataMode s- | otherwise = doSpan isDATACHAR (:) (CDATA . (c:)) pcdataMode s- where isDATACHAR ch =- case ch of '<' -> False; '&' ->False; _ -> True--tagMode [] = []-tagMode ('/':'>':r) = EETAGC : pcdataMode r-tagMode ('>':r) = TAGC : pcdataMode r-tagMode ('=':r) = VI : tagMode r-tagMode ('"':r) = doSpan ('"'/=) (:) LITERAL (tagMode . drop1) r-tagMode ('\'':r) = doSpan ('\''/=) (:) LITERAL (tagMode . drop1) r-tagMode ('<':'/':r) = ETAGO : tagMode r -- not allowed in XML-tagMode ('<':r) = STAGO : tagMode r -- not allowed in XML-tagMode cs@(c:s)- | isSEPCHAR c = tagMode (dropWhile isSEPCHAR s)- | isNMSTART c = doSpan isNMCHAR (:) NAME tagMode cs- | otherwise = LEXERR [c] : tagMode s----- [ERO, CRO, HCRO]-expandReferences :: DTD.EntityMap -> String -> String-expandReferences entities = expand where- expand s = case s of- [] -> []- '&':'#':'X':r -> doCharRef 16 expand r- '&':'#':r -> doCharRef 10 expand r- '&':r -> doEntityRef entities expand r- x:r -> x : expand r--doCharRef :: Int -> (String -> String) -> [Char] -> [Char]-doCharRef base k = doSpan (';'/=) (:) (chr . stringToInt base) (k . drop1)-stringToInt :: Int -> String -> Int-stringToInt base = foldl digit 0 . map digitToInt- where digit num next = base*num + next---- @@@ This is not quite right: should rescan the replacement text.-doEntityRef :: DTD.EntityMap -> (String -> String) -> String -> String-doEntityRef entities k r = doSpan (';'/=) (++) replacement (k . drop1) r where- replacement ename = case DTD.expandInternalEntity entities ename of- Just s -> s--- changed by Leonidas Fegaras 5/27/08- _ -> "" -- error ("entity " ++ ename ++ " not defined")---- [...]-markupMode [] = []-markupMode ('%':s) = case span isNMCHAR s of- ([], ' ':r) -> PERO : markupMode r -- %%% Not Quite Right- (ename,';':r) -> PEREF ename : markupMode r- (ename,r) -> LEXERR ("Bad parameter entity reference %" ++ ename)- : markupMode r-markupMode ('-':'-':r) = eatComment r-markupMode ('>':r) = MDC : markupMode r -- %%% or pcdataMode?-markupMode ('"':r) = doSpan ('"'/=) (:) LITERAL (markupMode . drop1) r-markupMode ('\'':r) = doSpan ('\''/=) (:) LITERAL (markupMode . drop1) r-markupMode ('#':r) = doSpan isNMCHAR (:) (RNINAME . ('#':)) markupMode r-markupMode ('<':'!':'-':'-':r)- = MDOCOM : comMode markupMode r-markupMode ('<':'!':r) = MDO : markupMode r-markupMode ('<':'?':r) = PIO : piMode markupMode r-markupMode s@('<':_) = pcdataMode s -- %%% Not strictly correct, but- -- %%% needed to parse the prolog.-markupMode cs@(c:s)- | isSEPCHAR c = markupMode (dropWhile isSEPCHAR s)- | isNMSTART c = doSpan isNMCHAR (:) NAME markupMode cs- | otherwise = (case c of- '&' -> AND- '|' -> OR- ',' -> SEQ- '?' -> OPT- '*' -> REP- '+' -> PLUS- '-' -> MINUS- '[' -> DSO- ']' -> DSC- '(' -> GRPO- ')' -> GRPC- _ -> LEXERR [c]) : markupMode s------- Internal recognition modes:-----msMode, cdataMode, eatComment :: String -> [Delimiter]--piMode, comMode, cdMode :: (String -> [Delimiter]) -> String -> [Delimiter]------- msMode: marked section in instance. --- @@@ Only supports XML instance syntax (<![CDATA[ ... ]]>);--- In SGML (and XML DTDs), parameter entity references and whitespace--- are also allowed, in addition to INCLUDE and IGNORE keywords.--- 'cdataMode' checks for nested occurrences of <![. this is not--- an error according to the XML or SGML specs, but it ought to be.--- --msMode ('C':'D':'A':'T':'A':'[':rest) = cdataMode rest-msMode s = - let (ms, rest) = span ('['/=) s- in LEXERR ("Illegal marked section ["++ms) : pcdataMode (drop1 rest)--cdataMode (']':']':'>':rest) = pcdataMode rest-cdataMode ('<':'!':'[':rest) = error "Nested <![ in marked section"-cdataMode [] = []-cdataMode (c:cs) = doSpan spn (:) (CDATA . (c:)) cdataMode cs where- spn '\n' = False- spn ']' = False- spn '<' = False- spn _ = True------- comMode (inside comments): [COM]----comMode prevMode cs = case cs of- [] -> []- '-':'-':r -> COM : cdMode prevMode r- (c:s) -> doSpan brk (:) (CDATA . (c:)) (comMode prevMode) s where- brk '-' = False- brk '\n' = False -- split long comments at line breaks- brk _ = True---- cdMode (inside comment declarations): [COM,MDC, ignore whitespace]-cdMode prevMode cs = case cs of- [] -> []- '>':r -> MDC : prevMode r- '-':'-':r -> COM : comMode prevMode r- c:s -> if isSEPCHAR c- then cdMode prevMode (dropWhile isSEPCHAR s)- else LEXERR [c] : cdMode prevMode s--eatComment cs = case cs of- [] -> []- '-':'-':r -> markupMode r- (_:r) -> eatComment r--piMode prevMode cs = case cs of- [] -> []- '?':'>':r -> PIC : prevMode r- (c:s) -> doSpan ('?'/=) (:) (CDATA . (c:)) (piMode prevMode) s---- EOF --
index.html view
@@ -3,11 +3,13 @@ <body> <center> <h1>HXQ: A Compiler from XQuery to Haskell</h1>+<h3>Download <a href="/HXQ-0.9.0.tar.gz">HXQ-0.9.0.tar.gz</a></h3> </center> <p> <h2>Description</h2> <p>-HXQ is a fast and space-efficient translator from <a href="http://www.w3.org/XML/Query/">XQuery</a> (the standard+HXQ is a fast and space-efficient translator+from <a href="http://www.w3.org/XML/Query/">XQuery</a> (the standard query language for XML) to embedded Haskell code. The translation is based on Haskell templates. HXQ takes full advantage of Haskell's lazy evaluation to keep in memory only those parts of XML data needed at@@ -18,7 +20,7 @@ machines. Furthermore, the coding is far simpler and extensible since its based on XML trees, rather than SAX events. <p>-For example, the XQuery given at the bottom of this page, which is+For example, the <a href="Test2.hs">XQuery given below</a>, which is against the <a href="http://dblp.uni-trier.de/xml/">DBLP XML database</a> (420MB), runs in 39 seconds on my laptop PC (using 18MB of max heap space). To contrast this, <a href="http://www.gnu.org/software/qexo/">Qexo</a>, which@@ -26,52 +28,86 @@ Also <a href="http://xqilla.sourceforge.net/HomePage">XQilla</a>, which is written in C++, took 1 minute and 10 secs (using 1150MB of heap space). (All results are taken on an Intel Core 2 Duo 2.2GHz 2GB running ghc-6.8.2 on Linux 2.6.23 kernel.) <p>-Finally, HXQ can store XML documents in a relational database (currently SQLite), by shredding XML into relational-tuples, and by translating XQueries over the shredded documents into optimized SQL queries.+Finally, HXQ can store XML documents in a relational database+(currently SQLite), by shredding XML into relational tuples, and by+translating XQueries over the shredded documents into optimized SQL+queries. <p> <h2>Installation Instructions</h2> <p>-First, you need to install the Glasgow Haskell Compiler,-<a href="http://www.haskell.org/ghc/">ghc</a>,-the parser generator for Haskell,-<a href="http://www.haskell.org/happy/">happy</a>,-and <a href="http://sqlite.org/">SQLite</a> for database connectivity (optional).-For example, in Fedora Linux, you install them using:+HXQ can be installed on most platforms but I have only tested it on+Linux and Windows XP. The simplest installation is without database+connectivity (ie, it can only process XQueries against XML text+documents).+<p>+First, you need to install the Glasgow Haskell+Compiler, <a href="http://www.haskell.org/ghc/">ghc</a>. Optionally,+if you want to modify the XQuery parser, you need to install the+parser generator for Haskell,+<a href="http://www.haskell.org/happy/">happy</a>. Then,+download <a href="/HXQ-0.9.0.tar.gz">HXQ version 0.9.0</a> and untar+it (using <tt>tar xfz</tt> on Linux+or <a href="http://www.7-zip.org/">7z x</a> on Windows). Then+configure cabal without or with database connectivity:+<dl>+<dt><b>Without database connectivity:</b></dt>+<dd>+To configure HXQ, do: <pre>-yum install ghc happy sqlite+runhaskell Setup.lhs configure </pre>-Then, you need to install the haskell packages: <a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HDBC">HDBC</a>+</dd>+<p>+<dt><b>With database connectivity:</b></dt>+<dd>+For database connectivity, you need to install <a href="http://sqlite.org/">SQLite</a>.+(On Linux, you can install it using <tt>yum install sqlite</tt>.)+Then you need to install the Haskell packages:+<a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HDBC-1.1.4">HDBC 1.1.4</a> (but not version 1.1.5) and the-<a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HDBC-sqlite3">HDBC-sqlite3</a> driver+<a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HDBC-sqlite3-1.1.4.0">HDBC-sqlite3 1.1.4</a> driver to connect to SQLite relational databases.-<p>-Finally, download <a href="/HXQ-0.8.5.tar.gz">HXQ</a> and untar it.-You can use either make or cabal to build it. To build it with cabal, you do:+Then you configure HXQ: <pre>-runhaskell Setup.lhs configure --prefix=$HOME+runhaskell Setup.lhs configure -fdb+</pre>+</dd>+Finally, you do:+<pre> runhaskell Setup.lhs build runhaskell Setup.lhs install </pre>-(The last command must be run as root.)-It will create the executable <tt>xquery</tt>, which is the XQuery interpreter, and the HXQ library.-To use the library, you run ghc or ghci with <tt>-package HXQ</tt>.+On Linux, the last command must be run as root. This will create the+executable <tt>xquery</tt>, which is the XQuery interpreter, and the+HXQ library. To use the HXQ library in a Haskell program,+simply <tt>import Text.XML.HXQ.XQuery</tt>. <p> <h2>Current Status</h2> <p>-HXQ supports most essential XQuery features, although some system functions are missing (but are easy to add).-To see the list of supported system functions, run <tt>xquery -help</tt> .-HXQ does not have static typechecking; it leaves all checking to Haskell. This means that it distinguishes regular predicates-from indexing at run time: if an XPath predicate returns an integer at run time, it is taken as indexing and this index is-checked against the current node position. The most important omission is backward step axes, such as /.. (parent).-Some, but not all, parent axis steps are removed using optimization rules; all others cause a compilation error.-Finally, the XQuery semantics requires duplicate elimination and-sorting by document order for every XPath step, which is very expensive and unnecessary in most cases.-For example, <tt>e//*//*</tt> may return duplicate elements in HXQ.-This will be addressed in the future (needs a static analysis to determine when duplicate elimination is necessary).+HXQ supports most essential XQuery features, although some system+functions are missing (but are easy to add). To see the list of+supported system functions, run <tt>xquery -help</tt> . HXQ does not+have static typechecking; it leaves all checking to Haskell. In+addition, the XQuery semantics requires duplicate elimination and+sorting by document order for every XPath step, which is very+expensive and unnecessary in most cases. This is not currently+supported by HXQ but will be addressed in the future (needs a static+analysis to determine when duplicate elimination is necessary). For+example, <tt>e//*//*</tt> may return duplicate elements in HXQ. <p>-HXQ uses the <a href="http://www.flightlab.com/~joe/hxml/">HXML parser for XML</a> (developed by Joe English),-which is included in the source. I have also tried hexpat, tagsoup, HXT, and HaXML Xtract, but they all have space leaks.+HXQ uses the <a href="http://www.flightlab.com/~joe/hxml/">HXML parser+for XML</a> (developed by Joe English), which is included in the+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+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+axis /..) are removed from a query using optimization rules. If there+are backward axis steps left in the query, then HXQ uses the latter+parser, which may result to a performance penalty due to space leaks.+<p> <h2>Using the Compiler</h2> <p> The main functions for embedding XQueries in Haskell are:@@ -79,17 +115,18 @@ <li> <tt>$(xe query) :: XSeq</tt> <li> <tt>$(xq query) :: IO XSeq</tt> </ul>-where <tt>query</tt> is a string value (a Haskell expression that evaluates-to a string <b>at compile-time</b>). They both translate the query into Haskell-code, which is compiled and optimized into machine code directly.-The code that xe generates has type <tt>XSeq</tt> (a sequence of XML trees of type <tt>[XTree]</tt>)-while the code that xq generates has type <tt>(IO XSeq)</tt>. If the query reads-at least one document (using doc(...)), then you should use xq since it requires-IO. To define constant XML data or a function body, it is better to use xe.-You can use the value of a Haskell variable <tt>v</tt> inside a query using-<tt>$v</tt> as long as <tt>v</tt> has type <tt>XSeq</tt>.-To use a function in a query, it should be defined in Haskell-with type <tt>(XSeq,...,XSeq) -> XSeq</tt>.+where <tt>query</tt> is a string value (a Haskell expression that+evaluates to a string <b>at compile-time</b>). They both translate the+query into Haskell code, which is compiled and optimized into machine+code directly. The code that xe generates has type <tt>XSeq</tt> (a+sequence of XML trees of type <tt>[XTree]</tt>) while the code that xq+generates has type <tt>(IO XSeq)</tt>. If the query reads at least one+document (using doc(...)), then you should use xq since it requires+IO. To define constant XML data or a function body, it is better to+use xe. You can use the value of a Haskell variable <tt>v</tt> inside+a query using <tt>$v</tt> as long as <tt>v</tt> has+type <tt>XSeq</tt>. To use a function in a query, it should be+defined in Haskell with type <tt>(XSeq,...,XSeq) -> XSeq</tt>. <p> Here is an example of a main program: <pre>@@ -107,34 +144,39 @@ 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>.+Another example, can be found in <a href="Test1.hs">Test1.hs</a>. You compile it using+<tt>ghc --make Test1.hs -o a.out</tt>. <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 use the Unix shell script <tt>compile</tt> to compile the XQuery file to an executable. For example:+You can compile an XQuery file into a Haskell program+(<tt>Temp.hs</tt>) using <tt>xquery -c file</tt>. Or better, you can+use the script <tt>compile</tt> (on either Unix or Windows) to compile the XQuery file+to an executable. For example: <pre> compile data/q1.xq </pre>-will compile the XQuery file <tt>data/q1.xq</tt> into <tt>a.out</tt>.+will compile the XQuery file <a href="data/q1.xq">data/q1.xq</a> into the executable <tt>a.out</tt>. <p> <h2>Using the Interpreter</h2> <p>-The HXQ interpreter is far more slower than the compiler; use it only if you need to evaluate ad-hoc XQueries read from input or from files.+The HXQ interpreter is far more slower than the compiler; use it only+if you need to evaluate ad-hoc XQueries read from input or from files. The main functions are: <ul> <li> <tt>xquery :: String -> IO XSeq</tt> -- Evaluates an XQuery in a string <li> <tt>xfile :: String -> IO XSeq</tt> -- Evaluates an XQuery in a file </ul> 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>,+(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: <pre> xquery data/q1.xq-</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 evaluate an XPath query against an XML file, eg.-<tt>xquery -p "//inproceedings[100]" data/dblp.xml</tt>.-With <tt>xquery -help</tt> you get the list of system functions and usage information. +</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 evaluate an XPath query against an XML+file, eg. <tt>xquery -p "//inproceedings[100]" data/dblp.xml</tt>.+With <tt>xquery -help</tt> you get the list of system functions and+usage information. <p> <h2>Database Connectivity</h2> <p>@@ -153,26 +195,29 @@ <pre> xqueryDB :: (IConnection conn) => String -> conn -> IO XSeq </pre>-The xquery executable can also run XQueries that use a database by specifying the database name using the -db option.+The xquery executable can also run XQueries that use a database by+specifying the database name using the -db option. <p> Currently, HXQ works with <a href="http://sqlite.org/">SQLite</a> only, but is very easy to make it work with any relational database that supports ODBC: simply install <a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HDBC-odbc">HDBC-odbc</a>-and change the file <a href="Text/XML/HXQ/DBConnect.hs">Text/XML/HXQ/DBConnect.hs</a> accordingly.+and change the file <a href="src/withDB/Text/XML/HXQ/DBConnect.hs">src/withDB/Text/XML/HXQ/DBConnect.hs</a> accordingly. <p> <h3>Querying an Existing Database</h3> <p>-An XQuery may contain multiple SQL queries in the 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 install the <a href="data/company.sql">company</a> database. For example, using the sqlite3-interpreter, you do:+An XQuery may contain multiple SQL queries in the+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+install the <a href="data/company.sql">company</a> database. For+example, using the sqlite3 interpreter, you do: <pre> sqlite3 myDB .read data/company.sql .quit </pre>-and then compile and run <tt>TestDB.hs</tt> (or just do <tt>make test3</tt> on linux).+and then compile and run <tt>TestDB.hs</tt>. <p> <h3>Shredding</h3> <p>@@ -181,20 +226,27 @@ shred :: (IConnection conn) => conn -> String -> String -> IO () shred db file name </pre>-that shreds and stores the XML document located at the file pathname in the database db under a unique name.-HXQ will find a good relational schema (using hybrid inlining) to store the XML data by first scanning the document to-extract its structural summary, then deriving a good relational schema, and finally scanning the document-for a second time to store its data into the relational tables. For example,+that shreds and stores the XML document located at the file pathname+in the database db under a unique name. HXQ will find a good+relational schema (using hybrid inlining) to store the XML data by+first scanning the document to extract its structural summary, then+deriving a good relational schema, and finally scanning the document+for a second time to store its data into the relational tables. For+example, <pre> do db <- connect "myDB" shred db "data/cs.xml" "c" </pre> <p>-The haskell function+The Haskell function <pre>+printSchema db name+</pre>+displays the relational schema for the shredded document under the given name, while+<pre> createIndex db name tagname </pre>-creates a secondary index on tagname for the shredded document under the given name.+creates a secondary index on tagname for the shredded document. <p> <h3>Publishing</h3> <p>@@ -202,22 +254,14 @@ <pre> publish(dbame,name) </pre>-where dbname is the database file name and name is the unique name assigned to the XML document when was shredded.-The translation from XQuery to SQL is done at compile-time, so both dbname and name must be 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> (do <tt>make test4</tt> to run it on linux).-<p>-<h2>Experimental Features</h2>-<p>-There is an experimental-program, called <tt>hxqc</tt>, that works like <tt>xquery</tt> but is faster because it uses the-HXQ compiler instead of the interpreter. It's constructed with the Unix Makefile (<tt>make hxqc</tt>).-It is unstable and the <tt>hxqc</tt> executable is 10 times larger than <tt>xquery</tt> since it-uses the ghc libraries at run-time. Also, although it is faster than the interpreter, it is slower than a-compiled xquery because it uses part of the heap for the ghc compiler to compile Haskell code on-the-fly.-<p>-</body>+where dbname is the database file name and name is the unique name+assigned to the XML document when was shredded. The translation from+XQuery to SQL is done at compile-time, so both dbname and name must be+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>. <p> <hr> <p>-<address>Last modified: 07/24/08 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>+<address>Last modified: 08/23/08 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>
+ src/Text/XML/HXQ/Compiler.hs view
@@ -0,0 +1,509 @@+{-------------------------------------------------------------------------------------+-+- A Compiler from XQuery to Haskell+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 02/15/08, last update: 08/20/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++{-# OPTIONS_GHC -fth #-}++module Text.XML.HXQ.Compiler where++import Control.Monad+import Char(toLower)+import List(sortBy)+import Language.Haskell.TH+import XMLParse(parseDocument)+import Text.XML.HXQ.Parser+import Text.XML.HXQ.XTree+import Text.XML.HXQ.Optimizer+import Text.XML.HXQ.Functions+++undef1 = [| error "Undefined XQuery context (.)" |]+undef2 = [| error "Undefined position()" |]+undef3 = [| error "Undefined last()" |]+++-- does the expression contain a last()?+containsLast :: Ast -> Bool+containsLast (Ast "call" [Avar "last"]) = True+containsLast (Ast f _) | elem f ["let","for","predicate"] = False+containsLast (Ast "step" _) = False+containsLast (Ast _ args) = or (map containsLast args)+containsLast _ = False+++-- calculate the maximum position value used in a predicate, if there is one+maxPosition :: Ast -> Ast -> Int+maxPosition position e+ = case e of+ Ast "call" [Avar f,p,Aint n]+ | f `elem` ["=","<","<=","eq","lt","le"] && p == position+ -> n+ Ast "call" [Avar f,Aint n,p]+ | f `elem` ["=",">",">=","eq","gt","ge"] && p == position+ -> n+ Ast "let" [Avar x,source,body]+ -> if position == Avar x+ then 0 else minp (maxPosition position source) (maxPosition position body)+ Ast "for" [Avar x,Avar i,source,body]+ -> if position == Avar x || position == Avar i+ then 0 else minp (maxPosition position source) (maxPosition position body)+ Ast "predicate" [pred,body]+ -> minp (maxPosition position pred) (maxPosition position body)+ Ast "call" [Avar "and",x,y]+ -> minp (maxPosition position x) (maxPosition position y)+ Ast "call" [Avar "or",x,y]+ -> max (maxPosition position x) (maxPosition position y)+ _ -> 0+ where minp x y = if x == 0 then y else if y == 0 then x else min x y+++pathPosition = Ast "call" [Avar "position"]+++parent_error = error "constructed elements have no parent"+++-- extract the QName+qName :: XSeq -> Tag+qName [XText s] = s+qName e = error ("Invalid QName: "++(show e))+++-- Each XPath predicate must calculate position() and last() from its input XSeq+-- if last() is used, then the evaluation is blocking (need to store the whole input XSeq)+compilePredicates :: [Ast] -> Q Exp -> Bool -> Q Exp+compilePredicates [] xs _ = xs+compilePredicates ((Aint n):preds) xs _ -- shortcut that improves laziness+ = compilePredicates preds+ [| [ $xs !! $(litE (IntegerL (toInteger (n-1)))) ] |] True+compilePredicates (pred:preds) xs True -- top-k like+ | maxPosition pathPosition pred > 0+ = compilePredicates (pred:preds)+ [| take $(litE (IntegerL (toInteger (maxPosition pathPosition pred)))) $xs |] False+compilePredicates (pred:preds) xs _+ | containsLast pred -- blocking: use only when last() is used in the predicate+ = compilePredicates preds+ [| let bl = $xs+ len = length bl+ in foldir (\x i r -> if case $(compile pred [| x |] [| [XInt i] |] [| [XInt len] |] "") of+ [XInt k] -> k == i -- indexing+ b -> conditionTest b+ then x:r else r) [] bl 1 |] True+compilePredicates (pred:preds) xs _+ = compilePredicates preds+ [| foldir (\x i r -> if case $(compile pred [| x |] [| [XInt i] |] undef3 "") of+ [XInt k] -> k == i -- indexing+ b -> conditionTest b+ then x:r else r) [] $xs 1 |] True+++-- Compile the AST e into Haskell code+-- context: context node (XPath .)+-- position: the element position in the parent sequence (XPath position())+-- last: the length of the parent sequence (XPath last())+-- effective_axis: the XPath axis in /axis::tag(exp)+-- eg, the effective axis of //(A | B) is descendant+compile :: Ast -> Q Exp -> Q Exp -> Q Exp -> String -> Q Exp+compile e context position last effective_axis+ = case e of+ Avar "." -> [| [ $context :: XTree ] |]+ Avar v -> let x = varE (mkName v)+ in [| $x :: XSeq |]+ Aint n -> let x = litE (IntegerL (toInteger n))+ in [| [ XInt $x ] |]+ Afloat n -> let x = litE (RationalL (toRational n))+ in [| [ XFloat $x ] |]+ Astring s -> let x = litE (StringL s)+ in [| [ XText $x ] |]+ Ast "context" [v,Astring dp,body]+ -> [| foldr (\x r -> $(compile body [| x |] position last dp)++r)+ [] $(compile v context position last effective_axis) |]+ Ast "call" [Avar "position"]+ -> position+ Ast "call" [Avar "last"]+ -> last+ Ast "step" (Avar "child":tag:Avar ".":preds)+ | effective_axis /= ""+ -> compile (Ast "step" (Avar effective_axis:tag:Avar ".":preds)) context position last ""+ Ast "step" (Avar "descendant_any":Ast "tags" tags:e:preds)+ -> let bc = compile e context position last effective_axis+ ts = listE (map (\(Avar tag) -> litE (stringL tag)) tags)+ in [| foldr (\x r -> $(compilePredicates preds [| descendant_any_with_tagged_children $ts x |] True)++r)+ [] $bc |]+ Ast "step" (Avar step:Astring tag:e:preds)+ -> let bc = compile e context position last effective_axis+ tc = litE (stringL tag)+ in [| foldr (\x r -> $(compilePredicates preds [| $(findV step paths) $tc x |] True)++r)+ [] $bc |]+ Ast "filter" (e:preds)+ -> compilePredicates preds (compile e context position last effective_axis) True+ Ast "predicate" [condition,body]+ -> let xs = compile body context position last effective_axis+ in [| foldr (\x r -> if conditionTest $(compile condition undef1 undef2 undef3 "")+ then x:r else r) [] $xs |]+ Ast "append" args+ -> [| appendText $(listE (map (\x -> compile x context position last effective_axis) args)) |]+ Ast "call" ((Avar f):args)+ -> callF f (map (\x -> compile x context position last effective_axis) args)+ Ast "construction" [Astring tag,Ast "attributes" [],body]+ -> let ct = litE (StringL tag)+ bc = compile body context position last effective_axis+ in [| [ XElem $ct [] 0 parent_error $bc ] |]+ Ast "construction" [tag,Ast "attributes" al,body]+ -> let alc = foldr (\(Ast "pair" [a,v]) r+ -> let ac = compile a context position last effective_axis+ vc = compile v context position last effective_axis+ in [| (qName $ac,showXS $vc) : $r |]) [| [] |] al+ ct = compile tag context position last effective_axis+ bc = compile body context position last effective_axis+ in [| [ XElem (qName $ct) $alc 0 parent_error $bc ] |]+ Ast "let" [Avar var,source,body]+ -> do s <- compile source context position last effective_axis+ b <- compile body context position last effective_axis+ return (AppE (LamE [VarP (mkName var)] b) s)+ Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index+ -> let b = compile body [| head $(varE (mkName var)) |] undef2 undef3 ""+ f = lamE [varP (mkName var)] [| \r -> $b ++ r |]+ s = compile source context position last effective_axis+ in [| foldr (\x -> $f [x]) [] $s |]+ Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index+ -> let b = compile body [| head $(varE (mkName var)) |]+ [| $(varE (mkName ivar)) |] undef3 ""+ f = lamE [varP (mkName var)] (lamE [varP (mkName ivar)] [| \r -> $b ++ r |])+ p = maxPosition (Avar ivar) body+ ns = if p > 0 -- there is a top-k like restriction+ then Ast "step" [source,Ast "call" [Avar "<=",pathPosition,Aint p]]+ else source+ s = compile ns context position last effective_axis+ in [| foldir (\x i -> $f [x] [XInt i]) [] $s 1 |]+ Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting+ -> let res = foldl (\r a -> let ac = compile a context position last effective_axis+ in [| $r++[text $ac] |] )+ [| [ $(compile exp context position last effective_axis) ] |] orderBys+ in [| [ $res ] |]+ Ast "sort" (exp:ordList) -- blocking+ -> let ce = compile exp context position last effective_axis+ ordering = foldr (\(Avar ord) r+ -> let asc = if ord == "ascending"+ then [| True |]+ else [| False |]+ in [| \(x:xs) (y:ys) -> case compareXSeqs $asc x y of+ EQ -> $r xs ys+ o -> o |])+ [| \xs ys -> EQ |] ordList+ in [| concatMap head (sortBy (\(_:xs) (_:ys) -> $ordering xs ys) ($ce::[[XSeq]])) |]+ _ -> error ("Illegal XQuery: "++(show e))+++-- The monadic compilePredicates that propagates IO state+compilePredicatesM :: [Ast] -> Q Exp -> Bool -> Q Exp+compilePredicatesM [] xs _+ = [| return $xs |]+compilePredicatesM ((Aint n):preds) xs _ -- shortcut that improves laziness+ = compilePredicatesM preds+ [| [ $xs !! $(litE (IntegerL (toInteger (n-1)))) ] |] True+compilePredicatesM (pred:preds) xs True -- top-k like+ | maxPosition pathPosition pred > 0+ = compilePredicatesM (pred:preds)+ [| take $(litE (IntegerL (toInteger (maxPosition pathPosition pred)))) $xs |] False+compilePredicatesM (pred:preds) xs _+ | containsLast pred -- blocking: use only when last() is used in the predicate+ = [| do let bl = $xs+ last = length bl+ vs <- foldir (\x i r -> do vs <- $(compileM pred [| x |] [| [XInt i] |] [| [XInt last] |] "")+ s <- r+ return (if case vs of+ [XInt k] -> k == i -- indexing+ b -> conditionTest b+ then x:s else s))+ (return []) $xs 1+ $(compilePredicatesM preds [| vs |] True) |]+compilePredicatesM (pred:preds) xs _+ = [| do vs <- foldir (\x i r -> do vs <- $(compileM pred [| x |] [| [XInt i] |] undef3 "")+ s <- r+ return (if case vs of+ [XInt k] -> k == i -- indexing+ b -> conditionTest b+ then x:s else s))+ (return []) $xs 1+ $(compilePredicatesM preds [| vs |] True) |]+++-- The monadic XQuery compiler; it is like compile but has plumbing to propagate IO state+compileM :: Ast -> Q Exp -> Q Exp -> Q Exp -> String -> Q Exp+compileM e context position last effective_axis+ = case e of+ Avar "." -> [| return [ $context :: XTree ] |]+ Avar v -> let x = varE (mkName v)+ in [| return ($x :: XSeq) |]+ Aint n -> let x = litE (IntegerL (toInteger n))+ in [| return [ XInt $x ] |]+ Afloat n -> let x = litE (RationalL (toRational n))+ in [| return [ XFloat $x ] |]+ Astring s -> let x = litE (StringL s)+ in [| return [ XText $x ] |]+ -- for non-IO XQuery, use the regular compile+ Ast "nonIO" [u] -> [| return $(compile u context position last effective_axis) |]+ Ast "context" [v,Astring dp,body]+ -> [| do vs <- $(compileM v context position last effective_axis)+ foldr (\x r -> (liftM2 (++)) $(compileM body [| x |] position last dp) r)+ (return []) vs |]+ Ast "call" [Avar "position"]+ -> [| return $position |]+ Ast "call" [Avar "last"]+ -> [| return $last |]+ Ast "step" (Avar "child":tag:Avar ".":preds)+ | effective_axis /= ""+ -> compileM (Ast "step" (Avar effective_axis:tag:Avar ".":preds)) context position last ""+ Ast "step" (Avar "descendant_any":Ast "tags" tags:e:preds)+ -> let bc = compileM e context position last effective_axis+ ts = listE (map (\(Avar tag) -> litE (stringL tag)) tags)+ in [| do vs <- $bc+ foldr (\x r -> (liftM2 (++)) $(compilePredicatesM preds+ [| descendant_any_with_tagged_children $ts x |] True) r)+ (return []) vs |]+ Ast "step" (Avar step:Astring tag:e:preds)+ -> let bc = compileM e context position last effective_axis+ tc = litE (stringL tag)+ in [| do vs <- $bc+ foldr (\x r -> (liftM2 (++)) $(compilePredicatesM preds+ [| $(findV step paths) $tc x |] True) r)+ (return []) vs |]++ Ast "filter" (e:preds)+ ->[| do vs <- $(compileM e context position last effective_axis)+ $(compilePredicatesM preds [| vs |] True) |]+ Ast "predicate" [condition,body]+ -> [| do vs <- $(compileM body context position last effective_axis)+ foldr (\x r -> do vs <- $(compileM condition undef1 undef2 undef3 "")+ s <- r+ return (if conditionTest vs then x:s else s))+ (return []) vs |]+ Ast "executeSQL" [Avar stmt,args]+ -> [| do as <- $(compileM args context position last effective_axis)+ $(varE (mkName "executeSQL")) $(varE (mkName stmt)) as |]+ Ast "append" args+ -> let binds = zipWith (\i x -> (mkName ("x"++(show i)),x)) [1..(length args)] args+ in foldr (\(n,x) r -> [| $(compileM x context position last effective_axis) >>= $(lamE [varP n] r) |])+ [| return (appendText $(listE (map (\(n,_) -> varE n) binds))) |] binds+ Ast "call" ((Avar f):args)+ -> let binds = zipWith (\i x -> (mkName ("x"++(show i)),x)) [1..(length args)] args+ in foldr (\(n,x) r -> [| $(compileM x context position last effective_axis) >>= $(lamE [varP n] r) |])+ [| return $(callF f (map (\(n,_) -> varE n) binds)) |] binds+ Ast "construction" [Astring tag,Ast "attributes" [],body]+ -> let ct = litE (StringL tag)+ bc = compileM body context position last effective_axis+ in [| do b <- $bc+ return [ XElem $ct [] 0 parent_error b ] |]+ Ast "construction" [tag,Ast "attributes" al,body]+ -> let alc = foldr (\(Ast "pair" [a,v]) r+ -> [| do ac <- $(compileM a context position last effective_axis)+ vc <- $(compileM v context position last effective_axis)+ s <- $r+ return ((qName ac,showXS vc):s) |]) [| return [] |] al+ ct = compileM tag context position last effective_axis+ bc = compileM body context position last effective_axis+ in [| do a <- $alc+ c <- $ct+ b <- $bc+ return [ XElem (qName c) a 0 parent_error b ] |]+ Ast "let" [Avar var,source,body]+ -> [| $(compileM source context position last effective_axis)+ >>= $(lamE [varP (mkName var)] (compileM body context position last effective_axis)) |]+ Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index+ -> let b = compileM body [| head $(varE (mkName var)) |] undef2 undef3 ""+ f = lamE [varP (mkName var)] [| (liftM2 (++)) $b |]+ s = compileM source context position last effective_axis+ in [| do vs <- $s+ foldr (\x -> $f [x]) (return []) vs |]+ Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index+ -> let b = compileM body [| head $(varE (mkName var)) |]+ [| $(varE (mkName ivar)) |] undef3 ""+ f = lamE [varP (mkName var)] (lamE [varP (mkName ivar)] [| (liftM2 (++)) $b |])+ p = maxPosition (Avar ivar) body+ ns = if p > 0 -- there is a top-k like restriction+ then Ast "step" [source,Ast "call" [Avar "<=",pathPosition,Aint p]]+ else source+ s = compileM ns context position last effective_axis+ in [| do vs <- $s+ foldir (\x i -> $f [x] [XInt i]) (return []) vs 1 |]+ Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting+ -> let vs = compileM exp context position last effective_axis+ res = foldl (\r a -> [| do ac <- $(compileM a context position last effective_axis)+ s <- $r+ return (s++[text ac]) |] )+ [| do v <- $vs; return [ v ] |] orderBys+ in [| return $res |]+ Ast "sort" (exp:ordList) -- blocking+ -> let ce = compileM exp context position last effective_axis+ ordering = foldr (\(Avar ord) r+ -> let asc = if ord == "ascending"+ then [| True |]+ else [| False |]+ in [| \(x:xs) (y:ys) -> case compareXSeqs $asc x y of+ EQ -> $r xs ys+ o -> o |])+ [| \xs ys -> EQ |] ordList+ in [| do c <- $ce+ return (concatMap head (sortBy (\(_:xs) (_:ys) -> $ordering xs ys) (c::[[XSeq]]))) |]+ _ -> error ("Illegal XQuery: "++(show e))+++-- functions that need IO interaction (document reader, DB access, etc)+ioSources :: [ String ]+ioSources = ["executeSQL","doc","fn:doc","sql","fn:sql","publish","fn:publish"]+++-- steps that need the parent XTree link in evaluation (with a potential space leak)+backward_steps :: [ String ]+backward_steps = ["following-sibling", "following","parent", "ancestor", "preceding-sibling", "preceding", "ancestor-or-self" ]+++-- Collect all input documents and assign them a unique number.+-- The backward flag indicates whether there are backward steps+-- (so that they would require XTrees with parent links)+pullIOSources :: Ast -> Int -> Bool -> (Ast, Int, Bool, [(String, Bool, Ast)])+pullIOSources query count backward+ = case query of+ Ast "call" [Avar nm,file]+ | elem nm ["doc","fn:doc"]+ -> (Avar ("_doc"++(show count)), count+1, backward, [("_doc"++(show count),backward,file)])+ Ast "call" [Avar nm,sql]+ | elem nm ["sql","fn:sql"]+ -> (Ast "executeSQL" [Avar ("_sql"++(show count)),Ast "call" [Avar "empty"]], count+1,+ backward, [("_sql"++(show count),backward,Ast "prepareSQL" [sql])])+ Ast "call" [Avar nm,sql,args]+ | elem nm ["sql","fn:sql"]+ -> (Ast "executeSQL" [Avar ("_sql"++(show count)),args], count+1, backward,+ [("_sql"++(show count),backward,Ast "prepareSQL" [sql])])+ Ast "step" (args@(Avar step:_)) -- backward step+ | elem step backward_steps+ -> let (s,c,ns) = foldr (\a r c -> let (e,c1,_,n1) = pullIOSources a c True+ (s,c2,n2) = r c1+ in (e:s,c2,union n1 n2))+ (\c -> ([],c,[])) args count+ in (Ast "step" s,c,True,ns)+ Ast n args+ -> let (s,c,ns) = foldr (\a r c -> let (e,c1,_,n1) = pullIOSources a c backward+ (s,c2,n2) = r c1+ in (e:s,c2,union n1 n2))+ (\c -> ([],c,[])) args count+ in (Ast n s,c,backward,ns)+ _ -> (query,count,backward,[])+ where union xs ((n,b,s):ys) = (n,b,foldr(\(m,_,d) r -> if s==d then Avar m else r) s xs):(union xs ys)+ union xs [] = xs+++-- true if there is no need to lift to the IO monad+noIO :: Ast -> Bool+noIO (Ast nm _) | elem nm ioSources = False+noIO (Ast n args) = all noIO args+noIO _ = True+++liftIOSources :: Ast -> (Ast, [(String, Bool, Ast)])+liftIOSources query+ = let (ast,_,_,ns) = pullIOSources query 0 False+ f x = case x of+ Ast nm _ | elem nm ["attributes","tags"] -> x+ Ast _ _ | noIO x -> Ast "nonIO" [x]+ _ -> case x of+ Ast "call" ((Avar nm):args)+ -> Ast "call" ((Avar nm):(map f args))+ Ast n args -> Ast n (map f args)+ _ -> x+ in (f ast,ns)+++-- optimize and compile an AST +compileAst :: Ast -> Q Exp+compileAst ast = compile (optimize ast) undef1 undef2 undef3 ""+++-- Compile an XQuery AST that does not perform IO (unlifted).+-- When evaluated, it returns XSeq.+compileQuery :: [Ast] -> Q Exp+compileQuery ((Ast "function" ((Avar f):b:args)):xs)+ = let lvars = case args of+ [Astring a] -> [varP (mkName a)]+ _ -> [tupP (map (\(Avar a) -> varP (mkName a)) args)]+ in letE [valD (varP (mkName f)) (normalB (lamE lvars (compileAst b))) []]+ (compileQuery xs)+compileQuery ((Ast "variable" [Avar v,u]):xs)+ = letE [valD (varP (mkName v)) (normalB (compileAst u)) []]+ (compileQuery xs)+compileQuery (query:xs)+ = let code = compileAst query+ rest = compileQuery xs+ in [| $code ++ $rest |]+compileQuery [] = [| [] |]+++-- Compile an XQuery AST that may read XML documents or use databases (IO lifted).+-- When evaluated, it returns IO XSeq.+compileQueryM :: [Ast] -> Q Exp+compileQueryM ((Ast "function" ((Avar f):b:args)):xs)+ = let lvars = case args of+ [Astring a] -> [varP (mkName a)]+ _ -> [tupP (map (\(Avar a) -> varP (mkName a)) args)]+ in letE [valD (varP (mkName f)) (normalB (lamE lvars (compileAst b))) []]+ (compileQueryM xs)+compileQueryM ((Ast "variable" [Avar v,u]):xs)+ = letE [valD (varP (mkName v)) (normalB (compileAst u)) []]+ (compileQueryM xs)+compileQueryM (query:xs)+ = let (ast,ns) = liftIOSources (optimize query)+ code = compileM ast undef1 undef2 undef3 ""+ rest = compileQueryM xs+ in foldl (\r (n,b,e) -> let d = lamE [varP (mkName n)] r+ in case e of+ Avar m -> [| $d $(varE (mkName m)) |]+ Ast "prepareSQL" [Astring sql]+ -> [| ($(varE (mkName "prepareSQL"))+ $(varE (mkName "_db"))+ $(litE (StringL sql))) >>= $d |]+ _ -> [| do let [XText f] = $(compileAst e)+ doc <- readFile f+ $d [materialize b (parseDocument doc)] |])+ [| (liftM2 (++)) $code $rest |] ns+compileQueryM [] = [| return [] |]+++-- Debugging: display the AST and the Haskell code of an input XQuery+cq :: String -> IO ()+cq query = do putStrLn "Abstract Syntax Tree:"+ let ast = parse (scan query)+ putStrLn (show ast)+ let opt = optimize (last ast)+ putStrLn "Optimized AST:"+ putStrLn (show opt)+++-- | Run an XQuery expression that does not perform IO.+-- When evaluated, it returns XSeq.+xe :: String -> Q Exp+xe query = compileQuery (parse (scan query))+++-- | Run an XQuery that may read XML documents.+-- When evaluated, it returns IO XSeq.+xq :: String -> Q Exp+xq query = compileQueryM (parse (scan query))+++-- | Run an XQuery that reads XML documents and queries databases.+-- When evaluated, it returns (IConnection conn) => conn -> IO XSeq.+xqdb :: String -> Q Exp+xqdb query = lamE [varP (mkName "_db")] (compileQueryM (parse (scan query)))
+ src/Text/XML/HXQ/Functions.hs view
@@ -0,0 +1,447 @@+{-------------------------------------------------------------------------------------+-+- XQuery functions+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 08/15/08, last update: 08/18/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++{-# OPTIONS_GHC -fth -fbang-patterns #-}++module Text.XML.HXQ.Functions where++import Data.List+import Char(isDigit)+import Language.Haskell.TH+import HXML(AttList)+import Text.XML.HXQ.XTree+++{--------------- XPath Steps ---------------------------------------------------------}+++-- XPath step self /.+self_step :: Tag -> XTree -> XSeq+self_step tag x+ = case x of+ XElem t _ _ _ _ -> if t==tag || tag=="*" then [x] else []+ _ -> [x]+++-- XPath step /tag or /*+child_step :: Tag -> XTree -> XSeq+child_step tag x+ = case x of+ XElem _ _ _ _ bs+ -> foldr (\b s -> case b of+ XElem t _ _ _ _ | (t==tag || tag=="*") -> b:s+ _ -> s) [] bs+ _ -> []+++-- XPath step //tag or //*+descendant_or_self_step :: Tag -> XTree -> XSeq+descendant_or_self_step tag (x@(XElem t _ _ _ cs))+ | tag==t || tag=="*"+ = x:(concatMap (descendant_or_self_step tag) cs)+descendant_or_self_step tag (XElem t _ _ _ cs)+ = concatMap (descendant_or_self_step tag) cs+descendant_or_self_step _ _ = []+++-- XPath step descendant+descendant_step :: Tag -> XTree -> XSeq+descendant_step tag (XElem t _ _ _ cs)+ = concatMap (descendant_or_self_step tag) cs+descendant_step _ _ = []+++-- It's like //* but has tagged children, which are derived statically+-- After examing 100 children it gives up: this avoids space leaks+descendant_any_with_tagged_children :: [Tag] -> XTree -> XSeq+descendant_any_with_tagged_children tags (x@(XElem t _ _ _ cs))+ | all (\tag -> foldr (\b s -> case b of+ (XElem k _ _ _ _) -> s || k == tag+ _ -> s) False cs100) tags+ = x:(concatMap (descendant_any_with_tagged_children tags) cs)+ where cs100 = take 100 cs+descendant_any_with_tagged_children tags (XElem t _ _ _ cs)+ = concatMap (descendant_any_with_tagged_children tags) cs+descendant_any_with_tagged_children tags _ = []+++-- XPath step /@attr or /@*+attribute_step :: Tag -> XTree -> XSeq+attribute_step attr x+ = case x of+ (XElem _ al _ _ _) -> foldr (\(a,v) s -> if a==attr || attr=="*"+ then (XText v):s+ else s) [] al+ _ -> []+++-- XPath step //@attr or //@*+attribute_descendant_step :: Tag -> XTree -> XSeq+attribute_descendant_step attr (x@(XElem _ al _ _ cs))+ = foldr (\(a,v) s -> if a==attr || attr=="*"+ then (XText v):s+ else s)+ (concatMap (attribute_descendant_step attr) cs) al+attribute_descendant_step _ _ = []+++-- XPath step parent /..+parent_step :: Tag -> XTree -> XSeq+parent_step tag (XElem _ _ _ p _)+ = case p of+ XElem t _ _ _ _ | (t==tag || tag=="*") -> [p]+ _ -> []+parent_step _ _ = []+++-- XPath step ancestor+ancestor_step :: Tag -> XTree -> XSeq+ancestor_step tag (XElem _ _ _ p _)+ = case p of+ XElem t _ _ _ _+ -> if t==tag || tag=="*"+ then p:(ancestor_step tag p)+ else ancestor_step tag p+ _ -> []+ancestor_step _ _ = []+++-- XPath step ancestor-or-self+ancestor_or_self_step :: Tag -> XTree -> XSeq+ancestor_or_self_step tag e+ = case e of+ XElem t _ _ _ _+ -> if t==tag || tag=="*"+ then e:(ancestor_step tag e)+ else ancestor_step tag e+ _ -> []+++-- XPath step following-sibling+following_sibling_step :: Tag -> XTree -> XSeq+following_sibling_step tag (XElem _ _ order (XElem _ _ _ _ cs) _)+ = concatMap (self_step tag)+ (tail (dropWhile filter cs))+ where filter (XElem _ _ o _ _) = o /= order+ filter _ = True+following_sibling_step _ _ = []+++-- XPath step following+following_step :: Tag -> XTree -> XSeq+following_step tag (XElem _ _ order p _)+ = case p of+ XElem _ _ _ _ cs+ -> (concatMap (descendant_or_self_step tag)+ (tail (dropWhile filter cs)))+ ++(following_step tag p)+ where filter (XElem _ _ o _ _) = o /= order+ filter _ = True+ _ -> []+following_step _ _ = []+++-- XPath step preceding-sibling+preceding_sibling_step :: Tag -> XTree -> XSeq+preceding_sibling_step tag (XElem _ _ order (XElem _ _ _ _ cs) _)+ = concatMap (self_step tag)+ (takeWhile filter cs)+ where filter (XElem _ _ o _ _) = o /= order+ filter _ = True+preceding_sibling_step _ _ = []+++-- XPath step preceding+preceding_step :: Tag -> XTree -> XSeq+preceding_step tag (XElem _ _ order p _)+ = case p of+ XElem t _ _ _ cs+ -> (concatMap (descendant_or_self_step tag)+ (takeWhile filter cs))+ ++(preceding_step tag p)+ where filter (XElem _ _ o _ _) = o /= order+ filter _ = True+ _ -> []+preceding_step _ _ = []+++-- XPath steps+paths :: [(Tag,Q Exp)]+paths = [ ( "child", [| child_step |] ),+ ( "descendant", [| descendant_step |] ),+ ( "attribute", [| attribute_step |] ),+ ( "self", [| self_step |] ),+ ( "descendant-or-self", [| descendant_or_self_step |] ),+ ( "attribute-descendant", [| attribute_descendant_step |] ),+ ( "following-sibling", [| following_sibling_step |] ),+ ( "following", [| following_step |] ),+ ( "parent", [| parent_step |] ),+ ( "ancestor", [| ancestor_step |] ),+ ( "preceding-sibling", [| preceding_sibling_step |] ),+ ( "preceding", [| preceding_step |] ),+ ( "ancestor-or-self", [| ancestor_or_self_step |] ) ]+++-- XPath steps to be used by the interpreter+-- when evaluated, it gives [(String,Tag->XTree->XSeq)]+pFunctions = foldr (\(pname,p) r -> let pn = litE (StringL pname) in [| ($pn,$p) : $r |]) [| [] |] paths+++{------------ Functions --------------------------------------------------------------}+++-- find the value of a variable in an association list+findV var env+ = case filter (\(n,_) -> n==var) env of+ (_,b):_ -> b+ _ -> error ("Undefined variable: "++var)+++-- is the variable defined in the association list?+memV var env+ = case filter (\(n,_) -> n==var) env of+ (_,b):_ -> True+ _ -> False+++-- like foldr but with an index+foldir :: (a -> Int -> b -> b) -> b -> [a] -> Int -> b+foldir c n [] i = n+foldir c n (x:xs) i = c x i (foldir c n xs (i+1))+++trueXT = XBool True+falseXT = XBool False+++readNum :: String -> Maybe XTree+readNum cs = case span isDigit cs of+ (n,[]) -> Just (XInt (read n))+ (n,'.':rest) -> case span isDigit rest of+ (k,[]) -> Just (XFloat (read (n++('.':k))))+ _ -> Nothing+ _ -> Nothing+++text :: XSeq -> XSeq+text xs = foldr (\x r -> case x of+ XElem _ _ _ _ zs+ -> (filter (\a -> case a of XText _ -> True; XInt _ -> True;+ XFloat _ -> True; XBool _ -> True; _ -> False) zs)++r+ XText _ -> x:r+ XInt _ -> x:r+ XFloat _ -> x:r+ XBool _ -> x:r+ _ -> r) [] xs+++toString :: XSeq -> [String]+toString xs = map (\x -> case x of + XText t -> t+ XInt n -> show n+ XFloat n -> show n+ XBool n -> show n)+ (text xs)+++-- concatenate text with no padding (for element content)+appendText :: [XSeq] -> XSeq+appendText [] = []+appendText [x] = x+appendText (x:xs) = x++[XNoPad]++appendText xs+++toNum :: XSeq -> XSeq+toNum xs = foldr (\x r -> case x of+ XInt n -> x:r+ XFloat n -> x:r+ XText s -> case readNum s of+ Just t -> t:r+ _ -> r+ _ -> r) [] (text xs)+++toFloat :: XTree -> Float+toFloat (XText s) = case readNum s of+ Just (XInt n) -> fromIntegral n+ Just (XFloat n) -> n+ _ -> error("Cannot convert to a float: "++s)+toFloat (XInt n) = fromIntegral n+toFloat (XFloat n) = n+toFloat x = error("Cannot convert to a float: "++(show x))+++mean :: (Fractional t) => [t] -> t+mean = uncurry (/) . foldl' (\(!s, !n) x -> (s+x, n+1)) (0,0.0)+++contains :: String -> String -> Bool+contains text word+ = let len = length word+ c xs | ((take len xs) == word) = True+ c (_:xs) = c xs+ c _ = False+ in c text+++distinct :: Eq a => [a] -> [a]+distinct = foldl (\r a -> if elem a r then r else r++[a]) []+++arithmetic :: (Float -> Float -> Float) -> XTree -> XTree -> XTree+arithmetic op (XInt n) (XInt m) = XInt (round (op (fromIntegral n) (fromIntegral m)))+arithmetic op (XFloat n) (XFloat m) = XFloat (op n m)+arithmetic op (XFloat n) (XInt m) = XFloat (op n (fromIntegral m))+arithmetic op (XInt n) (XFloat m) = XFloat (op (fromIntegral n) m)+++compareXTrees :: XTree -> XTree -> Ordering+compareXTrees (XElem _ _ _ _ _) _ = EQ+compareXTrees _ (XElem _ _ _ _ _) = EQ+compareXTrees (XInt n) (XInt m) = compare n m+compareXTrees (XFloat n) (XInt m) = compare n (fromIntegral m)+compareXTrees (XInt n) (XFloat m) = compare (fromIntegral n) m+compareXTrees (XFloat n) (XFloat m) = compare n m+compareXTrees (XText n) (XText m) = compare n m+compareXTrees x y = compare (toFloat x) (toFloat y)+++strictCompareOne [XInt n] [XInt m] = compare n m+strictCompareOne [XFloat n] [XFloat m] = compare n m+strictCompareOne [XFloat n] [XInt m] = compare n (fromIntegral m)+strictCompareOne [XInt n] [XFloat m] = compare (fromIntegral n) m+strictCompareOne [XText n] [XText m] = compare n m+strictCompareOne x y = error ("Illegal operands in strict comparison: "++(show x)++" "++(show y))++strictCompare :: XSeq -> XSeq -> Ordering+strictCompare [XElem _ _ _ _ x] [XElem _ _ _ _ y] = strictCompareOne x y+strictCompare x [XElem _ _ _ _ y] = strictCompareOne x y+strictCompare [XElem _ _ _ _ x] y = strictCompareOne x y+strictCompare x y = strictCompareOne x y++compareXSeqs :: Bool -> XSeq -> XSeq -> Ordering+compareXSeqs ord xs ys+ = let comps = [ compareXTrees x y | x <- xs, y <- ys ]+ in if ord+ then if all (\x -> x == LT) comps+ then LT+ else if all (\x -> x == GT) comps+ then GT+ else EQ+ else if all (\x -> x == LT) comps+ then GT+ else if all (\x -> x == GT) comps+ then LT+ else EQ+++conditionTest :: XSeq -> Bool+conditionTest [] = False+conditionTest [XText ""] = False+conditionTest [XInt 0] = False+conditionTest [XBool False] = False+conditionTest _ = True+++type Function = [Q Exp] -> Q Exp++-- System functions: they can also be defined as Haskell functions of type (XSeq,...,XSeq) -> XSeq+-- but here we make sure they are unfolded and fused with the rest of the query+functions :: [(Tag,Int,Function)]+functions = [ ( "=", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y == EQ ] |] ),+ ( "!=", 2, \[xs,ys] -> [| if null [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y == EQ ]+ then [trueXT]+ else [falseXT] |] ),+ ( ">", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y == GT ] |] ),+ ( "<", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y == LT ] |] ),+ ( ">=", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y `elem` [GT,EQ] ] |] ),+ ( "<=", 2, \[xs,ys] -> [| [ trueXT | x <- text $xs, y <- text $ys, compareXTrees x y `elem` [LT,EQ] ] |] ),+ ( "eq", 2, \[xs,ys] -> [| if strictCompare $xs $ys == EQ then [trueXT] else [falseXT] |] ),+ ( "neq", 2, \[xs,ys] -> [| if strictCompare $xs $ys /= EQ then [trueXT] else [falseXT] |] ),+ ( "lt", 2, \[xs,ys] -> [| if strictCompare $xs $ys == LT then [trueXT] else [falseXT] |] ),+ ( "gt", 2, \[xs,ys] -> [| if strictCompare $xs $ys == GT then [trueXT] else [falseXT] |] ),+ ( "le", 2, \[xs,ys] -> [| if strictCompare $xs $ys `elem` [LT,EQ] then [trueXT] else [falseXT] |] ),+ ( "ge", 2, \[xs,ys] -> [| if strictCompare $xs $ys `elem` [GT,EQ] then [trueXT] else [falseXT] |] ),+ ( "<<", 2, \[xs,ys] -> [| [ trueXT | XElem _ _ ox _ _ <- $xs, XElem _ _ oy _ _ <- $ys, ox < oy ] |] ),+ ( ">>", 2, \[xs,ys] -> [| [ trueXT | XElem _ _ ox _ _ <- $xs, XElem _ _ oy _ _ <- $ys, ox > oy ] |] ),+ ( "is", 2, \[xs,ys] -> [| [ trueXT | XElem _ _ ox _ _ <- $xs, XElem _ _ oy _ _ <- $ys, ox == oy ] |] ),+ ( "+", 2, \[xs,ys] -> [| [ arithmetic (+) x y | x <- toNum $xs, y <- toNum $ys ] |] ),+ ( "-", 2, \[xs,ys] -> [| [ arithmetic (-) x y | x <- toNum $xs, y <- toNum $ys ] |] ),+ ( "*", 2, \[xs,ys] -> [| [ arithmetic (*) x y | x <- toNum $xs, y <- toNum $ys ] |] ),+ ( "div", 2, \[xs,ys] -> [| [ arithmetic (/) x y | x <- toNum $xs, y <- toNum $ys ] |] ),+ ( "idiv", 2, \[xs,ys] -> [| [ XInt (div x y) | (XInt x) <- toNum $xs, (XInt y) <- toNum $ys ] |] ),+ ( "mod", 2, \[xs,ys] -> [| [ XInt (mod x y) | (XInt x) <- toNum $xs, (XInt y) <- toNum $ys ] |] ),+ ( "uplus", 1, \[xs] -> [| [ x | x <- toNum $xs ] |] ),+ ( "uminus", 1, \[xs] -> [| [ case x of XInt n -> XInt (-n); XFloat n -> XFloat (-n) | x <- toNum $xs ] |] ),+ ( "and", 2, \[xs,ys] -> [| if (conditionTest $xs) && (conditionTest $ys) then [trueXT] else [falseXT] |] ),+ ( "or", 2, \[xs,ys] -> [| if (conditionTest $xs) || (conditionTest $ys) then [trueXT] else [falseXT] |] ),+ ( "not", 1, \[xs] -> [| if (conditionTest $xs) then [falseXT] else [trueXT] |] ),+ ( "some", 1, \[xs] -> [| if (conditionTest $xs) then [trueXT] else [falseXT] |] ),+ ( "count", 1, \[xs] -> [| [ XInt (length $xs) ] |] ),+ ( "sum", 1, \[xs] -> [| [ XFloat (sum [ toFloat x | x <- toNum $xs ]) ] |] ),+ ( "avg", 1, \[xs] -> [| [ XFloat (mean [ toFloat x | x <- toNum $xs ]) ] |] ),+ ( "min", 1, \[xs] -> [| [ XFloat (minimum [ toFloat x | x <- toNum $xs ]) ] |] ),+ ( "max", 1, \[xs] -> [| [ XFloat (maximum [ toFloat x | x <- toNum $xs ]) ] |] ),+ ( "to", 2, \[xs,ys] -> [| [ XInt i | XInt n <- toNum $xs, XInt m <- toNum $ys, i <- [n..m] ] |] ),+ ( "text", 1, \[xs] -> [| text $xs |] ),+ ( "string", 1, \[xs] -> [| text $xs |] ),+ ( "data", 1, \[xs] -> [| text $xs |] ),+ ( "node", 1, \[xs] -> [| [ w | w@(XElem _ _ _ _ _) <- $xs ] |] ),+ ( "exists", 1, \[xs] -> [| [ XBool (not (null $xs)) ] |] ),+ ( "empty", 0, \[] -> [| [] |] ),+ ( "true", 0, \[] -> [| [trueXT] |] ),+ ( "false", 0, \[] -> [| [] |] ),+ ( "if", 3, \[cs,ts,es] -> [| if conditionTest $cs then $ts else $es |] ),+ ( "element", 2, \[tags,xs] -> [| [ x | tag <- toString $tags, x@(XElem t _ _ _ _) <- $xs, (t==tag || tag=="*") ] |] ),+ ( "attribute", 2, \[tags,xs] -> [| [ z | tag <- toString $tags, x <- $xs, z <- attribute_step tag x ] |] ),+ ( "name", 1, \[xs] -> [| [ XText tag | XElem tag _ _ _ _ <- $xs ] |] ),+ ( "contains", 2, \[xs,text] -> [| [ trueXT | x <- toString $xs, t <- toString $text, contains x t ] |] ),+ ( "substring", 3, \[xs,n1,n2] -> [| [ XText (take m2 (drop (m1-1) x)) | x <- toString $xs,+ XInt m1 <- toNum $n1, XInt m2 <- toNum $n2 ] |] ),+ ( "concatenate", 2, \[xs,ys] -> [| $xs ++ $ys |] ),+ ( "distinct-values", 1, \[xs] -> [| distinct $xs |] ),+ ( "union", 2, \[xs,ys] -> [| distinct ($xs ++ $ys) |] ),+ ( "intersect", 2, \[xs,ys] -> [| filter (\x -> elem x $ys) $xs |] ),+ ( "except", 2, \[xs,ys] -> [| filter (\x -> not (elem x $ys)) $xs |] ),+ ( "reverse", 1, \[xs] -> [| reverse $xs |] )+ ]+++-- functions to be used by the interpreter+-- when evaluated, it gives [(String,Int,[XSeq]->XSeq)]+iFunctions :: Q Exp+iFunctions = foldr (\(fname,len,f) r+ -> let vars = map (\i -> mkName ("v_"++(show i))) [1..len]+ entry = tupE [litE (StringL fname),litE (IntegerL (toInteger len)),+ lamE [listP (map varP vars)] (f (map varE vars))]+ in [| $entry : $r |]) [| [] |] functions+++-- make a function call+callF :: Tag -> Function+callF fname args = case filter (\(n,_,_) -> n == fname || ("fn:"++n)==fname) functions of+ (_,len,f):_ -> if (length args) == len+ then f args+ else error ("wrong number of arguments in function call: " ++ fname)+ _ -> -- otherwise, it must be a Haskell function of type (XSeq,...,XSeq) -> XSeq+ let itp = case args of+ [] -> [t| () |]+ [_] -> [t| XSeq |]+ _ -> foldr (\_ r -> appT r [t| XSeq |]) (appT (tupleT (length args)) [t| XSeq |])+ (tail args)+ fn = sigE (varE (mkName fname))+ (appT (appT arrowT itp) [t| XSeq |])+ in appE fn (tupE args)
+ src/Text/XML/HXQ/Interpreter.hs view
@@ -0,0 +1,401 @@+{-------------------------------------------------------------------------------------+-+- The XQuery Interpreter+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 03/22/08, last update: 08/20/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++{-# OPTIONS_GHC -fth -fglasgow-exts #-}+++module Text.XML.HXQ.Interpreter where++import Control.Monad+import List(sortBy)+import XMLParse(parseDocument)+import System.Console.Readline+import Text.XML.HXQ.Parser+import Text.XML.HXQ.XTree+import Text.XML.HXQ.Optimizer+import Text.XML.HXQ.Functions+import Text.XML.HXQ.Compiler+import Text.XML.HXQ.OptionalDB+++-- system functions (=, concat, etc)+systemFunctions :: [(String,Int,[XSeq]->XSeq)]+systemFunctions = $(iFunctions)+++-- XPath step functions (child, descendant, etc)+pathFunctions :: [(String,Tag->XTree->XSeq)]+pathFunctions = $(pFunctions)+++-- run-time bindings of FLOWR variables+type Environment = [(String,XSeq)]+++-- a user-defined function is (fname,parameters,body)+type Functions = [(String,[String],Ast)]+++undefv1 = error "Undefined XQuery context (.)"+undefv2 = error "Undefined position()"+undefv3 = error "Undefined last()"++++-- Each XPath predicate must calculate position() and last() from its input XSeq+-- if last() is used, then the evaluation is blocking (need to store the whole input XSeq)+applyPredicates :: [Ast] -> XSeq -> Bool -> Environment -> Functions -> XSeq+applyPredicates [] xs _ _ _ = xs+applyPredicates ((Aint n):preds) xs _ env fncs -- shortcut that improves laziness+ = applyPredicates preds [xs !! (n-1)] True env fncs+applyPredicates (pred:preds) xs True env fncs -- top-k like+ | maxPosition pathPosition pred > 0+ = applyPredicates (pred:preds) (take (maxPosition pathPosition pred) xs) False env fncs+applyPredicates (pred:preds) xs _ env fncs+ | containsLast pred -- blocking: use only when last() is used in the predicate+ = let last = length xs+ in applyPredicates preds+ (foldir (\x i r -> case eval pred x i last "" env fncs of+ [XInt k] -> if k == i then x:r else r -- indexing+ b -> if conditionTest b then x:r else r) [] xs 1) True env fncs+applyPredicates (pred:preds) xs _ env fncs+ = applyPredicates preds+ (foldir (\x i r -> case eval pred x i undefv3 "" env fncs of+ [XInt k] -> if k == i then x:r else r -- indexing+ b -> if conditionTest b then x:r else r) [] xs 1) True env fncs+++-- The XQuery interpreter+-- context: context node (XPath .)+-- position: the element position in the parent sequence (XPath position())+-- last: the length of the parent sequence (XPath last())+-- effective_axis: the XPath axis in /axis::tag(exp)+-- eg, the effective axis of //(A | B) is descendant+-- env: contains FLOWR variable bindings+-- fncs: user-defined functions+eval :: Ast -> XTree -> Int -> Int -> String -> Environment -> Functions -> XSeq+eval e context position last effective_axis env fncs+ = case e of+ Avar "." -> [ context ]+ Avar v -> findV v env+ Aint n -> [ XInt n ]+ Afloat n -> [ XFloat n ]+ Astring s -> [ XText s ]+ Ast "context" [v,Astring dp,body]+ -> foldr (\x r -> (eval body x position last dp env fncs)++r)+ [] (eval v context position last effective_axis env fncs)+ Ast "call" [Avar "position"] -> [XInt position]+ Ast "call" [Avar "last"] -> [XInt last]+ Ast "step" (Avar "child":tag:Avar ".":preds)+ | effective_axis /= ""+ -> eval (Ast "step" (Avar effective_axis:tag:Avar ".":preds)) context position last "" env fncs+ Ast "step" (Avar "descendant_any":Ast "tags" tags:e:preds)+ -> let ts = map (\(Avar tag) -> tag) tags+ in foldr (\x r -> (applyPredicates preds (descendant_any_with_tagged_children ts x) True env fncs)++r)+ [] (eval e context position last effective_axis env fncs)+ Ast "step" (Avar step:Astring tag:e:preds)+ -> foldr (\x r -> (applyPredicates preds ((findV step pathFunctions) tag x) True env fncs)++r)+ [] (eval e context position last effective_axis env fncs)+ Ast "filter" (e:preds)+ -> applyPredicates preds (eval e context position last effective_axis env fncs) True env fncs+ Ast "predicate" [condition,body]+ -> let xs = eval body context position last effective_axis env fncs+ in foldr (\x r -> if conditionTest (eval condition undefv1 undefv2 undefv3 "" env fncs)+ then x:r else r) [] xs+ Ast "append" args+ -> appendText (map (\x -> eval x context position last effective_axis env fncs) args)+ Ast "call" ((Avar fname):args)+ -> case filter (\(n,_,_) -> n == fname || ("fn:"++n) == fname) systemFunctions of+ [(_,len,f)] -> if (length args) == len+ then f (map (\x -> eval x context position last effective_axis env fncs) args)+ else error ("Wrong number of arguments in system call: "++fname)+ _ -> case filter (\(n,_,_) -> n == fname) fncs of+ (_,params,body):_ -> if (length params) == (length args)+ then eval body context undefv2 undefv3 ""+ ((zipWith (\p a -> (p,eval a context position last effective_axis env fncs))+ params args)++env) fncs+ else error ("Wrong number of arguments in function call: "++fname)+ _ -> error ("Undefined function: "++fname)+ Ast "construction" [Astring tag,Ast "attributes" [],body]+ -> [ XElem tag [] 0 parent_error (eval body context position last effective_axis env fncs) ]+ Ast "construction" [tag,Ast "attributes" al,body]+ -> let alc = map (\(Ast "pair" [a,v])+ -> let ac = eval a context position last effective_axis env fncs+ vc = eval v context position last effective_axis env fncs+ in (qName ac,showXS vc)) al+ ct = eval tag context position last effective_axis env fncs+ bc = eval body context position last effective_axis env fncs+ in [ XElem (qName ct) alc 0 parent_error bc ]+ Ast "let" [Avar var,source,body]+ -> eval body context position last effective_axis+ ((var,eval source context position last effective_axis env fncs):env) fncs+ Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index+ -> foldr (\a r -> (eval body a undefv2 undefv3 "" ((var,[a]):env) fncs)++r)+ [] (eval source context position last effective_axis env fncs)+ Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index+ -> let p = maxPosition (Avar ivar) body+ ns = if p > 0 -- there is a top-k like restriction+ then Ast "step" [source,Ast "call" [Avar "<=",pathPosition,Aint p]]+ else source + in foldir (\a i r -> (eval body a i undefv3 "" ((var,[a]):(ivar,[XInt i]):env) fncs)++r)+ [] (eval ns context position last effective_axis env fncs) 1+ Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting+ -> [ XElem "" [] 0 parent_error+ (foldl (\r a -> r++[XElem "" [] 0 parent_error (text (eval a context position last effective_axis env fncs))])+ [XElem "" [] 0 parent_error (eval exp context position last effective_axis env fncs)] orderBys) ]+ Ast "sort" (exp:ordList) -- blocking+ -> let ce = map (\(XElem _ _ _ _ xs) -> map (\(XElem _ _ _ _ ys) -> ys) xs)+ (eval exp context position last effective_axis env fncs)+ ordering = foldr (\(Avar ord) r (x:xs) (y:ys)+ -> case compareXSeqs (ord == "ascending") x y of+ EQ -> r xs ys+ o -> o)+ (\xs ys -> EQ) ordList+ in concatMap head (sortBy (\(_:xs) (_:ys) -> ordering xs ys) ce)+ _ -> error ("Illegal XQuery: "++(show e))+++type Statements = [(String,Statement)]+++-- The monadic applyPredicates that propagates IO state+applyPredicatesM :: [Ast] -> XSeq -> Bool -> Environment -> Functions -> Statements -> IO XSeq+applyPredicatesM [] xs _ _ _ _ = return xs+applyPredicatesM ((Aint n):preds) xs _ env fncs stmts -- shortcut that improves laziness+ = applyPredicatesM preds [xs !! (n-1)] True env fncs stmts+applyPredicatesM (pred:preds) xs True env fncs stmts -- top-k like+ | maxPosition pathPosition pred > 0+ = applyPredicatesM (pred:preds) (take (maxPosition pathPosition pred) xs) False env fncs stmts+applyPredicatesM (pred:preds) xs _ env fncs stmts+ | containsLast pred -- blocking: use only when last() is used in the predicate+ = do let last = length xs+ vs <- foldir (\x i r -> do vs <- evalM pred x i last "" env fncs stmts+ s <- r+ return (if case vs of+ [XInt k] -> k == i -- indexing+ b -> conditionTest b+ then x:s else s))+ (return []) xs 1+ applyPredicatesM preds vs True env fncs stmts+applyPredicatesM (pred:preds) xs _ env fncs stmts+ = do vs <- foldir (\x i r -> do vs <- evalM pred x i undefv3 "" env fncs stmts+ s <- r+ return (if case vs of+ [XInt k] -> k == i -- indexing+ b -> conditionTest b+ then x:s else s))+ (return []) xs 1+ applyPredicatesM preds vs True env fncs stmts+++-- The monadic XQuery interpreter; it is like eval but has plumbing to propagate IO state+evalM :: Ast -> XTree -> Int -> Int -> String -> Environment -> Functions -> Statements -> IO XSeq+evalM e context position last effective_axis env fncs stmts+ = case e of+ Avar "." -> return [ context ]+ Avar v -> return (findV v env)+ Aint n -> return [ XInt n ]+ Afloat n -> return [ XFloat n ]+ Astring s -> return [ XText s ]+ -- for non-IO XQuery, use the regular eval+ Ast "nonIO" [u] -> return (eval u context position last effective_axis env fncs)+ Ast "context" [v,Astring dp,body]+ -> do vs <- evalM v context position last effective_axis env fncs stmts+ foldr (\x r -> (liftM2 (++)) (evalM body x position last dp env fncs stmts) r)+ (return []) vs+ Ast "call" [Avar "position"] -> return [XInt position]+ Ast "call" [Avar "last"] -> return [XInt last]+ Ast "step" (Avar "child":tag:Avar ".":preds)+ | effective_axis /= ""+ -> evalM (Ast "step" (Avar effective_axis:tag:Avar ".":preds)) context position last "" env fncs stmts+ Ast "step" (Avar "descendant_any":Ast "tags" tags:e:preds)+ -> do vs <- evalM e context position last effective_axis env fncs stmts+ let ts = map (\(Avar tag) -> tag) tags+ foldr (\x r -> (liftM2 (++)) (applyPredicatesM preds (descendant_any_with_tagged_children ts x) True env fncs stmts) r)+ (return []) vs+ Ast "step" (Avar step:Astring tag:e:preds)+ -> do vs <- evalM e context position last effective_axis env fncs stmts+ foldr (\x r -> (liftM2 (++)) (applyPredicatesM preds ((findV step pathFunctions) tag x) True env fncs stmts) r)+ (return []) vs+ Ast "filter" (e:preds)+ -> do vs <- evalM e context position last effective_axis env fncs stmts+ applyPredicatesM preds vs True env fncs stmts+ Ast "predicate" [condition,body]+ -> do vs <- evalM body context position last effective_axis env fncs stmts+ foldr (\x r -> do vs <- evalM condition undefv1 undefv2 undefv3 "" env fncs stmts+ s <- r+ return (if conditionTest vs then x:s else s))+ (return []) vs+ Ast "executeSQL" [Avar var,args]+ -> do as <- evalM args context position last effective_axis env fncs stmts+ executeSQL (findV var stmts) as+ Ast "call" [Avar nm,c,t,e] -- this is the only lazy function+ | elem nm ["if","fn:if"]+ -> do ce <- evalM c context position last effective_axis env fncs stmts+ evalM (if conditionTest ce then t else e) context position last effective_axis env fncs stmts+ Ast "append" args+ -> (liftM appendText) (mapM (\x -> evalM x context position last effective_axis env fncs stmts) args)+ Ast "call" ((Avar fname):args) -- Note: strict function application+ -> case filter (\(n,_,_) -> n == fname || ("fn:"++n) == fname) systemFunctions of+ [(_,len,f)] -> if (length args) == len+ then (liftM f) (mapM (\x -> evalM x context position last effective_axis env fncs stmts) args)+ else error ("Wrong number of arguments in system call: "++fname)+ _ -> case filter (\(n,_,_) -> n == fname) fncs of+ (_,params,body):_ -> if (length params) == (length args)+ then do vs <- mapM (\a -> evalM a context position last effective_axis env fncs stmts) args+ evalM body context undefv2 undefv3 ""+ ((zipWith (\p a -> (p,a)) params vs)++env) fncs stmts+ else error ("Wrong number of arguments in function call: "++fname)+ _ -> error ("Undefined function: "++fname)+ Ast "construction" [Astring tag,Ast "attributes" [],body]+ -> do b <- evalM body context position last effective_axis env fncs stmts+ return [ XElem tag [] 0 parent_error b ]+ Ast "construction" [tag,Ast "attributes" al,body]+ -> do alc <- mapM (\(Ast "pair" [a,v])+ -> do ac <- evalM a context position last effective_axis env fncs stmts+ vc <- evalM v context position last effective_axis env fncs stmts+ return (qName ac,showXS vc)) al+ ct <- evalM tag context position last effective_axis env fncs stmts+ bc <- evalM body context position last effective_axis env fncs stmts+ return [ XElem (qName ct) alc 0 parent_error bc ]+ Ast "let" [Avar var,source,body]+ -> do s <- evalM source context position last effective_axis env fncs stmts+ evalM body context position last effective_axis ((var,s):env) fncs stmts+ Ast "for" [Avar var,Avar "$",source,body] -- a for-loop without an index+ -> do vs <- evalM source context position last effective_axis env fncs stmts+ foldr (\a r -> (liftM2 (++)) (evalM body a undefv2 undefv3 "" ((var,[a]):env) fncs stmts) r)+ (return []) vs+ Ast "for" [Avar var,Avar ivar,source,body] -- a for-loop with an index+ -> do let p = maxPosition (Avar ivar) body+ ns = if p > 0 -- there is a top-k like restriction+ then Ast "step" [source,Ast "call" [Avar "<=",pathPosition,Aint p]]+ else source + vs <- evalM ns context position last effective_axis env fncs stmts+ foldir (\a i r -> (liftM2 (++)) (evalM body a i undefv3 "" ((var,[a]):(ivar,[XInt i]):env) fncs stmts) r)+ (return []) vs 1+ Ast "sortTuple" (exp:orderBys) -- prepare each FLWOR tuple for sorting+ -> do vs <- evalM exp context position last effective_axis env fncs stmts+ os <- mapM (\a -> evalM a context position last effective_axis env fncs stmts) orderBys+ return [ XElem "" [] 0 parent_error (foldl (\r a -> r++[XElem "" [] 0 parent_error (text a)])+ [XElem "" [] 0 parent_error vs] os) ]+ Ast "sort" (exp:ordList) -- blocking+ -> do vs <- evalM exp context position last effective_axis env fncs stmts+ let ce = map (\(XElem _ _ _ _ xs) -> map (\(XElem _ _ _ _ ys) -> ys) xs) vs+ ordering = foldr (\(Avar ord) r (x:xs) (y:ys)+ -> case compareXSeqs (ord == "ascending") x y of+ EQ -> r xs ys+ o -> o)+ (\xs ys -> EQ) ordList+ return (concatMap head (sortBy (\(_:xs) (_:ys) -> ordering xs ys) ce))+ _ -> error ("Illegal XQuery: "++(show e))+++-- evaluate from input continuously+evalInput :: (String -> Environment -> Functions -> IO(Environment,Functions)) -> Environment -> Functions -> IO ()+evalInput eval vs fs+ = do let oneline prompt = do line <- readline prompt+ case line of+ Nothing -> return "quit"+ Just t -> if t == ""+ then oneline prompt+ else return t+ readlines x = do line <- oneline ": "+ if last line == '}'+ then return (x++" "++(init line))+ else if line == "quit"+ then return line+ else readlines (x++" "++line)+ line <- oneline "> "+ stmt <- if head line == '{'+ then if last line == '}'+ then return (init (tail line))+ else readlines (tail line)+ else return line+ if stmt == "quit"+ then putStrLn "Bye!"+ else do addHistory stmt+ (nvs,nfs) <- eval (map (\c -> if c=='\"' then '\'' else c) stmt) vs fs+ evalInput eval nvs nfs+++evalQueryM :: [Ast] -> Environment -> Functions -> (String -> IO Statement) -> Bool -> IO (XSeq,Environment,Functions)+evalQueryM [] variables functions dbmapper verbose+ = return ([],variables,functions)+evalQueryM (query:xs) variables functions dbmapper verbose+ = case query of+ Ast "function" ((Avar f):b:args)+ -> evalQueryM xs variables ((f,map (\(Avar v) -> v) args,optimize b):functions) dbmapper verbose+ Ast "variable" [Avar v,u]+ -> do uv <- evalM (optimize u) undefv1 undefv2 undefv3 "" variables functions []+ evalQueryM xs ((v,uv):variables) functions dbmapper verbose+ _ -> do let opt = optimize query+ (ast,ns) = liftIOSources opt+ if verbose+ then do putStrLn "Abstract Syntax Tree (AST):"+ putStrLn (ppAst query)+ putStrLn "Optimized AST:"+ putStrLn (ppAst opt)+ putStrLn "Result:"+ else return ()+ env <- foldr (\(n,b,s) r -> case s of+ Avar m+ -> do env <- r+ return ((n,findV m env):env)+ Astring file+ -> do doc <- readFile file+ env <- r+ return ((n,[materialize b (parseDocument doc)]):env)+ _ -> r)+ (return []) ns+ stmts <- foldr (\(n,_,s) r -> case s of+ Ast "prepareSQL" [Astring sql]+ -> do stmts <- r+ t <- dbmapper sql+ return ((n,t):stmts)+ _ -> r)+ (return []) ns+ result <- evalM ast undefv1 undefv2 undefv3 "" (env++variables) functions stmts+ (rest,renv,rfuns) <- evalQueryM xs variables functions dbmapper verbose+ return (result++rest,renv,rfuns)+++xqueryE :: String -> Environment -> Functions -> (String -> IO Statement) -> Bool -> IO (XSeq,Environment,Functions)+xqueryE query variables functions dbmapper verbose+ = evalQueryM (parse (scan query)) variables functions dbmapper verbose+++-- | Evaluate the XQuery using the interpreter.+xquery :: String -> IO XSeq+xquery query = do (u,_,_) <- xqueryE query [] [] (\sql -> error "No database connectivity") False+ return u+++-- | Read an XQuery from a file and run it using the interpreter.+xfile :: String -> IO XSeq+xfile file = do query <- readFile file+ xquery query+++-- | Evaluate the XQuery with database connectivity using the interpreter.+xqueryDB :: (IConnection conn) => String -> conn -> IO XSeq+xqueryDB query db = do (u,_,_) <- xqueryE query [] [] (prepareSQL db) False+ return u+++-- | Read an XQuery with database connectivity from a file and run it using the interpreter.+xfileDB :: (IConnection conn) => String -> conn -> IO XSeq+xfileDB file db = do query <- readFile file+ xqueryDB query db
+ src/Text/XML/HXQ/Optimizer.hs view
@@ -0,0 +1,687 @@+{-------------------------------------------------------------------------------------+-+- Preprocess abstract syntax trees, remove backward steps, and optimize+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 05/01/08, last update: 08/23/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++module Text.XML.HXQ.Optimizer(optimize) where++import Control.Monad+import Char(toLower)+import HXML(AttList)+import Text.XML.HXQ.Parser+import Text.XML.HXQ.XTree+import Text.XML.HXQ.OptionalDB++++empty = Ast "call" [Avar "empty"]+true = Ast "call" [Avar "true"]+false = Ast "call" [Avar "false"]+++distinct :: Eq a => [a] -> [a]+distinct = foldl (\r a -> if elem a r then r else r++[a]) []+++-- collect attribute constructions inside element constructions+collect_attributes :: Ast -> (Ast,[Ast])+collect_attributes (Ast "attribute_construction" [attr,value])+ = (Ast "call" [Avar "empty"],[Ast "pair" [attr,value]])+collect_attributes (Ast "call" [Avar "concatenate",x,y])+ = let (cx,ax) = collect_attributes x+ (cy,ay) = collect_attributes y+ in (Ast "call" [Avar "concatenate",cx,cy],ax++ay)+collect_attributes (Ast "append" es)+ = let (s,a) = foldr (\e (r,ar) -> let (cx,ax) = collect_attributes e in (cx:r,ax++ar)) ([],[]) es+ in (Ast "append" s,a)+collect_attributes (Ast "step" (step:tag:e:preds))+ = let (ce,ae) = collect_attributes e+ in (Ast "step" (step:tag:ce:preds),ae)+collect_attributes e = (e,[])+++-- does the expression contain a $var/.. term?+parentOfVar :: Ast -> String -> Bool+parentOfVar (Ast "step" [Avar "parent",_,Avar x]) var = x == var+parentOfVar (Ast "let" [Avar v,s,_]) var | var == v = parentOfVar s var+parentOfVar (Ast "for" [Avar v,Avar i,s,_]) var | var == v || var == i = parentOfVar s var+parentOfVar (Ast _ args) var = or (map (\x -> parentOfVar x var) args)+parentOfVar _ _ = False+++-- replace $var/.. with $nvar+replaceParentOfVar :: Ast -> String -> String -> Ast+replaceParentOfVar (Ast "step" [Avar "parent",Astring "*",Avar x]) var nvar+ | x == var+ = Avar nvar+replaceParentOfVar (Ast "step" [Avar "parent",Astring tag,Avar x]) var nvar+ | x == var+ = Ast "step" [Avar "self",Astring tag,Avar nvar]+replaceParentOfVar (Ast "let" [Avar v,s,b]) var nvar | var == v+ = Ast "let" [Avar v,replaceParentOfVar s var nvar,b]+replaceParentOfVar (Ast "for" [Avar v,Avar i,s,b]) var nvar | var == v || var == i+ = Ast "for" [Avar v,Avar i,replaceParentOfVar s var nvar,b]+replaceParentOfVar (Ast f args) var nvar+ = Ast f (map (\x -> replaceParentOfVar x var nvar) args)+replaceParentOfVar e _ _ = e+++-- 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]]+removeParent :: Ast -> Maybe (Ast,Ast,Bool,Ast)+removeParent (Ast "predicate" [c,x])+ = do (nx,cond,childp,tag) <- removeParent x+ return (Ast "predicate" [c,nx],cond,childp,tag)+removeParent (Ast "step" (Avar "self":tag:x:preds))+ = do (nx,cond,childp,t) <- removeParent x+ return (Ast "step" (Avar "self":tag:nx:preds),cond,childp,t)+removeParent (Ast "step" (Avar "child":tag:x:preds))+ = Just (Ast "step" (Avar "child":tag:Avar ".":preds),x,True,tag)+removeParent (Ast "step" (Avar "descendant-or-self":tag:x:preds))+ = Just (Ast "step" (Avar "child":tag:Avar ".":preds),+ Ast "step" [Avar "descendant-or-self",Astring "*",x],True,tag)+removeParent (Ast "step" (Avar "descendant":tag:x:preds))+ = Just (Ast "step" (Avar "child":tag:Avar ".":preds),+ Ast "step" [Avar "descendant-or-self",Astring "*",x],True,tag)+removeParent (Ast "step" (Avar "attribute":tag:x:preds))+ = Just (Ast "step" (Avar "attribute":tag:Avar ".":preds),x,False,tag)+removeParent (Ast "step" (Avar "attribute-descendant":tag:x:preds))+ = Just (Ast "step" (Avar "attribute":tag:Avar ".":preds),+ Ast "step" [Avar "descendant-or-self",Astring "*",x],False,tag)+removeParent (Ast "step" (Avar "ancestor-or-self":tag:x:preds))+ = Just (true,Ast "step" (Avar "ancestor":tag:x:preds),False,tag)+removeParent (Ast "step" (Avar "preceding-sibling":tag:x:preds))+ = do (nx,cond,childp,t) <- removeParent x+ return (Ast "step" (Avar "child":tag:Avar ".":preds),cond,childp,t)+removeParent (Ast "step" (Avar "following-sibling":tag:x:preds))+ = do (nx,cond,childp,t) <- removeParent x+ return (Ast "step" (Avar "child":tag:Avar ".":preds),cond,childp,t)+removeParent e = Nothing+++-- to speed up //* step, find possible immediate tagged children, if any (eg, x in //*/x)+tagged_children :: String -> Ast -> [Tag]+tagged_children context (Ast "step" (Avar "child":Astring tag:Avar v:_))+ | v == context+ = [tag]+tagged_children _ (Ast "step" _) = []+tagged_children context (Ast "let" [Avar var,source,body])+ = if context == "." || context == var+ then tagged_children context source+ else (tagged_children context source)++(tagged_children context body)+tagged_children context (Ast "for" [Avar var,Avar ivar,source,body])+ = if context == "." || context == var || context == ivar+ then tagged_children context source+ else (tagged_children context source)++(tagged_children context body)+tagged_children context (Ast _ xs) = concatMap (tagged_children context) xs+tagged_children _ _ = []+++-- Preprocessing and simplification of ASTs+simplify :: Ast -> Ast+-- must be done bottom-up: /../..+simplify (Ast "step" [Avar "parent",t,z@(Ast "step" [Avar "parent",_,x])])+ = let nz = simplify z+ in simplify (Ast "step" [Avar "parent",t,nz])+-- get rid of a parent step+simplify (Ast "step" (Avar "parent":tag:x:preds))+ = case removeParent x of+ Just (cond,nx,_,_)+ -> Ast "step" (Avar "self":tag:simplify nx:simplify cond:preds)+ Nothing -> Ast "step" (Avar "parent":tag:simplify x:map simplify preds)+-- remove $var/.. in a let-FLWOR+simplify (Ast "let" [Avar var,source,body])+ | parentOfVar body var+ = case removeParent source of+ Just (cond,nx,childp,tag)+ -> simplify (Ast "let" [Avar (var++"_parent"),Ast "step" (Avar "self":Astring "*":nx:[cond]),+ Ast "let" [Avar var,+ Ast "step" [ Avar (if childp+ then "child"+ else "attribute"),+ tag, Avar (var++"_parent") ],+ replaceParentOfVar body var (var++"_parent")]])+ Nothing -> Ast "let" [Avar var,simplify source,simplify body]+-- remove $var/.. from a for-FLWOR+simplify (Ast "for" [Avar var,Avar "$",source,body])+ | parentOfVar body var+ = case removeParent source of+ Just (cond,nx,childp,tag)+ -> simplify (Ast "for" [Avar (var++"_parent"),Avar "$",Ast "step" (Avar "self":Astring "*":nx:[cond]),+ Ast "for" [Avar var,Avar "$",+ Ast "step" [ Avar (if childp+ then "child"+ else "attribute"),+ tag, Avar (var++"_parent") ],+ replaceParentOfVar body var (var++"_parent")]])+ Nothing -> Ast "for" [Avar var,Avar "$",simplify source,simplify body]+-- pull out attributes from a general element construction+simplify (Ast "element_construction" [tag,Ast "attributes" as,content])+ = let (nc,attrs) = collect_attributes content+ in simplify (Ast "construction" [tag,Ast "attributes" (as++attrs),nc])+-- if //* collect all children tagnames to use descendant_any+simplify (Ast "for" [Avar var,i,Ast "step" (Avar "descendant-or-self":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))+ tags = Ast "tags" (map Avar ctags)+ in simplify (Ast "for" [Avar var,i,Ast "step" (Avar "descendant_any":tags:path:preds),body])+simplify (Ast "step" (Avar "child":Astring tag:Ast "step" (Avar "descendant-or-self":Astring "*":path:preds):preds2))+ = let ctags = distinct(tag:(concatMap (tagged_children ".") preds))+ tags = Ast "tags" (map Avar ctags)+ in simplify (Ast "step" (Avar "child":Astring tag:Ast "step" (Avar "descendant_any":tags:path:preds):preds2))+simplify (Ast "step" (Avar "descendant-or-self":Astring "*":path:preds))+ | any (not . null . (tagged_children ".")) preds+ = let ctags = distinct (concatMap (tagged_children ".") preds)+ tags = Ast "tags" (map Avar ctags)+ in simplify (Ast "step" (Avar "descendant_any":tags:path:preds))+-- expand the wrapper of a stored document+simplify (Ast "call" [Avar "publish",Astring dbpath,Astring name])+ = simplify (publishXmlDoc dbpath name)+-- default+simplify (Ast n args) = Ast n (map simplify args)+simplify e = e+++-- simplify e/tag+taggedElement :: [Ast] -> String -> Maybe [Ast]+taggedElement (e@(Ast "construction" [Astring ctag,_,x]):xs) tag+ | ctag == tag || tag == "*"+ = do s <- taggedElement xs tag+ return (e:s)+taggedElement ((Ast "construction" [_,_,_]):xs) tag+ = taggedElement xs tag+taggedElement ((Ast "call" [Avar "concatenate",x,y]):xs) tag+ = do tx <- taggedElement (x:xs) tag+ ty <- taggedElement (y:xs) tag+ return (tx++ty)+taggedElement ((Astring _):xs) tag+ = taggedElement xs tag+taggedElement ((Aint _):xs) tag+ = taggedElement xs tag+taggedElement (e:xs) tag = Nothing+taggedElement [] _ = Just []+++sqlComparisson = [("=","="),("eq","="),("<=","<="),(">=",">="),("!=","!="),(">",">"),+ ("<","<"),("ne","!="),("gt",">"),("lt","<"),("ge",">="),("le","<=")]++sqlBoolean = [("and","and"),("or","or")]+++-- Can this be transformed to an SQL predicate?+sqlPredicate :: [String] -> Ast -> Bool+sqlPredicate tables e+ = case e of+ Ast "step" (Avar "child":Astring tag:Avar v:preds)+ -> (elem v tables) && (all (sqlPredicate tables) preds)+ Ast "construction" [_,_,Ast "append" xs]+ -> all (sqlPredicate tables) xs+ Ast "call" [Avar "text",x]+ -> sqlPredicate tables x+ Ast "call" [Avar cmp,x,y]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> (sqlExpr tables x) && (sqlExpr tables y)+ Ast "call" [Avar cmp,x,y]+ | any (\(f,_) -> f==cmp) sqlBoolean+ -> (sqlPredicate tables x) && (sqlPredicate tables y)+ _ -> False+ where sqlExpr tables e+ = case e of+ Astring s -> True+ Aint n -> True+ Ast "step" (Avar "child":Astring tag:Avar v:preds)+ -> elem v tables+ Ast "construction" [_,_,Ast "append" xs]+ -> all (sqlExpr tables) xs+ Ast "call" [Avar "text",x]+ -> sqlExpr tables x+ Ast "for" [Avar v,_,Ast "call" ((Avar "SQL"):_),x]+ -> sqlExpr (v:tables) x+ _ -> False+++-- Convert a predicate AST to an SQL predicate that uses the tables+predToSQL :: [String] -> Ast -> (String,[Ast])+predToSQL tables e+ = case e of+ Ast "step" [Avar "child",Astring tag,Avar v]+ -> if (elem v tables)+ then ("",[])+ else error ("Cannot convert to an SQL predicate: "++show e)+ Ast "step" (Avar "child":Astring tag:Avar v:pred:preds)+ -> if (elem v tables) && (all (sqlPredicate tables) preds)+ then let (p,ps) = foldl (\(r,rs) (p,ps) -> (r ++ " and " ++ p,rs++ps))+ (predToSQL tables pred)+ (map (predToSQL tables) preds)+ in (p,ps)+ else error ("Cannot convert to an SQL predicate: "++show e)+ Ast "construction" [_,_,Ast "append" xs]+ -> orAll (map (predToSQL tables) xs)+ Ast "call" [Avar "text",x]+ -> predToSQL tables x+ Ast "call" [Avar cmp,Ast "for" [Avar v,i,q@(Ast "call" ((Avar "SQL"):_)),x],y]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> let (p,ps) = predToSQL (v:tables) (Ast "call" [Avar cmp,x,y])+ Ast "call" [Avar "sql",Astring sql,vs] = foldSQL q+ in ("exists ("++sql++" and "++p++")",vs:ps)+ Ast "call" [Avar cmp,x,Ast "for" [Avar v,i,q@(Ast "call" ((Avar "SQL"):_)),y]]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> let (p,ps) = predToSQL (v:tables) (Ast "call" [Avar cmp,x,y])+ Ast "call" [Avar "sql",Astring sql,vs] = foldSQL q+ in ("exists ("++sql++" and "++p++")",vs:ps)+ Ast "call" [Avar cmp,x,y]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> let (nx,vx,px) = expToSQL tables x+ (ny,vy,py) = expToSQL tables y+ p = if (null vx) && (null vy) then "" else foldl (\r p -> r++" and "++p) "" (px++py)+ in if nx == ""+ then (ny,vx)+ else if ny == ""+ then (nx++p,vy)+ else (nx ++ " " ++ snd (head (filter (\(f,_) -> f==cmp) sqlComparisson)) ++ " " ++ ny++p,vx++vy)+ Ast "call" [Avar cmp,x,y]+ | any (\(f,_) -> f==cmp) sqlBoolean+ -> let (nx,vx) = predToSQL tables x+ (ny,vy) = predToSQL tables y+ in if nx == ""+ then (ny,vy)+ else if ny == ""+ then (nx,vx)+ else (nx ++ " " ++ snd (head (filter (\(f,_) -> f==cmp) sqlBoolean)) ++ " " ++ ny,vx++vy)+ _ -> error ("Cannot convert to an SQL predicate: "++show e)+ where expToSQL :: [String] -> Ast -> (String,[Ast],[String])+ expToSQL tables e+ = case e of+ Astring s -> ("\'"++s++"\'",[],[])+ Aint n -> (show n,[],[])+ Ast "step" [Avar "child",Astring tag,Avar v]+ -> if elem v tables+ then (v++"."++tag,[],[])+ else ("?",[e],[])+ Ast "step" (Avar "child":Astring tag:Avar v:pred:preds)+ -> let (p,ps) = foldl (\(r,rs) (p,ps) -> (r ++ " and " ++ p,rs++ps))+ (predToSQL tables pred)+ (map (predToSQL tables) preds)+ in if elem v tables+ then (v++"."++tag,ps,[p])+ else ("?",e:ps,[p])+ Ast "construction" [_,_,Ast "append" [x]]+ -> expToSQL tables x+ Ast "call" [Avar "text",x]+ -> expToSQL tables x+ _ -> ("?",[e],[])+ foldSQL (Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):cols),Ast "call" ((Avar "from"):ts),pred])+ = let (sql,args) = makeSQL tables ts pred cols+ in Ast "call" [Avar "sql",Astring sql,concatenateAll args]+ orAll [x] = x+ orAll (x:xs) = foldl (\(a,as) (b,bs) -> ("("++a++" or "++b++")",as++bs)) x xs+++-- Convert an AST to an SQL query+makeSQL :: [String] -> [Ast] -> Ast -> [Ast] -> (String,[Ast])+makeSQL tables fromTables pred cols+ = let tnames = [ x | Avar x <- fromTables ]+ ts = combine tnames+ cs = combine [ x | Avar x <- cols ]+ vars (Ast n args) = concatMap vars args+ vars (Avar v) | not (elem v tnames) = [v]+ vars _ = []+ combine [] = ""+ combine [x] = x+ combine (x:xs) = x++", "++combine xs+ in if pred == Ast "call" [Avar "true"]+ then (if null cs+ then "select * from "++ts+ else "select "++cs++" from "++ts,[])+ else let (p,args) = predToSQL (tables++tnames) pred+ in (if null cs+ then "select * from "++ts++" where "++p+ else "select "++cs++" from "++ts++" where "++p,args)+++findAttr :: String -> [Ast] -> Ast+findAttr tag ((Ast "pair" [Astring a,v]):_)+ | a==tag || tag=="*"+ = v+findAttr tag (_:xs) = findAttr tag xs+findAttr _ [] = empty+++andAll :: [Ast] -> Ast+andAll [] = true+andAll [x] = x+andAll (x:xs) = foldl (\a r -> call "and" [a,r]) x xs+++orAll :: [Ast] -> Ast+orAll [] = true+orAll [x] = x+orAll (x:xs) = foldl (\a r -> call "or" [a,r]) x xs+++occursContext :: Ast -> Int+occursContext e+ = case e of+ Avar "." -> 1+ Ast "let" _ -> 0+ Ast "for" _ -> 0+ Ast "call" [Avar "SQL",s,f,w]+ -> occursContext w+ Ast "step" (step:tag:x:preds)+ -> occursContext x+ Ast n xs -> sum (map occursContext xs)+ _ -> 0+++substContext :: Ast -> Ast -> Ast+substContext e b+ = case b of+ Avar "." -> e+ Ast "let" _ -> b+ Ast "for" _ -> b+ Ast "call" [Avar "SQL",s,f,w]+ -> Ast "call" [Avar "SQL",s,f,substContext e w]+ Ast "step" (step:tag:x:preds)+ -> Ast "step" (step:tag:(substContext e x):preds)+ Ast n xs -> Ast n (map (substContext e) xs)+ _ -> b+++occurs :: String -> Ast -> Int+occurs v e+ = case e of+ Avar w | v==w -> 1+ Ast "let" [Avar w,s,_] | v==w -> occurs v s+ Ast "for" [Avar w,Avar i,s,_] | v==w || v==i -> occurs v s+ Ast "call" [Avar "SQL",s,f,w]+ -> occurs v w+ Ast n xs -> sum (map (occurs v) xs)+ _ -> 0+++subst :: String -> Ast -> Ast -> Ast+subst v e b+ = case b of+ Avar w | v==w -> e+ Ast "let" [Avar w,s,_] | v==w -> subst v e s+ Ast "for" [Avar w,Avar i,s,_] | v==w || v==i -> subst v e s+ Ast "call" [Avar "SQL",s,f,w]+ -> Ast "call" [Avar "SQL",s,f,subst v e w]+ Ast n xs -> Ast n (map (subst v e) xs)+ _ -> b+++dependsOnPosition :: Bool -> Ast -> Bool+dependsOnPosition contextp e+ = case e of+ Avar "." -> contextp+ Ast "call" [Avar "position"] -> True+ Ast "call" [Avar "last"] -> True+ Ast "step" (step:tag:x:_)+ -> dependsOnPosition contextp x+ Ast _ xs -> any (dependsOnPosition contextp) xs+ _ -> False+++wellFormedPredicate :: Bool -> Ast -> Bool+wellFormedPredicate contextp e+ = case e of+ Ast "step" (step:tag:x:preds)+ -> not (dependsOnPosition contextp x)+ Ast "construction" xs+ -> not (any (dependsOnPosition contextp) xs)+ Ast "call" [Avar "not",x]+ -> not (dependsOnPosition contextp x)+ Ast "call" [Avar cmp,x,y]+ | any (\(f,_) -> f==cmp) (sqlComparisson++sqlBoolean)+ -> not (dependsOnPosition contextp x)+ && not (dependsOnPosition contextp y)+ _ -> False+++splitSqlPredicate :: [String] -> Ast -> Maybe (Ast,[Ast])+splitSqlPredicate tables (Ast "call" [Avar "and",p1,p2])+ = case (splitSqlPredicate tables p1,splitSqlPredicate tables p2) of+ (Nothing,Nothing) -> Nothing+ (Nothing,Just(pp1,pp2))+ -> Just(pp1,p1:pp2)+ (Just(pp1,pp2),Nothing)+ -> Just(pp1,p2:pp2)+ (Just(pp1,pp2),Just(pp3,pp4))+ -> Just(Ast "call" [Avar "and",pp1,pp3],pp2++pp4)+splitSqlPredicate tables pred+ | sqlPredicate tables pred+ = Just(pred,[])+splitSqlPredicate tables pred = Nothing+++is_constant :: Ast -> Bool+is_constant (Astring _) = True+is_constant (Aint _) = True+is_constant (Afloat _) = True+is_constant _ = False+++predicates :: Ast -> [Ast] -> Ast+predicates e [] = e+predicates e preds = Ast "step" (Avar "self":Astring "*":e:preds)+++-- Normalization+normalize :: Ast -> Bool -> Int -> (Ast,Bool,Int)+normalize exp changed count+ = case exp of+ Ast "step" (step:tag:x:preds)+ | any (\p -> p==true) preds+ -> let preds' = filter (\p -> p /= true) preds+ in norm (Ast "step" (step:tag:x:preds'))+ Ast "step" (step:tag:x:preds)+ | any (\p -> p==false) preds+ -> (empty,True,count)+ Ast "step" [Avar "self",Astring "*",e]+ -> norm e+-- path steps over constants always give ()+ Ast "step" (step:tag:c:_)+ | is_constant c+ -> (empty,True,count)+ Ast "step" (step:tag:Ast "call" [Avar "text",_]:_)+ -> (empty,True,count)+ Ast "step" (step:tag:Ast "call" [Avar "empty"]:_)+ -> (empty,True,count)+-- boolean reductions+ Ast "call" [Avar "and",x,y]+ | x == false || y == false+ -> (false,True,count)+ Ast "call" [Avar "or",x,y]+ | x == true && y == true+ -> (true,True,count)+ Ast "call" [Avar "and",Ast "call" [Avar "true"],y]+ -> norm y+ Ast "call" [Avar "and",x,Ast "call" [Avar "true"]]+ -> norm x+ Ast "call" [Avar "or",Ast "call" [Avar "false"],y]+ -> norm y+ Ast "call" [Avar "or",x,Ast "call" [Avar "false"]]+ -> norm x+ Ast "call" [Avar "not",Ast "call" [Avar "true"]]+ -> (false,True,count)+ Ast "call" [Avar "not",Ast "call" [Avar "false"]]+ -> (true,True,count)+ -- (x,()) -> x+ Ast "call" [Avar "concatenate",x,Ast "call" [Avar "empty"]]+ -> norm x+ -- ((),x) -> x+ Ast "call" [Avar "concatenate",Ast "call" [Avar "empty"],x]+ -> norm x+ Ast "call" [Avar "=",x,y]+ | x == empty && y == empty+ -> (true,True,count)+ Ast "call" [Avar "=",x,y]+ | (x == empty && is_constant y) || (y == empty && is_constant x)+ -> (false,True,count)+ Ast "call" [Avar cmp,Ast "construction" [_,_,Ast "append" xs],y]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> norm (orAll (map (\x -> Ast "call" [Avar cmp,x,y]) xs))+ Ast "call" [Avar cmp,x,Ast "construction" [_,_,Ast "append" ys]]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> norm (orAll (map (\y -> Ast "call" [Avar cmp,x,y]) ys))+ Ast "call" [Avar cmp,Ast "for" [v,i,s,Ast "construction" [_,_,Ast "append" xs]],y]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> norm (orAll (map (\x -> Ast "call" [Avar cmp,Ast "for" [v,i,s,x],y]) xs))+ Ast "call" [Avar cmp,x,Ast "for" [v,i,s,Ast "construction" [_,_,Ast "append" ys]]]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> norm (orAll (map (\y -> Ast "call" [Avar cmp,x,Ast "for" [v,i,s,y]]) ys))+ Ast "call" [Avar cmp,Ast "call" [Avar "empty"],y]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> (false,True,count)+ Ast "call" [Avar cmp,x,Ast "call" [Avar "empty"]]+ | any (\(f,_) -> f==cmp) sqlComparisson+ -> (false,True,count)+-- normalize FLWORs+ Ast "for" [v,i,Ast "call" [Avar "empty"],b]+ -> (empty,True,count)+ Ast "for" [v,i,s,Ast "call" [Avar "empty"]]+ -> (empty,True,count)+ -- for $v1 in (for $v2 in s2 return b2) return b1 --> for $v2 in s2, for $v1 in b2 return b1+ Ast "for" [v1,i1,Ast "for" [v2,i2,s2,b2],b1]+ -> norm (Ast "for" [v2,i2,s2,Ast "for" [v1,i1,b2,b1]])+ -- for $v in (x,y) return b --> (for $v in x return b,for $v in y return b)+ Ast "for" [v,i@(Avar "$"),Ast "call" [Avar "concatenate",x,y],b]+ -> norm (Ast "call" [Avar "concatenate",Ast "for" [v,i,x,b],Ast "for" [v,i,y,b]])+ -- for $v in <a>...</a> return b --> b[$v/(<a>...</a>)]+ Ast "for" [Avar v,Avar i,e@(Ast "construction" _),b]+ -> norm (if i == "$"+ then subst v e b+ else subst v e (subst i (Aint 1) b))+ Ast "for" [Avar v,Avar i,e,b]+ | is_constant e+ -> norm (if i == "$"+ then subst v e b+ else subst v e (subst i (Aint 1) b))+-- normalize XPath steps+ Ast "step" (step:tag:Ast "step" (Avar "self":Astring "*":x:preds1):preds2)+ -> let npreds1 = map (substContext x) preds1+ in norm (Ast "step" (step:tag:x:npreds1++preds2))+ -- (for $v in s return b)/tag --> for $v in s return b/tag+ Ast "step" (step:tag:Ast "for" [v,i,s,b]:preds)+ | all (wellFormedPredicate False) preds+ -> norm (Ast "for" [v,i,s,Ast "step" (step:tag:b:preds)])+ -- promote well-formed predicates; but note: (x,y)[1] <> (x[1],y[1])+ Ast "step" (step:tag:Ast "call" [Avar "concatenate",x,y]:preds)+ | all (wellFormedPredicate False) preds+ -> norm (Ast "call" [Avar "concatenate",+ Ast "step" (step:tag:x:preds),+ Ast "step" (step:tag:y:preds)])+ -- (<ctag>...<tag>...</tag>...</ctag>)/tag --> ...<tag>...</tag>...+ Ast "step" [Avar "child",Astring tag,Ast "construction" [_,_,Ast "append" x]]+ | taggedElement x tag /= Nothing+ -> case taggedElement x tag of+ Just [] -> (empty,True,count)+ Just s -> norm (concatenateAll s)+ Ast "step" (Avar "child":tag:Ast "construction" [ctag,al,Ast "append" x]:preds)+ -> norm (Ast "step" (Avar "self":tag:concatenateAll x:preds))+ Ast "step" (Avar "self":Astring tag:e@(Ast "construction" [Astring ctag,al,Ast "append" x]):preds)+ | tag /= "*"+ -> if tag == ctag+ then norm (Ast "step" (Avar "self":Astring "*":e:preds))+ else (empty,True,count)+ -- (<tag>x</tag>)//tag --> (x,x//tag)+ Ast "step" (Avar "descendant_any":tags:z@(Ast "construction" [Astring ctag,al,Ast "append" x]):preds)+ -> norm (Ast "call" [Avar "concatenate",predicates z preds,+ Ast "step" (Avar "descendant_any":tags:concatenateAll x:preds)])+ Ast "step" (Avar "descendant-or-self":Astring tag:z@(Ast "construction" [Astring ctag,al,Ast "append" x]):preds)+ -> norm (if tag == ctag || tag == "*"+ then Ast "call" [Avar "concatenate",predicates z preds,+ Ast "step" (Avar "descendant-or-self":Astring tag:concatenateAll x:preds)]+ else Ast "step" (Avar "descendant-or-self":Astring tag:concatenateAll x:preds))+ -- (<tag A=s>x</tag>)/@A --> s+ Ast "step" (Avar "attribute":Astring tag:Ast "construction" [ctag,Ast "attributes" as,x]:preds)+ -> norm (predicates (findAttr tag as) preds)+ -- (<tag A=s>x</tag>)//@A --> (s,x//@A)+ Ast "step" (Avar "attribute_descendant":Astring tag:Ast "construction" [ctag,Ast "attributes" as,Ast "append" x]:preds)+ -> norm (Ast "call" [Avar "concatenate",predicates (findAttr tag as) preds,+ Ast "step" (Avar "attribute_descendant":Astring tag:concatenateAll x:preds)])+-- SQL folding+ Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),Ast "call" ((Avar "from"):f1),pred1],+ Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),Ast "call" ((Avar "from"):f2),pred2],+ b]]+ | occurs v1 b == 0+ -> norm (Ast "for" [Avar v2,Avar "$",+ Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):(s1++s2)),+ Ast "call" ((Avar "from"):(f1++f2)),Ast "call" [Avar "and",pred1,pred2]],+ b])+ Ast "for" [Avar v,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s),Ast "call" ((Avar "from"):tables),pred1],+ Ast "step" (Avar "self":Astring "*":x:pred2)]+ | splitSqlPredicate [ v | Avar v <- tables ] (andAll pred2) /= Nothing+ -> let Just(pred3,pred4) = splitSqlPredicate [ v | Avar v <- tables ] (andAll pred2)+ in norm (Ast "for" [Avar v,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s),+ Ast "call" ((Avar "from"):tables),Ast "call" [Avar "and",pred1,pred3]],+ Ast "step" (Avar "self":Astring "*":x:pred4)])+ Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),Ast "call" ((Avar "from"):f1),pred1],+ Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),Ast "call" ((Avar "from"):f2),pred2],+ Ast "step" (Avar "self":Astring "*":b:predd)]]+ | occurs v1 b == 0 && splitSqlPredicate [ v | Avar v <- f1 ] (andAll predd) /= Nothing+ -> let Just(pred3,pred4) = splitSqlPredicate [ v | Avar v <- f1 ] (andAll predd)+ in norm (Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),+ Ast "call" ((Avar "from"):f1),Ast "call" [Avar "and",pred1,pred3]],+ Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),+ Ast "call" ((Avar "from"):f2),pred2],+ Ast "step" (Avar "self":Astring"*":b:pred4)]])+ Ast "for" [Avar v,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s),Ast "call" ((Avar "from"):tables),pred1],+ Ast "predicate" [pred2,x]]+ | splitSqlPredicate [ v | Avar v <- tables ] pred2 /= Nothing+ -> let Just(pred3,pred4) = splitSqlPredicate [ v | Avar v <- tables ] pred2+ in norm (Ast "for" [Avar v,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s),+ Ast "call" ((Avar "from"):tables),Ast "call" [Avar "and",pred1,pred3]],+ Ast "step" (Avar "self":Astring"*":x:pred4)])+ Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),Ast "call" ((Avar "from"):f1),pred1],+ Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),Ast "call" ((Avar "from"):f2),pred2],+ Ast "predicate" [predd,b]]]+ | occurs v1 b == 0 && splitSqlPredicate [ v | Avar v <- f1 ] predd /= Nothing+ -> let Just(pred3,pred4) = splitSqlPredicate [ v | Avar v <- f1 ] predd+ in norm (Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),+ Ast "call" ((Avar "from"):f1),Ast "call" [Avar "and",pred1,pred3]],+ Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),+ Ast "call" ((Avar "from"):f2),pred2],+ Ast "step" (Avar "self":Astring"*":b:pred4)]])+-- default+ Ast n args+ -> let (r,b,c) = foldr (\a (r,b,c) -> let (x,s,i) = normalize a b c in (x:r,s,i))+ ([],changed,count) args+ in (Ast n r,b,c)+ _ -> (exp,changed,count)+ where norm e = normalize e True count+++foldSQL :: Ast -> Ast+foldSQL e+ = case e of+ Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):cols),Ast "call" ((Avar "from"):tables),pred]+ -> let (sql,args) = makeSQL [] tables pred cols+ in Ast "call" [Avar "sql",Astring sql,concatenateAll args]+ Ast n args -> Ast n (map foldSQL args)+ _ -> e+++optimizeLoop :: Ast -> Int -> (Ast,Int)+optimizeLoop e c = let (ne,b,c') = normalize e False c+ in if b+ then optimizeLoop ne c'+ else (ne,c)+++optimize :: Ast -> Ast+optimize e = foldSQL (fst (optimizeLoop (simplify e) 0))
+ src/Text/XML/HXQ/Parser.hs view
@@ -0,0 +1,2240 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+module Text.XML.HXQ.Parser 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++-- parser produced by Happy Version 1.17++newtype HappyAbsSyn = HappyAbsSyn HappyAny+#if __GLASGOW_HASKELL__ >= 607+type HappyAny = GHC.Exts.Any+#else+type HappyAny = forall a . a+#endif+happyIn4 :: ([ Ast ]) -> (HappyAbsSyn )+happyIn4 x = unsafeCoerce# x+{-# INLINE happyIn4 #-}+happyOut4 :: (HappyAbsSyn ) -> ([ Ast ])+happyOut4 x = unsafeCoerce# x+{-# INLINE happyOut4 #-}+happyIn5 :: (Ast) -> (HappyAbsSyn )+happyIn5 x = unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> (Ast)+happyOut5 x = unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: (String) -> (HappyAbsSyn )+happyIn6 x = unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> (String)+happyOut6 x = unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: ([ Ast ]) -> (HappyAbsSyn )+happyIn7 x = unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> ([ Ast ])+happyOut7 x = unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (Ast) -> (HappyAbsSyn )+happyIn8 x = unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (Ast)+happyOut8 x = unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (Ast) -> (HappyAbsSyn )+happyIn9 x = unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> (Ast)+happyOut9 x = unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: ([ Ast ]) -> (HappyAbsSyn )+happyIn10 x = unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> ([ Ast ])+happyOut10 x = unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (Ast -> Ast) -> (HappyAbsSyn )+happyIn11 x = unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (Ast -> Ast)+happyOut11 x = unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: (Ast -> Ast) -> (HappyAbsSyn )+happyIn12 x = unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> (Ast -> Ast)+happyOut12 x = unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyIn13 :: (Ast -> Ast) -> (HappyAbsSyn )+happyIn13 x = unsafeCoerce# x+{-# INLINE happyIn13 #-}+happyOut13 :: (HappyAbsSyn ) -> (Ast -> Ast)+happyOut13 x = unsafeCoerce# x+{-# INLINE happyOut13 #-}+happyIn14 :: (Ast -> Ast) -> (HappyAbsSyn )+happyIn14 x = unsafeCoerce# x+{-# INLINE happyIn14 #-}+happyOut14 :: (HappyAbsSyn ) -> (Ast -> Ast)+happyOut14 x = unsafeCoerce# x+{-# INLINE happyOut14 #-}+happyIn15 :: (( Ast -> Ast, Ast -> Ast )) -> (HappyAbsSyn )+happyIn15 x = unsafeCoerce# x+{-# INLINE happyIn15 #-}+happyOut15 :: (HappyAbsSyn ) -> (( Ast -> Ast, Ast -> Ast ))+happyOut15 x = unsafeCoerce# x+{-# INLINE happyOut15 #-}+happyIn16 :: (( [ Ast ], [ Ast ] )) -> (HappyAbsSyn )+happyIn16 x = unsafeCoerce# x+{-# INLINE happyIn16 #-}+happyOut16 :: (HappyAbsSyn ) -> (( [ Ast ], [ Ast ] ))+happyOut16 x = unsafeCoerce# x+{-# INLINE happyOut16 #-}+happyIn17 :: (Ast) -> (HappyAbsSyn )+happyIn17 x = unsafeCoerce# x+{-# INLINE happyIn17 #-}+happyOut17 :: (HappyAbsSyn ) -> (Ast)+happyOut17 x = unsafeCoerce# x+{-# INLINE happyOut17 #-}+happyIn18 :: (Ast) -> (HappyAbsSyn )+happyIn18 x = unsafeCoerce# x+{-# INLINE happyIn18 #-}+happyOut18 :: (HappyAbsSyn ) -> (Ast)+happyOut18 x = unsafeCoerce# x+{-# INLINE happyOut18 #-}+happyIn19 :: (Ast) -> (HappyAbsSyn )+happyIn19 x = unsafeCoerce# x+{-# INLINE happyIn19 #-}+happyOut19 :: (HappyAbsSyn ) -> (Ast)+happyOut19 x = unsafeCoerce# x+{-# INLINE happyOut19 #-}+happyIn20 :: ([ Ast ]) -> (HappyAbsSyn )+happyIn20 x = unsafeCoerce# x+{-# INLINE happyIn20 #-}+happyOut20 :: (HappyAbsSyn ) -> ([ Ast ])+happyOut20 x = unsafeCoerce# x+{-# INLINE happyOut20 #-}+happyIn21 :: ([ Ast ]) -> (HappyAbsSyn )+happyIn21 x = unsafeCoerce# x+{-# INLINE happyIn21 #-}+happyOut21 :: (HappyAbsSyn ) -> ([ Ast ])+happyOut21 x = unsafeCoerce# x+{-# INLINE happyOut21 #-}+happyIn22 :: (Ast) -> (HappyAbsSyn )+happyIn22 x = unsafeCoerce# x+{-# INLINE happyIn22 #-}+happyOut22 :: (HappyAbsSyn ) -> (Ast)+happyOut22 x = unsafeCoerce# x+{-# INLINE happyOut22 #-}+happyIn23 :: ([Ast]) -> (HappyAbsSyn )+happyIn23 x = unsafeCoerce# x+{-# INLINE happyIn23 #-}+happyOut23 :: (HappyAbsSyn ) -> ([Ast])+happyOut23 x = unsafeCoerce# x+{-# INLINE happyOut23 #-}+happyIn24 :: ([ Ast ]) -> (HappyAbsSyn )+happyIn24 x = unsafeCoerce# x+{-# INLINE happyIn24 #-}+happyOut24 :: (HappyAbsSyn ) -> ([ Ast ])+happyOut24 x = unsafeCoerce# x+{-# INLINE happyOut24 #-}+happyIn25 :: (Ast) -> (HappyAbsSyn )+happyIn25 x = unsafeCoerce# x+{-# INLINE happyIn25 #-}+happyOut25 :: (HappyAbsSyn ) -> (Ast)+happyOut25 x = unsafeCoerce# x+{-# INLINE happyOut25 #-}+happyIn26 :: (Ast -> Ast) -> (HappyAbsSyn )+happyIn26 x = unsafeCoerce# x+{-# INLINE happyIn26 #-}+happyOut26 :: (HappyAbsSyn ) -> (Ast -> Ast)+happyOut26 x = unsafeCoerce# x+{-# INLINE happyOut26 #-}+happyIn27 :: (Ast -> Ast) -> (HappyAbsSyn )+happyIn27 x = unsafeCoerce# x+{-# INLINE happyIn27 #-}+happyOut27 :: (HappyAbsSyn ) -> (Ast -> Ast)+happyOut27 x = unsafeCoerce# x+{-# INLINE happyOut27 #-}+happyIn28 :: ([ Ast ]) -> (HappyAbsSyn )+happyIn28 x = unsafeCoerce# x+{-# INLINE happyIn28 #-}+happyOut28 :: (HappyAbsSyn ) -> ([ Ast ])+happyOut28 x = unsafeCoerce# x+{-# INLINE happyOut28 #-}+happyIn29 :: (String -> Ast -> [ Ast ] -> Ast) -> (HappyAbsSyn )+happyIn29 x = unsafeCoerce# x+{-# INLINE happyIn29 #-}+happyOut29 :: (HappyAbsSyn ) -> (String -> Ast -> [ Ast ] -> Ast)+happyOut29 x = unsafeCoerce# x+{-# INLINE happyOut29 #-}+happyIn30 :: (String -> Ast -> Ast) -> (HappyAbsSyn )+happyIn30 x = unsafeCoerce# x+{-# INLINE happyIn30 #-}+happyOut30 :: (HappyAbsSyn ) -> (String -> Ast -> Ast)+happyOut30 x = unsafeCoerce# x+{-# INLINE happyOut30 #-}+happyInTok :: Token -> (HappyAbsSyn )+happyInTok x = unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> Token+happyOutTok x = unsafeCoerce# x+{-# INLINE happyOutTok #-}+++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x45\x00\x45\x00\x00\x00\xee\x02\x00\x00\xd7\x01\x98\x00\x00\x00\x00\x00\x3e\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\xc4\x02\xc4\x02\x8b\x00\x5d\x00\x8b\x00\x8b\x00\x8b\x00\x00\x00\xcb\x02\x8b\x00\xc3\x02\xc3\x02\x2f\x00\x2b\x00\xfb\xff\xc2\x02\xf4\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x00\xbe\x02\x00\x00\x17\x00\xc9\x02\xba\x02\xdd\xff\x00\x00\xea\x02\xb8\x02\x8b\x00\xb6\x02\xe3\x02\xb3\x02\x8b\x00\xbf\x02\xbd\x02\xf3\xff\xb4\x02\x00\x00\xa5\x02\x00\x00\x00\x00\xd7\x01\xad\x00\x6c\x00\x00\x00\x03\x01\x44\x00\xea\xff\x29\x00\x8b\x00\x00\x00\x88\x00\x00\x00\xb5\x02\x9b\x02\x9b\x02\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\x8b\x00\xff\xff\x4e\x00\x00\x00\x42\x02\x42\x02\x42\x02\x74\x02\x42\x02\x5b\x02\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x1f\x01\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x00\xf9\x00\xb1\x08\xd7\x01\xb0\x02\xad\x02\xcd\x02\xa2\x02\x00\x00\x73\x00\x8b\x00\x58\x00\x1f\x00\x91\x02\x00\x00\x00\x00\xac\x00\x8e\x02\x00\x00\x8b\x00\x9c\x00\x83\x02\x8b\x00\x8b\x00\x8b\x00\x00\x00\x8b\x00\x00\x00\xb1\x02\x89\x02\x8b\x00\x7d\x02\x7d\x02\x8b\x00\xbb\x01\xb2\x02\x8b\x00\x80\x02\x9e\x01\xa8\x02\x8b\x00\x29\x00\x00\x00\xf5\xff\x81\x02\xa4\x02\x68\x02\x00\x00\x0a\x00\x8b\x00\x00\x00\x00\x00\x71\x02\xa7\x00\x00\x00\x9c\x02\xa1\x00\x00\x00\x98\x02\xd7\x01\x72\x02\x76\x02\xd7\x01\x8a\x02\xfc\xff\xd7\x01\x26\x01\xd7\x01\xd7\x01\xed\xff\x00\x00\xfb\xff\xa6\x00\x00\x00\x47\x01\x00\x00\x00\x00\x7f\x02\x9e\x00\x00\x00\x8b\x00\x11\x02\x00\x00\x00\x00\x8b\x00\x8b\x00\x00\x00\xd7\x01\xdd\x00\x20\x02\x67\x02\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\x00\x00\x41\x02\x8b\x00\x07\x02\x8b\x00\x00\x00\xfc\xff\x8b\x00\x8b\x00\x8b\x00\x00\x00\x8b\x00\x00\x00\xd7\x01\x02\x00\x00\x00\x3a\x02\x8b\x00\x36\x02\xfd\x01\x70\x00\x11\x00\xd7\x01\xd7\x01\x00\x00\xd7\x01\x13\x02\xd7\x01\x33\x02\x00\x00\x33\x02\x00\x00\x00\x00\x8b\x00\x00\x00\x00\x00\x00\x00\xdd\x00\x33\x02\x8b\x00\x00\x00\x00\x00\x00\x00\x8b\x00\x81\x01\x00\x00\x64\x01\xd7\x01\x00\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x00\x02\x34\x02\x00\x00\x00\x00\x00\x00\x00\x00\x35\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x02\x00\x00\xe0\x00\xdf\x00\xa4\x08\x90\x03\x77\x03\x8b\x08\x72\x08\x00\x00\x30\x02\x59\x08\xbc\x00\xd9\x00\x2c\x02\x29\x02\xd1\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x02\x24\x02\x1c\x02\x00\x00\x0c\x02\x00\x00\x1b\x02\x40\x08\x00\x00\x00\x00\x12\x02\x27\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x02\x5e\x03\x00\x00\x41\x01\x00\x00\x0b\x02\x6d\x00\x6e\x00\x0e\x08\xf5\x07\xdc\x07\xc3\x07\xaa\x07\x91\x07\x78\x07\x5f\x07\x46\x07\x2d\x07\x14\x07\xfb\x06\xe2\x06\xc9\x06\xb0\x06\x97\x06\x7e\x06\x65\x06\x4c\x06\x33\x06\x1a\x06\x01\x06\xe8\x05\xcf\x05\xb6\x05\x9d\x05\x84\x05\x6b\x05\x52\x05\x45\x03\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\x03\x00\x2c\x03\x0f\x02\x0a\x02\x08\x02\x00\x00\x00\x00\x00\x00\xca\x00\x00\x00\x39\x05\xb7\x02\xff\x01\x20\x05\x07\x05\xee\x04\x00\x00\xd5\x04\x00\x00\x00\x00\x04\x02\xbc\x04\x4f\x01\x09\x01\xa3\x04\x00\x00\x00\x00\x13\x03\x00\x00\x00\x00\x00\x00\xfa\x02\xf0\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x02\x8a\x04\x00\x00\x00\x00\xc3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x96\x00\x9e\x02\x23\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x02\xd5\x00\x00\x00\x00\x00\xc8\x02\x71\x04\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x09\x02\x69\x00\x00\x00\x58\x04\x60\x00\x3f\x04\x00\x00\x71\x00\x26\x04\x0d\x04\xaf\x02\x00\x00\x96\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\x03\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\xdb\x03\x00\x00\x00\x00\x00\x00\xf9\xff\x00\x00\xc2\x03\x00\x00\x00\x00\x00\x00\xa9\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x8a\xff\x87\xff\xfa\xff\xbb\xff\xeb\xff\xec\xff\x00\x00\xcb\xff\xa0\xff\xed\xff\x8d\xff\x8c\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8b\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\xff\x00\x00\x86\xff\xf2\xff\xca\xff\xc9\xff\x9f\xff\x00\x00\xfe\xff\xfd\xff\x00\x00\x00\x00\x00\x00\x00\x00\x8d\xff\x00\x00\x00\x00\x00\x00\xf6\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc5\xff\x00\x00\xc6\xff\xcc\xff\xaa\xff\xcd\xff\xce\xff\xc8\xff\x00\x00\x00\x00\x84\xff\x00\x00\x00\x00\x00\x00\x99\xff\x00\x00\x9d\xff\x00\x00\xaf\xff\xb9\xff\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\x82\xff\xcf\xff\xd0\xff\xd1\xff\xd2\xff\xd3\xff\xd4\xff\xd5\xff\xd6\xff\xd7\xff\xd8\xff\xd9\xff\xda\xff\xdb\xff\xdc\xff\xdd\xff\xde\xff\xdf\xff\xe0\xff\xe1\xff\xe2\xff\xe3\xff\xe4\xff\xe5\xff\xe6\xff\xe7\xff\xe8\xff\xe9\xff\xea\xff\xbc\xff\xc3\xff\xc4\xff\x00\x00\x00\x00\xa5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\xff\xa7\xff\x00\x00\x97\xff\x95\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\xff\x00\x00\x9e\xff\x00\x00\xa9\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\xff\xf5\xff\x00\x00\x00\x00\x00\x00\xfc\xff\xfb\xff\x00\x00\x00\x00\x89\xff\x88\xff\x96\xff\x00\x00\xb2\xff\x00\x00\x00\x00\xb3\xff\x00\x00\xbe\xff\x00\x00\x00\x00\xc2\xff\x00\x00\x00\x00\xc7\xff\x00\x00\xef\xff\xf0\xff\x00\x00\x8d\xff\x00\x00\x00\x00\x8f\xff\x00\x00\x94\xff\x9c\xff\x00\x00\x00\x00\xa1\xff\x00\x00\x00\x00\xa2\xff\xa3\xff\x00\x00\x00\x00\x83\xff\xf1\xff\xb4\xff\xba\xff\x00\x00\x00\x00\xa8\xff\xb0\xff\x8e\xff\x8d\xff\x00\x00\x8d\xff\x93\xff\x00\x00\x00\x00\x00\x00\x9b\xff\x00\x00\x00\x00\x00\x00\x00\x00\xac\xff\x00\x00\xab\xff\xf9\xff\x00\x00\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xff\xc1\xff\x9a\xff\xee\xff\x00\x00\xc0\xff\x92\xff\x8d\xff\x91\xff\xa4\xff\xb1\xff\x00\x00\xb8\xff\xb6\xff\xb5\xff\xb4\xff\x90\xff\x00\x00\xae\xff\xad\xff\xf3\xff\x00\x00\x00\x00\xf7\xff\x00\x00\xbf\xff\xb7\xff\xf8\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x04\x00\x09\x00\x10\x00\x0d\x00\x0b\x00\x09\x00\x0a\x00\x0b\x00\x10\x00\x0a\x00\x0e\x00\x0f\x00\x10\x00\x0b\x00\x02\x00\x0f\x00\x10\x00\x0a\x00\x16\x00\x2c\x00\x3a\x00\x2b\x00\x02\x00\x03\x00\x04\x00\x18\x00\x0c\x00\x2b\x00\x42\x00\x09\x00\x37\x00\x0b\x00\x14\x00\x25\x00\x0e\x00\x0f\x00\x10\x00\x29\x00\x2a\x00\x0b\x00\x3e\x00\x04\x00\x16\x00\x2c\x00\x3a\x00\x07\x00\x3e\x00\x33\x00\x34\x00\x09\x00\x3a\x00\x0b\x00\x38\x00\x09\x00\x3a\x00\x0b\x00\x40\x00\x25\x00\x2c\x00\x43\x00\x40\x00\x29\x00\x2a\x00\x43\x00\x47\x00\x45\x00\x46\x00\x47\x00\x02\x00\x03\x00\x04\x00\x33\x00\x34\x00\x47\x00\x43\x00\x09\x00\x38\x00\x0b\x00\x3a\x00\x3b\x00\x0e\x00\x0f\x00\x10\x00\x18\x00\x40\x00\x0a\x00\x3a\x00\x43\x00\x16\x00\x45\x00\x46\x00\x47\x00\x02\x00\x03\x00\x04\x00\x39\x00\x0b\x00\x04\x00\x3a\x00\x09\x00\x0a\x00\x0b\x00\x3a\x00\x25\x00\x0e\x00\x0f\x00\x10\x00\x29\x00\x2a\x00\x2c\x00\x04\x00\x04\x00\x16\x00\x36\x00\x08\x00\x0a\x00\x09\x00\x33\x00\x34\x00\x2c\x00\x37\x00\x0c\x00\x38\x00\x0b\x00\x3a\x00\x3b\x00\x18\x00\x25\x00\x12\x00\x13\x00\x40\x00\x29\x00\x2a\x00\x43\x00\x16\x00\x45\x00\x46\x00\x47\x00\x02\x00\x03\x00\x04\x00\x33\x00\x34\x00\x3a\x00\x0b\x00\x09\x00\x38\x00\x0b\x00\x3a\x00\x2c\x00\x0e\x00\x0f\x00\x10\x00\x2c\x00\x40\x00\x16\x00\x18\x00\x43\x00\x16\x00\x45\x00\x46\x00\x47\x00\x09\x00\x33\x00\x34\x00\x35\x00\x0c\x00\x0c\x00\x41\x00\x10\x00\x0c\x00\x18\x00\x09\x00\x25\x00\x0d\x00\x48\x00\x0c\x00\x29\x00\x2a\x00\x10\x00\x44\x00\x0c\x00\x0c\x00\x47\x00\x33\x00\x34\x00\x35\x00\x33\x00\x34\x00\x04\x00\x29\x00\x2a\x00\x38\x00\x08\x00\x3a\x00\x2e\x00\x12\x00\x13\x00\x2c\x00\x2c\x00\x40\x00\x44\x00\x2c\x00\x43\x00\x47\x00\x45\x00\x46\x00\x47\x00\x2c\x00\x38\x00\x39\x00\x3a\x00\x02\x00\x2c\x00\x2c\x00\x17\x00\x3f\x00\x40\x00\x04\x00\x38\x00\x43\x00\x3a\x00\x17\x00\x09\x00\x04\x00\x04\x00\x02\x00\x40\x00\x08\x00\x08\x00\x43\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x16\x00\x17\x00\x05\x00\x10\x00\x11\x00\x12\x00\x13\x00\x04\x00\x31\x00\x32\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x06\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x08\x00\x0f\x00\x10\x00\x11\x00\x04\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x00\x00\x01\x00\x02\x00\x04\x00\x04\x00\x05\x00\x02\x00\x07\x00\x03\x00\x04\x00\x02\x00\x02\x00\x02\x00\x04\x00\x0e\x00\x0f\x00\x10\x00\x02\x00\x12\x00\x13\x00\x02\x00\x15\x00\x0b\x00\x16\x00\x17\x00\x19\x00\x1a\x00\x01\x00\x02\x00\x02\x00\x04\x00\x05\x00\x04\x00\x07\x00\x19\x00\x1a\x00\x18\x00\x02\x00\x02\x00\x04\x00\x0e\x00\x0f\x00\x10\x00\x02\x00\x12\x00\x13\x00\x02\x00\x15\x00\x3c\x00\x3d\x00\x02\x00\x19\x00\x1a\x00\x01\x00\x02\x00\x18\x00\x04\x00\x05\x00\x07\x00\x07\x00\x19\x00\x1a\x00\x2b\x00\x0a\x00\x43\x00\x0b\x00\x0e\x00\x0f\x00\x10\x00\x0b\x00\x12\x00\x13\x00\x07\x00\x15\x00\x43\x00\x3a\x00\x2c\x00\x19\x00\x1a\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x18\x00\x25\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x18\x00\x02\x00\x25\x00\x04\x00\x05\x00\x06\x00\x07\x00\x14\x00\x2d\x00\x02\x00\x2b\x00\x04\x00\x0b\x00\x0e\x00\x0f\x00\x10\x00\x0b\x00\x12\x00\x13\x00\x39\x00\x15\x00\x44\x00\x09\x00\x2d\x00\x19\x00\x1a\x00\x02\x00\x0a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x19\x00\x1a\x00\x02\x00\x3a\x00\x04\x00\x0a\x00\x0e\x00\x0f\x00\x10\x00\x43\x00\x12\x00\x13\x00\x3a\x00\x15\x00\x14\x00\x43\x00\x39\x00\x19\x00\x1a\x00\x02\x00\x3a\x00\x04\x00\x05\x00\x01\x00\x07\x00\x19\x00\x1a\x00\x30\x00\x02\x00\x0c\x00\x04\x00\x0e\x00\x0f\x00\x10\x00\x2c\x00\x12\x00\x13\x00\x2c\x00\x15\x00\x43\x00\x3a\x00\x2c\x00\x19\x00\x1a\x00\x02\x00\x2f\x00\x04\x00\x05\x00\x06\x00\x07\x00\x2c\x00\x19\x00\x1a\x00\x2d\x00\x3a\x00\x0b\x00\x0e\x00\x0f\x00\x10\x00\x3a\x00\x12\x00\x13\x00\x0b\x00\x15\x00\x09\x00\x42\x00\xff\xff\x19\x00\x1a\x00\x02\x00\x43\x00\x04\x00\x05\x00\x06\x00\x07\x00\x44\x00\x3a\x00\x42\x00\x3a\x00\x43\x00\x43\x00\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\x1a\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x10\x00\x11\x00\x12\x00\x13\x00\xb8\x00\x15\x01\x14\x00\x13\x00\x6b\x00\x14\x00\x17\x00\xf8\x00\x15\x00\x16\x00\x17\x00\x45\x00\xa0\x00\xd3\x00\x09\x00\xf6\x00\x18\x00\x9a\x00\xaf\x00\xe8\x00\x10\x00\x11\x00\x12\x00\x0b\x01\x0e\x01\xa3\x00\xb0\x00\x13\x00\x9b\x00\x14\x00\xa1\x00\x19\x00\x15\x00\x16\x00\x17\x00\x1a\x00\x1b\x00\x30\x00\xe9\x00\x0f\x01\x18\x00\xf9\x00\x31\x00\x98\x00\xa4\x00\x1c\x00\x1d\x00\x2f\x00\x1f\x00\x30\x00\x1e\x00\x33\x00\x1f\x00\x34\x00\x21\x00\x19\x00\x9f\x00\x22\x00\x21\x00\x1a\x00\x1b\x00\x22\x00\x25\x00\x23\x00\x24\x00\x25\x00\x10\x00\x11\x00\x12\x00\x1c\x00\x1d\x00\x46\x00\x22\x00\x13\x00\x1e\x00\x14\x00\x1f\x00\x20\x00\x15\x00\x16\x00\x17\x00\x47\x00\x21\x00\xdb\x00\x31\x00\x22\x00\x18\x00\x23\x00\x24\x00\x25\x00\x10\x00\x11\x00\x12\x00\x99\x00\x34\x00\xff\x00\x31\x00\x13\x00\x40\x00\x14\x00\x31\x00\x19\x00\x15\x00\x16\x00\x17\x00\x1a\x00\x1b\x00\x9a\x00\x36\x00\x34\x00\x18\x00\x48\x00\x89\x00\x9e\x00\x88\x00\x1c\x00\x1d\x00\x9f\x00\x9c\x00\x0f\x01\x1e\x00\xd5\x00\x1f\x00\x20\x00\x01\x01\x19\x00\xfd\x00\x0b\x00\x21\x00\x1a\x00\x1b\x00\x22\x00\x18\x00\x23\x00\x24\x00\x25\x00\x10\x00\x11\x00\x12\x00\x1c\x00\x1d\x00\x31\x00\x8f\x00\x13\x00\x1e\x00\x14\x00\x1f\x00\x9f\x00\x15\x00\x16\x00\x17\x00\x9f\x00\x21\x00\x18\x00\x03\x01\x22\x00\x18\x00\x23\x00\x24\x00\x25\x00\x13\x00\x90\x00\x91\x00\xd6\x00\x05\x01\xe1\x00\x29\x00\x17\x00\xf0\x00\xe6\x00\x13\x00\x19\x00\x07\x01\xff\xff\xf2\x00\x1a\x00\x1b\x00\x17\x00\xd7\x00\xd1\x00\xa0\x00\xd8\x00\x90\x00\x91\x00\x92\x00\x1c\x00\x1d\x00\x36\x00\x4a\x00\x4b\x00\x1e\x00\x37\x00\x1f\x00\x4c\x00\xea\x00\x0b\x00\x9f\x00\x9f\x00\x21\x00\x93\x00\x9f\x00\x22\x00\x94\x00\x23\x00\x24\x00\x25\x00\x9f\x00\xcc\x00\xcd\x00\x1f\x00\xde\x00\x9f\x00\x9f\x00\xcf\x00\xce\x00\x21\x00\x34\x00\xe5\x00\x22\x00\x1f\x00\xcf\x00\x35\x00\x36\x00\x36\x00\xb6\x00\x21\x00\x41\x00\x42\x00\x22\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\xb8\x00\x96\x00\x9d\x00\x50\x00\x51\x00\x52\x00\x53\x00\xc0\x00\x09\x01\x0a\x01\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\xea\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\xe3\x00\x8c\x00\x09\x00\x8d\x00\xc1\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x17\x01\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x13\x01\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\xbc\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\xbf\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x25\x00\x26\x00\x03\x00\xc9\x00\x04\x00\x05\x00\xc3\x00\x06\x00\xf3\x00\xf4\x00\xd1\x00\x03\x00\x2d\x00\x04\x00\x07\x00\x08\x00\x09\x00\x31\x00\x0a\x00\x0b\x00\xa7\x00\x0c\x00\x8a\x00\x95\x00\x96\x00\x0d\x00\x0e\x00\xb2\x00\x03\x00\xab\x00\x04\x00\x05\x00\xb0\x00\x06\x00\x02\x01\x0e\x00\xad\x00\x03\x00\xb1\x00\x04\x00\x07\x00\x08\x00\x09\x00\x2d\x00\x0a\x00\x0b\x00\x31\x00\x0c\x00\x2a\x00\x2b\x00\x39\x00\x0d\x00\x0e\x00\x02\x00\x03\x00\x43\x00\x04\x00\x05\x00\x98\x00\x06\x00\xe3\x00\x0e\x00\x0d\x01\x48\x00\x22\x00\x11\x01\x07\x00\x08\x00\x09\x00\xf7\x00\x0a\x00\x0b\x00\x98\x00\x0c\x00\x22\x00\x31\x00\x07\x01\x0d\x00\x0e\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x06\x01\x65\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\xe2\x00\x03\x00\x00\x00\x04\x00\x3c\x00\xf9\x00\x06\x00\xec\x00\xee\x00\x03\x00\xed\x00\x04\x00\xef\x00\x07\x00\x08\x00\x09\x00\xf1\x00\x0a\x00\x0b\x00\x99\x00\x0c\x00\xb4\x00\xb5\x00\xb6\x00\x0d\x00\x0e\x00\x03\x00\xbb\x00\x04\x00\x3c\x00\xfa\x00\x06\x00\xe5\x00\x0e\x00\x03\x00\xaf\x00\x04\x00\xbe\x00\x07\x00\x08\x00\x09\x00\x22\x00\x0a\x00\x0b\x00\x31\x00\x0c\x00\xc5\x00\x22\x00\x99\x00\x0d\x00\x0e\x00\x03\x00\x31\x00\x04\x00\xdc\x00\xda\x00\x06\x00\xca\x00\x0e\x00\xd9\x00\x03\x00\xdd\x00\x04\x00\x07\x00\x08\x00\x09\x00\x9a\x00\x0a\x00\x0b\x00\xa5\x00\x0c\x00\x22\x00\x31\x00\x9a\x00\x0d\x00\x0e\x00\x03\x00\x8c\x00\x04\x00\x3c\x00\xdf\x00\x06\x00\xa5\x00\x2c\x00\x0e\x00\xa6\x00\x31\x00\xa9\x00\x07\x00\x08\x00\x09\x00\x31\x00\x0a\x00\x0b\x00\xad\x00\x0c\x00\x69\x00\xaa\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x22\x00\x04\x00\x3c\x00\xb9\x00\x06\x00\x28\x00\x31\x00\x2c\x00\x31\x00\x22\x00\x22\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x3c\x00\xbc\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x3c\x00\xd2\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x3c\x00\x69\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x3c\x00\x94\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x3c\x00\x3d\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x3c\x00\x3e\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x13\x01\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x14\x01\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x0a\x01\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x11\x01\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xfb\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xfc\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xfe\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x00\x01\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xdb\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xf2\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xbf\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xc2\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xc5\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xc6\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xc7\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xc8\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xce\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x6b\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x6c\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x6d\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x6e\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x6f\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x70\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x71\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x72\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x73\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x74\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x75\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x76\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x77\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x78\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x79\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x7a\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x7b\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x7c\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x7d\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x7e\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x7f\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x80\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x81\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x82\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x83\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x84\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x85\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x86\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x87\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xa6\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\xaa\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x38\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x3a\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x3b\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x03\x00\x00\x00\x04\x00\x40\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x08\x00\x09\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\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, 125) [+ (1 , happyReduce_1),+ (2 , happyReduce_2),+ (3 , happyReduce_3),+ (4 , happyReduce_4),+ (5 , happyReduce_5),+ (6 , happyReduce_6),+ (7 , happyReduce_7),+ (8 , happyReduce_8),+ (9 , happyReduce_9),+ (10 , happyReduce_10),+ (11 , happyReduce_11),+ (12 , happyReduce_12),+ (13 , happyReduce_13),+ (14 , happyReduce_14),+ (15 , happyReduce_15),+ (16 , happyReduce_16),+ (17 , happyReduce_17),+ (18 , happyReduce_18),+ (19 , happyReduce_19),+ (20 , happyReduce_20),+ (21 , happyReduce_21),+ (22 , happyReduce_22),+ (23 , happyReduce_23),+ (24 , happyReduce_24),+ (25 , happyReduce_25),+ (26 , happyReduce_26),+ (27 , happyReduce_27),+ (28 , happyReduce_28),+ (29 , happyReduce_29),+ (30 , happyReduce_30),+ (31 , happyReduce_31),+ (32 , happyReduce_32),+ (33 , happyReduce_33),+ (34 , happyReduce_34),+ (35 , happyReduce_35),+ (36 , happyReduce_36),+ (37 , happyReduce_37),+ (38 , happyReduce_38),+ (39 , happyReduce_39),+ (40 , happyReduce_40),+ (41 , happyReduce_41),+ (42 , happyReduce_42),+ (43 , happyReduce_43),+ (44 , happyReduce_44),+ (45 , happyReduce_45),+ (46 , happyReduce_46),+ (47 , happyReduce_47),+ (48 , happyReduce_48),+ (49 , happyReduce_49),+ (50 , happyReduce_50),+ (51 , happyReduce_51),+ (52 , happyReduce_52),+ (53 , happyReduce_53),+ (54 , happyReduce_54),+ (55 , happyReduce_55),+ (56 , happyReduce_56),+ (57 , happyReduce_57),+ (58 , happyReduce_58),+ (59 , happyReduce_59),+ (60 , happyReduce_60),+ (61 , happyReduce_61),+ (62 , happyReduce_62),+ (63 , happyReduce_63),+ (64 , happyReduce_64),+ (65 , happyReduce_65),+ (66 , happyReduce_66),+ (67 , happyReduce_67),+ (68 , happyReduce_68),+ (69 , happyReduce_69),+ (70 , happyReduce_70),+ (71 , happyReduce_71),+ (72 , happyReduce_72),+ (73 , happyReduce_73),+ (74 , happyReduce_74),+ (75 , happyReduce_75),+ (76 , happyReduce_76),+ (77 , happyReduce_77),+ (78 , happyReduce_78),+ (79 , happyReduce_79),+ (80 , happyReduce_80),+ (81 , happyReduce_81),+ (82 , happyReduce_82),+ (83 , happyReduce_83),+ (84 , happyReduce_84),+ (85 , happyReduce_85),+ (86 , happyReduce_86),+ (87 , happyReduce_87),+ (88 , happyReduce_88),+ (89 , happyReduce_89),+ (90 , happyReduce_90),+ (91 , happyReduce_91),+ (92 , happyReduce_92),+ (93 , happyReduce_93),+ (94 , happyReduce_94),+ (95 , happyReduce_95),+ (96 , happyReduce_96),+ (97 , happyReduce_97),+ (98 , happyReduce_98),+ (99 , happyReduce_99),+ (100 , happyReduce_100),+ (101 , happyReduce_101),+ (102 , happyReduce_102),+ (103 , happyReduce_103),+ (104 , happyReduce_104),+ (105 , happyReduce_105),+ (106 , happyReduce_106),+ (107 , happyReduce_107),+ (108 , happyReduce_108),+ (109 , happyReduce_109),+ (110 , happyReduce_110),+ (111 , happyReduce_111),+ (112 , happyReduce_112),+ (113 , happyReduce_113),+ (114 , happyReduce_114),+ (115 , happyReduce_115),+ (116 , happyReduce_116),+ (117 , happyReduce_117),+ (118 , happyReduce_118),+ (119 , happyReduce_119),+ (120 , happyReduce_120),+ (121 , happyReduce_121),+ (122 , happyReduce_122),+ (123 , happyReduce_123),+ (124 , happyReduce_124),+ (125 , happyReduce_125)+ ]++happy_n_terms = 73 :: Int+happy_n_nonterms = 27 :: Int++happyReduce_1 = happySpecReduce_1 0# happyReduction_1+happyReduction_1 happy_x_1+ = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn4+ ([happy_var_1]+ )}++happyReduce_2 = happySpecReduce_2 0# happyReduction_2+happyReduction_2 happy_x_2+ happy_x_1+ = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn4+ ([happy_var_1]+ )}++happyReduce_3 = happySpecReduce_3 0# happyReduction_3+happyReduction_3 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut5 happy_x_3 of { happy_var_3 -> + happyIn4+ (happy_var_1++[happy_var_3]+ )}}++happyReduce_4 = happyReduce 4# 0# happyReduction_4+happyReduction_4 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut5 happy_x_3 of { happy_var_3 -> + happyIn4+ (happy_var_1++[happy_var_3]+ ) `HappyStk` happyRest}}++happyReduce_5 = happySpecReduce_1 1# happyReduction_5+happyReduction_5 happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn5+ (happy_var_1+ )}++happyReduce_6 = happyReduce 5# 1# happyReduction_6+happyReduction_6 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut8 happy_x_3 of { happy_var_3 -> + case happyOut9 happy_x_5 of { happy_var_5 -> + happyIn5+ (Ast "variable" [happy_var_3,happy_var_5]+ ) `HappyStk` happyRest}}++happyReduce_7 = happyReduce 9# 1# happyReduction_7+happyReduction_7 (happy_x_9 `HappyStk`+ happy_x_8 `HappyStk`+ happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut6 happy_x_3 of { happy_var_3 -> + case happyOut7 happy_x_5 of { happy_var_5 -> + case happyOut9 happy_x_8 of { happy_var_8 -> + happyIn5+ (Ast "function" ([Avar happy_var_3,happy_var_8]++happy_var_5)+ ) `HappyStk` happyRest}}}++happyReduce_8 = happyReduce 8# 1# happyReduction_8+happyReduction_8 (happy_x_8 `HappyStk`+ happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut6 happy_x_3 of { happy_var_3 -> + case happyOut9 happy_x_7 of { happy_var_7 -> + happyIn5+ (Ast "function" [Avar happy_var_3,happy_var_7]+ ) `HappyStk` happyRest}}++happyReduce_9 = happySpecReduce_1 2# happyReduction_9+happyReduction_9 happy_x_1+ = case happyOutTok happy_x_1 of { (QName happy_var_1) -> + happyIn6+ (happy_var_1+ )}++happyReduce_10 = happySpecReduce_3 2# happyReduction_10+happyReduction_10 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOutTok happy_x_1 of { (QName happy_var_1) -> + case happyOutTok happy_x_3 of { (QName happy_var_3) -> + happyIn6+ (happy_var_1++":"++happy_var_3+ )}}++happyReduce_11 = happySpecReduce_1 3# happyReduction_11+happyReduction_11 happy_x_1+ = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn7+ ([happy_var_1]+ )}++happyReduce_12 = happySpecReduce_3 3# happyReduction_12+happyReduction_12 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut7 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_3 of { happy_var_3 -> + happyIn7+ (happy_var_1++[happy_var_3]+ )}}++happyReduce_13 = happySpecReduce_1 4# happyReduction_13+happyReduction_13 happy_x_1+ = case happyOutTok happy_x_1 of { (Variable happy_var_1) -> + happyIn8+ (Avar happy_var_1+ )}++happyReduce_14 = happyReduce 5# 5# happyReduction_14+happyReduction_14 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut14 happy_x_2 of { happy_var_2 -> + case happyOut15 happy_x_3 of { happy_var_3 -> + case happyOut9 happy_x_5 of { happy_var_5 -> + happyIn9+ ((snd happy_var_3) (happy_var_1 (happy_var_2 ((fst happy_var_3) happy_var_5)))+ ) `HappyStk` happyRest}}}}++happyReduce_15 = happyReduce 4# 5# happyReduction_15+happyReduction_15 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut12 happy_x_2 of { happy_var_2 -> + case happyOut9 happy_x_4 of { happy_var_4 -> + happyIn9+ (call "some" [happy_var_2 happy_var_4]+ ) `HappyStk` happyRest}}++happyReduce_16 = happyReduce 4# 5# happyReduction_16+happyReduction_16 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut12 happy_x_2 of { happy_var_2 -> + case happyOut9 happy_x_4 of { happy_var_4 -> + happyIn9+ (call "not" [call "some" [happy_var_2 (call "not" [happy_var_4])]]+ ) `HappyStk` happyRest}}++happyReduce_17 = happyReduce 6# 5# happyReduction_17+happyReduction_17 (happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut9 happy_x_2 of { happy_var_2 -> + case happyOut9 happy_x_4 of { happy_var_4 -> + case happyOut9 happy_x_6 of { happy_var_6 -> + happyIn9+ (call "if" [happy_var_2,happy_var_4,happy_var_6]+ ) `HappyStk` happyRest}}}++happyReduce_18 = happySpecReduce_1 5# happyReduction_18+happyReduction_18 happy_x_1+ = case happyOut25 happy_x_1 of { happy_var_1 -> + happyIn9+ (happy_var_1+ )}++happyReduce_19 = happySpecReduce_1 5# happyReduction_19+happyReduction_19 happy_x_1+ = case happyOut19 happy_x_1 of { happy_var_1 -> + happyIn9+ (happy_var_1+ )}++happyReduce_20 = happySpecReduce_1 5# happyReduction_20+happyReduction_20 happy_x_1+ = case happyOut18 happy_x_1 of { happy_var_1 -> + happyIn9+ (happy_var_1+ )}++happyReduce_21 = happySpecReduce_3 5# happyReduction_21+happyReduction_21 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "to" [happy_var_1,happy_var_3]+ )}}++happyReduce_22 = happySpecReduce_3 5# happyReduction_22+happyReduction_22 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "+" [happy_var_1,happy_var_3]+ )}}++happyReduce_23 = happySpecReduce_3 5# happyReduction_23+happyReduction_23 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "-" [happy_var_1,happy_var_3]+ )}}++happyReduce_24 = happySpecReduce_3 5# happyReduction_24+happyReduction_24 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "*" [happy_var_1,happy_var_3]+ )}}++happyReduce_25 = happySpecReduce_3 5# happyReduction_25+happyReduction_25 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "div" [happy_var_1,happy_var_3]+ )}}++happyReduce_26 = happySpecReduce_3 5# happyReduction_26+happyReduction_26 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "idiv" [happy_var_1,happy_var_3]+ )}}++happyReduce_27 = happySpecReduce_3 5# happyReduction_27+happyReduction_27 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "mod" [happy_var_1,happy_var_3]+ )}}++happyReduce_28 = happySpecReduce_3 5# happyReduction_28+happyReduction_28 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "=" [happy_var_1,happy_var_3]+ )}}++happyReduce_29 = happySpecReduce_3 5# happyReduction_29+happyReduction_29 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "!=" [happy_var_1,happy_var_3]+ )}}++happyReduce_30 = happySpecReduce_3 5# happyReduction_30+happyReduction_30 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "<" [happy_var_1,happy_var_3]+ )}}++happyReduce_31 = happySpecReduce_3 5# happyReduction_31+happyReduction_31 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "<=" [happy_var_1,happy_var_3]+ )}}++happyReduce_32 = happySpecReduce_3 5# happyReduction_32+happyReduction_32 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call ">" [happy_var_1,happy_var_3]+ )}}++happyReduce_33 = happySpecReduce_3 5# happyReduction_33+happyReduction_33 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call ">=" [happy_var_1,happy_var_3]+ )}}++happyReduce_34 = happySpecReduce_3 5# happyReduction_34+happyReduction_34 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "<<" [happy_var_1,happy_var_3]+ )}}++happyReduce_35 = happySpecReduce_3 5# happyReduction_35+happyReduction_35 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call ">>" [happy_var_1,happy_var_3]+ )}}++happyReduce_36 = happySpecReduce_3 5# happyReduction_36+happyReduction_36 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "is" [happy_var_1,happy_var_3]+ )}}++happyReduce_37 = happySpecReduce_3 5# happyReduction_37+happyReduction_37 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "eq" [happy_var_1,happy_var_3]+ )}}++happyReduce_38 = happySpecReduce_3 5# happyReduction_38+happyReduction_38 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "ne" [happy_var_1,happy_var_3]+ )}}++happyReduce_39 = happySpecReduce_3 5# happyReduction_39+happyReduction_39 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "lt" [happy_var_1,happy_var_3]+ )}}++happyReduce_40 = happySpecReduce_3 5# happyReduction_40+happyReduction_40 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "le" [happy_var_1,happy_var_3]+ )}}++happyReduce_41 = happySpecReduce_3 5# happyReduction_41+happyReduction_41 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "gt" [happy_var_1,happy_var_3]+ )}}++happyReduce_42 = happySpecReduce_3 5# happyReduction_42+happyReduction_42 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "ge" [happy_var_1,happy_var_3]+ )}}++happyReduce_43 = happySpecReduce_3 5# happyReduction_43+happyReduction_43 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "and" [happy_var_1,happy_var_3]+ )}}++happyReduce_44 = happySpecReduce_3 5# happyReduction_44+happyReduction_44 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "or" [happy_var_1,happy_var_3]+ )}}++happyReduce_45 = happySpecReduce_3 5# happyReduction_45+happyReduction_45 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "not" [happy_var_1,happy_var_3]+ )}}++happyReduce_46 = happySpecReduce_3 5# happyReduction_46+happyReduction_46 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "union" [happy_var_1,happy_var_3]+ )}}++happyReduce_47 = happySpecReduce_3 5# happyReduction_47+happyReduction_47 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "intersect" [happy_var_1,happy_var_3]+ )}}++happyReduce_48 = happySpecReduce_3 5# happyReduction_48+happyReduction_48 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn9+ (call "except" [happy_var_1,happy_var_3]+ )}}++happyReduce_49 = happySpecReduce_2 5# happyReduction_49+happyReduction_49 happy_x_2+ happy_x_1+ = case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn9+ (call "uplus" [happy_var_2]+ )}++happyReduce_50 = happySpecReduce_2 5# happyReduction_50+happyReduction_50 happy_x_2+ happy_x_1+ = case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn9+ (call "uminus" [happy_var_2]+ )}++happyReduce_51 = happySpecReduce_2 5# happyReduction_51+happyReduction_51 happy_x_2+ happy_x_1+ = case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn9+ (call "not" [happy_var_2]+ )}++happyReduce_52 = happySpecReduce_1 5# happyReduction_52+happyReduction_52 happy_x_1+ = case happyOut22 happy_x_1 of { happy_var_1 -> + happyIn9+ (happy_var_1+ )}++happyReduce_53 = happySpecReduce_1 5# happyReduction_53+happyReduction_53 happy_x_1+ = case happyOutTok happy_x_1 of { (TInteger happy_var_1) -> + happyIn9+ (Aint happy_var_1+ )}++happyReduce_54 = happySpecReduce_1 5# happyReduction_54+happyReduction_54 happy_x_1+ = case happyOutTok happy_x_1 of { (TFloat happy_var_1) -> + happyIn9+ (Afloat happy_var_1+ )}++happyReduce_55 = happySpecReduce_1 6# happyReduction_55+happyReduction_55 happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn10+ ([happy_var_1]+ )}++happyReduce_56 = happySpecReduce_3 6# happyReduction_56+happyReduction_56 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut10 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn10+ (happy_var_1++[happy_var_3]+ )}}++happyReduce_57 = happySpecReduce_2 7# happyReduction_57+happyReduction_57 happy_x_2+ happy_x_1+ = case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn11+ (happy_var_2+ )}++happyReduce_58 = happySpecReduce_2 7# happyReduction_58+happyReduction_58 happy_x_2+ happy_x_1+ = case happyOut13 happy_x_2 of { happy_var_2 -> + happyIn11+ (happy_var_2+ )}++happyReduce_59 = happySpecReduce_3 7# happyReduction_59+happyReduction_59 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut12 happy_x_3 of { happy_var_3 -> + happyIn11+ (happy_var_1 . happy_var_3+ )}}++happyReduce_60 = happySpecReduce_3 7# happyReduction_60+happyReduction_60 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut13 happy_x_3 of { happy_var_3 -> + happyIn11+ (happy_var_1 . happy_var_3+ )}}++happyReduce_61 = happySpecReduce_3 8# happyReduction_61+happyReduction_61 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut8 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn12+ (\x -> Ast "for" [happy_var_1,Avar "$",happy_var_3,x]+ )}}++happyReduce_62 = happyReduce 5# 8# happyReduction_62+happyReduction_62 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut8 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_3 of { happy_var_3 -> + case happyOut9 happy_x_5 of { happy_var_5 -> + happyIn12+ (\x -> Ast "for" [happy_var_1,happy_var_3,happy_var_5,x]+ ) `HappyStk` happyRest}}}++happyReduce_63 = happyReduce 5# 8# happyReduction_63+happyReduction_63 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut12 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_3 of { happy_var_3 -> + case happyOut9 happy_x_5 of { happy_var_5 -> + happyIn12+ (\x -> happy_var_1(Ast "for" [happy_var_3,Avar "$",happy_var_5,x])+ ) `HappyStk` happyRest}}}++happyReduce_64 = happyReduce 7# 8# happyReduction_64+happyReduction_64 (happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut12 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_3 of { happy_var_3 -> + case happyOut8 happy_x_5 of { happy_var_5 -> + case happyOut9 happy_x_7 of { happy_var_7 -> + happyIn12+ (\x -> happy_var_1(Ast "for" [happy_var_3,happy_var_5,happy_var_7,x])+ ) `HappyStk` happyRest}}}}++happyReduce_65 = happySpecReduce_3 9# happyReduction_65+happyReduction_65 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut8 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn13+ (\x -> Ast "let" [happy_var_1,happy_var_3,x]+ )}}++happyReduce_66 = happyReduce 5# 9# happyReduction_66+happyReduction_66 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut13 happy_x_1 of { happy_var_1 -> + case happyOut8 happy_x_3 of { happy_var_3 -> + case happyOut9 happy_x_5 of { happy_var_5 -> + happyIn13+ (\x -> happy_var_1(Ast "let" [happy_var_3,happy_var_5,x])+ ) `HappyStk` happyRest}}}++happyReduce_67 = happySpecReduce_2 10# happyReduction_67+happyReduction_67 happy_x_2+ happy_x_1+ = case happyOut9 happy_x_2 of { happy_var_2 -> + happyIn14+ (\x -> Ast "predicate" [happy_var_2,x]+ )}++happyReduce_68 = happySpecReduce_0 10# happyReduction_68+happyReduction_68 = happyIn14+ (id+ )++happyReduce_69 = happySpecReduce_3 11# happyReduction_69+happyReduction_69 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut16 happy_x_3 of { happy_var_3 -> + happyIn15+ ((\x -> Ast "sortTuple" (x:(fst happy_var_3)),+ \x -> Ast "sort" (x:(snd happy_var_3)))+ )}++happyReduce_70 = happySpecReduce_0 11# happyReduction_70+happyReduction_70 = happyIn15+ ((id,id)+ )++happyReduce_71 = happySpecReduce_2 12# happyReduction_71+happyReduction_71 happy_x_2+ happy_x_1+ = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut17 happy_x_2 of { happy_var_2 -> + happyIn16+ (([happy_var_1],[happy_var_2])+ )}}++happyReduce_72 = happyReduce 4# 12# happyReduction_72+happyReduction_72 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut16 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + case happyOut17 happy_x_4 of { happy_var_4 -> + happyIn16+ (((fst happy_var_1)++[happy_var_3],(snd happy_var_1)++[happy_var_4])+ ) `HappyStk` happyRest}}}++happyReduce_73 = happySpecReduce_1 13# happyReduction_73+happyReduction_73 happy_x_1+ = happyIn17+ (Avar "ascending"+ )++happyReduce_74 = happySpecReduce_1 13# happyReduction_74+happyReduction_74 happy_x_1+ = happyIn17+ (Avar "descending"+ )++happyReduce_75 = happySpecReduce_0 13# happyReduction_75+happyReduction_75 = happyIn17+ (Avar "ascending"+ )++happyReduce_76 = happyReduce 4# 14# happyReduction_76+happyReduction_76 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn18+ (call "element" [Avar happy_var_3]+ ) `HappyStk` happyRest}++happyReduce_77 = happyReduce 4# 14# happyReduction_77+happyReduction_77 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut6 happy_x_3 of { happy_var_3 -> + happyIn18+ (call "attribute" [Avar happy_var_3]+ ) `HappyStk` happyRest}++happyReduce_78 = happyReduce 6# 15# happyReduction_78+happyReduction_78 (happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut20 happy_x_1 of { happy_var_1 -> + case happyOut21 happy_x_3 of { happy_var_3 -> + case happyOut6 happy_x_5 of { happy_var_5 -> + happyIn19+ (if head happy_var_1 == Astring happy_var_5+ then Ast "element_construction" (happy_var_1++[Ast "append" happy_var_3])+ else parseError [TError ("Unmatched tags in element construction: "+ ++(show (head happy_var_1))++" '"++happy_var_5++"'")]+ ) `HappyStk` happyRest}}}++happyReduce_79 = happyReduce 5# 15# happyReduction_79+happyReduction_79 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut20 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_4 of { happy_var_4 -> + happyIn19+ (if head happy_var_1 == Astring happy_var_4+ then Ast "element_construction" (happy_var_1++[Ast "append" []])+ else parseError [TError ("Unmatched tags in element construction: "+ ++(show (head happy_var_1))++" '"++happy_var_4++"'")]+ ) `HappyStk` happyRest}}++happyReduce_80 = happySpecReduce_2 15# happyReduction_80+happyReduction_80 happy_x_2+ happy_x_1+ = case happyOut20 happy_x_1 of { happy_var_1 -> + happyIn19+ (Ast "element_construction" (happy_var_1++[Ast "append" []])+ )}++happyReduce_81 = happyReduce 7# 15# happyReduction_81+happyReduction_81 (happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut9 happy_x_3 of { happy_var_3 -> + case happyOut10 happy_x_6 of { happy_var_6 -> + happyIn19+ (Ast "element_construction" [happy_var_3,Ast "attributes" [],concatenateAll happy_var_6]+ ) `HappyStk` happyRest}}++happyReduce_82 = happyReduce 7# 15# happyReduction_82+happyReduction_82 (happy_x_7 `HappyStk`+ happy_x_6 `HappyStk`+ happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut9 happy_x_3 of { happy_var_3 -> + case happyOut10 happy_x_6 of { happy_var_6 -> + happyIn19+ (Ast "attribute_construction" [happy_var_3,concatenateAll happy_var_6]+ ) `HappyStk` happyRest}}++happyReduce_83 = happyReduce 5# 15# happyReduction_83+happyReduction_83 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut6 happy_x_2 of { happy_var_2 -> + case happyOut10 happy_x_4 of { happy_var_4 -> + happyIn19+ (Ast "element_construction" [Astring happy_var_2,Ast "attributes" [],concatenateAll happy_var_4]+ ) `HappyStk` happyRest}}++happyReduce_84 = happyReduce 5# 15# happyReduction_84+happyReduction_84 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut6 happy_x_2 of { happy_var_2 -> + case happyOut10 happy_x_4 of { happy_var_4 -> + happyIn19+ (Ast "attribute_construction" [Astring happy_var_2,concatenateAll happy_var_4]+ ) `HappyStk` happyRest}}++happyReduce_85 = happySpecReduce_2 16# happyReduction_85+happyReduction_85 happy_x_2+ happy_x_1+ = case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn20+ ([Astring happy_var_2,Ast "attributes" []]+ )}++happyReduce_86 = happySpecReduce_3 16# happyReduction_86+happyReduction_86 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut6 happy_x_2 of { happy_var_2 -> + case happyOut24 happy_x_3 of { happy_var_3 -> + happyIn20+ ([Astring happy_var_2,Ast "attributes" happy_var_3]+ )}}++happyReduce_87 = happySpecReduce_3 17# happyReduction_87+happyReduction_87 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut10 happy_x_2 of { happy_var_2 -> + happyIn21+ ([concatenateAll happy_var_2]+ )}++happyReduce_88 = happySpecReduce_1 17# happyReduction_88+happyReduction_88 happy_x_1+ = case happyOutTok happy_x_1 of { (TString happy_var_1) -> + happyIn21+ ([Astring happy_var_1]+ )}++happyReduce_89 = happySpecReduce_1 17# happyReduction_89+happyReduction_89 happy_x_1+ = case happyOutTok happy_x_1 of { (XMLtext happy_var_1) -> + happyIn21+ ([Astring happy_var_1]+ )}++happyReduce_90 = happySpecReduce_1 17# happyReduction_90+happyReduction_90 happy_x_1+ = case happyOut19 happy_x_1 of { happy_var_1 -> + happyIn21+ ([happy_var_1]+ )}++happyReduce_91 = happyReduce 4# 17# happyReduction_91+happyReduction_91 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn21+ (happy_var_1++[concatenateAll happy_var_3]+ ) `HappyStk` happyRest}}++happyReduce_92 = happySpecReduce_2 17# happyReduction_92+happyReduction_92 happy_x_2+ happy_x_1+ = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { (TString happy_var_2) -> + happyIn21+ (happy_var_1++[Astring happy_var_2]+ )}}++happyReduce_93 = happySpecReduce_2 17# happyReduction_93+happyReduction_93 happy_x_2+ happy_x_1+ = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { (XMLtext happy_var_2) -> + happyIn21+ (happy_var_1++[Astring happy_var_2]+ )}}++happyReduce_94 = happySpecReduce_2 17# happyReduction_94+happyReduction_94 happy_x_2+ happy_x_1+ = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOut19 happy_x_2 of { happy_var_2 -> + happyIn21+ (happy_var_1++[happy_var_2]+ )}}++happyReduce_95 = happySpecReduce_1 18# happyReduction_95+happyReduction_95 happy_x_1+ = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn22+ (if length happy_var_1 == 1 then head happy_var_1 else Ast "append" happy_var_1+ )}++happyReduce_96 = happySpecReduce_1 19# happyReduction_96+happyReduction_96 happy_x_1+ = case happyOutTok happy_x_1 of { (TString happy_var_1) -> + happyIn23+ (if happy_var_1=="" then [] else [Astring happy_var_1]+ )}++happyReduce_97 = happySpecReduce_3 19# happyReduction_97+happyReduction_97 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut10 happy_x_2 of { happy_var_2 -> + happyIn23+ ([concatenateAll happy_var_2]+ )}++happyReduce_98 = happySpecReduce_2 19# happyReduction_98+happyReduction_98 happy_x_2+ happy_x_1+ = case happyOut23 happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { (TString happy_var_2) -> + happyIn23+ (if happy_var_2=="" then happy_var_1 else happy_var_1++[Astring happy_var_2]+ )}}++happyReduce_99 = happyReduce 4# 19# happyReduction_99+happyReduction_99 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut23 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn23+ (happy_var_1++[concatenateAll happy_var_3]+ ) `HappyStk` happyRest}}++happyReduce_100 = happySpecReduce_3 20# happyReduction_100+happyReduction_100 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_3 of { happy_var_3 -> + happyIn24+ ([Ast "pair" [Astring happy_var_1,happy_var_3]]+ )}}++happyReduce_101 = happyReduce 4# 20# happyReduction_101+happyReduction_101 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut24 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + case happyOut22 happy_x_4 of { happy_var_4 -> + happyIn24+ (happy_var_1++[Ast "pair" [Astring happy_var_2,happy_var_4]]+ ) `HappyStk` happyRest}}}++happyReduce_102 = happySpecReduce_2 21# happyReduction_102+happyReduction_102 happy_x_2+ happy_x_1+ = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOut28 happy_x_2 of { happy_var_2 -> + happyIn25+ (happy_var_1 "child" (Avar ".") happy_var_2+ )}}++happyReduce_103 = happySpecReduce_3 21# happyReduction_103+happyReduction_103 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut29 happy_x_2 of { happy_var_2 -> + case happyOut28 happy_x_3 of { happy_var_3 -> + happyIn25+ (happy_var_2 "attribute" (Avar ".") happy_var_3+ )}}++happyReduce_104 = happySpecReduce_3 21# happyReduction_104+happyReduction_104 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOut28 happy_x_2 of { happy_var_2 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn25+ (happy_var_3 (happy_var_1 "child" (Avar ".") happy_var_2)+ )}}}++happyReduce_105 = happyReduce 4# 21# happyReduction_105+happyReduction_105 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut29 happy_x_2 of { happy_var_2 -> + case happyOut28 happy_x_3 of { happy_var_3 -> + case happyOut26 happy_x_4 of { happy_var_4 -> + happyIn25+ (happy_var_4 (happy_var_2 "attribute" (Avar ".") happy_var_3)+ ) `HappyStk` happyRest}}}++happyReduce_106 = happySpecReduce_1 22# happyReduction_106+happyReduction_106 happy_x_1+ = case happyOut27 happy_x_1 of { happy_var_1 -> + happyIn26+ (happy_var_1+ )}++happyReduce_107 = happySpecReduce_2 22# happyReduction_107+happyReduction_107 happy_x_2+ happy_x_1+ = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut27 happy_x_2 of { happy_var_2 -> + happyIn26+ (happy_var_2 . happy_var_1+ )}}++happyReduce_108 = happySpecReduce_3 23# happyReduction_108+happyReduction_108 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut29 happy_x_2 of { happy_var_2 -> + case happyOut28 happy_x_3 of { happy_var_3 -> + happyIn27+ (\e -> happy_var_2 "child" e happy_var_3+ )}}++happyReduce_109 = happyReduce 4# 23# happyReduction_109+happyReduction_109 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut29 happy_x_3 of { happy_var_3 -> + case happyOut28 happy_x_4 of { happy_var_4 -> + happyIn27+ (\e -> happy_var_3 "attribute" e happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_110 = happyReduce 4# 23# happyReduction_110+happyReduction_110 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut29 happy_x_3 of { happy_var_3 -> + case happyOut28 happy_x_4 of { happy_var_4 -> + happyIn27+ (\e -> happy_var_3 "descendant-or-self" e happy_var_4+ ) `HappyStk` happyRest}}++happyReduce_111 = happyReduce 5# 23# happyReduction_111+happyReduction_111 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut29 happy_x_4 of { happy_var_4 -> + case happyOut28 happy_x_5 of { happy_var_5 -> + happyIn27+ (\e -> happy_var_4 "attribute-descendant" e happy_var_5+ ) `HappyStk` happyRest}}++happyReduce_112 = happySpecReduce_2 23# happyReduction_112+happyReduction_112 happy_x_2+ happy_x_1+ = happyIn27+ (\e -> Ast "step" [Avar "parent",Astring "*",e]+ )++happyReduce_113 = happyReduce 4# 24# happyReduction_113+happyReduction_113 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut28 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn28+ (happy_var_1 ++ [happy_var_3]+ ) `HappyStk` happyRest}}++happyReduce_114 = happySpecReduce_0 24# happyReduction_114+happyReduction_114 = happyIn28+ ([]+ )++happyReduce_115 = happySpecReduce_1 25# happyReduction_115+happyReduction_115 happy_x_1+ = case happyOut30 happy_x_1 of { happy_var_1 -> + happyIn29+ (\t e ps -> if null ps+ then happy_var_1 t e+ else Ast "filter" (happy_var_1 t e:ps)+ )}++happyReduce_116 = happySpecReduce_1 25# happyReduction_116+happyReduction_116 happy_x_1+ = happyIn29+ (\t e ps -> Ast "step" ((Avar t):(Astring "*"):e:ps)+ )++happyReduce_117 = happySpecReduce_1 25# happyReduction_117+happyReduction_117 happy_x_1+ = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn29+ (\t e ps -> if elem happy_var_1 path_steps+ then parseError [TError ("Axis "++happy_var_1++" is missing a node step")]+ else Ast "step" ((Avar t):(Astring happy_var_1):e:ps)+ )}++happyReduce_118 = happyReduce 4# 25# happyReduction_118+happyReduction_118 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_1 of { (QName happy_var_1) -> + case happyOut6 happy_x_4 of { happy_var_4 -> + happyIn29+ (\t e ps -> if elem happy_var_1 path_steps+ then if t == "child"+ then Ast "step" ((Avar happy_var_1):(Astring happy_var_4):e:ps)+ else parseError [TError ("The navigation step must be /"++happy_var_1++"::"++happy_var_4)]+ else parseError [TError ("Not a valid axis name: "++happy_var_1)]+ ) `HappyStk` happyRest}}++happyReduce_119 = happyReduce 4# 25# happyReduction_119+happyReduction_119 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_1 of { (QName happy_var_1) -> + happyIn29+ (\t e ps -> if elem happy_var_1 path_steps+ then if t == "child"+ then Ast "step" ((Avar happy_var_1):(Astring "*"):e:ps)+ else parseError [TError ("The navigation step must be /"++happy_var_1++"::*")]+ else parseError [TError ("Not a valid axis name: "++happy_var_1)]+ ) `HappyStk` happyRest}++happyReduce_120 = happySpecReduce_1 26# happyReduction_120+happyReduction_120 happy_x_1+ = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn30+ (\_ _ -> happy_var_1+ )}++happyReduce_121 = happySpecReduce_1 26# happyReduction_121+happyReduction_121 happy_x_1+ = happyIn30+ (\_ e -> e+ )++happyReduce_122 = happySpecReduce_3 26# happyReduction_122+happyReduction_122 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut10 happy_x_2 of { happy_var_2 -> + happyIn30+ (\t e -> if e == Avar "."+ then concatenateAll happy_var_2+ else Ast "context" [e,Astring t,concatenateAll happy_var_2]+ )}++happyReduce_123 = happySpecReduce_2 26# happyReduction_123+happyReduction_123 happy_x_2+ happy_x_1+ = happyIn30+ (\_ _ -> call "empty" []+ )++happyReduce_124 = happyReduce 4# 26# happyReduction_124+happyReduction_124 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut6 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_3 of { happy_var_3 -> + happyIn30+ (\t e -> if e == Avar "."+ then call happy_var_1 happy_var_3+ else Ast "context" [e,Astring t,call happy_var_1 happy_var_3]+ ) `HappyStk` happyRest}}++happyReduce_125 = happySpecReduce_3 26# happyReduction_125+happyReduction_125 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn30+ (\_ e -> call happy_var_1 (if e == Avar "." then [] else [e])+ )}++happyNewToken action sts stk [] =+ happyDoAction 72# notHappyAtAll action sts stk []++happyNewToken action sts stk (tk:tks) =+ let cont i = happyDoAction i tk action sts stk tks in+ case tk of {+ RETURN -> cont 1#;+ SOME -> cont 2#;+ EVERY -> cont 3#;+ IF -> cont 4#;+ THEN -> cont 5#;+ ELSE -> cont 6#;+ LB -> cont 7#;+ RB -> cont 8#;+ LP -> cont 9#;+ RP -> cont 10#;+ LSB -> cont 11#;+ RSB -> cont 12#;+ TO -> cont 13#;+ PLUS -> cont 14#;+ MINUS -> cont 15#;+ TIMES -> cont 16#;+ DIV -> cont 17#;+ IDIV -> cont 18#;+ MOD -> cont 19#;+ TEQ -> cont 20#;+ TNE -> cont 21#;+ TLT -> cont 22#;+ TLE -> cont 23#;+ TGT -> cont 24#;+ TGE -> cont 25#;+ PRE -> cont 26#;+ POST -> cont 27#;+ IS -> cont 28#;+ SEQ -> cont 29#;+ SNE -> cont 30#;+ SLT -> cont 31#;+ SLE -> cont 32#;+ SGT -> cont 33#;+ SGE -> cont 34#;+ AND -> cont 35#;+ OR -> cont 36#;+ NOT -> cont 37#;+ UNION -> cont 38#;+ INTERSECT -> cont 39#;+ EXCEPT -> cont 40#;+ FOR -> cont 41#;+ LET -> cont 42#;+ IN -> cont 43#;+ COMMA -> cont 44#;+ ASSIGN -> cont 45#;+ WHERE -> cont 46#;+ ORDER -> cont 47#;+ BY -> cont 48#;+ ASCENDING -> cont 49#;+ DESCENDING -> cont 50#;+ ELEMENT -> cont 51#;+ ATTRIBUTE -> cont 52#;+ STAG -> cont 53#;+ ETAG -> cont 54#;+ SATISFIES -> cont 55#;+ ATSIGN -> cont 56#;+ SLASH -> cont 57#;+ QName happy_dollar_dollar -> cont 58#;+ DECLARE -> cont 59#;+ FUNCTION -> cont 60#;+ VARIABLE -> cont 61#;+ AT -> cont 62#;+ DOTS -> cont 63#;+ DOT -> cont 64#;+ SEMI -> cont 65#;+ COLON -> cont 66#;+ Variable happy_dollar_dollar -> cont 67#;+ XMLtext happy_dollar_dollar -> cont 68#;+ TInteger happy_dollar_dollar -> cont 69#;+ TFloat happy_dollar_dollar -> cont 70#;+ TString happy_dollar_dollar -> cont 71#;+ _ -> happyError' (tk:tks)+ }++happyError_ tk tks = happyError' (tk:tks)++newtype HappyIdentity a = HappyIdentity a+happyIdentity = HappyIdentity+happyRunIdentity (HappyIdentity a) = a++instance Monad HappyIdentity where+ return = HappyIdentity+ (HappyIdentity p) >>= q = q p++happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b+happyThen = (>>=)+happyReturn :: () => a -> HappyIdentity a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> HappyIdentity a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [Token] -> HappyIdentity a+happyError' = HappyIdentity . parseError++parse tks = happyRunIdentity happySomeParser where+ happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x))++happySeq = happyDontSeq+++-- Abstract Syntax Tree for XQueries+data Ast = Ast String [Ast]+ | Avar String+ | Aint Int+ | Afloat Float+ | 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" []+++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+ | 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 |AT | DOT | DOTS | TokenEOF | PRE | POST | IS+ | QName String | Variable String | XMLtext String | TInteger Int+ | TFloat Float | 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"+++tokenList :: [(Token,String)]+tokenList = [(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"),(SEQ,"eq"),(SNE,"ne"),(SLT,"lt"),(SLE,"le"),(SGT,"gt"),(SGE,"ge"),(AND,"and"),+ (OR,"or"),(NOT,"not"),(UNION,"union"),(INTERSECT,"intersect"),(EXCEPT,"except"),+ (FOR,"for"),(LET,"let"),(IN,"in"),(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"),+ (AT,"at"),(DOTS,".."),(DOT,"."),(SEMI,";"),(COLON,":")]+++parseError tk = error (case tk of+ ((TError s):_) -> "Parse error: "++s+ _ -> "Parse error: "++(foldr (\a r -> (show a)++" "++r) "" (take 20 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 = (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 (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 [] "" = []+lexer [] _ = [ TError "Unexpected end of input" ]+lexer (' ':'>':' ':cs) n = TGT : lexer cs n+lexer (c:cs) n+ | isSpace c = lexer cs n+ | isAlpha 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 = 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 = 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+++lexNum :: String -> String -> [Token]+lexNum cs n = if null rest || head rest /= '.'+ then TInteger (read k) : lexer rest n+ else let (m,rest2) = span isDigit (tail rest)+ val::Float = read (k++('.':m))+ in case rest2 of+ ('e':rest3) -> let (exp,rest4) = span isDigit rest3+ in (TFloat (val*10^(read exp))) : lexer rest4 n+ _ -> (TFloat val) : lexer rest2 n+ where (k,rest) = span isDigit cs+++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+lexString ('{':cs) s n = (TString s) : LSB : (lexer cs ('{':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 (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+ in (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+ "where" -> WHERE+ "order" -> ORDER+ "by" -> BY+ "ascending" -> ASCENDING+ "descending" -> DESCENDING+ "element" -> ELEMENT+ "attribute" -> ATTRIBUTE+ "satisfies" -> SATISFIES+ "declare" -> DECLARE+ "function" -> FUNCTION+ "variable" -> VARIABLE+ "at" -> AT+ "eq" -> SEQ+ "ne" -> SNE+ "lt" -> SLT+ "le" -> SLE+ "gt" -> SGT+ "ge" -> SGE+ "is" -> IS+ var -> QName var+ ) : lexer rest n+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp ++{-# LINE 28 "templates/GenericTemplate.hs" #-}+++data Happy_IntList = HappyCons Int# Happy_IntList++++++{-# LINE 49 "templates/GenericTemplate.hs" #-}++{-# LINE 59 "templates/GenericTemplate.hs" #-}++{-# LINE 68 "templates/GenericTemplate.hs" #-}++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is 0#, it means we've just accepted a partial+-- parse (a %partial parser). We must ignore the saved token on the top of+-- the stack in this case.+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =+ happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++++happyDoAction i tk st+ = {- nothing -}+++ case action of+ 0# -> {- nothing -}+ happyFail i tk st+ -1# -> {- nothing -}+ happyAccept i tk st+ n | (n <# (0# :: Int#)) -> {- nothing -}++ (happyReduceArr ! rule) i tk st+ where rule = (I# ((negateInt# ((n +# (1# :: 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)+ else False+ action | check = indexShortOffAddr happyTable off_i+ | otherwise = indexShortOffAddr happyDefActions st++{-# LINE 127 "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+ 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#++++++data HappyAddr = HappyA# Addr#+++++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++{-# LINE 170 "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+-- trace "shifting the error token" $+ happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)++happyShift new_state i tk st sts stk =+ happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_0 nt fn j tk st@((action)) sts stk+ = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')+ = let r = fn v1 in+ happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')+ = let r = fn v1 v2 in+ happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+ = let r = fn v1 v2 v3 in+ happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++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+ 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)++happyMonadReduce k nt fn 0# tk st sts stk+ = 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))+ 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))+ drop_stk = happyDropStk k stk++ off = indexShortOffAddr happyGotoOffsets st1+ off_i = (off +# nt)+ new_state = indexShortOffAddr happyTable off_i+++++happyDrop 0# l = l+happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t++happyDropStk 0# l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction+++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+++++-----------------------------------------------------------------------------+-- Error recovery (0# is the error token)++-- parse error if we are in recovery and we fail again+happyFail 0# tk old_st _ stk =+-- trace "failing" $ + happyError_ tk++{- We don't need state discarding for our restricted implementation of+ "error". In fact, it can cause some bogus parses, so I've disabled it+ for now --SDM++-- discard a state+happyFail 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) =+-- trace ("discarding state, depth " ++ show (length stk)) $+ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+-- 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)++-- Internal happy errors:++notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions+++happyTcHack :: Int# -> a -> a+happyTcHack x y = y+{-# INLINE happyTcHack #-}+++-----------------------------------------------------------------------------+-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq+-- otherwise it emits+-- happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template. GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.+++{-# NOINLINE happyDoAction #-}+{-# NOINLINE happyTable #-}+{-# NOINLINE happyCheck #-}+{-# NOINLINE happyActOffsets #-}+{-# NOINLINE happyGotoOffsets #-}+{-# NOINLINE happyDefActions #-}++{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.
+ src/Text/XML/HXQ/XQuery.hs view
@@ -0,0 +1,42 @@+{-------------------------------------------------------------------------------------+-+- The XQuery Compiler and Interpreter+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 03/22/08, last update: 08/14/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++-- | HXQ is a fast and space-efficient compiler from XQuery (the standard+-- query language for XML) to embedded Haskell code. The translation is+-- based on Haskell templates. It also provides an interpreter for+-- evaluating ad-hoc XQueries read from input or from files+-- and optional database connectivity using HDBC.+-- For more information, look at <http://lambda.uta.edu/HXQ/>.+module Text.XML.HXQ.XQuery (+ -- * The XML Data Representation+ XTree(..), XSeq, Tag, AttList, putXSeq,+ -- * The XQuery Compiler+ xq, xe,+ -- * The XQuery Interpreter+ xquery, xfile,+ -- * The XQuery Compiler with Database Connectivity+ xqdb, connect, disconnect, prepareSQL, executeSQL,+ -- * The XQuery Interpreter with Database Connectivity+ xqueryDB, xfileDB,+ -- * Shredding and Publishing XML Documents Using a Relational Database+ shred, printSchema, createIndex+ ) where++import HXML(AttList)+import Text.XML.HXQ.XTree+import Text.XML.HXQ.Compiler+import Text.XML.HXQ.Interpreter+import Text.XML.HXQ.OptionalDB
+ src/Text/XML/HXQ/XTree.hs view
@@ -0,0 +1,147 @@+{-------------------------------------------------------------------------------------+-+- XML Trees (represented as rose trees)+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 05/01/08, last update: 07/24/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++{-# OPTIONS_GHC -funbox-strict-fields #-}+++module Text.XML.HXQ.XTree where++import System.IO+import XMLParse(XMLEvent(..))+import HXML(AttList)+import Text.XML.HXQ.Parser(Ast(..))+++type Tag = String+++-- | Rose tree representation of XML data.+-- An XML element is: XElem tagname atributes preorder parent children+-- The preorder numbering is the document order of elements.+-- The parent is a cyclic reference to the parent element.+data XTree = XElem !Tag !AttList !Int XTree [XTree] -- ^ an XML tree node (element)+ | XText !String -- ^ an XML tree leaf (PCDATA)+ | XInt !Int -- ^ an XML tree leaf (int)+ | XFloat !Float -- ^ an XML tree leaf (float)+ | XBool !Bool -- ^ an XML tree leaf (boolean)+ | XPI Tag String -- ^ processing instruction+ | XGERef Tag -- ^ general entity reference+ | XComment String -- ^ comment+ | XError String -- ^ error report+ | XNoPad -- ^ marker for no padding in XSeq+ deriving Eq+++type XSeq = [XTree]+++showAL :: AttList -> String+showAL = foldr (\(a,v) r -> " "++a++"=\""++v++"\""++r) []++showXT :: XTree -> Bool -> String+showXT e pad+ = case e of+ XElem tag al _ _ [] -> "<"++tag++showAL al++"/>"+ XElem tag al _ _ xs -> "<"++tag++showAL al++">"++showXS xs++"</"++tag++">"+ XText text -> p++text+ XInt n -> p++show n+ XFloat n -> p++show n+ XBool v -> p++if v then "true" else "false"+ XComment s -> "<!--"++s++"-->"+ XPI n s -> "<?"++n++" "++s++">"+ XError s -> error s+ _ -> ""+ where p = if pad then " " else ""++showXS :: XSeq -> String+showXS [] = ""+showXS (x:xs) = showXT x False ++ sXS xs+ where sXS (XNoPad:x:xs) = (showXT x False) ++ sXS xs+ sXS (x:xs) = (showXT x True) ++ sXS xs+ sXS _ = ""++instance Show XTree where+ show t = showXT t False+++-- | Print the XQuery result (which is a sequence of XML fragments) without buffering.+putXSeq :: XSeq -> IO ()+putXSeq xs = hSetBuffering stdout NoBuffering >> putStrLn (showXS xs)++++{--------------- Build the rose tree from the XML stream ----------------------------}+++type Stream = [XMLEvent]++noParentError = error "Undefined parent reference"+++-- Lazily materialize the SAX stream into a DOM tree without setting parent references.+materializeWithoutParent :: Stream -> XTree+materializeWithoutParent stream+ = XElem "document" [] 1 noParentError+ [head (filter (\x -> case x of XElem _ _ _ _ _ -> True; _ -> False)+ ((\(x,_,_)->x) (ml stream 2)))]+ where m ((TextEvent t):xs) i = (XText t,xs,i)+ m ((EmptyEvent n atts):xs) i = (XElem n atts i noParentError [],xs,i+1)+ m ((StartEvent n atts):xs) i+ = let (el,xs',i') = ml xs (i+1)+ in (XElem n atts i noParentError el,xs',i')+ m ((PIEvent n s):xs) i = (XPI n s,xs,i)+ m ((CommentEvent s):xs) i = (XComment s,xs,i)+ m ((GERefEvent n):xs) i = (XGERef n,xs,i)+ 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 [] i = ([],[],i)+ ml ((EndEvent n):xs) i = ([],xs,i)+ ml xs i = let (e,xs',i') = m xs i+ (el,xs'',i'') = ml xs' i'+ in (e:el,xs'',i'')+++-- Lazily materialize the SAX stream into a DOM tree setting parent references.+-- It has space leaks for large documents.+-- Used only if the query has backward steps that cannot be eliminated.+materializeWithParent :: Stream -> XTree+materializeWithParent stream = root+ where root = XElem "document" [] 1 (XError "Trying to access the root parent")+ [head (filter (\x -> case x of XElem _ _ _ _ _ -> True; _ -> False)+ ((\(x,_,_)->x) (ml stream 2 root)))]+ m ((TextEvent t):xs) i _ = (XText t,xs,i)+ m ((EmptyEvent n atts):xs) i p = (XElem n atts i p [],xs,i+1)+ m ((StartEvent n atts):xs) i p+ = let (el,xs',i') = ml xs (i+1) node+ node = XElem n atts i p el+ in (node,xs',i')+ m ((PIEvent n s):xs) i _ = (XPI n s,xs,i)+ m ((CommentEvent s):xs) i _ = (XComment s,xs,i)+ m ((GERefEvent n):xs) i _ = (XGERef n,xs,i)+ 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 [] i _ = ([],[],i)+ ml ((EndEvent n):xs) i _ = ([],xs,i)+ ml xs i p = let (e,xs',i') = m xs i p+ (el,xs'',i'') = ml xs' i' p+ in (e:el,xs'',i'')+++materialize :: Bool -> Stream -> XTree+materialize True = materializeWithParent+materialize False = materializeWithoutParent
+ src/hxml-0.2/00-LICENSE.txt view
@@ -0,0 +1,22 @@+LICENSE ("MIT-style")++Copyright (C) 2000, 2001, Joe English++Permission is hereby granted to use, copy, modify, distribute,+and license this software and its documentation for any purpose, provided+that existing copyright notices are retained in all copies and that this+notice is included in any distributions. No written agreement,+license, or royalty fee is required for any of the authorized uses.+Modifications to this software may be copyrighted by their authors+and need not follow the licensing terms described here, provided that+the new terms are clearly indicated on the first page of each file where+they apply.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT+SHALL THE AUTHORS OF THIS SOFTWARE BE LIABLE TO ANY PARTY FOR+DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES+ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION.++
+ src/hxml-0.2/00-README.txt view
@@ -0,0 +1,57 @@++$Id: 00-README.txt,v 1.3 2003/08/01 19:59:00 joe Exp $++5 Mar 2002++Announcing HXML version 0.2, a non-validating XML parser written in Haskell.++HXML is available at:++ <URL: http://www.flightlab.com/~joe/hxml >++The current version is 0.2, and is pre-beta quality.++HXML has been tested with GHC 6.0, GHC 5.02, NHC 1.10, and +various versions of Hugs 98.++Please contact Joe English <jenglish@flightlab.com> with+any questions, comments, or bug reports.++* * * KNOWN BUGS++ + The XML declaration is ignored.+ + Unicode support is only as good as that provided+ by the Haskell system (i.e., typically not very).+ + Does not do any well-formedness or validity checks.+ + Under Hugs 98 only, suffers a serious space fault.+ + Does not support XML Namespaces.++* * * USAGE++Documentation in XML format is available in the 'doc' subdirectory,+along with a Haskell program which converts it into HTML.+Run 'make html' in that directory to build the HTML docs+with Hugs. doc/mkSite.hs also serves as an example of how+to use the library.++* * * INSTALLATION++Installation instructions depend on the Haskell system.+For Hugs, put the sources somewhere in the Hugs search path.+For NHC, just use 'hmake'.++For GHC, copy Makefile.dist to Makefile, edit as desired, and run+ make library+ make profiled-library ;# optional+Next, edit the file "hxml.conf.in" and replace @INSTDIR@+with the installation directory (i.e., wherever you extracted+the distribution). Finally, run+ ghc-pkg --add hxml.conf.in+If all goes well, you may then use 'ghc -package hxml' to access+the library.++At some point, I'll add proper 'configure ; make ; make install' support.+Recommended procedures for doing this are still (Aug 2003) being hashed out+on various mailing lists.++* * * END.
+ src/hxml-0.2/AssocList.hs view
@@ -0,0 +1,56 @@+----------------------------------------------------------------------------+--+-- Module : AssocList.hs+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : provisional+-- Portability : portable+--+-- CVS : $Id: AssocList.hs,v 1.5 2002/10/12 01:58:56 joe Exp $+--+----------------------------------------------------------------------------+--+-- Quick hack; need a stub FiniteMap implementation+--++module AssocList + ( FM, unsafeLookup, lookupM, lookupWithDefault, empty+ , insert , insertWith+ ) where++import Prelude -- hiding (null,map,foldr,foldl,foldr1,foldl1,filter)++type FM k a = [(k,a)]++lookupM :: (Eq k) => FM k a -> k -> Maybe a+lookupM = flip Prelude.lookup++lookupWithDefault :: (Eq key) => FM key elt -> elt -> key -> elt+lookupWithDefault m d = maybe d id . lookupM m++unsafeLookup :: (Eq a) => FM a b -> a -> b+unsafeLookup m = maybe (error "Error: Not found") id . lookupM m++insertWith :: (Eq k) => (a -> a -> a) -> k -> a -> FM k a -> FM k a+insertWith _ key elt [] = [(key,elt)]+insertWith c key elt ((k,e):l)+ | k == key = (k,c e elt):l+ | otherwise = (k,e):insertWith c key elt l++insert :: (Eq k) => k -> a -> FM k a -> FM k a+insert = insertWith (\_old new -> new)++{-+-- GHC 'data' library convention:+addToFM_C :: (elt -> elt -> elt) -> FM key elt -> key -> elt -> FM key elt+addToFM :: FM key elt -> key -> elt -> FM key elt+lookupFM :: FM key elt -> key -> Maybe elt+lookupWithDefaultFM :: FM key elt -> elt -> key -> elt+-}++empty :: FM a b+empty = []++-- EOF --
+ src/hxml-0.2/DTD.hs view
@@ -0,0 +1,218 @@+----------------------------------------------------------------------------+--+-- Module : HXML.DTD+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : provisional+-- Portability : portable+--+-- CVS : $Id: DTD.hs,v 1.6 2002/10/12 01:58:57 joe Exp $+--+----------------------------------------------------------------------------+--+-- | Data types for SGML and XML document type definitions.+-- This is based on the SGML property set found in the DSSSL spec,+-- section 9.6.+--+-- History:+-- [23 Jan 2000], taken from earlier work, [4 Jan 1997]+--++module DTD where++import XML+import qualified AssocList as FM++type GI = Name -- generic identifier (element type name)+type DCN = Name -- data content notation name ++-- | Content expression, parameterized over type of primitive tokens+data CE a =+ Prim a -- ^ Primitive content token+ | Rep (CE a) -- ^ Zero or more, '*' occurrence indicator+ | Opt (CE a) -- ^ Optional, '?' occurrence indicator+ | Plus (CE a) -- ^ One or more, '+' occurrence indicator+ | Seq [(CE a)] -- ^ Sequence, ',' connector+ | Or [(CE a)] -- ^ Alternation, '|' connector+ | And [(CE a)] -- ^ Permutation, '&' connector+ deriving Eq++data PrimitiveToken =+ PCDATA -- ^ Parsed character data+ | ELEMENT GI -- ^ Element+ deriving Eq++type ModelGroup = CE PrimitiveToken+data CONTYPE = -- (element) content type+ DC_EMPTY -- ^ declared content (also: CDATA, RCDATA in SGML)+ | DC_ANY -- ^ "ANY"+ | DC_MODELGRP ModelGroup+ deriving Show++data ELEMTYPE = ELEMTYPE { -- element type definition+ gi :: GI, -- ^ generic identifier+ contype :: CONTYPE, -- ^ content type+ omissibility:: (Bool,Bool), -- ^ omitstrt+omitend+ inclusions :: [GI],+ exclusions :: [GI] } deriving Show++-- Missing: attdefs, srmap(nm); all from DTGABS++data ATT_TYPE = -- (dcltype/decl value type)+ ATcdata+ | ATentity+ | ATentities+ | ATid+ | ATidref+ | ATidrefs+ | ATnmtoken -- %%% or name/number/nutoken+ | ATnmtokens -- %%% or names/numbers/nutokens+ | ATnotation [DCN] -- List of notation names+ | ATenumerated [Name] -- nmtkgrp / name token group+ deriving Show++data ATT_DV = -- attribute default value (dflttype/default value type)+ ADVfixed String -- "#FIXED ..."+ | ADVrequired -- "#REQUIRED"+ | ADVimplied -- "#IMPLIED"+ | ADVdefault String -- "..."+ -- SGML only:+ | ADVcurrent -- "#CURRENT"+ | ADVconref -- "#CONREF"+ deriving Show++data ATTDEF = ATTDEF { -- attribute definition+ att_name :: Name,+ att_type :: ATT_TYPE,+ att_dv :: ATT_DV } deriving Show++type ATTSPEC = (Name,String) -- (attasgn/attribute assignment)+++-- +-- Entities:+--++type ExternalID = (Maybe PUBID, Maybe SYSID)+type PUBID = String+type SYSID = String++data ENTTYPE = -- entity type+ ETtext -- SGML text entity+ | ETcdata+ | ETsdata+ | ETndata+ | ETsubdoc+ | ETpi -- processing instruction entity++data EntityText =+ EN_INTERNAL String -- entity.text/replacement text + | EN_EXTERNAL ExternalID -- entity.extid/external identifier+ deriving Show++data Entity = Entity {+ ename :: Name, -- name+ etype :: ENTTYPE, -- enttype/entity type+ etext :: EntityText, -- see above+ edcn :: Maybe DCN, -- notname/notation name+ eatts :: [ATTSPEC] -- atts/attributes+}++type EntityMap = FM.FM Name EntityText+predefinedEntities :: EntityMap+predefinedEntities = foldr (uncurry FM.insert) FM.empty predefinedGEs+ where+ (==>) = \a b -> (a,EN_INTERNAL b)+ predefinedGEs = [+ "lt" ==> "<",+ "amp" ==> "&",+ "gt" ==> ">",+ "apos" ==> "'",+ "quot" ==> "\"" ]+-- +-- Utility routine, used by scanner:+--++expandInternalEntity :: EntityMap -> Name -> Maybe String+expandInternalEntity entities name = + case FM.lookupM entities name of+ Just (EN_INTERNAL text) -> Just text+ _ -> Nothing++--+-- DTDS:+--+data DTD = DTD {+ elements :: FM.FM Name ELEMTYPE, -- elemtps / element types+ attlists :: FM.FM Name [ATTDEF], -- elemtype.attdefs+ genents :: FM.FM Name EntityText, -- general entities+ parments :: FM.FM Name EntityText, -- parameter entities+ notations:: [DCN], -- nots/notations+ dtdname :: Name -- name (document type name)+} deriving Show++emptyDTD :: DTD+emptyDTD = DTD {+ elements = FM.empty,+ attlists = FM.empty,+ genents = predefinedEntities,+ parments = FM.empty,+ dtdname = "",+ notations= []+} ++declareParameterEntity,declareGeneralEntity :: Name -> EntityText -> DTD -> DTD+declareParameterEntity name entityText dtd =+ dtd { parments = FM.insertWith keepOld name entityText (parments dtd) }+ where keepOld old _new = old+declareGeneralEntity name entityText dtd =+ dtd { genents = FM.insertWith keepOld name entityText (genents dtd) }+ where keepOld old _new = old++-- %%% DEAL WITH DUPLICATE DEFINITIONS HERE:+declareElements :: [GI] -> (Bool,Bool) -> CONTYPE -> ([GI],[GI]) -> DTD -> DTD+declareElements elementNames omissibility contentDefinition (incl,excl) dtd =+ dtd { elements = foldl mkElement (elements dtd) elementNames }+ where mkElement fm gi = FM.insert gi el fm where + el = ELEMTYPE {+ gi = gi,+ contype = contentDefinition,+ omissibility = omissibility,+ inclusions = incl,+ exclusions = excl+ }++-- %%% DEAL WITH DUPLICATES:+declareAttlist :: [GI] -> [ATTDEF] -> DTD -> DTD+declareAttlist elementNames attdefs dtd =+ dtd { attlists = foldl addAttdefs (attlists dtd) elementNames }+ where addAttdefs fm gi = FM.insert gi attdefs fm++declareNotation :: DCN -> ExternalID -> DTD -> DTD+declareNotation dcn _unused dtd =+ dtd { notations = dcn : notations dtd }++-- Need srmaps::Dict[SRASSOC]+usemaps::Dict{-GI-}srmap(nm)|elemtype.srmap(nm)+-- notation: name, extid, attdefs++instance Show PrimitiveToken where+ showsPrec _ PCDATA = showString "#PCDATA"+ showsPrec _ (ELEMENT gi) = showString gi++instance (Show prim) => Show (CE prim) where+ showsPrec _ mg = pp mg where+ pp (Prim p) = shows p+ pp (Rep x) = shows x . showString "*"+ pp (Opt x) = shows x . showString "?"+ pp (Plus x) = shows x . showString "+"+ pp (Seq x) = showgroup ", " x+ pp (Or x) = showgroup " | " x+ pp (And x) = showgroup " & " x+ showgroup delim l = showString "(" . showl l . showString ")" where+ showl [x] = shows x+ showl (x:xs) = shows x . showString delim . showl xs+ showl [] = showString "-- ERROR: empty model group! --"++-- EOF --
+ src/hxml-0.2/ETree.hs view
@@ -0,0 +1,44 @@+----------------------------------------------------------------------------+--+-- Module : HXML.ETree+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable+--+-- CVS : $Id: ETree.hs,v 1.3 2002/10/12 01:58:57 joe Exp $+--+----------------------------------------------------------------------------+--+-- 11 Mar 2002+--+-- Simplified XML representation with only the essential Infoset properties.+--++module ETree(ETree, xmlToETree, etreeToXML) where++import XML+import Tree++data ETree+ = Element Name AttList [ETree]+ | Text String+ deriving Show++xmlToETree :: XML -> ETree+xmlToETree = maybe fallback id . foldTree etree mcons [] where+ etree (TXNode txt) _ = Just $ Text txt+ etree (ELNode gi atts) c = Just $ Element gi atts c+ etree RTNode (c:_) = Just c+ etree _ _ = Nothing+ mcons = maybe id (:)+ fallback = Text "Error: ill-formed XML input"++etreeToXML :: ETree -> XML+etreeToXML = anaTree psi where+ psi (Text txt) = (TXNode txt,[])+ psi (Element gi atts content) = (ELNode gi atts,content)++-- EOF --
+ src/hxml-0.2/HXML.hs view
@@ -0,0 +1,38 @@+----------------------------------------------------------------------------+--+-- Module : HXML+-- Copyright : (C) 2001-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable+--+-- Created : 1 Nov 2001+-- CVS : $Id: HXML.hs,v 1.5 2002/10/12 01:58:57 joe Exp $+--+----------------------------------------------------------------------------+--+-- | Package module for HXML -- just reexports all the public modules.+--++module HXML + ( module XML+ , module Tree+ , module PrintXML+ , module ETree++ , parseXML+ ) where++import XML+import XMLParse+import Tree+import TreeBuild+import PrintXML+import ETree++parseXML :: String -> Tree XMLNode+parseXML = buildTree . parseDocument++-- EOF --
+ src/hxml-0.2/LLParsing.hs view
@@ -0,0 +1,110 @@+{-# OPTIONS -fno-warn-missing-signatures #-}+{-# OPTIONS -fglasgow-exts #-}+----------------------------------------------------------------------------+--+-- Module : HXML.LLParsing+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable (wants rank-2 polymorphism but can live without it)+--+-- CVS : $Id: LLParsing.hs,v 1.6 2002/10/12 01:58:57 joe Exp $+--+----------------------------------------------------------------------------+--+-- 20 Jan 2000+-- Simple, non-backtracking, no-lookahead parser combinators.+-- Use with caution!+--++module LLParsing+ ( pTest , pCheck , pSym , pSucceed+ ,(<|>),(<*>),(<$>),(<^>),(<$),(<*),(*>),(<?>),(<**>)+ , pMaybe , pFoldr , pList , pSome , pChainr , pChainl, pTry+ , pRun+ ) where++infixl 3 <|>+infixl 4 <*>, <$>, <^>, <?>, <$, <*, *>, <**>++{- <H98> -}+-- Use this for Haskell 98:+newtype P p = P p+{- </H98> -}++{- <H98EXT> -}+{-+-- Use this if the system supports rank-2 polymorphism:+newtype Parser sym res = P (forall a .+ (res -> [sym] -> a) -- ok continuation+ -> ([sym] -> a) -- failure continuation+ -> ([sym] -> a) -- error continuation+ -> [sym] -- input+ -> a) -- result++pTest :: (a -> Bool) -> Parser a a+pCheck :: (a -> Maybe b) -> Parser a b+pSym :: (Eq a) => a -> Parser a a+pSucceed:: b -> Parser a b+(<|>) :: Parser a b -> Parser a b -> Parser a b -- union+(<*>) :: Parser a (b->c) -> Parser a b -> Parser a c -- sequence+(<$>) :: (b->c) -> Parser a b -> Parser a c -- application+(<$ ) :: c -> Parser a b -> Parser a c -- application, dropr+(<^>) :: Parser a b -> Parser a c -> Parser a (b,c) -- sequence+(<* ) :: Parser a b -> Parser a c -> Parser a b -- sequence, dropr+( *>) :: Parser a b -> Parser a c -> Parser a c -- sequence, dropl+(<?>) :: Parser a b -> b -> Parser a b -- optional+(<**>) :: Parser s b -> Parser s (b->a) -> Parser s a -- postfix application+pMaybe :: Parser s a -> Parser s (Maybe a)+pFoldr :: (a->b->b) -> b -> Parser s a -> Parser s b+pList :: Parser a b -> Parser a [b]+pSome :: Parser a b -> Parser a [b]+pChainr :: Parser a (b -> b -> b) -> Parser a b -> Parser a b+pChainl :: Parser a (b -> b -> b) -> Parser a b -> Parser a b+pRun :: Parser a b -> [a] -> Maybe (b,[a])+-}+{- </H98EXT> -}++pTest pred = P (ptest pred)+ where+ ptest _p _o f _e [] = f []+ ptest p ok f _e l@(c:cs)+ | p c = ok c cs+ | otherwise = f l++pSym a = pTest (a==)+pCheck cmf = P (pcheck cmf) where+ pcheck _mf _ok f _e [] = f []+ pcheck mf ok f _e cs@(c:s) = case (mf c) of+ Just x -> ok x s+ Nothing -> f cs++pTry (P pa) = P (\ok f _e i -> pa ok f (\ _i' -> f i) i)++pSucceed a = P (\ok _f _e -> ok a)+(P pa) <|> (P pb) = P (\ok f e -> pa ok (pb ok f e) e)+(P pa) <*> (P pb) = P (\ok f e -> pa (\a -> pb (ok . a) e e) f e)+(P pa) <?> a = P (\ok _f -> pa ok (ok a))+(P pa) <^> (P pb) = P (\ok f e -> pa (\a->pb(\b->ok (a,b)) e e) f e)+f <$> (P pb) = P (\ok -> pb (ok . f))+f <$ (P pb) = P (\ok -> pb (ok . const f))+pa <* pb = curry fst <$> pa <*> pb+pa *> pb = curry snd <$> pa <*> pb+pa <**> pb = (\x f -> f x) <$> pa <*> pb++pMaybe p = Just <$> p <|> pSucceed Nothing+pFoldr op e p = loop where loop = (op <$> p <*> loop) <?> e+pList = pFoldr (:) []+pSome p = (:) <$> p <*> pList p+pChainr op p = loop+ where loop = p <**> ((flip <$> op <*> loop) <?> id)+pChainl op p = foldl ap <$> p <*> pList (flip <$> op <*> p)+ where ap x f = f x++pRun (P p) = p just2 fail fail where+ just2 x y = Just (x,y)+ fail = const Nothing++-- EOF --
+ src/hxml-0.2/Misc.hs view
@@ -0,0 +1,62 @@+----------------------------------------------------------------------------+--+-- Module : HXML.Misc+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable+--+-- CVS : $Id: Misc.hs,v 1.8 2002/10/12 01:58:58 joe Exp $+--+----------------------------------------------------------------------------+--+-- 21 Jan 2000+-- Miscellaneous combinators that I find useful+--+ +module Misc where++errNYI :: String -> a+errNYI msg = error ("Not Yet Implemented: " ++ msg)++-- Kleisli composition:+o :: (Monad m) => (b -> m c) -> (a -> m b) -> (a -> m c)+f `o` g = \x -> g x >>= f++-- Some useful anamorphisms:+maybeStar, maybePlus :: (a -> Maybe a) -> a -> [a]+maybeStar f a = a : maybe [] (maybeStar f) (f a)+maybePlus f a = maybe [] (maybeStar f) (f a)++-- Used to be in Haskell Prelude:+done :: Monad m => m ()+done = return ()++-- H98: found in module Monad:+liftM2 :: (Monad m) => (b->c->d) -> m b -> m c -> m d+liftM2 op x y = x >>= \a -> y >>= \b -> return (op a b)++-- H98: found in module Maybe:+maybeToList :: Maybe a -> [a]+maybeToList Nothing = []+maybeToList (Just a) = [a]++-- ... other stuff+{- Removed by Leonidas Fegaras because it classes with the profiler+instance Monad ((->) s) where -- Reader Monad+ return = const+ f >>= g = \x -> g (f x) x+-}++lift :: (b->c->d) -> (a->b) -> (a->c) -> (a->d)+lift f g h x = f (g x) (h x)++pair :: a -> b -> (a,b)+pair x y = (x,y)++wrap :: a -> [a]+wrap x = [x]++-- EOF --
+ src/hxml-0.2/PrintXML.hs view
@@ -0,0 +1,91 @@+----------------------------------------------------------------------------+--+-- Module : HXML.PrintXML+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable+--+-- CVS : $Id: PrintXML.hs,v 1.5 2002/10/12 01:58:58 joe Exp $+--+----------------------------------------------------------------------------++module PrintXML + ( printXML, showXML+ , printEvent, showEvent, showEvents, printEvents+ ) where++import XML+import Tree+import TreeBuild+import XMLParse (XMLEvent(..))++printXML :: XML -> IO ()+printXML = printEvents . serializeTree++showXML :: XML -> String+showXML t = pp t [] where+ pp (Tree nd children) k = case nd of+ RTNode -> ppl children k+ TXNode txt -> textEscape txt k+ PINode tgt [] -> "<?" ++ tgt ++ "?>" ++ k+ PINode tgt val -> "<?" ++ tgt ++ " " ++ val ++ "?>" ++ k+ CXNode txt -> "<!--" ++ txt ++ "-->" ++ k+ ENNode ename -> "&" ++ ename ++ ";" ++ k+ ELNode gi attlist ->+ let atts = showAttlist attlist+ in case children of+ [] -> "<" ++ gi ++ atts ++ "/>" ++ k+ _ -> "<" ++ gi ++ atts ++ ">"+ ++ ppl children ("</" ++ gi ++ "\n>" ++ k)+ ppl [] k = k+ ppl (x:xs) k = pp x (ppl xs k)++showEvent :: XMLEvent -> String+printEvent :: XMLEvent -> IO ()+showEvents :: [XMLEvent] -> String+printEvents :: [XMLEvent] -> IO ()++showEvents = concatMap showEvent+printEvent = putStr . showEvent+printEvents = mapM_ printEvent++showEvent (StartEvent gi atts) = "<" ++ gi ++ showAttlist atts ++ ">"+showEvent (EmptyEvent gi atts) = "<" ++ gi ++ showAttlist atts ++ "/>"+showEvent (EndEvent gi) = "</" ++ gi ++ "\n>"+showEvent (TextEvent txt) = textEscape txt []+showEvent (PIEvent tgt []) = "<?" ++ tgt ++ "?>"+showEvent (PIEvent tgt val) = "<?" ++ tgt ++ " " ++ val ++ "?>"+showEvent (GERefEvent name) = "&" ++ name ++ ";"+showEvent (CommentEvent txt) = "<--" ++ txt ++ "-->"+showEvent (ErrorEvent txt) = error txt++showAttlist :: [(Name,String)] -> String+showAttlist attlist = concat [' ':patt nm val | (nm,val) <- attlist]+ where+ vi = "="+ patt nm val = nm ++ vi ++ "\"" ++ attvalEscape val "\""++textEscape, attvalEscape :: String -> ShowS++textEscape [] k = k+textEscape (c:cs) k =+ case c of+ '<' -> "<" ++ textEscape cs k+ '>' -> ">" ++ textEscape cs k+ '&' -> "&" ++ textEscape cs k+ _ -> c : textEscape cs k++attvalEscape [] k = k+attvalEscape (c:cs) k =+ case c of+ '<' -> "<" ++ attvalEscape cs k+ '>' -> ">" ++ attvalEscape cs k+ '&' -> "&" ++ attvalEscape cs k+ '\'' -> "'" ++ attvalEscape cs k+ '\"' -> """ ++ attvalEscape cs k+ _ -> c : attvalEscape cs k++-- EOF --
+ src/hxml-0.2/Tree.hs view
@@ -0,0 +1,73 @@+----------------------------------------------------------------------------+--+-- Module : HXML.Tree+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable+--+-- CVS : $Id: Tree.hs,v 1.9 2002/10/12 01:58:58 joe Exp $+--+----------------------------------------------------------------------------+--+-- 7 Jan 2000+--++module Tree where++data Tree a = Tree a [Tree a]+ deriving Show++--+-- Projections:+--+treeRoot :: Tree a -> a+treeChildren :: Tree a -> [Tree a]+treeRoot (Tree a _) = a+treeChildren (Tree _ c) = c++leafNode :: a -> Tree a+leafNode x = Tree x []++-- preorderTree (Tree a c) = a : concatMap preorderTree c+-- preorderTree = cataTree(\(x,bs) -> x : concat bs)+preorderTree :: Tree a -> [a]+preorderTree t = traverse t [] where+ traverse (Tree a c) k = a : travlist c k+ travlist (c:cs) k = traverse c (travlist cs k)+ travlist [] k = k++-- The usual polytypic routines:++mapTree :: (a -> b) -> Tree a -> Tree b+mapTree f (Tree a c) = Tree (f a) (map (mapTree f) c)++instance Functor Tree where fmap = mapTree++-- type TreeF a b = (a, [b])+cataTree :: ((a, [b]) -> b) -> Tree a -> b -- (TreeF a b -> b) -> Tree a -> b+anaTree :: (b -> (a, [b])) -> b -> Tree a -- (b -> TreeF a b) -> b -> Tree a+cataTree f (Tree a c) = f (a,map (cataTree f) c)+anaTree g b = let (a,bs) = g b in Tree a (map (anaTree g) bs)++-- A friendlier variant of cataTree:+--+foldTree :: (a -> b -> c) -> (c -> b -> b) -> b -> Tree a -> c+foldTree tree cons nil (Tree a c)+ = tree a (foldr cons nil (map (foldTree tree cons nil) c))++-- Downwards accumulation:+--+scanTree :: (a -> b -> a) -> a -> Tree b -> Tree a+scanTree op a (Tree b children)+ = let a' = a `op` b in Tree a' (map (scanTree op a') children)++-- A variant:+--+accumTree :: (a -> b -> (c, a)) -> a -> Tree b -> Tree c+accumTree op a (Tree b children)+ = let (c,a') = a `op` b in Tree c (map (accumTree op a') children)++-- EOF --
+ src/hxml-0.2/TreeBuild.hs view
@@ -0,0 +1,69 @@+----------------------------------------------------------------------------+--+-- Module : HXML.TreeBuild+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable+--+-- CVS : $Id: TreeBuild.hs,v 1.7 2002/10/12 01:58:58 joe Exp $+--+----------------------------------------------------------------------------+--+-- 30 Jan 2000+--++module TreeBuild (buildTree, constructTree, serializeTree) where++import XMLParse+import XML+import Tree++--+-- TODO: add basic error-checks: matching end-tags, ensure input exhausted+--+-- %%% There is apparently a space leak here, but I can't find it.+-- %%% Update 28 Feb 2000: There is a leak, but it's fixed+-- %%% by a well-known GC implementation technique. Hugs 98 happens+-- %%% not to implement this technique, but STG Hugs (and most other+-- %%% Haskell systems) do implement it.+-- %%% Thanks to Simon Peyton-Jones, Malcolm Wallace, Colin Runcinman+-- %%% Mark Jones, and others for investigating this.++buildTree :: [XMLEvent] -> Tree XMLNode+buildTree = constructTree Tree (:) []++constructTree :: (XMLNode -> f -> t) -> (t -> f -> f) -> f -> [XMLEvent] -> t+constructTree tree cons nil events = let+ pair x y = (x,y)+ addNode nd children es = addTree (tree nd children) es+ addLeaf nd es = addTree (tree nd nil) es+ addTree t es = let (s,es') = build es in pair (cons t s) es'+ build [] = pair nil []+ build (e:es) = case e of+ StartEvent gi atts -> let (c,es') = build es + in addNode (ELNode gi atts) c es'+ EndEvent _ -> pair nil es+ EmptyEvent gi atts -> addLeaf (ELNode gi atts) es+ TextEvent s -> addLeaf (TXNode s) es+ PIEvent tgt val -> addLeaf (PINode tgt val) es+ CommentEvent txt -> addLeaf (CXNode txt) es+ GERefEvent name -> addLeaf (ENNode name) es+ ErrorEvent s -> error s -- %%% deal with this+ in tree RTNode (fst (build events))++serializeTree :: Tree XMLNode -> [XMLEvent]+serializeTree tree = sn tree [] where+ sn (Tree node content) k = case node of+ RTNode -> sl content k+ ELNode gi atts -> StartEvent gi atts : sl content (EndEvent gi : k)+ TXNode txt -> TextEvent txt : k+ PINode tgt val -> PIEvent tgt val : k+ CXNode txt -> CommentEvent txt : k+ ENNode name -> GERefEvent name : k+ sl [] k = k+ sl (x:xs) k = sn x (sl xs k)++-- EOF --
+ src/hxml-0.2/XML.hs view
@@ -0,0 +1,102 @@+----------------------------------------------------------------------------+--+-- Module : HXML.XML+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable+--+-- CVS : $Id: XML.hs,v 1.9 2002/10/12 01:58:59 joe Exp $+--+----------------------------------------------------------------------------+--+-- 16 Jan 2000+-- Basic XML data types+--++module XML+ ( XMLNode(..)+ , Name, XML, AttList+ , stringValue, nodeName+ , xAttlist, xAttval+ , attributes, attval+ , xELNode, xTXNode, xPINode+ ) where++import Tree++type Name = String -- %%% XMLNS makes this more complex+type GI = Name -- generic identifier, element type name+type AttList = [(Name,String)] -- attribute list+type XML = Tree XMLNode++data XMLNode =+ RTNode -- root node+ | ELNode GI AttList -- element node: GI, attributes+ | TXNode String -- text node+ | PINode Name String -- processing instruction (target,value)+ | CXNode String -- comment node+ | ENNode Name -- general entity reference++ -- XPath also defines:+ -- ATNodeP Name String -- attribute node+ -- NSNodeP Name {- prefix-} String {-URI-} -- namespace node+ deriving Show++stringValue :: XML -> String -- [XPATH, 5]+stringValue nd@(Tree d _) = case d of+ RTNode -> concat [sv | TXNode sv <- preorderTree nd] -- [XPATH 5.1]+ ELNode _ _ -> concat [sv | TXNode sv <- preorderTree nd] -- [XPATH 5.2]+ TXNode s -> s -- [XPATH 5.7]+ PINode _ v -> v -- [XPATH 5.5]+ CXNode s -> s -- [XPATH 5.6]+ ENNode _ -> "" -- [not defined in XPATH]+ -- ATNodeP _ v -> v -- [XPATH 5.3]+ -- NSNodeP _ uri -> uri -- [XPATH 5.4]++-- %%% need to fix this to account for [XMLNS]+nodeName :: XMLNode -> Maybe Name -- [XPATH, 5; "expanded-name"]+nodeName nd = case nd of+ ELNode gi _ -> Just gi -- %%% Check [XMLNS]+ PINode tgt _-> Just tgt -- [XPATH 5.5], pi target, null URI+ ENNode name -> Just name -- [not defined in XPATH]+ --ATNodeP n _-> Just n -- %%% Check [XMLNS]+ --NSNodeP p _-> Just p -- [XPATH 5.4], ns prefix, null URI+ RTNode -> Nothing -- [XPATH 5.1]+ TXNode _ -> Nothing -- [XPATH 5.7]+ CXNode _ -> Nothing -- [XPATH 5.6]++--+-- Accessors:+--+xAttlist :: XMLNode -> AttList+xAttlist (ELNode _ attlist) = attlist+xAttlist _ = []++xAttval :: Name -> XMLNode -> Maybe String+xAttval name = lookup name . xAttlist++xELNode :: (Name -> AttList -> a) -> XMLNode -> Maybe a+xTXNode :: (String -> a) -> XMLNode -> Maybe a+xPINode :: (String -> String -> a) -> XMLNode -> Maybe a++xELNode f (ELNode gi atts) = Just (f gi atts)+xELNode _ _ = Nothing+xTXNode f (TXNode txt) = Just (f txt)+xTXNode _ _ = Nothing+xPINode f (PINode tgt val) = Just (f tgt val)+xPINode _ _ = Nothing++--+-- Tree +--++attributes :: XML -> AttList+attributes = xAttlist . treeRoot++attval :: Name -> XML -> Maybe String+attval name = xAttval name . treeRoot++-- EOF --
+ src/hxml-0.2/XMLParse.hs view
@@ -0,0 +1,278 @@+{-# OPTIONS -fno-warn-missing-signatures #-}+----------------------------------------------------------------------------+--+-- Module : XMLParse+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable+--+-- CVS : $Id: XMLParse.hs,v 1.9 2002/10/12 01:58:59 joe Exp $+--+----------------------------------------------------------------------------+--+-- started 23 Jan 2000+--+-- TODO: expand parameter entity references in DTD and parameter literals+-- TODO: implement marked sections in DTD+--++module XMLParse+ ( XMLEvent(..)+ , parseInstance, parseDTD, parseDocument+ ) where++import XMLScanner+import LLParsing+import XML+import DTD+import Misc+import List(unfoldr)++parseInstance :: String -> [XMLEvent]++newtype UNPARSED = UNPARSED String -- Unparsed literal+ deriving Show++replaceGERefs (UNPARSED s) = expandReferences DTD.predefinedEntities s+replacePERefs (UNPARSED s) = s -- %%% FIX+attributeValueLiteral = replaceGERefs <$> pLiteral+parameterLiteral = replacePERefs <$> pLiteral+systemLiteral = unparsed <$> pLiteral+ where unparsed (UNPARSED s) = s++-- External interface:++data XMLEvent =+ StartEvent Name [(Name,String)] -- start-tag (gi, attspecs)+ | EmptyEvent Name [(Name,String)] -- empty element tag (gi,attspecs)+ | EndEvent Name -- end-tag (gi)+ | TextEvent String -- character data (text)+ | PIEvent Name String -- processing instruction (tgt value)+ | GERefEvent Name -- general entity reference (ename)+ | CommentEvent String -- comment+ | ErrorEvent String -- error report+ deriving (Read,Show)++-- Too strict: parseInstance = fmap fst . pRun (pList instanceItem) . pcdataMode+parseInstance = unfoldr (pRun instanceItem) . pcdataMode+parseDTD = foldl (\a b->b a) emptyDTD . unfoldr (pRun dtdItem) . markupMode++parseDocument text = + case pRun prolog (pcdataMode text) of+ Just (_, rest) -> unfoldr (pRun instanceItem) rest+ Nothing -> [ErrorEvent "Error parsing prolog"] -- can't happen.++-- Interface to scanner:++pDelim d = pTest (==d)+pKeyword kw = pTest (\d->case d of NAME n -> n == kw; _ -> False)+rniName kw = pTest (\d->case d of RNINAME n -> n == kw; _ -> False)+pName = pCheck (\d->case d of NAME n -> Just n ; _ -> Nothing)+pGEREF = pCheck (\d->case d of GEREF n -> Just n ; _ -> Nothing)+pPEREF = pCheck (\d->case d of PEREF n -> Just n ; _ -> Nothing)+pLiteral = pCheck literal where+ literal (LITERAL s) = Just (UNPARSED s)+ literal _ = Nothing+pCDATA = pCheck cdata where+ cdata (CDATA txt) = Just txt+ cdata (WS ws) = Just ws+ cdata _ = Nothing++-- Main grammar:++-- dtdItem :: Parser Delimiter (DTD -> DTD)+dtdItem =+ dtdDeclaration+ <|> const id <$> processingInstruction -- %%% REPORT THESE+ <|> const id <$> sgmlCommentDeclaration+ <|> const id <$> pPEREF -- %%% FIX++dtdDeclaration =+ pDelim MDO *> (+ pKeyword "ELEMENT" *> elementDeclaration+ <|> pKeyword "ATTLIST" *> attlistDeclaration+ <|> pKeyword "ENTITY" *> entityDeclaration+ <|> pKeyword "NOTATION" *> notationDeclaration+ ) <* pDelim MDC++prolog =+ pair <$> (ws *> pMaybe xmlDeclaration) <*> (ws *> pMaybe doctypeDeclaration)++ws = () <$ pList (pTest (\d -> case d of WS _ -> True ; _ -> False))++xmlDeclaration = processingInstruction++doctypeDeclaration = + pDelim MDO *> pKeyword "DOCTYPE" *> doctype <* pDelim MDC+doctype =+ () <$ pName <* externalIdentifier {-pMaybe internalSubset-}++--+-- Common constructs:+--++elementNames =+ wrap <$> pName <|> nameGroup+nameGroup =+ (:) <$ pDelim GRPO <*> pName <*>+ ( (:) <$ pDelim SEQ <*> pName <*> pList (pDelim SEQ *> pName)+ <|> (:) <$ pDelim OR <*> pName <*> pList (pDelim OR *> pName)+ <|> (:) <$ pDelim AND <*> pName <*> pList (pDelim AND *> pName)+ <|> pSucceed []+ ) <* pDelim GRPC++externalIdentifier =+ pair Nothing+ <$ pKeyword "SYSTEM" <*> pMaybe systemLiteral+ <|> pair <$ pKeyword "PUBLIC"+ <*> (Just <$> systemLiteral) <*> pMaybe systemLiteral+ <|> pSucceed (Nothing,Nothing) -- implicit identifier++-- This works for XML:+xmlCommentDeclaration =+ pDelim MDOCOM *> pcdata <* pDelim COM <* pDelim MDC+ where pcdata = pFoldr (++) [] pCDATA++-- This works for SGML:+sgmlCommentDeclaration =+ (++) <$ pDelim MDOCOM <*> (pcdata <* pDelim COM) <*> comments <* pDelim MDC+ where pcdata = pFoldr (++) [] pCDATA+ comments = pFoldr (++) [] (pDelim COM *> pcdata <* pDelim COM)++processingInstruction =+ makePI . concat <$ pDelim PIO <*> pList pCDATA <* pDelim PIC where + makePI string =+ let (pitgt, rest) = span isNMCHAR string+ pival = dropWhile isSEPCHAR rest+ in (pitgt,pival)++--+-- Instance items:+--++instanceItem =+ pTag+ <|> TextEvent <$> pCDATA -- also: WSEvent+ <|> GERefEvent <$> pGEREF+ <|> uncurry PIEvent <$> processingInstruction+ <|> CommentEvent <$> xmlCommentDeclaration++pTag =+ startEvent <$ pDelim STAGO <*> pName <*> attributes <*> tagc+ <|> EndEvent <$ pDelim ETAGO <*> pName <* pDelim TAGC+ where+ attributes = pList (pName <* pDelim VI <^> attributeValue)+ tagc = StartEvent <$ pDelim TAGC + <|> EmptyEvent <$ pDelim EETAGC+ startEvent name atts closing = closing name atts++attributeValue = -- XML: attributeValueLiteral only+ attributeValueLiteral <|> pName++--+-- <!ELEMENT ...> declarations+--+elementDeclaration =+ declareElements+ <$> elementNames <*> omissibility <*> contentDefinition <*> exceptions+ where+ omissibility =+ (pair <$> dashoro <*> dashoro) <?> (False,False)+ dashoro =+ (True <$ pKeyword "O" <|> False <$ pDelim MINUS)+ exceptions = -- NOTE ambiguity+ pair <$> (pDelim MINUS *> nameGroup <?> [])+ <*> (pDelim PLUS *> nameGroup <?> [])++contentDefinition = -- in SGML: "declared content-or-content-model-w/oexc"+ DC_EMPTY <$ pKeyword "EMPTY"+ <|> DC_ANY <$ pKeyword "ANY"+ <|> DC_MODELGRP <$> contentModel++contentModel =+ ( Prim . ELEMENT <$> pName+ <|> Prim PCDATA <$ rniName "#PCDATA"+ <|> pDelim GRPO *> contentModel <**>+ ( mk Seq <$> pSome (pDelim SEQ *> contentModel)+ <|> mk And <$> pSome (pDelim AND *> contentModel)+ <|> mk Or <$> pSome (pDelim OR *> contentModel)+ <|> pSucceed id ) <* pDelim GRPC+ ) <**> occurrenceIndicator+ where mk f l a = f (a:l)++occurrenceIndicator =+ Plus <$ pDelim PLUS+ <|> Rep <$ pDelim REP+ <|> Opt <$ pDelim OPT+ <|> pSucceed id++--+-- <!ATTLIST ...> declarations:+--+-- Also need: <!ATTLIST #NOTATION ... > , <!ATTLIST #ANY ...>+--+attlistDeclaration =+ declareAttlist <$> elementNames <*> pList attributeDefinition++attributeDefinition =+ ATTDEF <$> pName <*> declaredValue <*> defaultValue+declaredValue =+ ATcdata <$ pKeyword "CDATA"+ <|> ATid <$ pKeyword "ID"+ <|> ATidref <$ pKeyword "IDREF"+ <|> ATidrefs <$ pKeyword "IDREFS"+ <|> ATentity <$ pKeyword "ENTITY"+ <|> ATentities <$ pKeyword "ENTITIES"+ <|> ATnmtoken <$ pKeyword "NMTOKEN"+ <|> ATnmtokens <$ pKeyword "NMTOKENS"+ <|> ATnotation <$ pKeyword "NOTATION" <*> nameGroup+ <|> ATenumerated <$> nameGroup+ -- SGML only: (NB: currently ignore distinction between these)+ <|> ATnmtoken <$ pKeyword "NAME"+ <|> ATnmtoken <$ pKeyword "NUMBER"+ <|> ATnmtoken <$ pKeyword "NUTOKEN"+ <|> ATnmtokens <$ pKeyword "NAMES"+ <|> ATnmtokens <$ pKeyword "NUMBERS"+ <|> ATnmtokens <$ pKeyword "NUTOKENS"+defaultValue = -- SGML: also #CURRENT, #CONREF+ ADVimplied <$ rniName "#IMPLIED"+ <|> ADVrequired <$ rniName "#REQUIRED"+ <|> ADVfixed <$ rniName "#FIXED" <*> attributeValue+ <|> ADVdefault <$> attributeValue+ -- SGML only:+ <|> ADVcurrent <$ rniName "#CURRENT"+ <|> ADVconref <$ rniName "#CONREF"++-- Entity declarations:+-- %%% In SGML grammar there are a few more restrictions++entityDeclaration =+ declareParameterEntity <$ pDelim PERO <*> pName <*> entityText+ <|> declareGeneralEntity <$> pName <*> entityText++-- @@@ Discards entity type, DCN, and data attributes+entityText =+ EN_INTERNAL <$> parameterLiteral+ <|> EN_EXTERNAL <$> externalIdentifier <* entityType where+ entityType =+ ETsubdoc <$ pKeyword "SUBDOC"+ <|> csndata <* pName <* dataAttributes+ dataAttributes =+ pDelim DSO+ *> pList (pair <$> pName <* pDelim VI <*> attributeValue)+ <* pDelim DSC+ csndata = + ETcdata <$ pKeyword "CDATA" + <|> ETsdata <$ pKeyword "SDATA"+ <|> ETndata <$ pKeyword "NDATA"++notationDeclaration =+ declareNotation <$> pName <*> externalIdentifier++-- SGML: also need SHORTREF, USEMAP(1) in DTDs;+-- LINKTYPE in prolog; USEMAP(2), USELINK in instance.++-- EOF --
+ src/hxml-0.2/XMLScanner.hs view
@@ -0,0 +1,270 @@+----------------------------------------------------------------------------+--+-- Module : XMLScanner+-- Copyright : (C) 2000-2002 Joe English. Freely redistributable.+-- License : "MIT-style"+--+-- Author : Joe English <jenglish@flightlab.com>+-- Stability : experimental+-- Portability : portable+--+-- CVS : $Id: XMLScanner.hs,v 1.9 2002/10/12 01:58:59 joe Exp $+--+----------------------------------------------------------------------------+--+-- 9 Jan 2000+--++-- doesn't check as many errors as it ought to...++module XMLScanner+ ( Delimiter(..)+ , pcdataMode, markupMode+ , isNMCHAR, isSEPCHAR+ , expandReferences+ ) where++import XML -- for "Name"+import Char++import qualified DTD++isSEPCHAR, isNMCHAR, isNMSTART :: Char -> Bool++isSEPCHAR = isSpace+isNMCHAR c = isAlphaNum c || c `elem` ".-_:" -- 2.3 prodn 4+--isNMSTART c = isAlpha c || c `elem` "_:" -- 2.3 prodn 5+isNMSTART c = isAlphaNum c || c `elem` "_:" -- for NUTOKEN, NMTOKEN attvals++-- Utility:+--+-- doSpan pred k f g s = k (f x) (g y) where (x,y) = span pred s+--+doSpan :: (a -> Bool) -> (b -> c -> d) -> ([a] -> b) -> ([a] -> c) -> [a] -> d+doSpan pred k f g = sp f where+ sp f' [] = k (f' []) (g [])+ sp f' s@(c:cs)+ | pred c = sp (f' . (c:)) cs+ | otherwise = k (f' []) (g s)++drop1 :: [a] -> [a] -- drop1 == drop 1; safe version of tail+drop1 [] = []+drop1 (_:xs) = xs++data Delimiter =+ -- character data mode:+ WS String -- whitespace+ | CDATA String -- character data+ | GEREF Name -- general entity reference+ | STAGO -- start tag open, "<"+ | ETAGO -- end tag open, "</"++ -- Markup mode and character data mode:+ | MDO -- markup declaration open, "<!"+ | MDOCOM -- MDO + COM delimiter-in-context, "<!--"+ | MDODSO -- MDO + DSO delimiter-in-context, "<!["+ | PIO -- processing instruction open, "<?"+ | PIC -- processing instruction close, "?>" (">" in SGML)++ -- Errors:+ | LEXERR String -- lexical error+ | REST String -- rest of input++ -- Markup mode:+ | NAME Name -- name+ | RNINAME Name -- name prefixed with RNI (#)+ | PEREF Name -- parameter entity reference+ | LITERAL String -- attribute value literal or parameter literal++ | TAGC -- tag close, ">"+ | VI -- value indicator, "="+ | EETAGC -- empty element tag close (XML), "/>"++ | MDC -- markup declaration close, ">"+ | DSO -- declaration subset open, "["+ | DSC -- declaration subset close, "]"+ | MSC -- DSC+MDC, delimiter-in-context, "]]>"+ | COM -- comment, "--"+ | GRPO -- group open, "("+ | GRPC -- group close, ")"+ | AND -- and connector, "&"+ | OR -- or connector, "|"+ | SEQ -- seq connector, ","+ | OPT -- opt occurrence indicator, "?"+ | REP -- rep occurrence indicator, "*"+ | PLUS -- plus occurrence indicator, inclusion, "+"+ | MINUS -- exclusion, omission flag, "-"+ | PERO -- parameter entity reference open, "%"+ -- ALSO:+ -- Shortref -- short reference string (SGML only)+ -- NET -- null end-tag (SGML only)+ -- RNI -- reserved name indicator, "#"+ -- LIT -- literal, """+ -- LITA -- alternative literal, "'"+ -- CRO -- character reference open, "&#"+ -- HCRO -- hex character reference open, "&#X" (new in XML)+ -- ERO -- entity reference open, "&"+ -- REFC -- reference close, ";"+ deriving (Eq, Show)++pcdataMode, tagMode, markupMode :: String -> [Delimiter]++-- [STAGO, ETAGO, NET, CRO, ERO, MDO, MDOCOM, MDODSO, PIO, MSC]+pcdataMode [] = []+pcdataMode ('<':s) = case s of+ '!':'-':'-':r -> MDOCOM : comMode pcdataMode r+ '!':'[':r -> {- MDODSO : -} msMode r+ '!':r -> MDO : markupMode r+ '/':r -> ETAGO : tagMode r+ '?':r -> PIO : piMode pcdataMode r+ ']':']':'>':r -> MSC : pcdataMode r+ r -> STAGO : tagMode r+pcdataMode ('&':'#':s) = doSpan (';'/=) (:) mkCREF (pcdataMode . drop1) s+ where mkCREF = CDATA . return . chr . stringToInt 10+pcdataMode ('&':s) =+ case span isNMCHAR s of+ (ename,';':r) -> GEREF ename : pcdataMode r+ (junk,r) -> LEXERR ("Bad entity reference " ++ junk)+ : pcdataMode r+pcdataMode ('>':r) = LEXERR "Warning: %%% SKIPPING UNESCAPED '>'":pcdataMode r+pcdataMode (c:s)+ | isSEPCHAR c = doSpan isSEPCHAR (:) (WS . (c:)) pcdataMode s+ | otherwise = doSpan isDATACHAR (:) (CDATA . (c:)) pcdataMode s+ where isDATACHAR ch =+ case ch of '<' -> False; '&' ->False; _ -> True++tagMode [] = []+tagMode ('/':'>':r) = EETAGC : pcdataMode r+tagMode ('>':r) = TAGC : pcdataMode r+tagMode ('=':r) = VI : tagMode r+tagMode ('"':r) = doSpan ('"'/=) (:) LITERAL (tagMode . drop1) r+tagMode ('\'':r) = doSpan ('\''/=) (:) LITERAL (tagMode . drop1) r+tagMode ('<':'/':r) = ETAGO : tagMode r -- not allowed in XML+tagMode ('<':r) = STAGO : tagMode r -- not allowed in XML+tagMode cs@(c:s)+ | isSEPCHAR c = tagMode (dropWhile isSEPCHAR s)+ | isNMSTART c = doSpan isNMCHAR (:) NAME tagMode cs+ | otherwise = LEXERR [c] : tagMode s+++-- [ERO, CRO, HCRO]+expandReferences :: DTD.EntityMap -> String -> String+expandReferences entities = expand where+ expand s = case s of+ [] -> []+ '&':'#':'X':r -> doCharRef 16 expand r+ '&':'#':r -> doCharRef 10 expand r+ '&':r -> doEntityRef entities expand r+ x:r -> x : expand r++doCharRef :: Int -> (String -> String) -> [Char] -> [Char]+doCharRef base k = doSpan (';'/=) (:) (chr . stringToInt base) (k . drop1)+stringToInt :: Int -> String -> Int+stringToInt base = foldl digit 0 . map digitToInt+ where digit num next = base*num + next++-- @@@ This is not quite right: should rescan the replacement text.+doEntityRef :: DTD.EntityMap -> (String -> String) -> String -> String+doEntityRef entities k r = doSpan (';'/=) (++) replacement (k . drop1) r where+ replacement ename = case DTD.expandInternalEntity entities ename of+ Just s -> s+-- changed by Leonidas Fegaras 5/27/08+ _ -> "" -- error ("entity " ++ ename ++ " not defined")++-- [...]+markupMode [] = []+markupMode ('%':s) = case span isNMCHAR s of+ ([], ' ':r) -> PERO : markupMode r -- %%% Not Quite Right+ (ename,';':r) -> PEREF ename : markupMode r+ (ename,r) -> LEXERR ("Bad parameter entity reference %" ++ ename)+ : markupMode r+markupMode ('-':'-':r) = eatComment r+markupMode ('>':r) = MDC : markupMode r -- %%% or pcdataMode?+markupMode ('"':r) = doSpan ('"'/=) (:) LITERAL (markupMode . drop1) r+markupMode ('\'':r) = doSpan ('\''/=) (:) LITERAL (markupMode . drop1) r+markupMode ('#':r) = doSpan isNMCHAR (:) (RNINAME . ('#':)) markupMode r+markupMode ('<':'!':'-':'-':r)+ = MDOCOM : comMode markupMode r+markupMode ('<':'!':r) = MDO : markupMode r+markupMode ('<':'?':r) = PIO : piMode markupMode r+markupMode s@('<':_) = pcdataMode s -- %%% Not strictly correct, but+ -- %%% needed to parse the prolog.+markupMode cs@(c:s)+ | isSEPCHAR c = markupMode (dropWhile isSEPCHAR s)+ | isNMSTART c = doSpan isNMCHAR (:) NAME markupMode cs+ | otherwise = (case c of+ '&' -> AND+ '|' -> OR+ ',' -> SEQ+ '?' -> OPT+ '*' -> REP+ '+' -> PLUS+ '-' -> MINUS+ '[' -> DSO+ ']' -> DSC+ '(' -> GRPO+ ')' -> GRPC+ _ -> LEXERR [c]) : markupMode s++--+-- Internal recognition modes:+--++msMode, cdataMode, eatComment :: String -> [Delimiter]++piMode, comMode, cdMode :: (String -> [Delimiter]) -> String -> [Delimiter]++--+-- msMode: marked section in instance. +-- @@@ Only supports XML instance syntax (<![CDATA[ ... ]]>);+-- In SGML (and XML DTDs), parameter entity references and whitespace+-- are also allowed, in addition to INCLUDE and IGNORE keywords.+-- 'cdataMode' checks for nested occurrences of <![. this is not+-- an error according to the XML or SGML specs, but it ought to be.+-- ++msMode ('C':'D':'A':'T':'A':'[':rest) = cdataMode rest+msMode s = + let (ms, rest) = span ('['/=) s+ in LEXERR ("Illegal marked section ["++ms) : pcdataMode (drop1 rest)++cdataMode (']':']':'>':rest) = pcdataMode rest+cdataMode ('<':'!':'[':rest) = error "Nested <![ in marked section"+cdataMode [] = []+cdataMode (c:cs) = doSpan spn (:) (CDATA . (c:)) cdataMode cs where+ spn '\n' = False+ spn ']' = False+ spn '<' = False+ spn _ = True++--+-- comMode (inside comments): [COM]+--+comMode prevMode cs = case cs of+ [] -> []+ '-':'-':r -> COM : cdMode prevMode r+ (c:s) -> doSpan brk (:) (CDATA . (c:)) (comMode prevMode) s where+ brk '-' = False+ brk '\n' = False -- split long comments at line breaks+ brk _ = True++-- cdMode (inside comment declarations): [COM,MDC, ignore whitespace]+cdMode prevMode cs = case cs of+ [] -> []+ '>':r -> MDC : prevMode r+ '-':'-':r -> COM : comMode prevMode r+ c:s -> if isSEPCHAR c+ then cdMode prevMode (dropWhile isSEPCHAR s)+ else LEXERR [c] : cdMode prevMode s++eatComment cs = case cs of+ [] -> []+ '-':'-':r -> markupMode r+ (_:r) -> eatComment r++piMode prevMode cs = case cs of+ [] -> []+ '?':'>':r -> PIC : prevMode r+ (c:s) -> doSpan ('?'/=) (:) (CDATA . (c:)) (piMode prevMode) s++-- EOF --
+ src/noDB/Text/XML/HXQ/OptionalDB.hs view
@@ -0,0 +1,68 @@+{-------------------------------------------------------------------------------------+-+- No database connectivity+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 08/14/08, last update: 08/14/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++module Text.XML.HXQ.OptionalDB where++import Text.XML.HXQ.XTree+import Text.XML.HXQ.Parser+++type Statement = String++class IConnection conn++data Connection = Connection String++instance IConnection Connection+++noDBerror = error "This version of HXQ does not provide database connectivity"+++publishXmlDoc :: FilePath -> String -> Ast+publishXmlDoc filepath name = noDBerror+++executeSQL :: Statement -> XSeq -> IO XSeq+executeSQL stmt args = noDBerror+++prepareSQL :: (IConnection conn) => conn -> String -> IO Statement+prepareSQL db sql = noDBerror+++-- | Connect to the relational database in filepath+connect :: FilePath -> IO Connection+connect filepath = noDBerror+++disconnect :: conn -> IO ()+disconnect db = noDBerror+++-- | Print the relational schema of the XML document stored in the database under the given name+printSchema :: (IConnection conn) => conn -> String -> IO ()+printSchema db name = noDBerror+++-- | Store an XML document into the database under the given name.+shred :: (IConnection conn) => conn -> String -> String -> IO ()+shred db file name = noDBerror+++-- | Create a secondary index on tagname for the shredded document under the given name..+createIndex :: (IConnection conn) => conn -> String -> String -> IO ()+createIndex db name tagname = noDBerror
+ src/readline/System/Console/Readline.hs view
@@ -0,0 +1,10 @@+module System.Console.Readline where++import System.IO++readline prompt = do putStr prompt+ hFlush stdout+ line <- getLine+ return (Just line)++addHistory stmt = return ""
+ src/withDB/Text/XML/HXQ/DB.hs view
@@ -0,0 +1,414 @@+{-------------------------------------------------------------------------------------+-+- Database connectivity using HDBC+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 05/12/08, last update: 08/14/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++module Text.XML.HXQ.DB where++import System.IO.Unsafe+import Char(isSpace,toLower)+import Control.Monad.State+import Database.HDBC+import Text.XML.HXQ.XTree+import XMLParse(XMLEvent(..),parseDocument)+import HXML(AttList)+import Text.XML.HXQ.Parser+import Text.XML.HXQ.DBConnect+++sql2xml :: SqlValue -> XTree+sql2xml value =+ case value of+ SqlString s -> XText s+ SqlByteString bs -> XText (show bs)+ SqlWord32 n -> XInt (fromEnum n)+ SqlWord64 n -> XInt (fromEnum n)+ SqlInt32 n -> XText (show n)+ SqlInt64 n -> XText (show n)+ SqlInteger n -> XInt (fromEnum n)+ SqlChar c -> XText [c]+ SqlBool b -> XBool b+ SqlDouble n -> XText (show n)+ SqlRational n -> XText (show n)+ SqlEpochTime n -> XText (show n)+ SqlTimeDiff n -> XText (show n)+ SqlNull -> XText ""+++xml2sql :: XTree -> SqlValue+xml2sql e =+ case e of+ XText s -> SqlString s+ XInt n -> SqlInteger (toInteger n)+ XFloat n -> SqlString (show n)+ XBool n -> SqlBool n+ XElem n _ _ _ [x] -> xml2sql x+ _ -> error ("Cannot convert "++show e++" into sql")+++perror = error "constructed elements have no parent"+++executeSQL :: Statement -> XSeq -> IO XSeq+executeSQL stmt args+ = do n <- handleSqlError (execute stmt (map xml2sql args))+ result <- handleSqlError (fetchAllRowsAL stmt)+ return (map (\x -> XElem "row" [] 0 perror (map (\(s,v) -> XElem s [] 0 perror [sql2xml v]) x)) result)+++prepareSQL :: (IConnection conn) => conn -> String -> IO Statement+prepareSQL db sql = handleSqlError (prepare db sql)+++{---------------------------------------------------------------------------------------+-- extract the structural summary and statistics of an XML file+----------------------------------------------------------------------------------------}+++-- structural summary: tag id max# hasText children+data SSnode = SSnode String !Int !Int !Int !Bool [SSnode]+ deriving (Eq,Show)+++insertSS :: String -> [SSnode] -> State Int (Int,SSnode,[SSnode])+insertSS tag ((SSnode n i j l b ts):s)+ | n == tag+ = return (i,SSnode n i j (l+1) b ts,s)+insertSS tag (x:xs)+ = do (i,t,ts) <- insertSS tag xs+ return (i,t,x:ts)+insertSS tag []+ = do count <- get+ put (count+1)+ return (count+1,SSnode tag (count+1) 1 1 False [],[])+++insSS :: String -> [SSnode] -> State Int [SSnode]+insSS tag ns = do (k,t,s) <- insertSS tag ns+ return (t:s)+++getSS :: [XMLEvent] -> [SSnode] -> State Int [SSnode]+getSS ((EmptyEvent n atts):xs) rs+ = getSS ((StartEvent n atts):(EndEvent n):xs) rs+getSS ((StartEvent n atts):xs) ((SSnode m i j l b ns):rs)+ = do (k,SSnode m' i' j' l' b' ks,ts) <- insertSS n ns+ as <- foldM (\r (a,_) -> insSS ('@':a) r) ks atts+ getSS xs (reset(SSnode m' i' j' l' b' as):(SSnode m i j l b ts):rs)+ where r (SSnode m i j _ b ts) = SSnode m i j 0 b ts+ reset (SSnode m i j l b ts) = SSnode m i j l b (map r ts)+getSS ((EndEvent n):xs) (t:(SSnode m i j l b ns):rs)+ = getSS xs ((SSnode m i j l b (set t:ns):rs))+ where s (SSnode m i j l b ts) = SSnode m i (max j l) 0 b ts+ set (SSnode m i j l b ts) = SSnode m i j l b (map s ts)+getSS ((TextEvent t):xs) ((SSnode m i j l False ns):rs)+ | any (not . isSpace) t+ = getSS xs ((SSnode m i j l True ns):rs)+getSS (_:xs) rs = getSS xs rs+getSS [] rs = return rs+++{---------------------------------------------------------------------------------------+-- Derive a good relational schema based on the structural summary (using hybrid inlining)+----------------------------------------------------------------------------------------}+++type Path = [Tag]+++data Table = Table String Path Bool [Table]+ | Column String Path+ deriving (Show,Read)+++printPath :: Path -> String+printPath [] = ""+printPath [p] = p+printPath (p:ps) = printPath ps++"/"++p+++pathCons p ps = if p=="root" then ps else p:ps+++schema :: SSnode -> String -> [String] -> [Table]+schema (SSnode n i _ (-1) _ ts) prefix path+ = [ Table (prefix++show i) (pathCons n path) True+ ((reverse (concatMap (\t -> schema t prefix []) ts))+ ++[ Column "value" [] ]) ]+schema (SSnode n i j _ _ []) prefix path+ | j == 1 || head n == '@'+ = [ Column (prefix++show i) (pathCons n path) ]+schema (SSnode n i 1 _ _ ts) prefix path+ = concatMap (\t -> schema t prefix (pathCons n path)) ts+schema (SSnode n i _ _ b ts) prefix path+ = [ Table (prefix++show i) (pathCons n path) False+ ((reverse (concatMap (\t -> schema t prefix []) ts))+ ++(if b && all (\(SSnode x _ _ _ _ _)-> head x == '@') ts+ then [ Column "value" [] ] else [])) ]+++fixSS :: SSnode -> SSnode+fixSS (SSnode n i j l True ts)+ | any (\(SSnode x _ _ _ _ _)-> head x /= '@') ts+ = SSnode n i j (-1) True (filter (\(SSnode x _ _ _ _ _)-> head x == '@') ts)+fixSS (SSnode n i j l b ts)+ = SSnode n i j l b (map fixSS ts)+++deriveSchema :: String -> String -> IO Table+deriveSchema file prefix+ = do doc <- readFile file+ let ts = parseDocument doc+ d = getSS ts [SSnode "root" 1 1 1 False []]+ [SSnode _ _ _ _ _ [t]] = evalState d 1+ nt@(SSnode m i j l b s) = fixSS t+ return (Table prefix [] False (reverse (schema (SSnode m i 2 l b s) prefix [])))+++relationalSchema :: Table -> String -> [String]+relationalSchema (Table n path b ts) parent+ = ("create table "++n++" ( /* "++printPath path+ ++(if b then " (mixed content)" else "")++" */\n"+ ++n++"_id int,\n"+ ++(if parent /= "" then (n++"_parent int references "++parent++"("++parent++"_id),\n") else "")+ ++(concat [ m++" varchar, /* "++printPath p++" */\n" | Column m p <- ts ])+ ++"primary key ("++n++"_id))\n")+ :[ s | t@(Table _ _ _ _) <- ts, s <- relationalSchema t n ]+++getTableNames :: Table -> [String]+getTableNames (Table n _ _ ts) = n:(concatMap getTableNames ts)+getTableNames _ = []+++initializeDB :: (IConnection conn) => conn -> IO ()+initializeDB db+ = do tables <- getTables db+ if elem "HXQCatalog" tables+ then return ()+ else do let s = "create table HXQCatalog ( name varchar primary key,"+ ++" path varchar, summary varchar, relational_schema varchar )"+ handleSqlError (run db s [])+ commit db+++createSchema :: (IConnection conn) => conn -> String -> String -> IO Table+createSchema db file name+ = do initializeDB db+ stmt <- handleSqlError (prepare db "select summary from HXQCatalog where name = ?")+ _ <- handleSqlError (execute stmt [SqlString name])+ result <- handleSqlError (fetchAllRowsAL stmt)+ if length result > 0+ then do let [[(_,SqlString s)]] = result+ summary = (read s)::Table+ tables = getTableNames summary+ _ <- mapM (\t -> handleSqlError (run db ("drop table if exists "++t) [])) tables+ _ <- handleSqlError (run db "delete from HXQCatalog where name = ?" [SqlString name])+ commit db+ else return ()+ t <- deriveSchema file name+ let schema = relationalSchema t ""+ _ <- handleSqlError (run db "insert into HXQCatalog values (?,?,?,?)"+ [SqlString name, SqlString file,+ SqlString (show t), SqlString (concat schema)])+ _ <- mapM (\s -> handleSqlError (run db s [])) schema+ commit db+ return t+++findSchema :: (IConnection conn) => conn -> String -> IO Table+findSchema db name+ = do initializeDB db+ stmt <- handleSqlError (prepare db "select summary from HXQCatalog where name = ?")+ _ <- handleSqlError (execute stmt [SqlString name])+ result <- handleSqlError (fetchAllRowsAL stmt)+ if length result == 1+ then let [[(_,SqlString s)]] = result+ in return ((read s)::Table)+ else error ("Schema "++name++" doesn't exist")+++-- | Print the relational schema of the XML document stored in the database under the given name+printSchema :: (IConnection conn) => conn -> String -> IO ()+printSchema db name+ = do initializeDB db+ stmt <- handleSqlError (prepare db "select relational_schema from HXQCatalog where name = ?")+ _ <- handleSqlError (execute stmt [SqlString name])+ result <- handleSqlError (fetchAllRowsAL stmt)+ if length result == 1+ then let [[(_,SqlString s)]] = result+ in putStrLn s+ else error ("Schema "++name++" doesn't exist")+++{---------------------------------------------------------------------------------------+-- Populate the database from the XML file and its derived structural summary+----------------------------------------------------------------------------------------}+++findPath :: [Table] -> [String] -> Int -> Maybe (Int,Table)+findPath (t@(Table _ p _ s):ts) path _ | p == path = Just ((length s)-1,t)+findPath (t@(Column _ p):ts) path n | p == path = Just (n,t)+findPath ((Table _ _ _ _):ts) path n = findPath ts path n+findPath (_:ts) path n = findPath ts path (n+1)+findPath [] _ _ = Nothing+++populate :: [XMLEvent] -> [Table] -> Int -> [[String]] -> [(Int,String)]+populate ((EmptyEvent tag atts):xs) ts n ps+ = populate ((StartEvent tag atts):(EndEvent tag):xs) ts n ps+populate (x@(StartEvent tag atts):xs) ((t@(Table n path _ s)):ts) _ (p:ps)+ = case findPath s (tag:p) 0 of+ Just (n,nt@(Table m _ True as))+ -> (-1,m):(popAtts atts as ++ showXTree xs 1 "")+ where showXTree ((EmptyEvent tag atts):xs) i s+ = showXTree xs i (s++"<"++tag++showAL atts++"/>")+ showXTree ((StartEvent tag atts):xs) i s+ = showXTree xs (i+1) (s++"<"++tag++showAL atts++">")+ showXTree ((EndEvent tag):xs) i s+ = if i==1 then (n,s):(-2,m):(populate xs (t:ts) n (p:ps))+ else showXTree xs (i-1) (s++"</"++tag++">")+ showXTree ((TextEvent text):xs) i s = showXTree xs i (s++text)+ showXTree (_:xs) i s = showXTree xs i s+ Just (n,nt@(Table m _ _ as))+ -> (-1,m):((popAtts atts as)++(populate xs (nt:t:ts) n ([]:p:ps)))+ Just (n,nt)+ -> populate xs (nt:t:ts) n ((tag:p):ps)+ Nothing -> populate xs (t:ts) 0 ((tag:p):ps)+ where popAtts ((a,v):as) ks+ = let Just(m,_) = findPath ks ['@':a] 0+ in (m,v):(popAtts as ks)+ popAtts [] _ = []+populate ((EndEvent tag):xs) ((t@(Table n path _ s)):ts) _ ([]:ps)+ = (-2,n):populate xs ts 0 ps+populate ((EndEvent tag):xs) ((Column m path):ts) n (p:ps)+ = populate xs ts 0 (tail p:ps)+populate ((EndEvent text):xs) ts _ (p:ps)+ = populate xs ts 0 (tail p:ps)+populate ((TextEvent text):xs) ts n ps+ | any (not . isSpace) text+ = (n,text):populate xs ts n ps+populate (x:xs) ts n ps+ = populate xs ts n ps+populate [] ts n ps = []+++insert :: (IConnection conn) => conn -> [(Int,String)] -> [(String,Int,Statement)] -> IO ()+insert db xs stmts = let (s,_,_,_) = m xs 0 0 in s+ where m ((-1,m):xs) i p = let (s,el,xs',i') = ml xs (i+1) i+ in (s >> insertTuple m el i p,[],xs',i')+ m ((k,m):xs) i p = (return (),[(k,m)],xs,i)+ ml [] i p = (return (),[],[],i)+ ml ((-2,m):xs) i p = (return (),[],xs,i)+ ml xs i p = let (s,el,xs',i') = m xs i p+ (s',el',xs'',i'') = ml xs' i' p+ in (s >> s',el++el',xs'',i'')+ find x xs = foldr (\(a,v) r -> if x==a then v else r) "\NUL" xs+ insertTuple m e i p+ = let (len,stmt) = foldr (\(a,l,s) r -> if m==a then (l,s) else r) (error "") stmts+ tuple = map (\c -> find c e) [0..len]+ lift x = if x=="\NUL" then SqlNull else SqlString x+ in do _ <- handleSqlError (execute stmt+ (if i==0+ then SqlInteger i:(map lift tuple)+ else SqlInteger i:SqlInteger p:(map lift tuple)))+ if mod i 100 == 99 then commit db else return ()+ return ()+++-- | Store an XML document into the database under the given name.+shred :: (IConnection conn) => conn -> String -> String -> IO ()+shred db file name+ = do let prefix = map toLower name+ let tableStmt (Table n _ _ ts)+ = do let len = length[ 1 | Column _ _ <- ts]-1+ stmt <- handleSqlError (prepare db ("insert into "++n++" values ("+ ++(if n==prefix then "" else "?,")++"?"+ ++(concatMap (\_ -> ",?") [0..len])++")"))+ l <- mapM tableStmt ts+ return ((n,len,stmt):(concat l))+ tableStmt _ = return []+ t <- createSchema db file prefix+ stmts <- tableStmt t+ doc <- readFile file+ let ts = parseDocument doc+ let ic = (-1,prefix):(populate ts [t] 0 [[]] ++ [(-2,prefix)])+ insert db ic stmts+ commit db+ return ()+++-- | Create a secondary index on tagname for the shredded document under the given name..+createIndex :: (IConnection conn) => conn -> String -> String -> IO ()+createIndex db name tagname+ = do let prefix = map toLower name+ table <- findSchema db name+ let indexes = getIndexes "" table+ _ <- if null indexes+ then error ("there is no tagname: "++tagname)+ else mapM (\(t,c) -> do stmt <- handleSqlError (prepare db ("create index "++t++"_"++c++" on "++t++" ("++c++")"))+ handleSqlError (execute stmt [])) indexes+ commit db+ return ()+ where getIndexes _ (Table n _ _ ts) = concatMap (getIndexes n) ts+ getIndexes table (Column n path) | (head path)==tagname = [(table,n)]+ getIndexes _ _ = []+++{----------------------------------------------------------------------------------------------------+-- Export (publish) a shredded XML document+----------------------------------------------------------------------------------------------------}+++publishES :: [String] -> [String] -> String+publishES (p:ps) xs+ | head p == '@'+ = "attribute "++(tail p)++" {"++publishES ps xs++"}"+publishES (p:ps) xs+ = "<"++p++">{"++publishES ps xs++"}</"++p++">"+publishES [] [x] = x+publishES [] (x:xs) = x++","++publishES [] xs+++-- for each relational table, synthesize the XQuery that reconstructs the XML from table+publishS :: Table -> String -> String+publishS (Table n path b ts) "error"+ = "for $"++n++" in SQL(select(),from($"++n++"),true()) return "+ ++publishES (reverse path) (map (\t -> publishS t n) ts)+publishS (Table n path b ts) parent+ = "for $"++n++" in SQL(select(),from($"++n++"),$"++n++"/"++n++"_parent eq $"+ ++parent++"/"++parent++"_id) return "+ ++publishES (reverse path) (map (\t -> publishS t n) ts)+publishS (Column n path) parent+ = publishES (reverse path) ["$"++parent++"/"++n++"/text()"]+++-- construct an XQuery (in string form) that extracts a shredded XML document+publishTable :: Table -> String+publishTable table = "<root>{" ++ publishS table "error" ++ "}</root>"+++{-# NOINLINE publishXmlDoc #-}+-- construct the Ast of an XQuery that extracts a shredded XML document+publishXmlDoc :: FilePath -> String -> Ast+publishXmlDoc filepath name+ = let query = unsafePerformIO (publishWrapper filepath name)+ [ast] = parse (scan query)+ in ast+ where publishWrapper filepath name+ = do let prefix = map toLower name+ db <- connect filepath+ table <- findSchema db prefix+ let query = publishTable table+ return query
+ src/withDB/Text/XML/HXQ/DBConnect.hs view
@@ -0,0 +1,26 @@+{-------------------------------------------------------------------------------------+-+- HDBC driver. Currently, Sqlite3.+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 05/30/08, last update: 07/24/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++module Text.XML.HXQ.DBConnect where+++import Database.HDBC.Sqlite3++++-- | Connect to the relational database in filepath using the HDBC Sqlite3 driver+connect :: FilePath -> IO Connection+connect filepath = connectSqlite3 filepath
+ src/withDB/Text/XML/HXQ/OptionalDB.hs view
@@ -0,0 +1,24 @@+{-------------------------------------------------------------------------------------+-+- Database connectivity using HDBC+- Programmer: Leonidas Fegaras+- Email: fegaras@cse.uta.edu+- Web: http://lambda.uta.edu/+- Creation: 08/14/08, last update: 08/14/08+- +- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.+- This material is provided as is, with absolutely no warranty expressed or implied.+- Any use is at your own risk. Permission is hereby granted to use or copy this program+- for any purpose, provided the above notices are retained on all copies.+-+--------------------------------------------------------------------------------------}+++module Text.XML.HXQ.OptionalDB+ ( IConnection, Statement, publishXmlDoc, executeSQL, prepareSQL, connect, disconnect, shred, printSchema, createIndex+ ) where+++import Database.HDBC+import Text.XML.HXQ.DB+import Text.XML.HXQ.DBConnect