diff options
| author | aarne <aarne@cs.chalmers.se> | 2007-12-13 20:19:47 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2007-12-13 20:19:47 +0000 |
| commit | b447cf1a047a6f6e1c4945e809bffa57c88a08af (patch) | |
| tree | 4b6792997f34b764796a8b787b3e8a9638c6ff49 /src/GF | |
| parent | a311dda5392ac1d019bc4f60bd94b37df01a1411 (diff) | |
new GFCC concrete syntax in place everywhere
Diffstat (limited to 'src/GF')
32 files changed, 189 insertions, 1745 deletions
diff --git a/src/GF/Canon/CanonToGFCC.hs b/src/GF/Canon/CanonToGFCC.hs index 290b6ba33..9beb1a2b7 100644 --- a/src/GF/Canon/CanonToGFCC.hs +++ b/src/GF/Canon/CanonToGFCC.hs @@ -21,8 +21,10 @@ import qualified GF.Canon.Look as Look import qualified GF.Canon.Subexpressions as Sub import qualified GF.GFCC.Macros as CM -import qualified GF.GFCC.AbsGFCC as C +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) +import qualified GF.GFCC.DataGFCC as C import qualified GF.GFCC.DataGFCC as D +import GF.Devel.PrintGFCC import GF.GFCC.OptimizeGFCC import GF.Canon.GFC @@ -46,7 +48,7 @@ import Debug.Trace ---- -- the main function: generate GFCC from GFCM. prCanon2gfcc :: CanonGrammar -> String -prCanon2gfcc = D.printGFCC . mkCanon2gfcc +prCanon2gfcc = printGFCC . mkCanon2gfcc -- this variant makes utf8 conversion; used in back ends mkCanon2gfcc :: CanonGrammar -> D.GFCC @@ -99,8 +101,8 @@ canon2gfcc cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = printnames = Map.fromAscList [] ---- printnames params = Map.fromAscList [] ---- params -i2i :: Ident -> C.CId -i2i (IC c) = C.CId c +i2i :: Ident -> CId +i2i (IC c) = CId c mkType :: A.Type -> C.Type mkType t = case GM.catSkeleton t of diff --git a/src/GF/Canon/CanonToJS.hs b/src/GF/Canon/CanonToJS.hs index 3bd44eedd..a88a2f46a 100644 --- a/src/GF/Canon/CanonToJS.hs +++ b/src/GF/Canon/CanonToJS.hs @@ -7,7 +7,8 @@ import GF.Data.ErrM import GF.Infra.Option import qualified GF.GFCC.Macros as M import qualified GF.GFCC.DataGFCC as D -import qualified GF.GFCC.AbsGFCC as C +import qualified GF.GFCC.DataGFCC as C +import GF.GFCC.Raw.AbsGFCCRaw (CId(CId)) import qualified GF.JavaScript.AbsJS as JS import qualified GF.JavaScript.PrintJS as JS @@ -32,28 +33,28 @@ gfcc2js start gfcc = as = D.abstract gfcc cs = Map.assocs (D.concretes gfcc) -abstract2js :: String -> C.CId -> D.Abstr -> [JS.Element] -abstract2js start (C.CId n) ds = +abstract2js :: String -> CId -> D.Abstr -> [JS.Element] +abstract2js start (CId n) ds = [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit a (new "Abstract" [JS.EStr start])]] ++ concatMap (absdef2js a) (Map.assocs (D.funs ds)) where a = JS.Ident n -absdef2js :: JS.Ident -> (C.CId,(C.Type,C.Exp)) -> [JS.Element] -absdef2js a (C.CId f,(typ,_)) = - let (args,C.CId cat) = M.catSkeleton typ in +absdef2js :: JS.Ident -> (CId,(C.Type,C.Exp)) -> [JS.Element] +absdef2js a (CId f,(typ,_)) = + let (args,CId cat) = M.catSkeleton typ in [JS.ElStmt $ JS.SDeclOrExpr $ JS.DExpr $ JS.ECall (JS.EMember (JS.EVar a) (JS.Ident "addType")) - [JS.EStr f, JS.EArray [JS.EStr x | C.CId x <- args], JS.EStr cat]] + [JS.EStr f, JS.EArray [JS.EStr x | CId x <- args], JS.EStr cat]] -concrete2js :: C.CId -> (C.CId,D.Concr) -> [JS.Element] -concrete2js (C.CId a) (C.CId c, cnc) = +concrete2js :: CId -> (CId,D.Concr) -> [JS.Element] +concrete2js (CId a) (CId c, cnc) = [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit l (new "Concrete" [JS.EVar (JS.Ident a)])]] ++ concatMap (cncdef2js l) ds where l = JS.Ident c ds = concatMap Map.assocs [D.lins cnc, D.opers cnc, D.lindefs cnc] -cncdef2js :: JS.Ident -> (C.CId,C.Term) -> [JS.Element] -cncdef2js l (C.CId f, t) = +cncdef2js :: JS.Ident -> (CId,C.Term) -> [JS.Element] +cncdef2js l (CId f, t) = [JS.ElStmt $ JS.SDeclOrExpr $ JS.DExpr $ JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "addRule")) [JS.EStr f, JS.EFun [children] [JS.SReturn (term2js l t)]]] term2js :: JS.Ident -> C.Term -> JS.Expr @@ -67,7 +68,7 @@ term2js l t = f t C.K t -> tokn2js t C.V i -> JS.EIndex (JS.EVar children) (JS.EInt i) C.C i -> new "Int" [JS.EInt i] - C.F (C.CId f) -> JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "rule")) [JS.EStr f, JS.EVar children] + C.F (CId f) -> JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "rule")) [JS.EStr f, JS.EVar children] C.FV xs -> new "Variants" (map f xs) C.W str x -> new "Suffix" [JS.EStr str, f x] C.RP x y -> new "Rp" [f x, f y] diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index 43ac6074e..d8d77bc11 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -16,7 +16,7 @@ import GF.GFCC.ShowLinearize import GF.GFCC.API import GF.GFCC.Macros import GF.Devel.PrintGFCC -import GF.GFCC.AbsGFCC ---- +import GF.GFCC.DataGFCC ---- import GF.Command.ErrM ---- diff --git a/src/GF/Command/Importing.hs b/src/GF/Command/Importing.hs index 8a8cd55bf..676eec37f 100644 --- a/src/GF/Command/Importing.hs +++ b/src/GF/Command/Importing.hs @@ -5,7 +5,6 @@ import GF.Devel.GrammarToGFCC import GF.GFCC.OptimizeGFCC import GF.GFCC.CheckGFCC import GF.GFCC.DataGFCC -import GF.GFCC.ParGFCC import GF.GFCC.API import qualified GF.Command.AbsGFShell as C diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs index fce0014db..ab6ee7f44 100644 --- a/src/GF/Command/Interpreter.hs +++ b/src/GF/Command/Interpreter.hs @@ -9,7 +9,7 @@ import GF.Command.PPrTree import GF.Command.ParGFShell import GF.GFCC.API import GF.GFCC.Macros -import GF.GFCC.AbsGFCC ---- +import GF.GFCC.DataGFCC import GF.Command.ErrM ---- diff --git a/src/GF/Command/PPrTree.hs b/src/GF/Command/PPrTree.hs index 7e1755bbc..2a3aff4da 100644 --- a/src/GF/Command/PPrTree.hs +++ b/src/GF/Command/PPrTree.hs @@ -1,6 +1,7 @@ module GF.Command.PPrTree (pTree, prExp, tree2exp) where -import GF.GFCC.AbsGFCC +import GF.GFCC.DataGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import GF.GFCC.Macros import qualified GF.Command.ParGFShell as P import GF.Command.PrintGFShell diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index cec179202..bbf443b35 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -17,7 +17,7 @@ module GF.Compile.ShellState where import GF.Data.Operations import GF.Canon.GFC import GF.Canon.AbsGFC -import GF.GFCC.AbsGFCC(CId(CId)) +import GF.GFCC.Raw.AbsGFCCRaw(CId(CId)) --import GF.GFCC.DataGFCC(mkGFCC) import GF.Canon.CanonToGFCC as C2GFCC import GF.Grammar.Macros diff --git a/src/GF/Conversion/SimpleToFCFG.hs b/src/GF/Conversion/SimpleToFCFG.hs index e1fa52297..a85c1843e 100644 --- a/src/GF/Conversion/SimpleToFCFG.hs +++ b/src/GF/Conversion/SimpleToFCFG.hs @@ -22,9 +22,9 @@ import Control.Monad import GF.Formalism.Utilities import GF.Formalism.FCFG -import GF.GFCC.Macros hiding (prt) +import GF.GFCC.Macros --hiding (prt) import GF.GFCC.DataGFCC -import GF.GFCC.AbsGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import GF.Data.BacktrackM import GF.Data.SortedList diff --git a/src/GF/Conversion/Types.hs b/src/GF/Conversion/Types.hs index 913ee24bf..befc495a0 100644 --- a/src/GF/Conversion/Types.hs +++ b/src/GF/Conversion/Types.hs @@ -18,7 +18,7 @@ module GF.Conversion.Types where import qualified GF.Infra.Ident as Ident (Ident(..), wildIdent, isWildIdent) import qualified GF.Canon.AbsGFC as AbsGFC (CIdent(..), Label(..)) -import qualified GF.GFCC.AbsGFCC as AbsGFCC (CId(..)) +import qualified GF.GFCC.Raw.AbsGFCCRaw as AbsGFCC (CId(..)) import qualified GF.Grammar.Grammar as Grammar (Term) import GF.Formalism.GCFG diff --git a/src/GF/Devel/GFC.hs b/src/GF/Devel/GFC.hs index 6780d32cb..af124c9ed 100644 --- a/src/GF/Devel/GFC.hs +++ b/src/GF/Devel/GFC.hs @@ -7,9 +7,11 @@ import GF.Devel.GrammarToGFCC import GF.GFCC.OptimizeGFCC import GF.GFCC.CheckGFCC import GF.GFCC.DataGFCC -import GF.GFCC.ParGFCC +import GF.GFCC.Raw.ParGFCCRaw +import GF.GFCC.Raw.ConvertGFCC import GF.Devel.UseIO import GF.Infra.Option +import GF.GFCC.API import GF.GFCC.ErrM mainGFC :: [String] -> IO () @@ -44,12 +46,6 @@ mainGFC xx = do mapM_ (batchCompile opts) (map return fs) putStrLn "Done." -file2gfcc f = do - f <- readFileIf f - case pGrammar (myLexer f) of - Ok g -> return (mkGFCC g) - Bad s -> error s - targetName opts abs = case getOptVal opts (aOpt "target") of Just n -> n _ -> abs diff --git a/src/GF/Devel/GFCCtoHaskell.hs b/src/GF/Devel/GFCCtoHaskell.hs index 2d6e761d4..6eccff7e5 100644 --- a/src/GF/Devel/GFCCtoHaskell.hs +++ b/src/GF/Devel/GFCCtoHaskell.hs @@ -18,7 +18,7 @@ module GF.Devel.GFCCtoHaskell (grammar2haskell, grammar2haskellGADT) where import GF.GFCC.Macros import GF.GFCC.DataGFCC -import GF.GFCC.AbsGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import GF.Data.Operations import GF.Text.UTF8 diff --git a/src/GF/Devel/GFCCtoJS.hs b/src/GF/Devel/GFCCtoJS.hs index 5ec438bc7..542f2dfa7 100644 --- a/src/GF/Devel/GFCCtoJS.hs +++ b/src/GF/Devel/GFCCtoJS.hs @@ -2,7 +2,7 @@ module GF.Devel.GFCCtoJS (gfcc2js,gfcc2grammarRef) where import qualified GF.GFCC.Macros as M import qualified GF.GFCC.DataGFCC as D -import qualified GF.GFCC.AbsGFCC as C +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import qualified GF.JavaScript.AbsJS as JS import qualified GF.JavaScript.PrintJS as JS @@ -24,50 +24,50 @@ gfcc2js gfcc = cs = Map.assocs (D.concretes gfcc) start = M.lookAbsFlag gfcc (M.cid "startcat") -abstract2js :: String -> C.CId -> D.Abstr -> [JS.Element] -abstract2js start (C.CId n) ds = +abstract2js :: String -> CId -> D.Abstr -> [JS.Element] +abstract2js start (CId n) ds = [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit a (new "Abstract" [JS.EStr start])]] ++ concatMap (absdef2js a) (Map.assocs (D.funs ds)) where a = JS.Ident n -absdef2js :: JS.Ident -> (C.CId,(C.Type,C.Exp)) -> [JS.Element] -absdef2js a (C.CId f,(typ,_)) = - let (args,C.CId cat) = M.catSkeleton typ in +absdef2js :: JS.Ident -> (CId,(D.Type,D.Exp)) -> [JS.Element] +absdef2js a (CId f,(typ,_)) = + let (args,CId cat) = M.catSkeleton typ in [JS.ElStmt $ JS.SDeclOrExpr $ JS.DExpr $ JS.ECall (JS.EMember (JS.EVar a) (JS.Ident "addType")) - [JS.EStr f, JS.EArray [JS.EStr x | C.CId x <- args], JS.EStr cat]] + [JS.EStr f, JS.EArray [JS.EStr x | CId x <- args], JS.EStr cat]] -concrete2js :: C.CId -> (C.CId,D.Concr) -> [JS.Element] -concrete2js (C.CId a) (C.CId c, cnc) = +concrete2js :: CId -> (CId,D.Concr) -> [JS.Element] +concrete2js (CId a) (CId c, cnc) = [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit l (new "Concrete" [JS.EVar (JS.Ident a)])]] ++ concatMap (cncdef2js l) ds where l = JS.Ident c ds = concatMap Map.assocs [D.lins cnc, D.opers cnc, D.lindefs cnc] -cncdef2js :: JS.Ident -> (C.CId,C.Term) -> [JS.Element] -cncdef2js l (C.CId f, t) = +cncdef2js :: JS.Ident -> (CId,D.Term) -> [JS.Element] +cncdef2js l (CId f, t) = [JS.ElStmt $ JS.SDeclOrExpr $ JS.DExpr $ JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "addRule")) [JS.EStr f, JS.EFun [children] [JS.SReturn (term2js l t)]]] -term2js :: JS.Ident -> C.Term -> JS.Expr +term2js :: JS.Ident -> D.Term -> JS.Expr term2js l t = f t where f t = case t of - C.R xs -> new "Arr" (map f xs) - C.P x y -> JS.ECall (JS.EMember (f x) (JS.Ident "sel")) [f y] - C.S xs -> mkSeq (map f xs) - C.K t -> tokn2js t - C.V i -> JS.EIndex (JS.EVar children) (JS.EInt i) - C.C i -> new "Int" [JS.EInt i] - C.F (C.CId f) -> JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "rule")) [JS.EStr f, JS.EVar children] - C.FV xs -> new "Variants" (map f xs) - C.W str x -> new "Suffix" [JS.EStr str, f x] - C.RP x y -> new "Rp" [f x, f y] - C.TM -> new "Meta" [] - -tokn2js :: C.Tokn -> JS.Expr -tokn2js (C.KS s) = mkStr s -tokn2js (C.KP ss vs) = mkSeq (map mkStr ss) -- FIXME + D.R xs -> new "Arr" (map f xs) + D.P x y -> JS.ECall (JS.EMember (f x) (JS.Ident "sel")) [f y] + D.S xs -> mkSeq (map f xs) + D.K t -> tokn2js t + D.V i -> JS.EIndex (JS.EVar children) (JS.EInt i) + D.C i -> new "Int" [JS.EInt i] + D.F (CId f) -> JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "rule")) [JS.EStr f, JS.EVar children] + D.FV xs -> new "Variants" (map f xs) + D.W str x -> new "Suffix" [JS.EStr str, f x] + D.RP x y -> new "Rp" [f x, f y] + D.TM -> new "Meta" [] + +tokn2js :: D.Tokn -> JS.Expr +tokn2js (D.KS s) = mkStr s +tokn2js (D.KP ss vs) = mkSeq (map mkStr ss) -- FIXME mkStr :: String -> JS.Expr mkStr s = new "Str" [JS.EStr s] @@ -91,7 +91,7 @@ gfcc2grammarRef :: D.GFCC -> String gfcc2grammarRef gfcc = encodeUTF8 $ refs where - C.CId abstr = D.absname gfcc + CId abstr = D.absname gfcc refs = unlines $ [ "// Grammar Reference", "function concreteReference(concreteSyntax, concreteSyntaxName) {", @@ -102,5 +102,5 @@ gfcc2grammarRef gfcc = "var myConcrete = new Array();" ] ++ [ "myConcrete.push(new concreteReference(" ++ c ++ ",\"" ++ c ++ "\"));" - | C.CId c <- D.cncnames gfcc] + | CId c <- D.cncnames gfcc] diff --git a/src/GF/Devel/GrammarToGFCC.hs b/src/GF/Devel/GrammarToGFCC.hs index 7f346619d..6cbd68793 100644 --- a/src/GF/Devel/GrammarToGFCC.hs +++ b/src/GF/Devel/GrammarToGFCC.hs @@ -6,8 +6,9 @@ import GF.Grammar.Grammar import qualified GF.Grammar.Lookup as Look import qualified GF.GFCC.Macros as CM -import qualified GF.GFCC.AbsGFCC as C +import qualified GF.GFCC.DataGFCC as C import qualified GF.GFCC.DataGFCC as D +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import qualified GF.Grammar.Abstract as A import qualified GF.Grammar.Macros as GM --import qualified GF.Grammar.Compute as Compute @@ -15,6 +16,7 @@ import qualified GF.Infra.Modules as M import qualified GF.Infra.Option as O import GF.Devel.PrGrammar +import GF.Devel.PrintGFCC import GF.Devel.ModDeps import GF.Infra.Ident import GF.Infra.Option @@ -29,7 +31,7 @@ import Debug.Trace ---- -- the main function: generate GFCC from GF. prGrammar2gfcc :: Options -> String -> SourceGrammar -> (String,String) -prGrammar2gfcc opts cnc gr = (abs, D.printGFCC gc) where +prGrammar2gfcc opts cnc gr = (abs,printGFCC gc) where (abs,gc) = mkCanon2gfcc opts cnc gr mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.GFCC) @@ -51,9 +53,9 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = an = (i2i a) cns = map (i2i . fst) cms abs = D.Abstr aflags funs cats catfuns - gflags = Map.fromList [(C.CId fg,x) | Just x <- [getOptVal opts (aOpt fg)]] + gflags = Map.fromList [(CId fg,x) | Just x <- [getOptVal opts (aOpt fg)]] where fg = "firstlang" - aflags = Map.fromList [(C.CId f,x) | Opt (f,[x]) <- M.flags abm] + aflags = Map.fromList [(CId f,x) | Opt (f,[x]) <- M.flags abm] mkDef pty = case pty of Yes t -> mkExp t _ -> CM.primNotion @@ -73,7 +75,7 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = (lang,D.Concr flags lins opers lincats lindefs printnames params) where js = tree2list (M.jments mo) - flags = Map.fromList [(C.CId f,x) | Opt (f,[x]) <- M.flags mo] + flags = Map.fromList [(CId f,x) | Opt (f,[x]) <- M.flags mo] opers = Map.fromAscList [] -- opers will be created as optimization utf = if elem (Opt ("coding",["utf8"])) (M.flags mo) then D.convertStringsInTerm decodeUTF8 else id @@ -89,8 +91,8 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = params = Map.fromAscList [(i2i c, pars lang0 c) | (c,CncCat (Yes ty) _ _) <- js] -i2i :: Ident -> C.CId -i2i = C.CId . prIdent +i2i :: Ident -> CId +i2i = CId . prIdent mkType :: A.Type -> C.Type mkType t = case GM.typeForm t of diff --git a/src/GF/Devel/PrintGFCC.hs b/src/GF/Devel/PrintGFCC.hs index 864fc07c0..700eb7ce0 100644 --- a/src/GF/Devel/PrintGFCC.hs +++ b/src/GF/Devel/PrintGFCC.hs @@ -1,6 +1,8 @@ module GF.Devel.PrintGFCC where -import GF.GFCC.DataGFCC (GFCC,printGFCC) +import GF.GFCC.DataGFCC (GFCC) +import GF.GFCC.Raw.ConvertGFCC (fromGFCC) +import GF.GFCC.Raw.PrintGFCCRaw (printTree) import GF.Devel.GFCCtoHaskell import GF.Devel.GFCCtoJS @@ -14,3 +16,6 @@ prGFCC printer gr = case printer of "jsref" -> gfcc2grammarRef gr _ -> printGFCC gr +printGFCC :: GFCC -> String +printGFCC = printTree . fromGFCC + diff --git a/src/GF/Formalism/FCFG.hs b/src/GF/Formalism/FCFG.hs index be0398fa3..37d5485a8 100644 --- a/src/GF/Formalism/FCFG.hs +++ b/src/GF/Formalism/FCFG.hs @@ -38,7 +38,7 @@ import Data.Array import qualified Data.Map as Map import GF.Formalism.Utilities -import qualified GF.GFCC.AbsGFCC as AbsGFCC +import qualified GF.GFCC.Raw.AbsGFCCRaw as AbsGFCC import GF.Infra.PrintClass diff --git a/src/GF/GFCC/API.hs b/src/GF/GFCC/API.hs index 093d13b97..bf795d91b 100644 --- a/src/GF/GFCC/API.hs +++ b/src/GF/GFCC/API.hs @@ -19,8 +19,9 @@ import GF.GFCC.Linearize import GF.GFCC.Generate import GF.GFCC.Macros import GF.GFCC.DataGFCC -import GF.GFCC.AbsGFCC -import GF.GFCC.ParGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) +import GF.GFCC.Raw.ConvertGFCC +import GF.GFCC.Raw.ParGFCCRaw import GF.Command.PPrTree import GF.GFCC.ErrM @@ -81,8 +82,10 @@ file2grammar f = do gfcc2parsers gfcc = [(lang, buildFCFPInfo fcfg) | (CId lang,fcfg) <- convertGrammar gfcc] -file2gfcc f = - readFileIf f >>= err (error) (return . mkGFCC) . pGrammar . myLexer +file2gfcc f = do + s <- readFileIf f + g <- parseGrammar s + return $ toGFCC g linearize mgr lang = GF.GFCC.Linearize.linearize (gfcc mgr) (CId lang) diff --git a/src/GF/GFCC/AbsGFCC.hs b/src/GF/GFCC/AbsGFCC.hs deleted file mode 100644 index e3b2582be..000000000 --- a/src/GF/GFCC/AbsGFCC.hs +++ /dev/null @@ -1,82 +0,0 @@ -module GF.GFCC.AbsGFCC where - --- Haskell module generated by the BNF converter - -newtype CId = CId String deriving (Eq,Ord,Show) -data Grammar = - Grm CId [CId] [Flag] Abstract [Concrete] - deriving (Eq,Ord,Show) - -data Abstract = - Abs [Flag] [FunDef] [CatDef] - deriving (Eq,Ord,Show) - -data Concrete = - Cnc CId [Flag] [LinDef] [LinDef] [LinDef] [LinDef] [LinDef] [LinDef] - deriving (Eq,Ord,Show) - -data Flag = - Flg CId String - deriving (Eq,Ord,Show) - -data CatDef = - Cat CId [Hypo] - deriving (Eq,Ord,Show) - -data FunDef = - Fun CId Type Exp - deriving (Eq,Ord,Show) - -data LinDef = - Lin CId Term - deriving (Eq,Ord,Show) - -data Type = - DTyp [Hypo] CId [Exp] - deriving (Eq,Ord,Show) - -data Exp = - DTr [CId] Atom [Exp] - | EEq [Equation] - deriving (Eq,Ord,Show) - -data Atom = - AC CId - | AS String - | AI Integer - | AF Double - | AM Integer - | AV CId - deriving (Eq,Ord,Show) - -data Term = - R [Term] - | P Term Term - | S [Term] - | K Tokn - | V Int --H - | C Int --H - | F CId - | FV [Term] - | W String Term - | TM - | RP Term Term - deriving (Eq,Ord,Show) - -data Tokn = - KS String - | KP [String] [Variant] - deriving (Eq,Ord,Show) - -data Variant = - Var [String] [String] - deriving (Eq,Ord,Show) - -data Hypo = - Hyp CId Type - deriving (Eq,Ord,Show) - -data Equation = - Equ [Exp] Exp - deriving (Eq,Ord,Show) - diff --git a/src/GF/GFCC/CheckGFCC.hs b/src/GF/GFCC/CheckGFCC.hs index 88a9e12f3..f3098d02c 100644 --- a/src/GF/GFCC/CheckGFCC.hs +++ b/src/GF/GFCC/CheckGFCC.hs @@ -1,8 +1,8 @@ module GF.GFCC.CheckGFCC (checkGFCC, checkGFCCio) where +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import GF.GFCC.Macros import GF.GFCC.DataGFCC -import GF.GFCC.AbsGFCC import GF.GFCC.ErrM import qualified Data.Map as Map @@ -39,7 +39,7 @@ labelBoolErr ms iob = do checkConcrete :: GFCC -> (CId,Concr) -> Err ((CId,Concr),Bool) checkConcrete gfcc (lang,cnc) = - labelBoolErr ("happened in language " ++ prt lang) $ do + labelBoolErr ("happened in language " ++ printCId lang) $ do (rs,bs) <- mapM checkl (Map.assocs (lins cnc)) >>= return . unzip return ((lang,cnc{lins = Map.fromAscList rs}),and bs) where @@ -47,7 +47,7 @@ checkConcrete gfcc (lang,cnc) = checkLin :: GFCC -> CId -> (CId,Term) -> Err ((CId,Term),Bool) checkLin gfcc lang (f,t) = - labelBoolErr ("happened in function " ++ prt f) $ do + labelBoolErr ("happened in function " ++ printCId f) $ do (t',b) <- checkTerm (lintype gfcc lang f) t --- $ inline gfcc lang t return ((f,t'),b) @@ -62,7 +62,7 @@ inferTerm args trm = case trm of (ts',tys) <- mapM infer ts >>= return . unzip let tys' = filter (/=str) tys testErr (null tys') - ("expected Str in " ++ prt trm ++ " not " ++ unwords (map prt tys')) + ("expected Str in " ++ show trm ++ " not " ++ unwords (map show tys')) return (S ts',str) R ts -> do (ts',tys) <- mapM infer ts >>= return . unzip @@ -78,21 +78,21 @@ inferTerm args trm = case trm of C i -> do testErr (i < length tys) - ("required more than " ++ show i ++ " fields in " ++ prt (R tys)) + ("required more than " ++ show i ++ " fields in " ++ show (R tys)) return (P t' u', tys !! i) -- record: index must be known _ -> do let typ = head tys - testErr (all (==typ) tys) ("different types in table " ++ prt trm) + testErr (all (==typ) tys) ("different types in table " ++ show trm) return (P t' u', typ) -- table: types must be same - _ -> Bad $ "projection from " ++ prt t ++ " : " ++ prt tt + _ -> Bad $ "projection from " ++ show t ++ " : " ++ show tt FV [] -> returnt TM ---- FV (t:ts) -> do (t',ty) <- infer t (ts',tys) <- mapM infer ts >>= return . unzip - testErr (all (eqType ty) tys) ("different types in variants " ++ prt trm) + testErr (all (eqType ty) tys) ("different types in variants " ++ show trm) return (FV (t':ts'),ty) W s r -> infer r - _ -> Bad ("no type inference for " ++ prt trm) + _ -> Bad ("no type inference for " ++ show trm) where returnt ty = return (trm,ty) infer = inferTerm args @@ -102,9 +102,9 @@ checkTerm (args,val) trm = case inferTerm args trm of Ok (t,ty) -> if eqType ty val then return (t,True) else do - msg ("term: " ++ prt trm ++ - "\nexpected type: " ++ prt val ++ - "\ninferred type: " ++ prt ty) + msg ("term: " ++ show trm ++ + "\nexpected type: " ++ show val ++ + "\ninferred type: " ++ show ty) return (t,False) Bad s -> do msg s diff --git a/src/GF/GFCC/DataGFCC.hs b/src/GF/GFCC/DataGFCC.hs index dce0fa4d4..74d8948a0 100644 --- a/src/GF/GFCC/DataGFCC.hs +++ b/src/GF/GFCC/DataGFCC.hs @@ -1,7 +1,6 @@ module GF.GFCC.DataGFCC where import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) -import GF.GFCC.PrintGFCC import GF.Infra.CompactPrint import GF.Text.UTF8 diff --git a/src/GF/GFCC/Generate.hs b/src/GF/GFCC/Generate.hs index 64ef5d5cf..f03718d8c 100644 --- a/src/GF/GFCC/Generate.hs +++ b/src/GF/GFCC/Generate.hs @@ -2,7 +2,7 @@ module GF.GFCC.Generate where import GF.GFCC.Macros import GF.GFCC.DataGFCC -import GF.GFCC.AbsGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import qualified Data.Map as M import System.Random diff --git a/src/GF/GFCC/Linearize.hs b/src/GF/GFCC/Linearize.hs index 7147afdcf..9618c33e6 100644 --- a/src/GF/GFCC/Linearize.hs +++ b/src/GF/GFCC/Linearize.hs @@ -2,7 +2,7 @@ module GF.GFCC.Linearize where import GF.GFCC.Macros import GF.GFCC.DataGFCC -import GF.GFCC.AbsGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import Data.Map import Data.List @@ -56,7 +56,7 @@ compute mcfg lang args = comp where idx xs i = if i > length xs - 1 then trace - ("too large " ++ show i ++ " for\n" ++ unlines (lmap prt xs) ++ "\n") TM + ("too large " ++ show i ++ " for\n" ++ unlines (lmap show xs) ++ "\n") TM else xs !! i proj r p = case (r,p) of diff --git a/src/GF/GFCC/Macros.hs b/src/GF/GFCC/Macros.hs index dd9d594d6..29d1f6947 100644 --- a/src/GF/GFCC/Macros.hs +++ b/src/GF/GFCC/Macros.hs @@ -1,8 +1,8 @@ module GF.GFCC.Macros where -import GF.GFCC.AbsGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import GF.GFCC.DataGFCC -import GF.GFCC.PrintGFCC +----import GF.GFCC.PrintGFCC import Data.Map import Data.List @@ -83,9 +83,6 @@ term0 _ = TM kks :: String -> Term kks = K . KS -prt :: Print a => a -> String -prt = printTree - -- lookup with default value lookMap :: (Show i, Ord i) => a -> i -> Map i a -> a lookMap d c m = maybe d id $ Data.Map.lookup c m diff --git a/src/GF/GFCC/OptimizeGFCC.hs b/src/GF/GFCC/OptimizeGFCC.hs index 68ee66c42..c385b069b 100644 --- a/src/GF/GFCC/OptimizeGFCC.hs +++ b/src/GF/GFCC/OptimizeGFCC.hs @@ -1,6 +1,6 @@ module GF.GFCC.OptimizeGFCC where -import GF.GFCC.AbsGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import GF.GFCC.DataGFCC import GF.Data.Operations diff --git a/src/GF/GFCC/ParGFCC.hs b/src/GF/GFCC/ParGFCC.hs deleted file mode 100644 index 2ccd5b19e..000000000 --- a/src/GF/GFCC/ParGFCC.hs +++ /dev/null @@ -1,1305 +0,0 @@ -{-# OPTIONS -fglasgow-exts -cpp #-} -{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} -module GF.GFCC.ParGFCC where -import GF.GFCC.AbsGFCC -import GF.GFCC.LexGFCC -import GF.GFCC.ErrM -import Array -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif - --- parser produced by Happy Version 1.15 - -newtype HappyAbsSyn = HappyAbsSyn (() -> ()) -happyIn30 :: (String) -> (HappyAbsSyn ) -happyIn30 x = unsafeCoerce# x -{-# INLINE happyIn30 #-} -happyOut30 :: (HappyAbsSyn ) -> (String) -happyOut30 x = unsafeCoerce# x -{-# INLINE happyOut30 #-} -happyIn31 :: (Integer) -> (HappyAbsSyn ) -happyIn31 x = unsafeCoerce# x -{-# INLINE happyIn31 #-} -happyOut31 :: (HappyAbsSyn ) -> (Integer) -happyOut31 x = unsafeCoerce# x -{-# INLINE happyOut31 #-} -happyIn32 :: (Double) -> (HappyAbsSyn ) -happyIn32 x = unsafeCoerce# x -{-# INLINE happyIn32 #-} -happyOut32 :: (HappyAbsSyn ) -> (Double) -happyOut32 x = unsafeCoerce# x -{-# INLINE happyOut32 #-} -happyIn33 :: (CId) -> (HappyAbsSyn ) -happyIn33 x = unsafeCoerce# x -{-# INLINE happyIn33 #-} -happyOut33 :: (HappyAbsSyn ) -> (CId) -happyOut33 x = unsafeCoerce# x -{-# INLINE happyOut33 #-} -happyIn34 :: (Grammar) -> (HappyAbsSyn ) -happyIn34 x = unsafeCoerce# x -{-# INLINE happyIn34 #-} -happyOut34 :: (HappyAbsSyn ) -> (Grammar) -happyOut34 x = unsafeCoerce# x -{-# INLINE happyOut34 #-} -happyIn35 :: (Abstract) -> (HappyAbsSyn ) -happyIn35 x = unsafeCoerce# x -{-# INLINE happyIn35 #-} -happyOut35 :: (HappyAbsSyn ) -> (Abstract) -happyOut35 x = unsafeCoerce# x -{-# INLINE happyOut35 #-} -happyIn36 :: (Concrete) -> (HappyAbsSyn ) -happyIn36 x = unsafeCoerce# x -{-# INLINE happyIn36 #-} -happyOut36 :: (HappyAbsSyn ) -> (Concrete) -happyOut36 x = unsafeCoerce# x -{-# INLINE happyOut36 #-} -happyIn37 :: (Flag) -> (HappyAbsSyn ) -happyIn37 x = unsafeCoerce# x -{-# INLINE happyIn37 #-} -happyOut37 :: (HappyAbsSyn ) -> (Flag) -happyOut37 x = unsafeCoerce# x -{-# INLINE happyOut37 #-} -happyIn38 :: (CatDef) -> (HappyAbsSyn ) -happyIn38 x = unsafeCoerce# x -{-# INLINE happyIn38 #-} -happyOut38 :: (HappyAbsSyn ) -> (CatDef) -happyOut38 x = unsafeCoerce# x -{-# INLINE happyOut38 #-} -happyIn39 :: (FunDef) -> (HappyAbsSyn ) -happyIn39 x = unsafeCoerce# x -{-# INLINE happyIn39 #-} -happyOut39 :: (HappyAbsSyn ) -> (FunDef) -happyOut39 x = unsafeCoerce# x -{-# INLINE happyOut39 #-} -happyIn40 :: (LinDef) -> (HappyAbsSyn ) -happyIn40 x = unsafeCoerce# x -{-# INLINE happyIn40 #-} -happyOut40 :: (HappyAbsSyn ) -> (LinDef) -happyOut40 x = unsafeCoerce# x -{-# INLINE happyOut40 #-} -happyIn41 :: (Type) -> (HappyAbsSyn ) -happyIn41 x = unsafeCoerce# x -{-# INLINE happyIn41 #-} -happyOut41 :: (HappyAbsSyn ) -> (Type) -happyOut41 x = unsafeCoerce# x -{-# INLINE happyOut41 #-} -happyIn42 :: (Exp) -> (HappyAbsSyn ) -happyIn42 x = unsafeCoerce# x -{-# INLINE happyIn42 #-} -happyOut42 :: (HappyAbsSyn ) -> (Exp) -happyOut42 x = unsafeCoerce# x -{-# INLINE happyOut42 #-} -happyIn43 :: (Atom) -> (HappyAbsSyn ) -happyIn43 x = unsafeCoerce# x -{-# INLINE happyIn43 #-} -happyOut43 :: (HappyAbsSyn ) -> (Atom) -happyOut43 x = unsafeCoerce# x -{-# INLINE happyOut43 #-} -happyIn44 :: (Term) -> (HappyAbsSyn ) -happyIn44 x = unsafeCoerce# x -{-# INLINE happyIn44 #-} -happyOut44 :: (HappyAbsSyn ) -> (Term) -happyOut44 x = unsafeCoerce# x -{-# INLINE happyOut44 #-} -happyIn45 :: (Tokn) -> (HappyAbsSyn ) -happyIn45 x = unsafeCoerce# x -{-# INLINE happyIn45 #-} -happyOut45 :: (HappyAbsSyn ) -> (Tokn) -happyOut45 x = unsafeCoerce# x -{-# INLINE happyOut45 #-} -happyIn46 :: (Variant) -> (HappyAbsSyn ) -happyIn46 x = unsafeCoerce# x -{-# INLINE happyIn46 #-} -happyOut46 :: (HappyAbsSyn ) -> (Variant) -happyOut46 x = unsafeCoerce# x -{-# INLINE happyOut46 #-} -happyIn47 :: ([Concrete]) -> (HappyAbsSyn ) -happyIn47 x = unsafeCoerce# x -{-# INLINE happyIn47 #-} -happyOut47 :: (HappyAbsSyn ) -> ([Concrete]) -happyOut47 x = unsafeCoerce# x -{-# INLINE happyOut47 #-} -happyIn48 :: ([Flag]) -> (HappyAbsSyn ) -happyIn48 x = unsafeCoerce# x -{-# INLINE happyIn48 #-} -happyOut48 :: (HappyAbsSyn ) -> ([Flag]) -happyOut48 x = unsafeCoerce# x -{-# INLINE happyOut48 #-} -happyIn49 :: ([CatDef]) -> (HappyAbsSyn ) -happyIn49 x = unsafeCoerce# x -{-# INLINE happyIn49 #-} -happyOut49 :: (HappyAbsSyn ) -> ([CatDef]) -happyOut49 x = unsafeCoerce# x -{-# INLINE happyOut49 #-} -happyIn50 :: ([FunDef]) -> (HappyAbsSyn ) -happyIn50 x = unsafeCoerce# x -{-# INLINE happyIn50 #-} -happyOut50 :: (HappyAbsSyn ) -> ([FunDef]) -happyOut50 x = unsafeCoerce# x -{-# INLINE happyOut50 #-} -happyIn51 :: ([LinDef]) -> (HappyAbsSyn ) -happyIn51 x = unsafeCoerce# x -{-# INLINE happyIn51 #-} -happyOut51 :: (HappyAbsSyn ) -> ([LinDef]) -happyOut51 x = unsafeCoerce# x -{-# INLINE happyOut51 #-} -happyIn52 :: ([CId]) -> (HappyAbsSyn ) -happyIn52 x = unsafeCoerce# x -{-# INLINE happyIn52 #-} -happyOut52 :: (HappyAbsSyn ) -> ([CId]) -happyOut52 x = unsafeCoerce# x -{-# INLINE happyOut52 #-} -happyIn53 :: ([Term]) -> (HappyAbsSyn ) -happyIn53 x = unsafeCoerce# x -{-# INLINE happyIn53 #-} -happyOut53 :: (HappyAbsSyn ) -> ([Term]) -happyOut53 x = unsafeCoerce# x -{-# INLINE happyOut53 #-} -happyIn54 :: ([Exp]) -> (HappyAbsSyn ) -happyIn54 x = unsafeCoerce# x -{-# INLINE happyIn54 #-} -happyOut54 :: (HappyAbsSyn ) -> ([Exp]) -happyOut54 x = unsafeCoerce# x -{-# INLINE happyOut54 #-} -happyIn55 :: ([String]) -> (HappyAbsSyn ) -happyIn55 x = unsafeCoerce# x -{-# INLINE happyIn55 #-} -happyOut55 :: (HappyAbsSyn ) -> ([String]) -happyOut55 x = unsafeCoerce# x -{-# INLINE happyOut55 #-} -happyIn56 :: ([Variant]) -> (HappyAbsSyn ) -happyIn56 x = unsafeCoerce# x -{-# INLINE happyIn56 #-} -happyOut56 :: (HappyAbsSyn ) -> ([Variant]) -happyOut56 x = unsafeCoerce# x -{-# INLINE happyOut56 #-} -happyIn57 :: (Hypo) -> (HappyAbsSyn ) -happyIn57 x = unsafeCoerce# x -{-# INLINE happyIn57 #-} -happyOut57 :: (HappyAbsSyn ) -> (Hypo) -happyOut57 x = unsafeCoerce# x -{-# INLINE happyOut57 #-} -happyIn58 :: (Equation) -> (HappyAbsSyn ) -happyIn58 x = unsafeCoerce# x -{-# INLINE happyIn58 #-} -happyOut58 :: (HappyAbsSyn ) -> (Equation) -happyOut58 x = unsafeCoerce# x -{-# INLINE happyOut58 #-} -happyIn59 :: ([Hypo]) -> (HappyAbsSyn ) -happyIn59 x = unsafeCoerce# x -{-# INLINE happyIn59 #-} -happyOut59 :: (HappyAbsSyn ) -> ([Hypo]) -happyOut59 x = unsafeCoerce# x -{-# INLINE happyOut59 #-} -happyIn60 :: ([Equation]) -> (HappyAbsSyn ) -happyIn60 x = unsafeCoerce# x -{-# INLINE happyIn60 #-} -happyOut60 :: (HappyAbsSyn ) -> ([Equation]) -happyOut60 x = unsafeCoerce# x -{-# INLINE happyOut60 #-} -happyInTok :: Token -> (HappyAbsSyn ) -happyInTok x = unsafeCoerce# x -{-# INLINE happyInTok #-} -happyOutTok :: (HappyAbsSyn ) -> Token -happyOutTok x = unsafeCoerce# x -{-# INLINE happyOutTok #-} - -happyActOffsets :: HappyAddr -happyActOffsets = HappyA# "\x40\x01\x41\x01\x3d\x01\x3b\x01\x3b\x01\x3b\x01\x3b\x01\x4a\x01\xc9\x00\xf7\xff\x05\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x01\x05\x00\x00\x00\x00\x00\x37\x01\x36\x01\x00\x00\x36\x01\x00\x00\x33\x01\x00\x00\x32\x01\x3a\x01\x35\x01\x31\x01\x00\x00\x79\x00\x31\x01\x31\x01\x30\x01\x47\x00\x2c\x01\x95\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x2f\x01\x00\x00\x2a\x01\x05\x00\x01\x00\x00\x00\x2b\x01\x05\x00\x00\x00\x2e\x01\x29\x01\xa8\x00\xa8\x00\xa8\x00\xa8\x00\x06\x00\x29\x01\x29\x01\x2d\x01\x28\x01\x00\x00\x00\x00\x00\x00\x00\x00\x28\x01\x27\x01\x26\x01\x00\x00\x25\x01\x00\x00\x24\x01\x22\x01\x21\x01\x23\x01\x20\x01\x1f\x01\x1e\x01\x1d\x01\x18\x01\x1c\x01\x17\x01\x17\x01\x1b\x01\x16\x01\x1a\x01\x15\x01\x13\x01\x19\x01\x10\x01\x14\x01\x0d\x01\x09\x01\x12\x01\x05\x00\x0f\x01\x06\x01\x11\x01\x00\x00\x00\x00\x00\x00\x0e\x01\x0c\x01\x0b\x01\x0a\x01\x08\x01\xf8\x00\x07\x01\x00\x00\x04\x01\xfa\x00\x9e\x00\x05\x01\x05\x00\x00\x00\x00\x00\x00\x00\x3f\x00\xc9\x00\xf7\x00\x03\x01\x02\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\x00\x00\x00\x00\x00\x05\x00\x05\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x01\x01\xf0\x00\x00\x00\xfe\x00\x00\x01\x00\x00\xef\x00\x00\x00\xec\x00\xff\x00\x7c\x00\x00\x00\x00\x00\xc9\x00\x00\x00\xf7\xff\x3f\x00\xfd\x00\xfc\x00\xfb\x00\x00\x00\x00\x00\x00\x00\xf4\x00\x00\x00\xc9\x00\x00\x00\x49\x00\x00\x00\xf9\x00\x00\x00\x54\x00\x00\x00\xb8\x00\xf3\x00\x00\x00\x00\x00\x8f\x00\x00\x00\x07\x00\xf6\x00\x10\x00\x00\x00\x8a\x00\x00\x00\xee\x00\xf5\x00\x00\x00\x11\x00\x00\x00\xea\x00\x00\x00\xab\x00\x00\x00\x93\x00\x00\x00\x0f\x00\x00\x00\x00\x00"# - -happyGotoOffsets :: HappyAddr -happyGotoOffsets = HappyA# "\xf2\x00\xed\x00\xeb\x00\xc3\x00\xb2\x00\xa4\x00\x9c\x00\xe9\x00\xe7\x00\x9b\x00\x88\x00\x4e\x00\x71\x00\xe6\x00\xe3\x00\xd9\x00\xd5\x00\xdb\x00\x48\x00\x58\x00\xd7\x00\xd4\x00\x91\x00\x25\x00\xad\x00\x1b\x00\xcd\x00\x00\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\x00\x00\x00\x00\x00\x00\x00\xe8\x00\x00\x00\xe8\x00\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x53\x00\x43\x00\x00\x00\xe5\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x8e\x00\x5c\x00\xb1\x00\xc0\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x00\xe0\x00\x00\x00\x00\x00\xc1\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\xdd\x00\x00\x00\x00\x00\x00\x00\xdc\x00\x13\x00\xd3\x00\x84\x00\x00\x00\x46\x00\xa6\x00\x00\x00\x00\x00\xcb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x00\x00\xc8\x00\x89\x00\xd1\x00\x02\x00\xd0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xda\x00\x00\x00\x00\x00\x74\x00\x70\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xda\x00\x00\x00\x00\x00\xd6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc6\x00\x27\x00\x00\x00\xba\x00\xc5\x00\x00\x00\xca\x00\xbd\x00\x8d\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\xc7\x00\x00\x00\xba\x00\xbe\x00\x00\x00\xbf\x00\x5c\x00\xa3\x00\x98\x00\x00\x00\x00\x00\x00\x00\x8e\x00\x9f\x00\xba\x00\x00\x00\xb1\x00\x80\x00\x8e\x00\x00\x00\x81\x00\x00\x00\x30\x00\x8e\x00\x65\x00\x5e\x00\x2d\x00\x8e\x00\xf2\xff\x8e\x00\xef\xff\x8e\x00\x00\x00\x00\x00"# - -happyDefActions :: HappyAddr -happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\xff\xc2\xff\xc0\xff\xbe\xff\xbc\xff\xba\xff\xb8\xff\xb5\xff\xb2\xff\xb0\xff\xb0\xff\x00\x00\xb2\xff\xa9\xff\xa6\xff\x00\x00\xe4\xff\xb2\xff\x00\x00\xa8\xff\x00\x00\xe1\xff\x00\x00\x00\x00\x00\x00\xad\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc5\xff\xcb\xff\xca\xff\xb4\xff\xcd\xff\x00\x00\xb5\xff\xb5\xff\xc7\xff\x00\x00\xb5\xff\xe3\xff\xb7\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd5\xff\xd4\xff\xd3\xff\xd6\xff\x00\x00\x00\x00\x00\x00\xe2\xff\x00\x00\xa6\xff\x00\x00\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa9\xff\x00\x00\x00\x00\x00\x00\xb8\xff\xb2\xff\xd1\xff\xd2\xff\xb0\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\xff\x00\x00\xcc\xff\x00\x00\xc5\xff\xb4\xff\x00\x00\xb5\xff\xb1\xff\xaf\xff\xb0\xff\xae\xff\x00\x00\xa9\xff\x00\x00\x00\x00\xa5\xff\xab\xff\xa7\xff\xaa\xff\xac\xff\xc3\xff\xb3\xff\xce\xff\x00\x00\x00\x00\x00\x00\xd0\xff\xc9\xff\xb6\xff\xb9\xff\xbb\xff\xbd\xff\xbf\xff\xc1\xff\x00\x00\xd7\xff\x00\x00\x00\x00\xda\xff\x00\x00\x00\x00\xdd\xff\x00\x00\xc0\xff\xb8\xff\x00\x00\x00\x00\xc0\xff\xdc\xff\x00\x00\xb2\xff\x00\x00\xae\xff\x00\x00\x00\x00\x00\x00\xcf\xff\xc6\xff\xc8\xff\x00\x00\xb2\xff\xd9\xff\xdb\xff\x00\x00\xbc\xff\x00\x00\xc0\xff\x00\x00\xba\xff\x00\x00\x00\x00\xc4\xff\xd8\xff\x00\x00\xbe\xff\x00\x00\x00\x00\x00\x00\xba\xff\x00\x00\xdf\xff\x00\x00\x00\x00\xba\xff\x00\x00\xc2\xff\xe0\xff\xba\xff\x00\x00\xba\xff\x00\x00\xba\xff\x00\x00\xde\xff"# - -happyCheck :: HappyAddr -happyCheck = HappyA# "\xff\xff\x0a\x00\x01\x00\x0c\x00\x15\x00\x03\x00\x01\x00\x15\x00\x07\x00\x02\x00\x07\x00\x0a\x00\x07\x00\x0c\x00\x0d\x00\x0a\x00\x04\x00\x0c\x00\x0d\x00\x07\x00\x05\x00\x05\x00\x03\x00\x03\x00\x21\x00\x22\x00\x23\x00\x24\x00\x16\x00\x1b\x00\x03\x00\x1d\x00\x1f\x00\x07\x00\x21\x00\x22\x00\x21\x00\x24\x00\x21\x00\x22\x00\x03\x00\x24\x00\x03\x00\x24\x00\x26\x00\x1c\x00\x1b\x00\x1b\x00\x1d\x00\x1d\x00\x26\x00\x24\x00\x24\x00\x24\x00\x1b\x00\x03\x00\x1d\x00\x00\x00\x01\x00\x21\x00\x03\x00\x16\x00\x00\x00\x01\x00\x1b\x00\x03\x00\x15\x00\x00\x00\x01\x00\x15\x00\x03\x00\x0e\x00\x0f\x00\x03\x00\x16\x00\x03\x00\x0e\x00\x0f\x00\x00\x00\x10\x00\x17\x00\x0e\x00\x0f\x00\x00\x00\x01\x00\x17\x00\x03\x00\x10\x00\x00\x00\x01\x00\x17\x00\x03\x00\x16\x00\x0f\x00\x16\x00\x03\x00\x21\x00\x0e\x00\x0f\x00\x1a\x00\x06\x00\x09\x00\x0e\x00\x0f\x00\x21\x00\x15\x00\x17\x00\x00\x00\x01\x00\x24\x00\x03\x00\x17\x00\x00\x00\x01\x00\x10\x00\x03\x00\x00\x00\x01\x00\x11\x00\x03\x00\x24\x00\x0e\x00\x0f\x00\x19\x00\x1a\x00\x04\x00\x0e\x00\x0f\x00\x07\x00\x10\x00\x0e\x00\x0f\x00\x00\x00\x01\x00\x05\x00\x03\x00\x00\x00\x01\x00\x19\x00\x03\x00\x13\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x0e\x00\x0f\x00\x18\x00\x15\x00\x0e\x00\x0f\x00\x0a\x00\x10\x00\x0d\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x24\x00\x10\x00\x19\x00\x1a\x00\x0c\x00\x1b\x00\x0a\x00\x03\x00\x0d\x00\x0b\x00\x19\x00\x1a\x00\x1d\x00\x09\x00\x24\x00\x11\x00\x12\x00\x1e\x00\x13\x00\x24\x00\x03\x00\x03\x00\x21\x00\x24\x00\x15\x00\x08\x00\x08\x00\x26\x00\x04\x00\x03\x00\x18\x00\x07\x00\x08\x00\x07\x00\x1c\x00\x03\x00\x18\x00\x18\x00\x03\x00\x07\x00\x1c\x00\x1c\x00\x07\x00\x20\x00\x24\x00\x04\x00\x26\x00\x24\x00\x07\x00\x12\x00\x14\x00\x0c\x00\x18\x00\x18\x00\x0c\x00\x12\x00\x12\x00\x03\x00\x00\x00\x0b\x00\x00\x00\x0c\x00\x0b\x00\x1e\x00\x03\x00\x19\x00\x03\x00\x03\x00\x19\x00\x01\x00\x01\x00\x06\x00\x00\x00\x14\x00\x0c\x00\x1e\x00\x13\x00\x19\x00\x0c\x00\x18\x00\x15\x00\x06\x00\x05\x00\x0c\x00\x0b\x00\x12\x00\x04\x00\x11\x00\x03\x00\x03\x00\x01\x00\x08\x00\x08\x00\x02\x00\x02\x00\x02\x00\x16\x00\x02\x00\x14\x00\x02\x00\x06\x00\x03\x00\x17\x00\x02\x00\x08\x00\x0f\x00\x07\x00\x03\x00\x08\x00\x03\x00\x03\x00\x03\x00\x24\x00\x03\x00\x21\x00\xff\xff\x24\x00\x0e\x00\x05\x00\x08\x00\x04\x00\x07\x00\x01\x00\x24\x00\x24\x00\xff\xff\x04\x00\xff\xff\xff\xff\xff\xff\x06\x00\xff\xff\x07\x00\x01\x00\xff\xff\x17\x00\x09\x00\x06\x00\x24\x00\xff\xff\xff\xff\x24\x00\x21\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\x26\x00\x26\x00\x26\x00\x26\x00\x24\x00\x12\x00\x12\x00\x12\x00\x09\x00\x26\x00\x24\x00\x26\x00\x12\x00\x26\x00\x22\x00\x24\x00\x26\x00\x1f\x00\x22\x00\x26\x00\x26\x00\x26\x00\x07\x00\x26\x00\x16\x00\x21\x00\x14\x00\xff\xff\x26\x00\x26\x00\x19\x00\x24\x00\xff\xff\x24\x00\x26\x00\xff\xff\x24\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"# - -happyTable :: HappyAddr -happyTable = HappyA# "\x00\x00\x47\x00\x31\x00\x48\x00\xcb\x00\x1e\x00\x31\x00\xc9\x00\x32\x00\xbc\x00\xa4\x00\x33\x00\x32\x00\x34\x00\x35\x00\x33\x00\x4b\x00\x34\x00\x35\x00\x4c\x00\xcd\x00\xc0\x00\x1e\x00\x1e\x00\x1d\x00\x36\x00\x49\x00\x22\x00\x58\x00\x1f\x00\x1e\x00\x80\x00\x69\x00\x40\x00\x1d\x00\x36\x00\x1d\x00\x22\x00\x1d\x00\x36\x00\x1e\x00\x22\x00\x36\x00\x22\x00\xff\xff\xc7\x00\x1f\x00\x1f\x00\x97\x00\x63\x00\xff\xff\x22\x00\x22\x00\x22\x00\x1f\x00\x36\x00\x20\x00\x2a\x00\x2b\x00\x1d\x00\x2c\x00\x9c\x00\x2a\x00\x2b\x00\x24\x00\x2c\x00\xc7\x00\x2a\x00\x2b\x00\xc3\x00\x2c\x00\x2d\x00\x2e\x00\x36\x00\x8b\x00\x36\x00\x2d\x00\x2e\x00\x2a\x00\xb0\xff\x84\x00\x2d\x00\x2e\x00\x72\x00\x2b\x00\x6f\x00\x2c\x00\x79\x00\x2a\x00\x2b\x00\x71\x00\x2c\x00\x93\x00\x3e\x00\x37\x00\x50\x00\xb0\xff\x73\x00\x2e\x00\xb4\x00\x69\x00\x6c\x00\x2d\x00\x2e\x00\x1d\x00\xba\x00\x74\x00\x2a\x00\x2b\x00\x22\x00\x2c\x00\x2f\x00\x2a\x00\x2b\x00\x25\x00\x2c\x00\x2a\x00\x2b\x00\xc5\x00\x2c\x00\x22\x00\xa4\x00\x2e\x00\x26\x00\xaa\x00\x4b\x00\xa5\x00\x2e\x00\x4c\x00\x3d\x00\xa6\x00\x2e\x00\x2a\x00\x2b\x00\xc1\x00\x2c\x00\x2a\x00\x2b\x00\x26\x00\x2c\x00\x7b\x00\x41\x00\x42\x00\x43\x00\x44\x00\x4e\x00\x95\x00\x2e\x00\xb0\x00\xbe\x00\x40\x00\x2e\x00\x6d\x00\x25\x00\xab\x00\x41\x00\x42\x00\x43\x00\x44\x00\x4e\x00\x22\x00\x25\x00\x26\x00\x82\x00\x76\x00\xc3\x00\x4f\x00\x50\x00\x45\x00\x87\x00\x26\x00\x27\x00\xbe\x00\x51\x00\x22\x00\x88\x00\x76\x00\xcb\x00\xbc\x00\x22\x00\x52\x00\x52\x00\x1d\x00\x22\x00\xb8\x00\x6b\x00\x53\x00\xff\xff\x4b\x00\x54\x00\x22\x00\x4c\x00\xb8\x00\x6a\x00\x7d\x00\x54\x00\x22\x00\x22\x00\x54\x00\x6a\x00\x7d\x00\x23\x00\x55\x00\xc9\x00\x22\x00\x4b\x00\xff\xff\x22\x00\x4c\x00\xba\x00\xb2\x00\x76\x00\xb4\x00\xac\x00\xad\x00\xae\x00\x9d\x00\xa1\x00\x77\x00\x7f\x00\x98\x00\x81\x00\x96\x00\x65\x00\x5c\x00\x83\x00\x5e\x00\x66\x00\x91\x00\x67\x00\x70\x00\x69\x00\x77\x00\x39\x00\x76\x00\x1d\x00\x3a\x00\x28\x00\x76\x00\x29\x00\x38\x00\x56\x00\x58\x00\x49\x00\x4c\x00\x3b\x00\x5a\x00\x3c\x00\xc5\x00\xc1\x00\xb2\x00\xb7\x00\xb6\x00\xa8\x00\xa9\x00\xaa\x00\x58\x00\xb1\x00\x5a\x00\xa3\x00\xa1\x00\x7f\x00\x9f\x00\x86\x00\xa0\x00\x89\x00\x4e\x00\x8d\x00\x8a\x00\x8e\x00\x8f\x00\x90\x00\x22\x00\x91\x00\x1d\x00\x00\x00\x22\x00\x8b\x00\x93\x00\x95\x00\x9a\x00\x4e\x00\x9c\x00\x22\x00\x22\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x61\x00\x65\x00\x00\x00\x9b\x00\x62\x00\x63\x00\x22\x00\x00\x00\x00\x00\x22\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\x6f\x00\x76\x00\x7a\x00\x7d\x00\xff\xff\x22\x00\xff\xff\x7c\x00\xff\xff\x36\x00\x22\x00\xff\xff\x69\x00\x36\x00\xff\xff\xff\xff\xff\xff\x4e\x00\xff\xff\x58\x00\x1d\x00\x5a\x00\x00\x00\xff\xff\xff\xff\x5c\x00\x22\x00\x00\x00\x22\x00\xae\xff\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (27, 90) [ - (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) - ] - -happy_n_terms = 39 :: Int -happy_n_nonterms = 31 :: Int - -happyReduce_27 = happySpecReduce_1 0# happyReduction_27 -happyReduction_27 happy_x_1 - = case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> - happyIn30 - (happy_var_1 - )} - -happyReduce_28 = happySpecReduce_1 1# happyReduction_28 -happyReduction_28 happy_x_1 - = case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> - happyIn31 - ((read happy_var_1) :: Integer - )} - -happyReduce_29 = happySpecReduce_1 2# happyReduction_29 -happyReduction_29 happy_x_1 - = case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> - happyIn32 - ((read happy_var_1) :: Double - )} - -happyReduce_30 = happySpecReduce_1 3# happyReduction_30 -happyReduction_30 happy_x_1 - = case happyOutTok happy_x_1 of { (PT _ (T_CId happy_var_1)) -> - happyIn33 - (CId (happy_var_1) - )} - -happyReduce_31 = happyReduce 12# 4# happyReduction_31 -happyReduction_31 (happy_x_12 `HappyStk` - happy_x_11 `HappyStk` - happy_x_10 `HappyStk` - 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 happyOut33 happy_x_2 of { happy_var_2 -> - case happyOut52 happy_x_4 of { happy_var_4 -> - case happyOut48 happy_x_7 of { happy_var_7 -> - case happyOut35 happy_x_10 of { happy_var_10 -> - case happyOut47 happy_x_12 of { happy_var_12 -> - happyIn34 - (Grm happy_var_2 happy_var_4 (reverse happy_var_7) happy_var_10 (reverse happy_var_12) - ) `HappyStk` happyRest}}}}} - -happyReduce_32 = happyReduce 9# 5# happyReduction_32 -happyReduction_32 (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 happyOut48 happy_x_4 of { happy_var_4 -> - case happyOut50 happy_x_6 of { happy_var_6 -> - case happyOut49 happy_x_8 of { happy_var_8 -> - happyIn35 - (Abs (reverse happy_var_4) (reverse happy_var_6) (reverse happy_var_8) - ) `HappyStk` happyRest}}} - -happyReduce_33 = happyReduce 18# 6# happyReduction_33 -happyReduction_33 (happy_x_18 `HappyStk` - happy_x_17 `HappyStk` - happy_x_16 `HappyStk` - happy_x_15 `HappyStk` - happy_x_14 `HappyStk` - happy_x_13 `HappyStk` - happy_x_12 `HappyStk` - happy_x_11 `HappyStk` - happy_x_10 `HappyStk` - 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 happyOut33 happy_x_2 of { happy_var_2 -> - case happyOut48 happy_x_5 of { happy_var_5 -> - case happyOut51 happy_x_7 of { happy_var_7 -> - case happyOut51 happy_x_9 of { happy_var_9 -> - case happyOut51 happy_x_11 of { happy_var_11 -> - case happyOut51 happy_x_13 of { happy_var_13 -> - case happyOut51 happy_x_15 of { happy_var_15 -> - case happyOut51 happy_x_17 of { happy_var_17 -> - happyIn36 - (Cnc happy_var_2 (reverse happy_var_5) (reverse happy_var_7) (reverse happy_var_9) (reverse happy_var_11) (reverse happy_var_13) (reverse happy_var_15) (reverse happy_var_17) - ) `HappyStk` happyRest}}}}}}}} - -happyReduce_34 = happySpecReduce_3 7# happyReduction_34 -happyReduction_34 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - case happyOut30 happy_x_3 of { happy_var_3 -> - happyIn37 - (Flg happy_var_1 happy_var_3 - )}} - -happyReduce_35 = happyReduce 4# 8# happyReduction_35 -happyReduction_35 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut33 happy_x_1 of { happy_var_1 -> - case happyOut59 happy_x_3 of { happy_var_3 -> - happyIn38 - (Cat happy_var_1 happy_var_3 - ) `HappyStk` happyRest}} - -happyReduce_36 = happyReduce 5# 9# happyReduction_36 -happyReduction_36 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut33 happy_x_1 of { happy_var_1 -> - case happyOut41 happy_x_3 of { happy_var_3 -> - case happyOut42 happy_x_5 of { happy_var_5 -> - happyIn39 - (Fun happy_var_1 happy_var_3 happy_var_5 - ) `HappyStk` happyRest}}} - -happyReduce_37 = happySpecReduce_3 10# happyReduction_37 -happyReduction_37 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - case happyOut44 happy_x_3 of { happy_var_3 -> - happyIn40 - (Lin happy_var_1 happy_var_3 - )}} - -happyReduce_38 = happyReduce 5# 11# happyReduction_38 -happyReduction_38 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut59 happy_x_2 of { happy_var_2 -> - case happyOut33 happy_x_4 of { happy_var_4 -> - case happyOut54 happy_x_5 of { happy_var_5 -> - happyIn41 - (DTyp happy_var_2 happy_var_4 (reverse happy_var_5) - ) `HappyStk` happyRest}}} - -happyReduce_39 = happyReduce 7# 12# happyReduction_39 -happyReduction_39 (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 happyOut52 happy_x_3 of { happy_var_3 -> - case happyOut43 happy_x_5 of { happy_var_5 -> - case happyOut54 happy_x_6 of { happy_var_6 -> - happyIn42 - (DTr happy_var_3 happy_var_5 (reverse happy_var_6) - ) `HappyStk` happyRest}}} - -happyReduce_40 = happySpecReduce_3 12# happyReduction_40 -happyReduction_40 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut60 happy_x_2 of { happy_var_2 -> - happyIn42 - (EEq (reverse happy_var_2) - )} - -happyReduce_41 = happySpecReduce_1 13# happyReduction_41 -happyReduction_41 happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - happyIn43 - (AC happy_var_1 - )} - -happyReduce_42 = happySpecReduce_1 13# happyReduction_42 -happyReduction_42 happy_x_1 - = case happyOut30 happy_x_1 of { happy_var_1 -> - happyIn43 - (AS happy_var_1 - )} - -happyReduce_43 = happySpecReduce_1 13# happyReduction_43 -happyReduction_43 happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - happyIn43 - (AI happy_var_1 - )} - -happyReduce_44 = happySpecReduce_1 13# happyReduction_44 -happyReduction_44 happy_x_1 - = case happyOut32 happy_x_1 of { happy_var_1 -> - happyIn43 - (AF happy_var_1 - )} - -happyReduce_45 = happySpecReduce_2 13# happyReduction_45 -happyReduction_45 happy_x_2 - happy_x_1 - = case happyOut31 happy_x_2 of { happy_var_2 -> - happyIn43 - (AM happy_var_2 - )} - -happyReduce_46 = happySpecReduce_2 13# happyReduction_46 -happyReduction_46 happy_x_2 - happy_x_1 - = case happyOut33 happy_x_2 of { happy_var_2 -> - happyIn43 - (AV happy_var_2 - )} - -happyReduce_47 = happySpecReduce_3 14# happyReduction_47 -happyReduction_47 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut53 happy_x_2 of { happy_var_2 -> - happyIn44 - (R happy_var_2 - )} - -happyReduce_48 = happyReduce 5# 14# happyReduction_48 -happyReduction_48 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut44 happy_x_2 of { happy_var_2 -> - case happyOut44 happy_x_4 of { happy_var_4 -> - happyIn44 - (P happy_var_2 happy_var_4 - ) `HappyStk` happyRest}} - -happyReduce_49 = happySpecReduce_3 14# happyReduction_49 -happyReduction_49 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut53 happy_x_2 of { happy_var_2 -> - happyIn44 - (S happy_var_2 - )} - -happyReduce_50 = happySpecReduce_1 14# happyReduction_50 -happyReduction_50 happy_x_1 - = case happyOut45 happy_x_1 of { happy_var_1 -> - happyIn44 - (K happy_var_1 - )} - -happyReduce_51 = happySpecReduce_2 14# happyReduction_51 -happyReduction_51 happy_x_2 - happy_x_1 - = case happyOut31 happy_x_2 of { happy_var_2 -> - happyIn44 - (V (fromInteger happy_var_2) --H - )} - -happyReduce_52 = happySpecReduce_1 14# happyReduction_52 -happyReduction_52 happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - happyIn44 - (C (fromInteger happy_var_1) --H - )} - -happyReduce_53 = happySpecReduce_1 14# happyReduction_53 -happyReduction_53 happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - happyIn44 - (F happy_var_1 - )} - -happyReduce_54 = happySpecReduce_3 14# happyReduction_54 -happyReduction_54 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut53 happy_x_2 of { happy_var_2 -> - happyIn44 - (FV happy_var_2 - )} - -happyReduce_55 = happyReduce 5# 14# happyReduction_55 -happyReduction_55 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut30 happy_x_2 of { happy_var_2 -> - case happyOut44 happy_x_4 of { happy_var_4 -> - happyIn44 - (W happy_var_2 happy_var_4 - ) `HappyStk` happyRest}} - -happyReduce_56 = happySpecReduce_1 14# happyReduction_56 -happyReduction_56 happy_x_1 - = happyIn44 - (TM - ) - -happyReduce_57 = happyReduce 5# 14# happyReduction_57 -happyReduction_57 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut44 happy_x_2 of { happy_var_2 -> - case happyOut44 happy_x_4 of { happy_var_4 -> - happyIn44 - (RP happy_var_2 happy_var_4 - ) `HappyStk` happyRest}} - -happyReduce_58 = happySpecReduce_1 15# happyReduction_58 -happyReduction_58 happy_x_1 - = case happyOut30 happy_x_1 of { happy_var_1 -> - happyIn45 - (KS happy_var_1 - )} - -happyReduce_59 = happyReduce 7# 15# happyReduction_59 -happyReduction_59 (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 happyOut55 happy_x_3 of { happy_var_3 -> - case happyOut56 happy_x_5 of { happy_var_5 -> - happyIn45 - (KP (reverse happy_var_3) happy_var_5 - ) `HappyStk` happyRest}} - -happyReduce_60 = happySpecReduce_3 16# happyReduction_60 -happyReduction_60 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut55 happy_x_1 of { happy_var_1 -> - case happyOut55 happy_x_3 of { happy_var_3 -> - happyIn46 - (Var (reverse happy_var_1) (reverse happy_var_3) - )}} - -happyReduce_61 = happySpecReduce_0 17# happyReduction_61 -happyReduction_61 = happyIn47 - ([] - ) - -happyReduce_62 = happySpecReduce_3 17# happyReduction_62 -happyReduction_62 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut47 happy_x_1 of { happy_var_1 -> - case happyOut36 happy_x_2 of { happy_var_2 -> - happyIn47 - (flip (:) happy_var_1 happy_var_2 - )}} - -happyReduce_63 = happySpecReduce_0 18# happyReduction_63 -happyReduction_63 = happyIn48 - ([] - ) - -happyReduce_64 = happySpecReduce_3 18# happyReduction_64 -happyReduction_64 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut48 happy_x_1 of { happy_var_1 -> - case happyOut37 happy_x_2 of { happy_var_2 -> - happyIn48 - (flip (:) happy_var_1 happy_var_2 - )}} - -happyReduce_65 = happySpecReduce_0 19# happyReduction_65 -happyReduction_65 = happyIn49 - ([] - ) - -happyReduce_66 = happySpecReduce_3 19# happyReduction_66 -happyReduction_66 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - case happyOut38 happy_x_2 of { happy_var_2 -> - happyIn49 - (flip (:) happy_var_1 happy_var_2 - )}} - -happyReduce_67 = happySpecReduce_0 20# happyReduction_67 -happyReduction_67 = happyIn50 - ([] - ) - -happyReduce_68 = happySpecReduce_3 20# happyReduction_68 -happyReduction_68 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut50 happy_x_1 of { happy_var_1 -> - case happyOut39 happy_x_2 of { happy_var_2 -> - happyIn50 - (flip (:) happy_var_1 happy_var_2 - )}} - -happyReduce_69 = happySpecReduce_0 21# happyReduction_69 -happyReduction_69 = happyIn51 - ([] - ) - -happyReduce_70 = happySpecReduce_3 21# happyReduction_70 -happyReduction_70 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut51 happy_x_1 of { happy_var_1 -> - case happyOut40 happy_x_2 of { happy_var_2 -> - happyIn51 - (flip (:) happy_var_1 happy_var_2 - )}} - -happyReduce_71 = happySpecReduce_0 22# happyReduction_71 -happyReduction_71 = happyIn52 - ([] - ) - -happyReduce_72 = happySpecReduce_1 22# happyReduction_72 -happyReduction_72 happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - happyIn52 - ((:[]) happy_var_1 - )} - -happyReduce_73 = happySpecReduce_3 22# happyReduction_73 -happyReduction_73 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - case happyOut52 happy_x_3 of { happy_var_3 -> - happyIn52 - ((:) happy_var_1 happy_var_3 - )}} - -happyReduce_74 = happySpecReduce_0 23# happyReduction_74 -happyReduction_74 = happyIn53 - ([] - ) - -happyReduce_75 = happySpecReduce_1 23# happyReduction_75 -happyReduction_75 happy_x_1 - = case happyOut44 happy_x_1 of { happy_var_1 -> - happyIn53 - ((:[]) happy_var_1 - )} - -happyReduce_76 = happySpecReduce_3 23# happyReduction_76 -happyReduction_76 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut44 happy_x_1 of { happy_var_1 -> - case happyOut53 happy_x_3 of { happy_var_3 -> - happyIn53 - ((:) happy_var_1 happy_var_3 - )}} - -happyReduce_77 = happySpecReduce_0 24# happyReduction_77 -happyReduction_77 = happyIn54 - ([] - ) - -happyReduce_78 = happySpecReduce_2 24# happyReduction_78 -happyReduction_78 happy_x_2 - happy_x_1 - = case happyOut54 happy_x_1 of { happy_var_1 -> - case happyOut42 happy_x_2 of { happy_var_2 -> - happyIn54 - (flip (:) happy_var_1 happy_var_2 - )}} - -happyReduce_79 = happySpecReduce_0 25# happyReduction_79 -happyReduction_79 = happyIn55 - ([] - ) - -happyReduce_80 = happySpecReduce_2 25# happyReduction_80 -happyReduction_80 happy_x_2 - happy_x_1 - = case happyOut55 happy_x_1 of { happy_var_1 -> - case happyOut30 happy_x_2 of { happy_var_2 -> - happyIn55 - (flip (:) happy_var_1 happy_var_2 - )}} - -happyReduce_81 = happySpecReduce_0 26# happyReduction_81 -happyReduction_81 = happyIn56 - ([] - ) - -happyReduce_82 = happySpecReduce_1 26# happyReduction_82 -happyReduction_82 happy_x_1 - = case happyOut46 happy_x_1 of { happy_var_1 -> - happyIn56 - ((:[]) happy_var_1 - )} - -happyReduce_83 = happySpecReduce_3 26# happyReduction_83 -happyReduction_83 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut46 happy_x_1 of { happy_var_1 -> - case happyOut56 happy_x_3 of { happy_var_3 -> - happyIn56 - ((:) happy_var_1 happy_var_3 - )}} - -happyReduce_84 = happySpecReduce_3 27# happyReduction_84 -happyReduction_84 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - case happyOut41 happy_x_3 of { happy_var_3 -> - happyIn57 - (Hyp happy_var_1 happy_var_3 - )}} - -happyReduce_85 = happySpecReduce_3 28# happyReduction_85 -happyReduction_85 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut54 happy_x_1 of { happy_var_1 -> - case happyOut42 happy_x_3 of { happy_var_3 -> - happyIn58 - (Equ (reverse happy_var_1) happy_var_3 - )}} - -happyReduce_86 = happySpecReduce_0 29# happyReduction_86 -happyReduction_86 = happyIn59 - ([] - ) - -happyReduce_87 = happySpecReduce_1 29# happyReduction_87 -happyReduction_87 happy_x_1 - = case happyOut57 happy_x_1 of { happy_var_1 -> - happyIn59 - ((:[]) happy_var_1 - )} - -happyReduce_88 = happySpecReduce_3 29# happyReduction_88 -happyReduction_88 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut57 happy_x_1 of { happy_var_1 -> - case happyOut59 happy_x_3 of { happy_var_3 -> - happyIn59 - ((:) happy_var_1 happy_var_3 - )}} - -happyReduce_89 = happySpecReduce_0 30# happyReduction_89 -happyReduction_89 = happyIn60 - ([] - ) - -happyReduce_90 = happySpecReduce_3 30# happyReduction_90 -happyReduction_90 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut60 happy_x_1 of { happy_var_1 -> - case happyOut58 happy_x_2 of { happy_var_2 -> - happyIn60 - (flip (:) happy_var_1 happy_var_2 - )}} - -happyNewToken action sts stk [] = - happyDoAction 38# (error "reading EOF!") action sts stk [] - -happyNewToken action sts stk (tk:tks) = - let cont i = happyDoAction i tk action sts stk tks in - case tk of { - PT _ (TS "(") -> cont 1#; - PT _ (TS ")") -> cont 2#; - PT _ (TS ";") -> cont 3#; - PT _ (TS "{") -> cont 4#; - PT _ (TS "}") -> cont 5#; - PT _ (TS "=") -> cont 6#; - PT _ (TS "[") -> cont 7#; - PT _ (TS "]") -> cont 8#; - PT _ (TS ":") -> cont 9#; - PT _ (TS "?") -> cont 10#; - PT _ (TS "!") -> cont 11#; - PT _ (TS "$") -> cont 12#; - PT _ (TS "[|") -> cont 13#; - PT _ (TS "|]") -> cont 14#; - PT _ (TS "+") -> cont 15#; - PT _ (TS "/") -> cont 16#; - PT _ (TS "@") -> cont 17#; - PT _ (TS ",") -> cont 18#; - PT _ (TS "->") -> cont 19#; - PT _ (TS "abstract") -> cont 20#; - PT _ (TS "cat") -> cont 21#; - PT _ (TS "concrete") -> cont 22#; - PT _ (TS "flags") -> cont 23#; - PT _ (TS "fun") -> cont 24#; - PT _ (TS "grammar") -> cont 25#; - PT _ (TS "lin") -> cont 26#; - PT _ (TS "lincat") -> cont 27#; - PT _ (TS "lindef") -> cont 28#; - PT _ (TS "oper") -> cont 29#; - PT _ (TS "param") -> cont 30#; - PT _ (TS "pre") -> cont 31#; - PT _ (TS "printname") -> cont 32#; - PT _ (TL happy_dollar_dollar) -> cont 33#; - PT _ (TI happy_dollar_dollar) -> cont 34#; - PT _ (TD happy_dollar_dollar) -> cont 35#; - PT _ (T_CId happy_dollar_dollar) -> cont 36#; - _ -> cont 37#; - _ -> happyError' (tk:tks) - } - -happyError_ tk tks = happyError' (tk:tks) - -happyThen :: () => Err a -> (a -> Err b) -> Err b -happyThen = (thenM) -happyReturn :: () => a -> Err a -happyReturn = (returnM) -happyThen1 m k tks = (thenM) m (\a -> k a tks) -happyReturn1 :: () => a -> b -> Err a -happyReturn1 = \a tks -> (returnM) a -happyError' :: () => [Token] -> Err a -happyError' = happyError - -pGrammar tks = happySomeParser where - happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut34 x)) - -pAbstract tks = happySomeParser where - happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut35 x)) - -pConcrete tks = happySomeParser where - happySomeParser = happyThen (happyParse 2# tks) (\x -> happyReturn (happyOut36 x)) - -pFlag tks = happySomeParser where - happySomeParser = happyThen (happyParse 3# tks) (\x -> happyReturn (happyOut37 x)) - -pCatDef tks = happySomeParser where - happySomeParser = happyThen (happyParse 4# tks) (\x -> happyReturn (happyOut38 x)) - -pFunDef tks = happySomeParser where - happySomeParser = happyThen (happyParse 5# tks) (\x -> happyReturn (happyOut39 x)) - -pLinDef tks = happySomeParser where - happySomeParser = happyThen (happyParse 6# tks) (\x -> happyReturn (happyOut40 x)) - -pType tks = happySomeParser where - happySomeParser = happyThen (happyParse 7# tks) (\x -> happyReturn (happyOut41 x)) - -pExp tks = happySomeParser where - happySomeParser = happyThen (happyParse 8# tks) (\x -> happyReturn (happyOut42 x)) - -pAtom tks = happySomeParser where - happySomeParser = happyThen (happyParse 9# tks) (\x -> happyReturn (happyOut43 x)) - -pTerm tks = happySomeParser where - happySomeParser = happyThen (happyParse 10# tks) (\x -> happyReturn (happyOut44 x)) - -pTokn tks = happySomeParser where - happySomeParser = happyThen (happyParse 11# tks) (\x -> happyReturn (happyOut45 x)) - -pVariant tks = happySomeParser where - happySomeParser = happyThen (happyParse 12# tks) (\x -> happyReturn (happyOut46 x)) - -pListConcrete tks = happySomeParser where - happySomeParser = happyThen (happyParse 13# tks) (\x -> happyReturn (happyOut47 x)) - -pListFlag tks = happySomeParser where - happySomeParser = happyThen (happyParse 14# tks) (\x -> happyReturn (happyOut48 x)) - -pListCatDef tks = happySomeParser where - happySomeParser = happyThen (happyParse 15# tks) (\x -> happyReturn (happyOut49 x)) - -pListFunDef tks = happySomeParser where - happySomeParser = happyThen (happyParse 16# tks) (\x -> happyReturn (happyOut50 x)) - -pListLinDef tks = happySomeParser where - happySomeParser = happyThen (happyParse 17# tks) (\x -> happyReturn (happyOut51 x)) - -pListCId tks = happySomeParser where - happySomeParser = happyThen (happyParse 18# tks) (\x -> happyReturn (happyOut52 x)) - -pListTerm tks = happySomeParser where - happySomeParser = happyThen (happyParse 19# tks) (\x -> happyReturn (happyOut53 x)) - -pListExp tks = happySomeParser where - happySomeParser = happyThen (happyParse 20# tks) (\x -> happyReturn (happyOut54 x)) - -pListString tks = happySomeParser where - happySomeParser = happyThen (happyParse 21# tks) (\x -> happyReturn (happyOut55 x)) - -pListVariant tks = happySomeParser where - happySomeParser = happyThen (happyParse 22# tks) (\x -> happyReturn (happyOut56 x)) - -pHypo tks = happySomeParser where - happySomeParser = happyThen (happyParse 23# tks) (\x -> happyReturn (happyOut57 x)) - -pEquation tks = happySomeParser where - happySomeParser = happyThen (happyParse 24# tks) (\x -> happyReturn (happyOut58 x)) - -pListHypo tks = happySomeParser where - happySomeParser = happyThen (happyParse 25# tks) (\x -> happyReturn (happyOut59 x)) - -pListEquation tks = happySomeParser where - happySomeParser = happyThen (happyParse 26# tks) (\x -> happyReturn (happyOut60 x)) - -happySeq = happyDontSeq - -returnM :: a -> Err a -returnM = return - -thenM :: Err a -> (a -> Err b) -> Err b -thenM = (>>=) - -happyError :: [Token] -> Err a -happyError ts = - Bad $ "syntax error at " ++ tokenPos ts ++ - case ts of - [] -> [] - [Err _] -> " due to lexer error" - _ -> " before " ++ unwords (map prToken (take 4 ts)) - -myLexer = tokens -{-# LINE 1 "GenericTemplate.hs" #-} -{-# LINE 1 "<built-in>" #-} -{-# LINE 1 "<command line>" #-} -{-# LINE 1 "GenericTemplate.hs" #-} --- $Id$ - - -{-# LINE 28 "GenericTemplate.hs" #-} - - -data Happy_IntList = HappyCons Int# Happy_IntList - - - - - - -{-# LINE 49 "GenericTemplate.hs" #-} - - -{-# LINE 59 "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 - - - - - - - - - - - -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 "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) (\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 - -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. diff --git a/src/GF/GFCC/PrintGFCC.hs b/src/GF/GFCC/PrintGFCC.hs deleted file mode 100644 index 9eed30d61..000000000 --- a/src/GF/GFCC/PrintGFCC.hs +++ /dev/null @@ -1,217 +0,0 @@ -{-# OPTIONS -fno-warn-incomplete-patterns #-} -module GF.GFCC.PrintGFCC where - --- pretty-printer generated by the BNF converter - -import GF.GFCC.AbsGFCC -import Char - --- the top-level printing method -printTree :: Print a => a -> String -printTree = render . prt 0 - -type Doc = [ShowS] -> [ShowS] - -doc :: ShowS -> Doc -doc = (:) - -render :: Doc -> String -render d = rend 0 (map ($ "") $ d []) "" where - rend i ss = case ss of - "[" :ts -> showChar '[' . rend i ts - "(" :ts -> showChar '(' . rend i ts - "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts - "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts - "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts - ";" :ts -> showChar ';' . new i . rend i ts - t : "," :ts -> showString t . space "," . rend i ts - t : ")" :ts -> showString t . showChar ')' . rend i ts - t : "]" :ts -> showString t . showChar ']' . rend i ts - t :ts -> space t . rend i ts - _ -> id - new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace - space t = showString t . (\s -> if null s then "" else (' ':s)) - -parenth :: Doc -> Doc -parenth ss = doc (showChar '(') . ss . doc (showChar ')') - -concatS :: [ShowS] -> ShowS -concatS = foldr (.) id - -concatD :: [Doc] -> Doc -concatD = foldr (.) id - -replicateS :: Int -> ShowS -> ShowS -replicateS n f = concatS (replicate n f) - --- the printer class does the job -class Print a where - prt :: Int -> a -> Doc - prtList :: [a] -> Doc - prtList = concatD . map (prt 0) - -instance Print a => Print [a] where - prt _ = prtList - -instance Print Char where - prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'') - prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"') - -mkEsc :: Char -> Char -> ShowS -mkEsc q s = case s of - _ | s == q -> showChar '\\' . showChar s - '\\'-> showString "\\\\" - '\n' -> showString "\\n" - '\t' -> showString "\\t" - _ -> showChar s - -prPrec :: Int -> Int -> Doc -> Doc -prPrec i j = if j<i then parenth else id - - -instance Print Integer where - prt _ x = doc (shows x) - -instance Print Int where --H - prt _ x = doc (shows x) --H - -instance Print Double where - prt _ x = doc (shows x) - - - -instance Print CId where - prt _ (CId i) = doc (showString i) - prtList es = case es of - [] -> (concatD []) - [x] -> (concatD [prt 0 x]) - x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) - - - -instance Print Grammar where - prt i e = case e of - Grm cid cids flags abstract concretes -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 cid , doc (showString "(") , prt 0 cids , doc (showString ")") , doc (showString "(") , prt 0 flags , doc (showString ")") , doc (showString ";") , prt 0 abstract , doc (showString ";") , prt 0 concretes]) - - -instance Print Abstract where - prt i e = case e of - Abs flags fundefs catdefs -> prPrec i 0 (concatD [doc (showString "abstract") , doc (showString "{") , doc (showString "flags") , prt 0 flags , doc (showString "fun") , prt 0 fundefs , doc (showString "cat") , prt 0 catdefs , doc (showString "}")]) - - -instance Print Concrete where - prt i e = case e of - Cnc cid flags lindefs0 lindefs1 lindefs2 lindefs3 lindefs4 lindefs -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 cid , doc (showString "{") , doc (showString "flags") , prt 0 flags , doc (showString "lin") , prt 0 lindefs0 , doc (showString "oper") , prt 0 lindefs1 , doc (showString "lincat") , prt 0 lindefs2 , doc (showString "lindef") , prt 0 lindefs3 , doc (showString "printname") , prt 0 lindefs4 , doc (showString "param") , prt 0 lindefs , doc (showString "}")]) - - prtList es = case es of - [] -> (concatD []) - x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) - -instance Print Flag where - prt i e = case e of - Flg cid str -> prPrec i 0 (concatD [prt 0 cid , doc (showString "=") , prt 0 str]) - - prtList es = case es of - [] -> (concatD []) - x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) - -instance Print CatDef where - prt i e = case e of - Cat cid hypos -> prPrec i 0 (concatD [prt 0 cid , doc (showString "[") , prt 0 hypos , doc (showString "]")]) - - prtList es = case es of - [] -> (concatD []) - x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) - -instance Print FunDef where - prt i e = case e of - Fun cid type' exp -> prPrec i 0 (concatD [prt 0 cid , doc (showString ":") , prt 0 type' , doc (showString "=") , prt 0 exp]) - - prtList es = case es of - [] -> (concatD []) - x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) - -instance Print LinDef where - prt i e = case e of - Lin cid term -> prPrec i 0 (concatD [prt 0 cid , doc (showString "=") , prt 0 term]) - - prtList es = case es of - [] -> (concatD []) - x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) - -instance Print Type where - prt i e = case e of - DTyp hypos cid exps -> prPrec i 0 (concatD [doc (showString "[") , prt 0 hypos , doc (showString "]") , prt 0 cid , prt 0 exps]) - - -instance Print Exp where - prt i e = case e of - DTr cids atom exps -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "(") , prt 0 cids , doc (showString ")") , prt 0 atom , prt 0 exps , doc (showString "]")]) - EEq equations -> prPrec i 0 (concatD [doc (showString "{") , prt 0 equations , doc (showString "}")]) - - prtList es = case es of - [] -> (concatD []) - x:xs -> (concatD [prt 0 x , prt 0 xs]) - -instance Print Atom where - prt i e = case e of - AC cid -> prPrec i 0 (concatD [prt 0 cid]) - AS str -> prPrec i 0 (concatD [prt 0 str]) - AI n -> prPrec i 0 (concatD [prt 0 n]) - AF d -> prPrec i 0 (concatD [prt 0 d]) - AM n -> prPrec i 0 (concatD [doc (showString "?") , prt 0 n]) - AV cid -> prPrec i 0 (concatD [doc (showString "$") , prt 0 cid]) - - -instance Print Term where - prt i e = case e of - R terms -> prPrec i 0 (concatD [doc (showString "[") , prt 0 terms , doc (showString "]")]) - P term0 term -> prPrec i 0 (concatD [doc (showString "(") , prt 0 term0 , doc (showString "!") , prt 0 term , doc (showString ")")]) - S terms -> prPrec i 0 (concatD [doc (showString "(") , prt 0 terms , doc (showString ")")]) - K tokn -> prPrec i 0 (concatD [prt 0 tokn]) - V n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n]) - C n -> prPrec i 0 (concatD [prt 0 n]) - F cid -> prPrec i 0 (concatD [prt 0 cid]) - FV terms -> prPrec i 0 (concatD [doc (showString "[|") , prt 0 terms , doc (showString "|]")]) - W str term -> prPrec i 0 (concatD [doc (showString "(") , prt 0 str , doc (showString "+") , prt 0 term , doc (showString ")")]) - TM -> prPrec i 0 (concatD [doc (showString "?")]) - RP term0 term -> prPrec i 0 (concatD [doc (showString "(") , prt 0 term0 , doc (showString "@") , prt 0 term , doc (showString ")")]) - - prtList es = case es of - [] -> (concatD []) - [x] -> (concatD [prt 0 x]) - x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) - -instance Print Tokn where - prt i e = case e of - KS str -> prPrec i 0 (concatD [prt 0 str]) - KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "pre") , prt 0 strs , doc (showString "[") , prt 0 variants , doc (showString "]") , doc (showString "]")]) - - -instance Print Variant where - prt i e = case e of - Var strs0 strs -> prPrec i 0 (concatD [prt 0 strs0 , doc (showString "/") , prt 0 strs]) - - prtList es = case es of - [] -> (concatD []) - [x] -> (concatD [prt 0 x]) - x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) - -instance Print Hypo where - prt i e = case e of - Hyp cid type' -> prPrec i 0 (concatD [prt 0 cid , doc (showString ":") , prt 0 type']) - - prtList es = case es of - [] -> (concatD []) - [x] -> (concatD [prt 0 x]) - x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) - -instance Print Equation where - prt i e = case e of - Equ exps exp -> prPrec i 0 (concatD [prt 0 exps , doc (showString "->") , prt 0 exp]) - - prtList es = case es of - [] -> (concatD []) - x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) - - diff --git a/src/GF/GFCC/Raw/ConvertGFCC.hs b/src/GF/GFCC/Raw/ConvertGFCC.hs index 18ac742c4..16f75d9d5 100644 --- a/src/GF/GFCC/Raw/ConvertGFCC.hs +++ b/src/GF/GFCC/Raw/ConvertGFCC.hs @@ -1,4 +1,4 @@ -module GF.GFCC.Raw.ConvertGFCC where +module GF.GFCC.Raw.ConvertGFCC (toGFCC,fromGFCC) where import GF.GFCC.DataGFCC import GF.GFCC.Raw.AbsGFCCRaw @@ -7,9 +7,9 @@ import Data.Map -- convert parsed grammar to internal GFCC -mkGFCC :: Grammar -> GFCC -mkGFCC (Grm [ - App (CId "abstract") [AId a], +toGFCC :: Grammar -> GFCC +toGFCC (Grm [ + AId a, App (CId "concrete") cs, App (CId "flags") gfs, ab@( @@ -37,8 +37,7 @@ mkGFCC (Grm [ } where mkCnc ( - App (CId "concrete") [ - AId lang, + App lang [ App (CId "flags") fls, App (CId "lin") ls, App (CId "oper") ops, @@ -72,7 +71,9 @@ toHypo e = case e of toExp :: RExp -> Exp toExp e = case e of App fun [App (CId "abs") xs, App (CId "arg") exps] -> - DTr [x | AId x <- xs] (AC fun) (lmap toExp exps) + DTr [x | AId x <- xs] (AC fun) (lmap toExp exps) + App (CId "Eq") _ -> EEq [] ---- + AMet -> DTr [] (AM 0) [] _ -> error $ "exp " ++ show e toTerm :: RExp -> Term @@ -90,29 +91,69 @@ toTerm e = case e of AStr s -> K (KS s) ---- _ -> error $ "term " ++ show e +------------------------------ +--- from internal to parser -- +------------------------------ -{- --- convert internal GFCC and pretty-print it +fromGFCC :: GFCC -> Grammar +fromGFCC gfcc0 = Grm [ + AId (absname gfcc), + app "concrete" (lmap AId (cncnames gfcc)), + app "flags" [App f [AStr v] | (f,v) <- toList (gflags gfcc)], + app "abstract" [ + app "flags" [App f [AStr v] | (f,v) <- toList (aflags agfcc)], + app "fun" [App f [fromType t,fromExp d] | (f,(t,d)) <- toList (funs agfcc)], + app "cat" [App f (lmap fromHypo hs) | (f,hs) <- toList (cats agfcc)] + ], + app "concrete" [App lang (fromConcrete c) | (lang,c) <- toList (concretes gfcc)] + ] + where + gfcc = utf8GFCC gfcc0 + app s = App (CId s) + agfcc = abstract gfcc + fromConcrete cnc = [ + app "flags" [App f [AStr v] | (f,v) <- toList (cflags cnc)], + app "lin" [App f [fromTerm v] | (f,v) <- toList (lins cnc)], + app "oper" [App f [fromTerm v] | (f,v) <- toList (opers cnc)], + app "lincat" [App f [fromTerm v] | (f,v) <- toList (lincats cnc)], + app "lindef" [App f [fromTerm v] | (f,v) <- toList (lindefs cnc)], + app "printname" [App f [fromTerm v] | (f,v) <- toList (printnames cnc)], + app "param" [App f [fromTerm v] | (f,v) <- toList (paramlincats cnc)] + ] -printGFCC :: GFCC -> String -printGFCC gfcc0 = compactPrintGFCC $ printTree $ Grm - (absname gfcc) - (cncnames gfcc) - [Flg f v | (f,v) <- assocs (gflags gfcc)] - (Abs - [Flg f v | (f,v) <- assocs (aflags (abstract gfcc))] - [Fun f ty df | (f,(ty,df)) <- assocs (funs (abstract gfcc))] - [Cat f v | (f,v) <- assocs (cats (abstract gfcc))] - ) - [fromCnc lang cnc | (lang,cnc) <- assocs (concretes gfcc)] +fromType :: Type -> RExp +fromType e = case e of + DTyp hypos cat exps -> + App cat [ + App (CId "hypo") (lmap fromHypo hypos), + App (CId "arg") (lmap fromExp exps)] + +fromHypo :: Hypo -> RExp +fromHypo e = case e of + Hyp x typ -> App x [fromType typ] + +fromExp :: Exp -> RExp +fromExp e = case e of + DTr xs (AC fun) exps -> + App fun [App (CId "abs") (lmap AId xs), App (CId "arg") (lmap fromExp exps)] + DTr xs (AM _) exps -> AMet ---- + EEq _ -> App (CId "Eq") [] ---- + _ -> error $ "exp " ++ show e + +fromTerm :: Term -> RExp +fromTerm e = case e of + R es -> app "R" (lmap fromTerm es) + S es -> app "S" (lmap fromTerm es) + FV es -> app "FV" (lmap fromTerm es) + P e v -> app "P" [fromTerm e, fromTerm v] + RP e v -> app "RP" [fromTerm e, fromTerm v] ---- + W s v -> app "W" [AStr s, fromTerm v] + C i -> AInt (toInteger i) + TM -> AMet + F f -> AId f + V i -> App (CId "A") [AInt (toInteger i)] + K (KS s) -> AStr s ---- + K (KP d vs) -> app "FV" (str d : [str v | Var v _ <- vs]) ---- where - fromCnc lang cnc = Cnc lang - [Flg f v | (f,v) <- assocs (cflags cnc)] - [Lin f v | (f,v) <- assocs (lins cnc)] - [Lin f v | (f,v) <- assocs (opers cnc)] - [Lin f v | (f,v) <- assocs (lincats cnc)] - [Lin f v | (f,v) <- assocs (lindefs cnc)] - [Lin f v | (f,v) <- assocs (printnames cnc)] - [Lin f v | (f,v) <- assocs (paramlincats cnc)] - gfcc = utf8GFCC gfcc0 --} + app = App . CId + str v = app "S" (lmap AStr v) diff --git a/src/GF/GFCC/ShowLinearize.hs b/src/GF/GFCC/ShowLinearize.hs index ec4952cc2..a9365a13b 100644 --- a/src/GF/GFCC/ShowLinearize.hs +++ b/src/GF/GFCC/ShowLinearize.hs @@ -8,8 +8,8 @@ module GF.GFCC.ShowLinearize ( import GF.GFCC.Linearize import GF.GFCC.Macros import GF.GFCC.DataGFCC -import GF.GFCC.AbsGFCC -import GF.GFCC.PrintGFCC ---- +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) +--import GF.GFCC.PrintGFCC ---- import GF.Data.Operations import Data.List @@ -46,7 +46,7 @@ mkRecord typ trm = case (typ,trm) of (_,W s (R ts)) -> mkRecord typ (R [K (KS (s ++ u)) | K (KS u) <- ts]) (FV ps, C i) -> RCon $ str $ ps !! i (S [], _) -> RS $ realize trm - _ -> RS $ printTree trm + _ -> RS $ show trm ---- printTree trm where str = realize @@ -82,6 +82,6 @@ recLinearize gfcc lang exp = mkRecord typ $ linExp gfcc lang exp where -- show GFCC term termLinearize :: GFCC -> CId -> Exp -> String -termLinearize gfcc lang = printTree . linExp gfcc lang +termLinearize gfcc lang = show . linExp gfcc lang diff --git a/src/GF/Parsing/FCFG.hs b/src/GF/Parsing/FCFG.hs index 69c2e5d93..9fbd3d986 100644 --- a/src/GF/Parsing/FCFG.hs +++ b/src/GF/Parsing/FCFG.hs @@ -21,7 +21,8 @@ import GF.Formalism.Utilities import qualified GF.Parsing.FCFG.Active as Active import GF.Parsing.FCFG.PInfo -import GF.GFCC.AbsGFCC +import GF.GFCC.DataGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import GF.GFCC.Macros import GF.GFCC.ErrM diff --git a/src/GF/Parsing/FCFG/PInfo.hs b/src/GF/Parsing/FCFG/PInfo.hs index 2d7edb89d..dcdade261 100644 --- a/src/GF/Parsing/FCFG/PInfo.hs +++ b/src/GF/Parsing/FCFG/PInfo.hs @@ -15,7 +15,7 @@ import GF.Formalism.FCFG import GF.Data.SortedList import GF.Data.Assoc import GF.Parsing.FCFG.Range -import qualified GF.GFCC.AbsGFCC as AbsGFCC +import qualified GF.GFCC.Raw.AbsGFCCRaw as AbsGFCC import Data.Array import Data.Maybe diff --git a/src/GF/Parsing/GFC.hs b/src/GF/Parsing/GFC.hs index e84a2ec90..03700daf5 100644 --- a/src/GF/Parsing/GFC.hs +++ b/src/GF/Parsing/GFC.hs @@ -24,7 +24,8 @@ import GF.Data.Operations (Err(..)) import qualified GF.Grammar.Grammar as Grammar import qualified GF.Grammar.Macros as Macros import qualified GF.Canon.AbsGFC as AbsGFC -import qualified GF.GFCC.AbsGFCC as AbsGFCC +import qualified GF.GFCC.DataGFCC as AbsGFCC +import GF.GFCC.Raw.AbsGFCCRaw (CId (..)) import qualified GF.GFCC.ErrM as ErrM import qualified GF.Infra.Ident as Ident import GF.CF.CFIdent (CFCat, cfCat2Ident, CFTok, wordsCFTok, prCFTok) @@ -134,7 +135,7 @@ parse "m" strategy pinfo abs startCat inString -- parsing via FCFG parse "f" strategy pinfo abs startCat inString = let Ident.IC x = cfCat2Ident startCat - cat' = AbsGFCC.CId x + cat' = CId x in case PF.parseFCF strategy (fcfPInfo pinfo) cat' (map prCFTok inString) of ErrM.Ok es -> Ok (map (exp2term abs) es) ErrM.Bad msg -> Bad msg @@ -144,7 +145,7 @@ parse "f" strategy pinfo abs startCat inString = selectParser prs strategy _ _ _ = Bad $ "Parser '" ++ prs ++ "' not defined with strategy: " ++ strategy cnv_forests FMeta = FMeta -cnv_forests (FNode (Name (AbsGFCC.CId n) p) fss) = FNode (Name (Ident.IC n) (map cnv_profile p)) (map (map cnv_forests) fss) +cnv_forests (FNode (Name (CId n) p) fss) = FNode (Name (Ident.IC n) (map cnv_profile p)) (map (map cnv_forests) fss) cnv_forests (FString x) = FString x cnv_forests (FInt x) = FInt x cnv_forests (FFloat x) = FFloat x @@ -153,7 +154,7 @@ cnv_profile (Unify x) = Unify x cnv_profile (Constant x) = Constant (cnv_forests2 x) cnv_forests2 FMeta = FMeta -cnv_forests2 (FNode (AbsGFCC.CId n) fss) = FNode (Ident.IC n) (map (map cnv_forests2) fss) +cnv_forests2 (FNode (CId n) fss) = FNode (Ident.IC n) (map (map cnv_forests2) fss) cnv_forests2 (FString x) = FString x cnv_forests2 (FInt x) = FInt x cnv_forests2 (FFloat x) = FFloat x @@ -173,7 +174,7 @@ exp2term abs (AbsGFCC.DTr _ a es) = ---- TODO: bindings Macros.mkApp (atom2term abs a) (map (exp2term abs) es) atom2term :: Ident.Ident -> AbsGFCC.Atom -> Grammar.Term -atom2term abs (AbsGFCC.AC (AbsGFCC.CId f)) = Macros.qq (abs,Ident.IC f) +atom2term abs (AbsGFCC.AC (CId f)) = Macros.qq (abs,Ident.IC f) atom2term abs (AbsGFCC.AS s) = Macros.string2term s atom2term abs (AbsGFCC.AI n) = Macros.int2term n atom2term abs (AbsGFCC.AF f) = Macros.float2term f diff --git a/src/GF/Speech/GrammarToVoiceXML.hs b/src/GF/Speech/GrammarToVoiceXML.hs index f84033e9c..b120c5538 100644 --- a/src/GF/Speech/GrammarToVoiceXML.hs +++ b/src/GF/Speech/GrammarToVoiceXML.hs @@ -11,8 +11,8 @@ module GF.Speech.GrammarToVoiceXML (grammar2vxml) where import GF.Canon.CanonToGFCC (mkCanon2gfcc) -import qualified GF.GFCC.AbsGFCC as C -import GF.GFCC.DataGFCC (GFCC(..), Abstr(..), mkGFCC) +import qualified GF.GFCC.Raw.AbsGFCCRaw as C +import GF.GFCC.DataGFCC (GFCC(..), Abstr(..)) import GF.GFCC.Macros import qualified GF.Canon.GFC as GFC import GF.Canon.AbsGFC (Term) @@ -281,4 +281,4 @@ isConsFun f = "Cons" `isPrefixOf` prIdent f baseSize :: (VIdent, [(VIdent, [VIdent])]) -> Int baseSize (_,rules) = length bs where Just (_,bs) = find (isBaseFun . fst) rules --}
\ No newline at end of file +-} diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs index bcd61f428..076477d90 100644 --- a/src/GF/Speech/TransformCFG.hs +++ b/src/GF/Speech/TransformCFG.hs @@ -17,7 +17,7 @@ module GF.Speech.TransformCFG where import GF.Canon.CanonToGFCC (mkCanon2gfcc) -import qualified GF.GFCC.AbsGFCC as C +import qualified GF.GFCC.Raw.AbsGFCCRaw as C import GF.GFCC.Macros (lookType,catSkeleton) import GF.GFCC.DataGFCC (GFCC) import GF.Conversion.Types |