diff options
Diffstat (limited to 'src')
274 files changed, 76644 insertions, 0 deletions
diff --git a/src/FILES b/src/FILES new file mode 100644 index 000000000..1311108b6 --- /dev/null +++ b/src/FILES @@ -0,0 +1,260 @@ + +Code map for GF source files. + +$Author: peb $ +$Date: 2005/02/07 10:58:08 $ + +Directories: + +[top level] GF main function and runtime-related modules +api high-level access to GF functionalities +canonical GFC (= GF Canonical) basic functionalities +cf context-free skeleton used in parsing +cfgm multilingual context-free skeleton exported to Java +compile compilation phases from GF to GFC +conversions [OBSOLETE] formats used in parser generation +for-ghc GHC-specific files (Glasgow Haskell Compiler) +for-hugs Hugs-specific files (a Haskell interpreter) +for-windows Windows-specific files (an operating system from Microsoft) +grammar basic functionalities of GF grammars used in compilation +infra GF-independent infrastructure and auxiliaries +newparsing parsing with GF grammars: current version (cf. parsing) +notrace debugging utilities for parser development (cf. trace) +parsers parsers of GF and GFC files +parsing [OBSOLETE] parsing with GF grammars: old version (cf. newparsing) +shell interaction shells +source utilities for reading in GF source files +speech generation of speech recognition grammars +trace debugging utilities for parser development (cf. notrace) +useGrammar grammar functionalities for applications +util utilities for using GF + + +Individual files: + +GF.hs the Main module +GFModes.hs +HelpFile.hs [AUTO] help file generated by util/MkHelpFile +Today.hs [AUTO] file generated by "make today" + +api/API.hs high-level access to GF functionalities +api/BatchTranslate.hs +api/GetMyTree.hs +api/GrammarToHaskell.hs +api/IOGrammar.hs +api/MyParser.hs slot for defining your own parser + +canonical/AbsGFC.hs [AUTO] abstract syntax of GFC +canonical/CanonToGrammar.hs +canonical/CMacros.hs +canonical/ErrM.hs +canonical/GetGFC.hs +canonical/GFC.cf [LBNF] source of GFC parser +canonical/GFC.hs +canonical/LexGFC.hs +canonical/Look.hs +canonical/MkGFC.hs +canonical/PrExp.hs +canonical/PrintGFC.hs pretty-printer of GFC +canonical/Share.hs +canonical/SkelGFC.hs [AUTO] +canonical/TestGFC.hs [AUTO] +canonical/Unlex.hs + +cf/CanonToCF.hs +cf/CF.hs abstract syntax of context-free grammars +cf/CFIdent.hs +cf/CFtoGrammar.hs +cf/CFtoSRG.hs +cf/ChartParser.hs the current default parsing method +cf/EBNF.hs +cf/PPrCF.hs +cf/PrLBNF.hs +cf/Profile.hs + +cfgm/CFG.cf [LBNF] source +cfgm/AbsCFG.hs [AUTO] +cfgm/LexCFG.hs [AUTO] +cfgm/ParCFG.hs [AUTO] +cfgm/PrintCFG.hs [AUTO] +cfgm/PrintCFGrammar.hs + +compile/CheckGrammar.hs +compile/Compile.hs the complete compiler pipeline +compile/Extend.hs +compile/GetGrammar.hs +compile/GrammarToCanon.hs +compile/MkResource.hs +compile/MkUnion.hs +compile/ModDeps.hs +compile/Optimize.hs +compile/PGrammar.hs +compile/PrOld.hs +compile/Rebuild.hs +compile/RemoveLiT.hs +compile/Rename.hs +compile/ShellState.hs the run-time multilingual grammar datastructure +compile/Update.hs + +for-ghc/ArchEdit.hs +for-ghc/Arch.hs + +for-ghc-nofud/ArchEdit.hs@ +for-ghc-nofud/Arch.hs@ + +for-hugs/ArchEdit.hs +for-hugs/Arch.hs +for-hugs/JGF.hs +for-hugs/MoreCustom.hs +for-hugs/Unicode.hs + +for-hugs/Arch.hs +for-hugs/ArchEdit.hs +for-hugs/JGF.hs +for-hugs/LexCFG.hs dummy CFG lexer +for-hugs/LexGF.hs dummy GF lexer +for-hugs/LexGFC.hs dummy GFC lexer +for-hugs/MoreCustom.hs +for-hugs/ParCFG.hs dummy CFG parser +for-hugs/ParGFC.hs dummy GFC parser +for-hugs/ParGF.hs dummy GF parser +for-hugs/Tracing.hs +for-hugs/Unicode.hs + +for-windows/ArchEdit.hs +for-windows/Arch.hs + +grammar/AbsCompute.hs +grammar/Abstract.hs GF and GFC abstract syntax datatypes +grammar/AppPredefined.hs +grammar/Compute.hs +grammar/Grammar.hs GF source grammar datatypes +grammar/LookAbs.hs +grammar/Lookup.hs +grammar/Macros.hs macros for creating GF terms and types +grammar/MMacros.hs more macros, mainly for abstract syntax +grammar/PatternMatch.hs +grammar/PrGrammar.hs the top-level grammar printer +grammar/Refresh.hs +grammar/ReservedWords.hs +grammar/TC.hs Coquand's type checking engine +grammar/TypeCheck.hs +grammar/Unify.hs +grammar/Values.hs + +infra/Arabic.hs ASCII coding of Arabic Unicode +infra/Assoc.hs finite maps/association lists as binary search trees +infra/CheckM.hs +infra/Comments.hs +infra/Devanagari.hs ASCII coding of Devanagari Unicode +infra/ErrM.hs +infra/Ethiopic.hs +infra/EventF.hs +infra/ExtendedArabic.hs +infra/ExtraDiacritics.hs +infra/FudgetOps.hs +infra/Glue.hs +infra/Greek.hs +infra/Hebrew.hs +infra/Hiragana.hs +infra/Ident.hs +infra/LatinASupplement.hs +infra/Map.hs finite maps as red black trees +infra/Modules.hs +infra/OCSCyrillic.hs +infra/Operations.hs library of strings, search trees, error monads +infra/Option.hs +infra/OrdMap2.hs abstract class of finite maps + implementation as association lists +infra/OrdSet.hs abstract class of sets + implementation as sorted lists +infra/Parsers.hs +infra/ReadFiles.hs +infra/RedBlack.hs red black trees +infra/RedBlackSet.hs sets and maps as red black trees +infra/Russian.hs +infra/SortedList.hs sets as sorted lists +infra/Str.hs +infra/Tamil.hs +infra/Text.hs +infra/Trie2.hs +infra/Trie.hs +infra/UnicodeF.hs +infra/Unicode.hs +infra/UseIO.hs +infra/UTF8.hs UTF3 en/decoding +infra/Zipper.hs + +newparsing/CFGrammar.hs type definitions for context-free grammars +newparsing/CFParserGeneral.hs several variants of general CFG chart parsing +newparsing/CFParserIncremental.hs several variants of incremental (Earley-style) CFG chart parsing +newparsing/ConvertGFCtoMCFG.hs converting GFC to MCFG +newparsing/ConvertGrammar.hs conversions between different grammar formats +newparsing/ConvertMCFGtoCFG.hs converting MCFG to CFG +newparsing/GeneralChart.hs Haskell framework for "parsing as deduction" +newparsing/GrammarTypes.hs instantiations of grammar types +newparsing/IncrementalChart.hs Haskell framework for incremental chart parsing +newparsing/MCFGrammar.hs type definitions for multiple CFG +newparsing/MCFParserBasic.hs MCFG chart parser +newparsing/MCFRange.hs ranges for MCFG parsing +newparsing/ParseCFG.hs parsing of CFG +newparsing/ParseCF.hs parsing of the CF format +newparsing/ParseGFC.hs parsing of GFC +newparsing/ParseMCFG.hs parsing of MCFG +newparsing/Parser.hs general definitions for parsers +newparsing/PrintParser.hs pretty-printing class for parsers +newparsing/PrintSimplifiedTerm.hs simplified pretty-printing for GFC terms + +notrace/Tracing.hs tracing predicates when we DON'T want tracing capabilities (normal case) + +parsers/ParGFC.hs [AUTO] +parsers/ParGF.hs [AUTO] + +shell/CommandF.hs +shell/CommandL.hs line-based syntax of editor commands +shell/Commands.hs commands of GF editor shell +shell/IDE.hs +shell/JGF.hs +shell/PShell.hs +shell/ShellCommands.hs commands of GF main shell +shell/Shell.hs +shell/SubShell.hs +shell/TeachYourself.hs + +source/AbsGF.hs [AUTO] +source/ErrM.hs +source/GF.cf [LBNF] source of GF parser +source/GrammarToSource.hs +source/LexGF.hs [AUTO] +source/PrintGF.hs [AUTO] +source/SourceToGrammar.hs + +speech/PrGSL.hs +speech/PrJSGF.hs +speech/SRG.hs +speech/TransformCFG.hs + +trace/Tracing.hs tracing predicates when we want tracing capabilities + +translate/GFT.hs Main module of html-producing batch translator + +useGrammar/Custom.hs database for customizable commands +useGrammar/Editing.hs +useGrammar/Generate.hs +useGrammar/GetTree.hs +useGrammar/Information.hs +useGrammar/Linear.hs the linearization algorithm +useGrammar/MoreCustom.hs +useGrammar/Morphology.hs +useGrammar/Paraphrases.hs +useGrammar/Parsing.hs the top-level parsing algorithm +useGrammar/Randomized.hs +useGrammar/RealMoreCustom.hs +useGrammar/Session.hs +useGrammar/TeachYourself.hs +useGrammar/Tokenize.hs lexer definitions (listed in Custom) +useGrammar/Transfer.hs + +util/GFDoc.hs utility for producing LaTeX and HTML from GF +util/HelpFile source of ../HelpFile.hs +util/Htmls.hs utility for chopping a HTML document to slides +util/MkHelpFile.hs +util/WriteF.hs diff --git a/src/GF.hs b/src/GF.hs new file mode 100644 index 000000000..5b1776987 --- /dev/null +++ b/src/GF.hs @@ -0,0 +1,41 @@ +{-# OPTIONS -cpp #-} +module Main where + +import GFC +import GFI +import GF.Data.ErrM +import GF.Infra.Option +import GF.Infra.UseIO +import Paths_gf + +import Data.Version +import System.Environment (getArgs) +import System.Exit +import System.IO +#ifdef mingw32_HOST_OS +import System.Win32.Console +import System.Win32.NLS +#endif + +main :: IO () +main = do +#ifdef mingw32_HOST_OS + codepage <- getACP + setConsoleCP codepage + setConsoleOutputCP codepage +#endif + args <- getArgs + case parseOptions args of + Ok (opts,files) -> mainOpts opts files + Bad err -> do hPutStrLn stderr err + hPutStrLn stderr "You may want to try --help." + exitFailure + +mainOpts :: Options -> [FilePath] -> IO () +mainOpts opts files = + case flag optMode opts of + ModeVersion -> putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version + ModeHelp -> putStrLn helpMessage + ModeInteractive -> mainGFI opts files + ModeCompiler -> dieIOE (mainGFC opts files) + diff --git a/src/GF/Command/Abstract.hs b/src/GF/Command/Abstract.hs new file mode 100644 index 000000000..29111b432 --- /dev/null +++ b/src/GF/Command/Abstract.hs @@ -0,0 +1,67 @@ +module GF.Command.Abstract where + +import PGF.Data + +type Ident = String + +type CommandLine = [Pipe] + +type Pipe = [Command] + +data Command + = Command Ident [Option] Argument + deriving (Eq,Ord,Show) + +data Option + = OOpt Ident + | OFlag Ident Value + deriving (Eq,Ord,Show) + +data Value + = VId Ident + | VInt Integer + | VStr String + deriving (Eq,Ord,Show) + +data Argument + = ATree Tree + | ANoArg + | AMacro Ident + deriving (Eq,Ord,Show) + +valIdOpts :: String -> String -> [Option] -> String +valIdOpts flag def opts = case valOpts flag (VId def) opts of + VId v -> v + _ -> def + +valIntOpts :: String -> Integer -> [Option] -> Int +valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of + VInt v -> v + _ -> def + +valStrOpts :: String -> String -> [Option] -> String +valStrOpts flag def opts = case valOpts flag (VStr def) opts of + VStr v -> v + _ -> def + +valOpts :: String -> Value -> [Option] -> Value +valOpts flag def opts = case lookup flag flags of + Just v -> v + _ -> def + where + flags = [(f,v) | OFlag f v <- opts] + +isOpt :: String -> [Option] -> Bool +isOpt o opts = elem o [x | OOpt x <- opts] + +isFlag :: String -> [Option] -> Bool +isFlag o opts = elem o [x | OFlag x _ <- opts] + +prOpt :: Option -> String +prOpt o = case o of + OOpt i -> i + OFlag f x -> f ++ "=" ++ show x + +mkOpt :: String -> Option +mkOpt = OOpt + diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs new file mode 100644 index 000000000..96e7c57f4 --- /dev/null +++ b/src/GF/Command/Commands.hs @@ -0,0 +1,603 @@ +module GF.Command.Commands ( + allCommands, + lookCommand, + exec, + isOpt, + options, + flags, + CommandInfo, + CommandOutput + ) where + +import PGF +import PGF.CId +import PGF.ShowLinearize +import PGF.Macros +import PGF.Data ---- +import PGF.Morphology +import PGF.Quiz +import PGF.VisualizeTree +import GF.Compile.Export +import GF.Infra.Option (noOptions) +import GF.Infra.UseIO +import GF.Data.ErrM ---- +import PGF.Expr (readTree) +import GF.Command.Abstract +import GF.Text.Lexing +import GF.Text.Transliterations + +import GF.Data.Operations + +import Data.Maybe +import qualified Data.Map as Map +import System.Cmd + +import Debug.Trace + +type CommandOutput = ([Tree],String) ---- errors, etc + +data CommandInfo = CommandInfo { + exec :: [Option] -> [Tree] -> IO CommandOutput, + synopsis :: String, + syntax :: String, + explanation :: String, + longname :: String, + options :: [(String,String)], + flags :: [(String,String)], + examples :: [String] + } + +emptyCommandInfo :: CommandInfo +emptyCommandInfo = CommandInfo { + exec = \_ ts -> return (ts,[]), ---- + synopsis = "", + syntax = "", + explanation = "", + longname = "", + options = [], + flags = [], + examples = [] + } + +lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo +lookCommand = Map.lookup + +commandHelpAll :: PGF -> [Option] -> String +commandHelpAll pgf opts = unlines + [commandHelp (isOpt "full" opts) (co,info) + | (co,info) <- Map.assocs (allCommands pgf)] + +commandHelp :: Bool -> (String,CommandInfo) -> String +commandHelp full (co,info) = unlines $ [ + co ++ ", " ++ longname info, + synopsis info] ++ if full then [ + "", + "syntax:" ++++ " " ++ syntax info, + "", + explanation info, + "options:" ++++ unlines [" -" ++ o ++ "\t" ++ e | (o,e) <- options info], + "flags:" ++++ unlines [" -" ++ o ++ "\t" ++ e | (o,e) <- flags info], + "examples:" ++++ unlines [" " ++ s | s <- examples info] + ] else [] + +-- this list must no more be kept sorted by the command name +allCommands :: PGF -> Map.Map String CommandInfo +allCommands pgf = Map.fromList [ + ("cc", emptyCommandInfo { + longname = "compute_concrete", + syntax = "cc (-all | -table | -unqual)? TERM", + synopsis = "computes concrete syntax term using a source grammar", + explanation = unlines [ + "Compute TERM by concrete syntax definitions. Uses the topmost", + "module (the last one imported) to resolve constant names.", + "N.B.1 You need the flag -retain when importing the grammar, if you want", + "the definitions to be retained after compilation.", + "N.B.2 The resulting term is not a tree in the sense of abstract syntax", + "and hence not a valid input to a Tree-expecting command.", + "This command must be a line of its own, and thus cannot be a part", + "of a pipe." + ], + options = [ + ("all","pick all strings (forms and variants) from records and tables"), + ("table","show all strings labelled by parameters"), + ("unqual","hide qualifying module names") + ] + }), + ("dc", emptyCommandInfo { + longname = "define_command", + syntax = "dc IDENT COMMANDLINE", + synopsis = "define a command macro", + explanation = unlines [ + "Defines IDENT as macro for COMMANDLINE, until IDENT gets redefined.", + "A call of the command has the form %IDENT. The command may take an", + "argument, which in COMMANDLINE is marked as ?0. Both strings and", + "trees can be arguments. Currently at most one argument is possible.", + "This command must be a line of its own, and thus cannot be a part", + "of a pipe." + ] + }), + ("dt", emptyCommandInfo { + longname = "define_tree", + syntax = "dt IDENT (TREE | STRING | \"<\" COMMANDLINE)", + synopsis = "define a tree or string macro", + explanation = unlines [ + "Defines IDENT as macro for TREE or STRING, until IDENT gets redefined.", + "The defining value can also come from a command, preceded by \"<\".", + "If the command gives many values, the first one is selected.", + "A use of the macro has the form %IDENT. Currently this use cannot be", + "a subtree of another tree. This command must be a line of its own", + "and thus cannot be a part of a pipe." + ], + examples = [ + ("dt ex \"hello world\" -- define ex as string"), + ("dt ex UseN man_N -- define ex as string"), + ("dt ex < p -cat=NP \"the man in the car\" -- define ex as parse result"), + ("l -lang=LangSwe %ex | ps -to_utf8 -- linearize the tree ex") + ] + }), + ("e", emptyCommandInfo { + longname = "empty", + synopsis = "empty the environment" + }), + ("gr", emptyCommandInfo { + longname = "generate_random", + synopsis = "generate random trees in the current abstract syntax", + syntax = "gr [-cat=CAT] [-number=INT]", + examples = [ + "gr -- one tree in the startcat of the current grammar", + "gr -cat=NP -number=16 -- 16 trees in the category NP" + ], + explanation = unlines [ + "Generates a list of random trees, by default one tree." +---- "If a tree argument is given, the command completes the Tree with values to", +---- "the metavariables in the tree." + ], + flags = [ + ("cat","generation category"), + ("lang","excludes functions that have no linearization in this language"), + ("number","number of trees generated") + ], + exec = \opts _ -> do + let pgfr = optRestricted opts + ts <- generateRandom pgfr (optCat opts) + return $ fromTrees $ take (optNum opts) ts + }), + ("gt", emptyCommandInfo { + longname = "generate_trees", + synopsis = "generates a list of trees, by default exhaustive", + explanation = unlines [ + "Generates all trees of a given category, with increasing depth.", + "By default, the depth is 4, but this can be changed by a flag." + ---- "If a Tree argument is given, the command completes the Tree with values", + ---- "to the metavariables in the tree." + ], + flags = [ + ("cat","the generation category"), + ("depth","the maximum generation depth"), + ("lang","excludes functions that have no linearization in this language"), + ("number","the number of trees generated") + ], + exec = \opts _ -> do + let pgfr = optRestricted opts + let dp = return $ valIntOpts "depth" 4 opts + let ts = generateAllDepth pgfr (optCat opts) dp + return $ fromTrees $ take (optNumInf opts) ts + }), + ("h", emptyCommandInfo { + longname = "help", + syntax = "h (-full)? COMMAND?", + synopsis = "get description of a command, or a the full list of commands", + explanation = unlines [ + "Displays information concerning the COMMAND.", + "Without argument, shows the synopsis of all commands." + ], + options = [ + ("full","give full information of the commands") + ], + exec = \opts ts -> return ([], case ts of + [t] -> let co = showTree t in + case lookCommand co (allCommands pgf) of ---- new map ??!! + Just info -> commandHelp True (co,info) + _ -> "command not found" + _ -> commandHelpAll pgf opts) + }), + ("i", emptyCommandInfo { + longname = "import", + synopsis = "import a grammar from source code or compiled .pgf file", + explanation = unlines [ + "Reads a grammar from File and compiles it into a GF runtime grammar.", + "If a grammar with the same concrete name is already in the state", + "it is overwritten - but only if compilation succeeds.", + "The grammar parser depends on the file name suffix:", + " .gf normal GF source", + " .gfo compiled GF source", + " .pgf precompiled grammar in Portable Grammar Format" + ], + options = [ + -- ["prob", "retain", "gfo", "src", "no-cpu", "cpu", "quiet", "verbose"] + ("retain","retain operations (used for cc command)"), + ("src", "force compilation from source"), + ("v", "be verbose - show intermediate status information") + ] + }), + ("l", emptyCommandInfo { + longname = "linearize", + synopsis = "convert an abstract syntax expression to string", + explanation = unlines [ + "Shows the linearization of a Tree by the grammars in scope.", + "The -lang flag can be used to restrict this to fewer languages.", + "A sequence of string operations (see command ps) can be given", + "as options, and works then like a pipe to the ps command, except", + "that it only affect the strings, not e.g. the table labels.", + "These can be given separately to each language with the unlexer flag", + "whose results are prepended to the other lexer flags. The value of the", + "unlexer flag is a space-separated list of comma-separated string operation", + "sequences; see example." + ], + examples = [ + "l -langs=LangSwe,LangNor no_Utt -- linearize tree to LangSwe and LangNor", + "gr -lang=LangHin -cat=Cl | l -table -to_devanagari -to_utf8 -- hindi table", + "l -unlexer=\"LangSwe=to_utf8 LangHin=to_devanagari,to_utf8\" -- different lexers" + ], + exec = \opts -> return . fromStrings . map (optLin opts), + options = [ + ("all","show all forms and variants"), + ("record","show source-code-like record"), + ("table","show all forms labelled by parameters"), + ("term", "show PGF term"), + ("treebank","show the tree and tag linearizations with language names") + ] ++ stringOpOptions, + flags = [ + ("lang","the languages of linearization (comma-separated, no spaces)"), + ("unlexer","set unlexers separately to each language (space-separated)") + ] + }), + ("ma", emptyCommandInfo { + longname = "morpho_analyse", + synopsis = "print the morphological analyses of all words in the string", + explanation = unlines [ + "Prints all the analyses of space-separated words in the input string,", + "using the morphological analyser of the actual grammar (see command pf)" + ], + exec = \opts -> + return . fromString . unlines . + map prMorphoAnalysis . concatMap (morphos opts) . + concatMap words . toStrings + }), + + ("mq", emptyCommandInfo { + longname = "morpho_quiz", + synopsis = "start a morphology quiz", + exec = \opts _ -> do + let lang = optLang opts + let cat = optCat opts + morphologyQuiz pgf lang cat + return void, + flags = [ + ("lang","language of the quiz"), + ("cat","category of the quiz"), + ("number","maximum number of questions") + ] + }), + + ("p", emptyCommandInfo { + longname = "parse", + synopsis = "parse a string to abstract syntax expression", + explanation = unlines [ + "Shows all trees returned by parsing a string in the grammars in scope.", + "The -lang flag can be used to restrict this to fewer languages.", + "The default start category can be overridden by the -cat flag.", + "See also the ps command for lexing and character encoding." + ], + exec = \opts -> return . fromTrees . concatMap (par opts) . toStrings, + flags = [ + ("cat","target category of parsing"), + ("lang","the languages of parsing (comma-separated, no spaces)") + ] + }), + ("pg", emptyCommandInfo { ----- + longname = "print_grammar", + synopsis = "print the actual grammar with the given printer", + explanation = unlines [ + "Prints the actual grammar, with all involved languages.", + "In some printers, this can be restricted to a subset of languages", + "with the -lang=X,Y flag (comma-separated, no spaces).", + "The -printer=P flag sets the format in which the grammar is printed.", + "N.B.1 Since grammars are compiled when imported, this command", + "generally shows a grammar that looks rather different from the source.", + "N.B.2 This command is slightly obsolete: to produce different formats", + "the batch compiler gfc is recommended, and has many more options." + ], + exec = \opts _ -> return $ fromString $ prGrammar opts, + flags = [ + --"cat", + ("lang", "select languages for the some options (default all languages)"), + ("printer","select the printing format (see gfc --help)") + ], + options = [ + ("cats", "show just the names of abstract syntax categories"), + ("fullform", "print the fullform lexicon"), + ("missing","show just the names of functions that have no linearization") + ] + }), + ("ph", emptyCommandInfo { + longname = "print_history", + synopsis = "print command history", + explanation = unlines [ + "Prints the commands issued during the GF session.", + "The result is readable by the eh command.", + "The result can be used as a script when starting GF." + ], + examples = [ + "ph | wf -file=foo.gfs -- save the history into a file" + ] + }), + ("ps", emptyCommandInfo { + longname = "put_string", + syntax = "ps OPT? STRING", + synopsis = "return a string, possibly processed with a function", + explanation = unlines [ + "Returns a string obtained from its argument string by applying", + "string processing functions in the order given in the command line", + "option list. Thus 'ps -f -g s' returns g (f s). Typical string processors", + "are lexers and unlexers, but also character encoding conversions are possible.", + "The unlexers preserve the division of their input to lines.", + "To see transliteration tables, use command ut." + ], + examples = [ + "l (EAdd 3 4) | ps -code -- linearize code-like output", + "ps -lexer=code | p -cat=Exp -- parse code-like input", + "gr -cat=QCl | l | ps -bind -to_utf8 -- linearization output from LangFin", + "ps -from_utf8 \"jag ?r h?r\" | p -- parser in LangSwe in UTF8 terminal", + "ps -to_devanagari -to_utf8 \"A-p\" -- show Devanagari in UTF8 terminal" + ], + exec = \opts -> return . fromString . stringOps (map prOpt opts) . toString, + options = stringOpOptions + }), + ("q", emptyCommandInfo { + longname = "quit", + synopsis = "exit GF interpreter" + }), + ("rf", emptyCommandInfo { + longname = "read_file", + synopsis = "read string or tree input from a file", + explanation = unlines [ + "Reads input from file. The filename must be in double quotes.", + "The input is interpreted as a string by default, and can hence be", + "piped e.g. to the parse command. The option -tree interprets the", + "input as a tree, which can be given e.g. to the linearize command.", + "The option -lines will result in a list of strings or trees, one by line." + ], + options = [ + ("lines","return the list of lines, instead of the singleton of all contents"), + ("tree","convert strings into trees") + ], + exec = \opts arg -> do + let file = valIdOpts "file" "_gftmp" opts + s <- readFile file + return $ case opts of + _ | isOpt "lines" opts && isOpt "tree" opts -> + fromTrees [t | l <- lines s, Just t <- [readTree l]] + _ | isOpt "tree" opts -> + fromTrees [t | Just t <- [readTree s]] + _ | isOpt "lines" opts -> fromStrings $ lines s + _ -> fromString s, + flags = [("file","the input file name")] + }), + ("tq", emptyCommandInfo { + longname = "translation_quiz", + synopsis = "start a translation quiz", + exec = \opts _ -> do + let from = valIdOpts "from" (optLang opts) opts + let to = valIdOpts "to" (optLang opts) opts + let cat = optCat opts + translationQuiz pgf from to cat + return void, + flags = [ + ("from","translate from this language"), + ("to","translate to this language"), + ("cat","translate in this category"), + ("number","the maximum number of questions") + ] + }), + ("sp", emptyCommandInfo { + longname = "system_pipe", + synopsis = "send argument to a system command", + syntax = "sp -command=\"SYSTEMCOMMAND\" STRING", + exec = \opts arg -> do + let tmpi = "_tmpi" --- + let tmpo = "_tmpo" + writeFile tmpi $ toString arg + let syst = optComm opts ++ " " ++ tmpi + system $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo + s <- readFile tmpo + return $ fromString s, + flags = [ + ("command","the system command applied to the argument") + ], + examples = [ + "ps -command=\"wc\" \"foo\"", + "gt | l | sp -command=\"grep \\\"who\\\"\" | sp -command=\"wc\"" + ] + }), + ("ut", emptyCommandInfo { + longname = "unicode_table", + synopsis = "show a transliteration table for a unicode character set", + exec = \opts arg -> do + let t = concatMap prOpt (take 1 opts) + let out = maybe "no such transliteration" characterTable $ transliteration t + return $ fromString out, + options = [ + ("devanagari","Devanagari"), + ("thai", "Thai") + ] + }), + ("vt", emptyCommandInfo { + longname = "visualize_tree", + synopsis = "show a set of trees graphically", + explanation = unlines [ + "Prints a set of trees in the .dot format (the graphviz format).", + "The graph can be saved in a file by the wf command as usual.", + "If the -view flag is defined, the graph is saved in a temporary file", + "which is processed by graphviz and displayed by the program indicated", + "by the flag. The target format is postscript, unless overridden by the", + "flag -format." + ], + exec = \opts ts -> do + let funs = not (isOpt "nofun" opts) + let cats = not (isOpt "nocat" opts) + let grph = visualizeTrees pgf (funs,cats) ts -- True=digraph + if isFlag "view" opts || isFlag "format" opts then do + let file s = "_grph." ++ s + let view = optViewGraph opts ++ " " + let format = optViewFormat opts + writeFile (file "dot") grph + system $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format ++ + " ; " ++ view ++ file format + return void + else return $ fromString grph, + examples = [ + "p \"hello\" | vt -- parse a string and show trees as graph script", + "p \"hello\" | vt -view=\"open\" -- parse a string and display trees on a Mac" + ], + options = [ + ("nofun","don't show functions but only categories"), + ("nocat","don't show categories but only functions") + ], + flags = [ + ("format","format of the visualization file (default \"ps\")"), + ("view","program to open the resulting file (default \"gv\")") + ] + }), + ("wf", emptyCommandInfo { + longname = "write_file", + synopsis = "send string or tree to a file", + exec = \opts arg -> do + let file = valIdOpts "file" "_gftmp" opts + if isOpt "append" opts + then appendFile file (toString arg) + else writeFile file (toString arg) + return void, + options = [ + ("append","append to file, instead of overwriting it") + ], + flags = [("file","the output filename")] + }) + ] + where + lin opts t = unlines [linearize pgf lang t | lang <- optLangs opts] + par opts s = concat [parse pgf lang (optCat opts) s | lang <- optLangs opts] + + void = ([],[]) + + optLin opts t = case opts of + _ | isOpt "treebank" opts -> treebank opts t + _ -> unlines [linear opts lang t | lang <- optLangs opts] + + linear opts lang = let unl = unlex opts lang in case opts of + _ | isOpt "all" opts -> allLinearize unl pgf (mkCId lang) + _ | isOpt "table" opts -> tableLinearize unl pgf (mkCId lang) + _ | isOpt "term" opts -> termLinearize pgf (mkCId lang) + _ | isOpt "record" opts -> recordLinearize pgf (mkCId lang) + _ -> unl . linearize pgf lang + + treebank opts t = unlines $ + (abstractName pgf ++ ": " ++ showTree t) : + [lang ++ ": " ++ linear opts lang t | lang <- optLangs opts] + + unlex opts lang = stringOps (getUnlex opts lang ++ map prOpt opts) + + getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of + lexs -> case lookup lang + [(la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of + Just le -> chunks ',' le + _ -> [] + +-- Proposed logic of coding in unlexing: +-- - If lang has no coding flag, or -to_utf8 is not in opts, just opts are used. +-- - If lang has flag coding=utf8, -to_utf8 is ignored. +-- - If lang has coding=other, and -to_utf8 is in opts, from_other is applied first. +-- THIS DOES NOT WORK UNFORTUNATELY - can't use the grammar flag properly + unlexx opts lang = {- trace (unwords optsC) $ -} stringOps optsC where + optsC = case lookFlag pgf lang "coding" of + Just "utf8" -> filter (/="to_utf8") $ map prOpt opts + Just other | isOpt "to_utf8" opts -> + let cod = ("from_" ++ other) + in cod : filter (/=cod) (map prOpt opts) + _ -> map prOpt opts + + optRestricted opts = restrictPGF (hasLin pgf (mkCId (optLang opts))) pgf + + optLangs opts = case valIdOpts "lang" "" opts of + "" -> languages pgf + lang -> chunks ',' lang + optLang opts = head $ optLangs opts ++ ["#NOLANG"] + optCat opts = valIdOpts "cat" (lookStartCat pgf) opts + optComm opts = valStrOpts "command" "" opts + optViewFormat opts = valStrOpts "format" "ps" opts + optViewGraph opts = valStrOpts "view" "gv" opts + optNum opts = valIntOpts "number" 1 opts + optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9 + + fromTrees ts = (ts,unlines (map showTree ts)) + fromStrings ss = (map (Lit . LStr) ss, unlines ss) + fromString s = ([Lit (LStr s)], s) + toStrings ts = [s | Lit (LStr s) <- ts] + toString ts = unwords [s | Lit (LStr s) <- ts] + + prGrammar opts = case opts of + _ | isOpt "cats" opts -> unwords $ categories pgf + _ | isOpt "fullform" opts -> concatMap + (prFullFormLexicon . buildMorpho pgf . mkCId) $ optLangs opts + _ | isOpt "missing" opts -> + unlines $ [unwords (la:":": map prCId cs) | + la <- optLangs opts, let cs = missingLins pgf (mkCId la)] + _ -> case valIdOpts "printer" "pgf" opts of + v -> concatMap snd $ exportPGF noOptions (read v) pgf + + morphos opts s = + [lookupMorpho (buildMorpho pgf (mkCId la)) s | la <- optLangs opts] + + -- ps -f -g s returns g (f s) + stringOps opts s = foldr app s (reverse opts) where + app f = maybe id id (stringOp f) + +stringOpOptions = [ + ("bind","bind tokens separated by Prelude.BIND, i.e. &+"), + ("chars","lexer that makes every non-space character a token"), + ("from_cp1251","decode from cp1251 (Cyrillic used in Bulgarian resource)"), + ("from_devanagari","from unicode to GF Devanagari transliteration"), + ("from_thai","from unicode to GF Thai transliteration"), + ("from_utf8","decode from utf8"), + ("lextext","text-like lexer"), + ("lexcode","code-like lexer"), + ("lexmixed","mixture of text and code (code between $...$)"), + ("to_cp1251","encode to cp1251 (Cyrillic used in Bulgarian resource)"), + ("to_devanagari","from GF Devanagari transliteration to unicode"), + ("to_html","wrap in a html file with linebreaks"), + ("to_thai","from GF Thai transliteration to unicode"), + ("to_utf8","encode to utf8"), + ("unlextext","text-like unlexer"), + ("unlexcode","code-like unlexer"), + ("unlexmixed","mixture of text and code (code between $...$)"), + ("unchars","unlexer that puts no spaces between tokens"), + ("unwords","unlexer that puts a single space between tokens (default)"), + ("words","lexer that assumes tokens separated by spaces (default)") + ] + +translationQuiz :: PGF -> Language -> Language -> Category -> IO () +translationQuiz pgf ig og cat = do + tts <- translationList pgf ig og cat infinity + mkQuiz "Welcome to GF Translation Quiz." tts + +morphologyQuiz :: PGF -> Language -> Category -> IO () +morphologyQuiz pgf ig cat = do + tts <- morphologyList pgf ig cat infinity + mkQuiz "Welcome to GF Morphology Quiz." tts + +-- | the maximal number of precompiled quiz problems +infinity :: Int +infinity = 256 + +lookFlag :: PGF -> String -> String -> Maybe String +lookFlag pgf lang flag = lookConcrFlag pgf (mkCId lang) (mkCId flag) diff --git a/src/GF/Command/Importing.hs b/src/GF/Command/Importing.hs new file mode 100644 index 000000000..c3ad9d746 --- /dev/null +++ b/src/GF/Command/Importing.hs @@ -0,0 +1,37 @@ +module GF.Command.Importing (importGrammar, importSource) where + +import PGF +import PGF.Data + +import GF.Compile +import GF.Grammar.Grammar (SourceGrammar) -- for cc command +import GF.Infra.UseIO +import GF.Infra.Option +import GF.Data.ErrM + +import Data.List (nubBy) +import System.FilePath + +-- import a grammar in an environment where it extends an existing grammar +importGrammar :: PGF -> Options -> [FilePath] -> IO PGF +importGrammar pgf0 _ [] = return pgf0 +importGrammar pgf0 opts files = + case takeExtensions (last files) of + s | elem s [".gf",".gfo"] -> do + res <- appIOE $ compileToPGF opts files + case res of + Ok pgf2 -> do return $ unionPGF pgf0 pgf2 + Bad msg -> do putStrLn msg + return pgf0 + ".pgf" -> do + pgf2 <- mapM readPGF files >>= return . foldl1 unionPGF + return $ unionPGF pgf0 pgf2 + +importSource :: SourceGrammar -> Options -> [FilePath] -> IO SourceGrammar +importSource src0 opts files = do + src <- appIOE $ batchCompile opts files + case src of + Ok gr -> return gr + Bad msg -> do + putStrLn msg + return src0 diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs new file mode 100644 index 000000000..e1a06a205 --- /dev/null +++ b/src/GF/Command/Interpreter.hs @@ -0,0 +1,121 @@ +module GF.Command.Interpreter ( + CommandEnv (..), + mkCommandEnv, + emptyCommandEnv, + interpretCommandLine, + interpretPipe, + getCommandOp + ) where + +import GF.Command.Commands +import GF.Command.Abstract +import GF.Command.Parse +import PGF +import PGF.Data +import PGF.Macros +import GF.System.Signal +import GF.Infra.UseIO + +import GF.Data.ErrM ---- + +import qualified Data.Map as Map + +data CommandEnv = CommandEnv { + multigrammar :: PGF, + commands :: Map.Map String CommandInfo, + commandmacros :: Map.Map String CommandLine, + expmacros :: Map.Map String Tree + } + +mkCommandEnv :: PGF -> CommandEnv +mkCommandEnv pgf = CommandEnv pgf (allCommands pgf) Map.empty Map.empty + +emptyCommandEnv :: CommandEnv +emptyCommandEnv = mkCommandEnv emptyPGF + +interpretCommandLine :: CommandEnv -> String -> IO () +interpretCommandLine env line = + case readCommandLine line of + Just [] -> return () + Just pipes -> do res <- runInterruptibly (mapM_ (interpretPipe env) pipes) + case res of + Left ex -> putStrLnFlush (show ex) + Right x -> return x + Nothing -> putStrLnFlush "command not parsed" + +interpretPipe env cs = do + v@(_,s) <- intercs ([],"") cs + putStrLnFlush s + return v + where + intercs treess [] = return treess + intercs (trees,_) (c:cs) = do + treess2 <- interc trees c + intercs treess2 cs + interc es comm@(Command co _ arg) = case co of + '%':f -> case Map.lookup f (commandmacros env) of + Just css -> do + mapM_ (interpretPipe env) (appLine (getCommandArg env arg es) css) + return ([],[]) ---- return ? + _ -> do + putStrLn $ "command macro " ++ co ++ " not interpreted" + return ([],[]) + _ -> interpret env es comm + appLine es = map (map (appCommand es)) + +-- macro definition applications: replace ?i by (exps !! i) +appCommand :: [Tree] -> Command -> Command +appCommand xs c@(Command i os arg) = case arg of + ATree e -> Command i os (ATree (app e)) + _ -> c + where + app e = case e of + Meta i -> xs !! i + Fun f as -> Fun f (map app as) + Abs x b -> Abs x (app b) + +-- return the trees to be sent in pipe, and the output possibly printed +interpret :: CommandEnv -> [Tree] -> Command -> IO CommandOutput +interpret env trees0 comm = case lookCommand co comms of + Just info -> do + checkOpts info + tss@(_,s) <- exec info opts trees + optTrace s + return tss + _ -> do + putStrLn $ "command " ++ co ++ " not interpreted" + return ([],[]) + where + optTrace = if isOpt "tr" opts then putStrLn else const (return ()) + (co,opts,trees) = getCommand env comm trees0 + comms = commands env + checkOpts info = + case + [o | OOpt o <- opts, notElem o ("tr" : map fst (options info))] ++ + [o | OFlag o _ <- opts, notElem o (map fst (flags info))] + of + [] -> return () + [o] -> putStrLn $ "option not interpreted: " ++ o + os -> putStrLn $ "options not interpreted: " ++ unwords os + +-- analyse command parse tree to a uniform datastructure, normalizing comm name +--- the env is needed for macro lookup +getCommand :: CommandEnv -> Command -> [Tree] -> (String,[Option],[Tree]) +getCommand env co@(Command c opts arg) ts = + (getCommandOp c,opts,getCommandArg env arg ts) + +getCommandArg :: CommandEnv -> Argument -> [Tree] -> [Tree] +getCommandArg env a ts = case a of + AMacro m -> case Map.lookup m (expmacros env) of + Just t -> [t] + _ -> [] + ATree t -> [t] -- ignore piped + ANoArg -> ts -- use piped + +-- abbreviation convention from gf commands +getCommandOp s = case break (=='_') s of + (a:_,_:b:_) -> [a,b] -- axx_byy --> ab + _ -> case s of + [a,b] -> s -- ab --> ab + a:_ -> [a] -- axx --> a + diff --git a/src/GF/Command/Parse.hs b/src/GF/Command/Parse.hs new file mode 100644 index 000000000..eaf4cba84 --- /dev/null +++ b/src/GF/Command/Parse.hs @@ -0,0 +1,48 @@ +module GF.Command.Parse(readCommandLine, pCommand) where + +import PGF.Expr +import PGF.Data(Tree) +import GF.Command.Abstract + +import Data.Char +import Control.Monad +import qualified Text.ParserCombinators.ReadP as RP + +readCommandLine :: String -> Maybe CommandLine +readCommandLine s = case [x | (x,cs) <- RP.readP_to_S pCommandLine s, all isSpace cs] of + [x] -> Just x + _ -> Nothing + +test s = RP.readP_to_S pCommandLine s + +pCommandLine = RP.sepBy (RP.skipSpaces >> pPipe) (RP.skipSpaces >> RP.char ';') + +pPipe = RP.sepBy1 (RP.skipSpaces >> pCommand) (RP.skipSpaces >> RP.char '|') + +pCommand = do + cmd <- pIdent RP.<++ (RP.char '%' >> pIdent >>= return . ('%':)) + RP.skipSpaces + opts <- RP.sepBy pOption RP.skipSpaces + arg <- pArgument + return (Command cmd opts arg) + +pOption = do + RP.char '-' + flg <- pIdent + RP.option (OOpt flg) (fmap (OFlag flg) (RP.char '=' >> pValue)) + +pValue = do + fmap (VInt . read) (RP.munch1 isDigit) + RP.<++ + fmap VStr pStr + RP.<++ + fmap VId pFilename + +pFilename = liftM2 (:) (RP.satisfy isFileFirst) (RP.munch (not . isSpace)) where + isFileFirst c = not (isSpace c) && not (isDigit c) + +pArgument = + RP.option ANoArg + (fmap ATree (pTree False) + RP.<++ + (RP.munch isSpace >> RP.char '%' >> fmap AMacro pIdent)) diff --git a/src/GF/Compile.hs b/src/GF/Compile.hs new file mode 100644 index 000000000..eb491cc78 --- /dev/null +++ b/src/GF/Compile.hs @@ -0,0 +1,226 @@ +module GF.Compile (batchCompile, link, compileToPGF, compileSourceGrammar) where + +-- the main compiler passes +import GF.Compile.GetGrammar +import GF.Compile.Extend +import GF.Compile.Rebuild +import GF.Compile.Rename +import GF.Compile.CheckGrammar +import GF.Compile.Optimize +import GF.Compile.OptimizeGF +import GF.Compile.OptimizeGFCC +import GF.Compile.GrammarToGFCC +import GF.Compile.ReadFiles +import GF.Compile.Update +import GF.Compile.Refresh + +import GF.Grammar.Grammar +import GF.Grammar.Lookup +import GF.Grammar.PrGrammar + +import GF.Infra.Ident +import GF.Infra.Option +import GF.Infra.Modules +import GF.Infra.UseIO + +import GF.Source.GrammarToSource +import qualified GF.Source.AbsGF as A +import qualified GF.Source.PrintGF as P + +import GF.Data.Operations + +import Control.Monad +import System.Directory +import System.FilePath +import System.Time +import qualified Data.Map as Map +import qualified Data.Set as Set + +import PGF.Check +import PGF.Data + + +-- | Compiles a number of source files and builds a 'PGF' structure for them. +compileToPGF :: Options -> [FilePath] -> IOE PGF +compileToPGF opts fs = + do gr <- batchCompile opts fs + let name = justModuleName (last fs) + link opts name gr + +link :: Options -> String -> SourceGrammar -> IOE PGF +link opts cnc gr = + do gc1 <- putPointE Normal opts "linking ... " $ + let (abs,gc0) = mkCanon2gfcc opts cnc gr + in case checkPGF gc0 of + Ok (gc,b) -> do + ioeIO $ putStrLn $ if b then "OK" else "Corrupted PGF" + return gc + Bad s -> fail s + return $ buildParser opts $ optimize opts gc1 + +optimize :: Options -> PGF -> PGF +optimize opts = cse . suf + where os = moduleFlag optOptimizations opts + cse = if OptCSE `Set.member` os then cseOptimize else id + suf = if OptStem `Set.member` os then suffixOptimize else id + +buildParser :: Options -> PGF -> PGF +buildParser opts = + if moduleFlag optBuildParser opts then addParsers else id + +batchCompile :: Options -> [FilePath] -> IOE SourceGrammar +batchCompile opts files = do + (_,gr,_) <- foldM (compileModule opts) emptyCompileEnv files + return gr + +-- to compile a set of modules, e.g. an old GF or a .cf file +compileSourceGrammar :: Options -> SourceGrammar -> IOE SourceGrammar +compileSourceGrammar opts gr@(MGrammar ms) = do + (_,gr',_) <- foldM compOne (0,emptySourceGrammar,Map.empty) ms + return gr' + where + compOne env mo = do + (k,mo') <- compileSourceModule opts env mo + extendCompileEnvInt env k Nothing mo' --- file for the same of modif time... + +-- to output an intermediate stage +intermOut :: Options -> Dump -> String -> IOE () +intermOut opts d s = if dump opts d then + ioeIO (putStrLn ("\n\n--#" +++ show d) >> putStrLn s) + else return () + + +-- | the environment +type CompileEnv = (Int,SourceGrammar,ModEnv) + +-- | compile with one module as starting point +-- command-line options override options (marked by --#) in the file +-- As for path: if it is read from file, the file path is prepended to each name. +-- If from command line, it is used as it is. + +compileModule :: Options -- ^ Options from program command line and shell command. + -> CompileEnv -> FilePath -> IOE CompileEnv +compileModule opts1 env file = do + opts0 <- getOptionsFromFile file + let opts = addOptions opts0 opts1 + let fdir = dropFileName file + let ps0 = moduleFlag optLibraryPath opts + ps2 <- ioeIO $ extendPathEnv $ fdir : ps0 + let ps = ps2 ++ map (fdir </>) ps0 + ioeIO $ putIfVerb opts $ "module search path:" +++ show ps ---- + let (_,sgr,rfs) = env + files <- getAllFiles opts ps rfs file + ioeIO $ putIfVerb opts $ "files to read:" +++ show files ---- + let names = map justModuleName files + ioeIO $ putIfVerb opts $ "modules to include:" +++ show names ---- + foldM (compileOne opts) (0,sgr,rfs) files + +compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv +compileOne opts env@(_,srcgr,_) file = do + + let putpOpt v m act + | verbAtLeast opts Verbose = putPointE Normal opts v act + | verbAtLeast opts Normal = ioeIO (putStrFlush m) >> act + | otherwise = putPointE Verbose opts v act + + let gf = takeExtensions file + let path = dropFileName file + let name = dropExtension file + let mos = modules srcgr + + case gf of + + -- for compiled gf, read the file and update environment + -- also undo common subexp optimization, to enable normal computations + ".gfo" -> do + sm0 <- putPointE Normal opts ("+ reading" +++ file) $ getSourceModule opts file + let sm1 = unsubexpModule sm0 + sm <- {- putPointE Normal opts "creating indirections" $ -} ioeErr $ extendModule mos sm1 + + extendCompileEnv env file sm + + -- for gf source, do full compilation and generate code + _ -> do + + let gfo = gfoFile (dropExtension file) + b1 <- ioeIO $ doesFileExist file + if not b1 + then compileOne opts env $ gfo + else do + + sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ + getSourceModule opts file + (k',sm) <- compileSourceModule opts env sm0 + let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str + cm <- putPointE Verbose opts " generating code... " $ generateModuleCode opts gfo sm1 + -- sm is optimized before generation, but not in the env + extendCompileEnvInt env k' (Just gfo) sm1 + where + isConcr (_,mi) = case mi of + ModMod m -> isModCnc m && mstatus m /= MSIncomplete + _ -> False + + +compileSourceModule :: Options -> CompileEnv -> + SourceModule -> IOE (Int,SourceModule) +compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do + + let putp = putPointE Normal opts + putpp = putPointE Verbose opts + mos = modules gr + + mo1 <- ioeErr $ rebuildModule mos mo + intermOut opts DumpRebuild (prModule mo1) + + mo1b <- ioeErr $ extendModule mos mo1 + intermOut opts DumpExtend (prModule mo1b) + + case mo1b of + (_,ModMod n) | not (isCompleteModule n) -> do + return (k,mo1b) -- refresh would fail, since not renamed + _ -> do + mo2:_ <- putpp " renaming " $ ioeErr $ renameModule mos mo1b + intermOut opts DumpRename (prModule mo2) + + (mo3:_,warnings) <- putpp " type checking" $ ioeErr $ showCheckModule mos mo2 + if null warnings then return () else putp warnings $ return () + intermOut opts DumpTypeCheck (prModule mo3) + + (k',mo3r:_) <- putpp " refreshing " $ ioeErr $ refreshModule (k,mos) mo3 + intermOut opts DumpRefresh (prModule mo3r) + + let eenv = () --- emptyEEnv + (mo4,eenv') <- + ---- if oElem "check_only" opts + putpp " optimizing " $ ioeErr $ optimizeModule opts (mos,eenv) mo3r + return (k',mo4) + where + ---- prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug + prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo] + +generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule +generateModuleCode opts file minfo = do + let minfo1 = subexpModule minfo + out = prGrammar (MGrammar [minfo1]) + putPointE Normal opts (" wrote file" +++ file) $ ioeIO $ writeFile file $ out + return minfo1 + +-- auxiliaries + +reverseModules (MGrammar ms) = MGrammar $ reverse ms + +emptyCompileEnv :: CompileEnv +emptyCompileEnv = (0,emptyMGrammar,Map.empty) + +extendCompileEnvInt (_,MGrammar ss,menv) k mfile sm = do + let (mod,imps) = importsOfModule (trModule sm) + menv2 <- case mfile of + Just file -> do + t <- ioeIO $ getModificationTime file + return $ Map.insert mod (t,imps) menv + _ -> return menv + return (k,MGrammar (sm:ss),menv2) --- reverse later + +extendCompileEnv e@(k,_,_) file sm = extendCompileEnvInt e k (Just file) sm + + diff --git a/src/GF/Compile/BackOpt.hs b/src/GF/Compile/BackOpt.hs new file mode 100644 index 000000000..8667023c0 --- /dev/null +++ b/src/GF/Compile/BackOpt.hs @@ -0,0 +1,105 @@ +---------------------------------------------------------------------- +-- | +-- Module : BackOpt +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:21:33 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.6 $ +-- +-- Optimizations on GF source code: sharing, parametrization, value sets. +-- +-- optimization: sharing branches in tables. AR 25\/4\/2003. +-- following advice of Josef Svenningsson +----------------------------------------------------------------------------- + +module GF.Compile.BackOpt (shareModule, OptSpec) where + +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Infra.Option +import qualified GF.Grammar.Macros as C +import GF.Grammar.PrGrammar (prt) +import GF.Data.Operations +import Data.List +import qualified GF.Infra.Modules as M +import qualified Data.ByteString.Char8 as BS + +import Data.Set (Set) +import qualified Data.Set as Set + +type OptSpec = Set Optimization + +shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo) +shareModule opt (i,m) = case m of + M.ModMod mo -> + (i,M.ModMod (M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo)))) + _ -> (i,m) + +shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (shareOptim opt c t)) m) +shareInfo opt (c, CncFun kxs (Yes t) m) = (c,CncFun kxs (Yes (shareOptim opt c t)) m) +shareInfo opt (c, ResOper ty (Yes t)) = (c,ResOper ty (Yes (shareOptim opt c t))) +shareInfo _ i = i + +-- the function putting together optimizations +shareOptim :: OptSpec -> Ident -> Term -> Term +shareOptim opt c = (if OptValues `Set.member` opt then values else id) + . (if OptParametrize `Set.member` opt then factor c 0 else id) + +-- do even more: factor parametric branches + +factor :: Ident -> Int -> Term -> Term +factor c i t = case t of + T _ [_] -> t + T _ [] -> t + T (TComp ty) cs -> + T (TTyped ty) $ factors i [(p, factor c (i+1) v) | (p, v) <- cs] + _ -> C.composSafeOp (factor c i) t + where + + factors i psvs = -- we know psvs has at least 2 elements + let p = qqIdent c i + vs' = map (mkFun p) psvs + in if allEqs vs' + then mkCase p vs' + else psvs + + mkFun p (patt, val) = replace (C.patt2term patt) (Vr p) val + + allEqs (v:vs) = all (==v) vs + + mkCase p (v:_) = [(PV p, v)] + +--- we hope this will be fresh and don't check... in GFC would be safe + +qqIdent c i = identC (BS.pack ("q_" ++ prt c ++ "__" ++ show i)) + + +-- we need to replace subterms + +replace :: Term -> Term -> Term -> Term +replace old new trm = case trm of + + -- these are the important cases, since they can correspond to patterns + QC _ _ | trm == old -> new + App t ts | trm == old -> new + App t ts -> App (repl t) (repl ts) + R _ | isRec && trm == old -> new + _ -> C.composSafeOp repl trm + where + repl = replace old new + isRec = case trm of + R _ -> True + _ -> False + +-- It is very important that this is performed only after case +-- expansion since otherwise the order and number of values can +-- be incorrect. Guaranteed by the TComp flag. + +values :: Term -> Term +values t = case t of + T ty [(ps,t)] -> T ty [(ps,values t)] -- don't destroy parametrization + T (TComp ty) cs -> V ty [values t | (_, t) <- cs] + _ -> C.composSafeOp values t diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs new file mode 100644 index 000000000..0a8361d36 --- /dev/null +++ b/src/GF/Compile/CheckGrammar.hs @@ -0,0 +1,1105 @@ +{-# LANGUAGE PatternGuards #-} +---------------------------------------------------------------------- +-- | +-- Module : CheckGrammar +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/11 23:24:33 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.31 $ +-- +-- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003 +-- +-- type checking also does the following modifications: +-- +-- - types of operations and local constants are inferred and put in place +-- +-- - both these types and linearization types are computed +-- +-- - tables are type-annotated +----------------------------------------------------------------------------- + +module GF.Compile.CheckGrammar ( + showCheckModule, justCheckLTerm, allOperDependencies, topoSortOpers) where + +import GF.Infra.Ident +import GF.Infra.Modules + +import GF.Compile.TypeCheck + +import GF.Compile.Refresh +import GF.Grammar.Grammar +import GF.Grammar.PrGrammar +import GF.Grammar.Lookup +import GF.Grammar.LookAbs +import GF.Grammar.Predef +import GF.Grammar.Macros +import GF.Grammar.ReservedWords +import GF.Grammar.PatternMatch +import GF.Grammar.AppPredefined +import GF.Grammar.Lockfield (isLockLabel) + +import GF.Data.Operations +import GF.Infra.CheckM + +import Data.List +import qualified Data.Set as Set +import qualified Data.Map as Map +import Control.Monad +import Debug.Trace --- + + +showCheckModule :: [SourceModule] -> SourceModule -> Err ([SourceModule],String) +showCheckModule mos m = do + (st,(_,msg)) <- checkStart $ checkModule mos m + return (st, unlines $ reverse msg) + +mapsCheckTree :: + (Ord a) => ((a,b) -> Check (a,c)) -> BinTree a b -> Check (BinTree a c) +mapsCheckTree f = checkErr . mapsErrTree (\t -> checkStart (f t) >>= return . fst) + + +-- | checking is performed in the dependency order of modules +checkModule :: [SourceModule] -> SourceModule -> Check [SourceModule] +checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod of + + ModMod mo -> do + let js = jments mo + checkRestrictedInheritance ms (name, mo) + js' <- case mtype mo of + MTAbstract -> mapsCheckTree (checkAbsInfo gr name mo) js + + MTTransfer a b -> mapsCheckTree (checkAbsInfo gr name mo) js + + MTResource -> mapsCheckTree (checkResInfo gr name mo) js + + MTConcrete a -> do + checkErr $ topoSortOpers $ allOperDependencies name js + ModMod abs <- checkErr $ lookupModule gr a + js1 <- checkCompleteGrammar abs mo + mapsCheckTree (checkCncInfo gr name mo (a,abs)) js1 + + MTInterface -> mapsCheckTree (checkResInfo gr name mo) js + + MTInstance a -> do + ModMod abs <- checkErr $ lookupModule gr a + -- checkCompleteInstance abs mo -- this is done in Rebuild + mapsCheckTree (checkResInfo gr name mo) js + + return $ (name, ModMod (replaceJudgements mo js')) : ms + + _ -> return $ (name,mod) : ms + where + gr = MGrammar $ (name,mod):ms + +-- check if restricted inheritance modules are still coherent +-- i.e. that the defs of remaining names don't depend on omitted names +---checkRestrictedInheritance :: [SourceModule] -> SourceModule -> Check () +checkRestrictedInheritance mos (name,mo) = do + let irs = [ii | ii@(_,mi) <- extend mo, mi /= MIAll] -- names with restr. inh. + let mrs = [((i,m),mi) | (i,ModMod m) <- mos, Just mi <- [lookup i irs]] + -- the restr. modules themself, with restr. infos + mapM_ checkRem mrs + where + checkRem ((i,m),mi) = do + let (incl,excl) = partition (isInherited mi) (map fst (tree2list (jments m))) + let incld c = Set.member c (Set.fromList incl) + let illegal c = Set.member c (Set.fromList excl) + let illegals = [(f,is) | + (f,cs) <- allDeps, incld f, let is = filter illegal cs, not (null is)] + case illegals of + [] -> return () + cs -> fail $ "In inherited module" +++ prt i ++ + ", dependence of excluded constants:" ++++ + unlines [" " ++ prt f +++ "on" +++ unwords (map prt is) | + (f,is) <- cs] + allDeps = ---- transClosure $ Map.fromList $ + concatMap (allDependencies (const True)) + [jments m | (_,ModMod m) <- mos] + transClosure ds = ds ---- TODO: check in deeper modules + +-- | check if a term is typable +justCheckLTerm :: SourceGrammar -> Term -> Err Term +justCheckLTerm src t = do + ((t',_),_) <- checkStart (inferLType src t) + return t' + +checkAbsInfo :: + SourceGrammar -> Ident -> Module Ident Info -> (Ident,Info) -> Check (Ident,Info) +checkAbsInfo st m mo (c,info) = do +---- checkReservedId c + case info of + AbsCat (Yes cont) _ -> mkCheck "category" $ + checkContext st cont ---- also cstrs + AbsFun (Yes typ0) md -> do + typ <- compAbsTyp [] typ0 -- to calculate let definitions + mkCheck "type of function" $ checkTyp st typ + md' <- case md of + Yes d -> do + let d' = elimTables d + mkCheckWarn "definition of function" $ checkEquation st (m,c) d' + return $ Yes d' + _ -> return md + return $ (c,AbsFun (Yes typ) md') + _ -> return (c,info) + where + mkCheck cat ss = case ss of + [] -> return (c,info) + ["[]"] -> return (c,info) ---- + _ -> checkErr $ Bad (unlines ss ++++ "in" +++ cat +++ prt c +++ pos c) + ---- temporary solution when tc of defs is incomplete + mkCheckWarn cat ss = case ss of + [] -> return (c,info) + ["[]"] -> return (c,info) ---- + _ -> do + checkWarn (unlines ss ++++ "in" +++ cat +++ prt c +++ pos c) + return (c,info) + + pos c = showPosition mo c + + compAbsTyp g t = case t of + Vr x -> maybe (fail ("no value given to variable" +++ prt x)) return $ lookup x g + Let (x,(_,a)) b -> do + a' <- compAbsTyp g a + compAbsTyp ((x, a'):g) b + Prod x a b -> do + a' <- compAbsTyp g a + b' <- compAbsTyp ((x,Vr x):g) b + return $ Prod x a' b' + Abs _ _ -> return t + _ -> composOp (compAbsTyp g) t + + elimTables e = case e of + S t a -> elimSel (elimTables t) (elimTables a) + T _ cs -> Eqs [(elimPatt p, elimTables t) | (p,t) <- cs] + _ -> composSafeOp elimTables e + elimPatt p = case p of + PR lps -> map snd lps + _ -> [p] + elimSel t a = case a of + R fs -> mkApp t (map (snd . snd) fs) + _ -> mkApp t [a] + +checkCompleteGrammar :: SourceAbs -> SourceCnc -> Check (BinTree Ident Info) +checkCompleteGrammar abs cnc = do + let js = jments cnc + let fs = tree2list $ jments abs + foldM checkOne js fs + where + checkOne js i@(c,info) = case info of + AbsFun (Yes _) _ -> case lookupIdent c js of + Ok _ -> return js + _ -> do + checkWarn $ "WARNING: no linearization of" +++ prt c + return js + AbsCat (Yes _) _ -> case lookupIdent c js of + Ok (AnyInd _ _) -> return js + Ok (CncCat (Yes _) _ _) -> return js + Ok (CncCat _ mt mp) -> do + checkWarn $ + "Warning: no linearization type for" +++ prt c ++ + ", inserting default {s : Str}" + return $ updateTree (c,CncCat (Yes defLinType) mt mp) js + _ -> do + checkWarn $ + "Warning: no linearization type for" +++ prt c ++ + ", inserting default {s : Str}" + return $ updateTree (c,CncCat (Yes defLinType) nope nope) js + _ -> return js + +-- | General Principle: only Yes-values are checked. +-- A May-value has always been checked in its origin module. +checkResInfo :: + SourceGrammar -> Ident -> Module Ident Info -> (Ident,Info) -> Check (Ident,Info) +checkResInfo gr mo mm (c,info) = do + checkReservedId c + case info of + ResOper pty pde -> chIn "operation" $ do + (pty', pde') <- case (pty,pde) of + (Yes ty, Yes de) -> do + ty' <- check ty typeType >>= comp . fst + (de',_) <- check de ty' + return (Yes ty', Yes de') + (_, Yes de) -> do + (de',ty') <- infer de + return (Yes ty', Yes de') + (_,Nope) -> do + checkWarn "No definition given to oper" + return (pty,pde) + _ -> return (pty, pde) --- other cases are uninteresting + return (c, ResOper pty' pde') + + ResOverload os tysts -> chIn "overloading" $ do + tysts' <- mapM (uncurry $ flip check) tysts -- return explicit ones + tysts0 <- checkErr $ lookupOverload gr mo c -- check against inherited ones too + tysts1 <- mapM (uncurry $ flip check) + [(mkFunType args val,tr) | (args,(val,tr)) <- tysts0] + let tysts2 = [(y,x) | (x,y) <- tysts1] + --- this can only be a partial guarantee, since matching + --- with value type is only possible if expected type is given + checkUniq $ + sort [t : map snd xs | (x,_) <- tysts2, Ok (xs,t) <- [typeFormCnc x]] + return (c,ResOverload os [(y,x) | (x,y) <- tysts']) + + ResParam (Yes (pcs,_)) -> chIn "parameter type" $ do +---- mapM ((mapM (computeLType gr . snd)) . snd) pcs + mapM_ ((mapM_ (checkIfParType gr . snd)) . snd) pcs + ts <- checkErr $ lookupParamValues gr mo c + return (c,ResParam (Yes (pcs, Just ts))) + + _ -> return (c,info) + where + infer = inferLType gr + check = checkLType gr + chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ pos c +++ ":") + comp = computeLType gr + pos c = showPosition mm c + + checkUniq xss = case xss of + x:y:xs + | x == y -> raise $ "ambiguous for type" +++ + prtType gr (mkFunType (tail x) (head x)) + | otherwise -> checkUniq $ y:xs + _ -> return () + + +checkCncInfo :: SourceGrammar -> Ident -> Module Ident Info -> + (Ident,SourceAbs) -> + (Ident,Info) -> Check (Ident,Info) +checkCncInfo gr m mo (a,abs) (c,info) = do + checkReservedId c + case info of + + CncFun _ (Yes trm) mpr -> chIn "linearization of" $ do + typ <- checkErr $ lookupFunType gr a c + cat0 <- checkErr $ valCat typ + (cont,val) <- linTypeOfType gr m typ -- creates arg vars + (trm',_) <- check trm (mkFunType (map snd cont) val) -- erases arg vars + checkPrintname gr mpr + cat <- return $ snd cat0 + return (c, CncFun (Just (cat,(cont,val))) (Yes trm') mpr) + -- cat for cf, typ for pe + + CncCat (Yes typ) mdef mpr -> chIn "linearization type of" $ do + checkErr $ lookupCatContext gr a c + typ' <- checkIfLinType gr typ + mdef' <- case mdef of + Yes def -> do + (def',_) <- checkLType gr def (mkFunType [typeStr] typ) + return $ Yes def' + _ -> return mdef + checkPrintname gr mpr + return (c,CncCat (Yes typ') mdef' mpr) + + _ -> checkResInfo gr m mo (c,info) + + where + env = gr + infer = inferLType gr + comp = computeLType gr + check = checkLType gr + chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ pos c +++ ":") + pos c = showPosition mo c + +checkIfParType :: SourceGrammar -> Type -> Check () +checkIfParType st typ = checkCond ("Not parameter type" +++ prt typ) (isParType typ) + where + isParType ty = True ---- +{- case ty of + Cn typ -> case lookupConcrete st typ of + Ok (CncParType _ _ _) -> True + Ok (CncOper _ ty' _) -> isParType ty' + _ -> False + Q p t -> case lookupInPackage st (p,t) of + Ok (CncParType _ _ _) -> True + _ -> False + RecType r -> all (isParType . snd) r + _ -> False +-} + +checkIfStrType :: SourceGrammar -> Type -> Check () +checkIfStrType st typ = case typ of + Table arg val -> do + checkIfParType st arg + checkIfStrType st val + _ | typ == typeStr -> return () + _ -> prtFail "not a string type" typ + + +checkIfLinType :: SourceGrammar -> Type -> Check Type +checkIfLinType st typ0 = do + typ <- computeLType st typ0 +{- ---- should check that not fun type + case typ of + RecType r -> do + let (lins,ihs) = partition (isLinLabel .fst) r + --- checkErr $ checkUnique $ map fst r + mapM_ checkInh ihs + mapM_ checkLin lins + _ -> prtFail "a linearization type cannot be" typ +-} + return typ + + where + checkInh (label,typ) = checkIfParType st typ + checkLin (label,typ) = return () ---- checkIfStrType st typ + + +computeLType :: SourceGrammar -> Type -> Check Type +computeLType gr t = do + g0 <- checkGetContext + let g = [(x, Vr x) | (x,_) <- g0] + checkInContext g $ comp t + where + comp ty = case ty of + _ | Just _ <- isTypeInts ty -> return ty ---- shouldn't be needed + | isPredefConstant ty -> return ty ---- shouldn't be needed + + Q m ident -> checkIn ("module" +++ prt m) $ do + ty' <- checkErr (lookupResDef gr m ident) + if ty' == ty then return ty else comp ty' --- is this necessary to test? + + Vr ident -> checkLookup ident -- never needed to compute! + + App f a -> do + f' <- comp f + a' <- comp a + case f' of + Abs x b -> checkInContext [(x,a')] $ comp b + _ -> return $ App f' a' + + Prod x a b -> do + a' <- comp a + b' <- checkInContext [(x,Vr x)] $ comp b + return $ Prod x a' b' + + Abs x b -> do + b' <- checkInContext [(x,Vr x)] $ comp b + return $ Abs x b' + + ExtR r s -> do + r' <- comp r + s' <- comp s + case (r',s') of + (RecType rs, RecType ss) -> checkErr (plusRecType r' s') >>= comp + _ -> return $ ExtR r' s' + + RecType fs -> do + let fs' = sortRec fs + liftM RecType $ mapPairsM comp fs' + + _ | ty == typeTok -> return typeStr + _ | isPredefConstant ty -> return ty + + _ -> composOp comp ty + +checkPrintname :: SourceGrammar -> Perh Term -> Check () +checkPrintname st (Yes t) = checkLType st t typeStr >> return () +checkPrintname _ _ = return () + +-- | for grammars obtained otherwise than by parsing ---- update!! +checkReservedId :: Ident -> Check () +checkReservedId x = let c = prt x in + if isResWord c + then checkWarn ("Warning: reserved word used as identifier:" +++ c) + else return () + +-- to normalize records and record types +labelIndex :: Type -> Label -> Int +labelIndex ty lab = case ty of + RecType ts -> maybe (error ("label index" +++ prt lab)) id $ lookup lab $ labs ts + _ -> error $ "label index" +++ prt ty + where + labs ts = zip (map fst (sortRec ts)) [0..] + +-- the underlying algorithms + +inferLType :: SourceGrammar -> Term -> Check (Term, Type) +inferLType gr trm = case trm of + + Q m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident) + + Q m ident -> checks [ + termWith trm $ checkErr (lookupResType gr m ident) >>= comp + , + checkErr (lookupResDef gr m ident) >>= infer + , + prtFail "cannot infer type of constant" trm + ] + + QC m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident) + + QC m ident -> checks [ + termWith trm $ checkErr (lookupResType gr m ident) >>= comp + , + checkErr (lookupResDef gr m ident) >>= infer + , + prtFail "cannot infer type of canonical constant" trm + ] + + Val ty i -> termWith trm $ return ty + + Vr ident -> termWith trm $ checkLookup ident + + Typed e t -> do + t' <- comp t + check e t' + return (e,t') + + App f a -> do + over <- getOverload gr Nothing trm + case over of + Just trty -> return trty + _ -> do + (f',fty) <- infer f + fty' <- comp fty + case fty' of + Prod z arg val -> do + a' <- justCheck a arg + ty <- if isWildIdent z + then return val + else substituteLType [(z,a')] val + return (App f' a',ty) + _ -> raise ("function type expected for"+++ + prt f +++"instead of" +++ prtType env fty) + + S f x -> do + (f', fty) <- infer f + case fty of + Table arg val -> do + x'<- justCheck x arg + return (S f' x', val) + _ -> prtFail "table lintype expected for the table in" trm + + P t i -> do + (t',ty) <- infer t --- ?? + ty' <- comp ty +----- let tr2 = PI t' i (labelIndex ty' i) + let tr2 = P t' i + termWith tr2 $ checkErr $ case ty' of + RecType ts -> maybeErr ("unknown label" +++ prt i +++ "in" +++ prt ty') $ + lookup i ts + _ -> prtBad ("record type expected for" +++ prt t +++ "instead of") ty' + PI t i _ -> infer $ P t i + + R r -> do + let (ls,fs) = unzip r + fsts <- mapM inferM fs + let ts = [ty | (Just ty,_) <- fsts] + checkCond ("cannot infer type of record"+++ prt trm) (length ts == length fsts) + return $ (R (zip ls fsts), RecType (zip ls ts)) + + T (TTyped arg) pts -> do + (_,val) <- checks $ map (inferCase (Just arg)) pts + check trm (Table arg val) + T (TComp arg) pts -> do + (_,val) <- checks $ map (inferCase (Just arg)) pts + check trm (Table arg val) + T ti pts -> do -- tries to guess: good in oper type inference + let pts' = [pt | pt@(p,_) <- pts, isConstPatt p] + case pts' of + [] -> prtFail "cannot infer table type of" trm +---- PInt k : _ -> return $ Ints $ max [i | PInt i <- pts'] + _ -> do + (arg,val) <- checks $ map (inferCase Nothing) pts' + check trm (Table arg val) + V arg pts -> do + (_,val) <- checks $ map infer pts + return (trm, Table arg val) + + K s -> do + if elem ' ' s + then do + let ss = foldr C Empty (map K (words s)) + ----- removed irritating warning AR 24/5/2008 + ----- checkWarn ("WARNING: token \"" ++ s ++ + ----- "\" converted to token list" ++ prt ss) + return (ss, typeStr) + else return (trm, typeStr) + + EInt i -> return (trm, typeInt) + + EFloat i -> return (trm, typeFloat) + + Empty -> return (trm, typeStr) + + C s1 s2 -> + check2 (flip justCheck typeStr) C s1 s2 typeStr + + Glue s1 s2 -> + check2 (flip justCheck typeStr) Glue s1 s2 typeStr ---- typeTok + +---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007 + Strs (Cn c : ts) | c == cConflict -> do + trace ("WARNING: unresolved constant, could be any of" +++ unwords (map prt ts)) (infer $ head ts) +-- checkWarn ("WARNING: unresolved constant, could be any of" +++ unwords (map prt ts)) +-- infer $ head ts + + Strs ts -> do + ts' <- mapM (\t -> justCheck t typeStr) ts + return (Strs ts', typeStrs) + + Alts (t,aa) -> do + t' <- justCheck t typeStr + aa' <- flip mapM aa (\ (c,v) -> do + c' <- justCheck c typeStr + v' <- justCheck v typeStrs + return (c',v')) + return (Alts (t',aa'), typeStr) + + RecType r -> do + let (ls,ts) = unzip r + ts' <- mapM (flip justCheck typeType) ts + return (RecType (zip ls ts'), typeType) + + ExtR r s -> do + (r',rT) <- infer r + rT' <- comp rT + (s',sT) <- infer s + sT' <- comp sT + + let trm' = ExtR r' s' + ---- trm' <- checkErr $ plusRecord r' s' + case (rT', sT') of + (RecType rs, RecType ss) -> do + rt <- checkErr $ plusRecType rT' sT' + check trm' rt ---- return (trm', rt) + _ | rT' == typeType && sT' == typeType -> return (trm', typeType) + _ -> prtFail "records or record types expected in" trm + + Sort _ -> + termWith trm $ return typeType + + Prod x a b -> do + a' <- justCheck a typeType + b' <- checkInContext [(x,a')] $ justCheck b typeType + return (Prod x a' b', typeType) + + Table p t -> do + p' <- justCheck p typeType --- check p partype! + t' <- justCheck t typeType + return $ (Table p' t', typeType) + + FV vs -> do + (_,ty) <- checks $ map infer vs +--- checkIfComplexVariantType trm ty + check trm ty + + EPattType ty -> do + ty' <- justCheck ty typeType + return (ty',typeType) + EPatt p -> do + ty <- inferPatt p + return (trm, EPattType ty) + + _ -> prtFail "cannot infer lintype of" trm + + where + env = gr + infer = inferLType env + comp = computeLType env + + check = checkLType env + + isPredef m = elem m [cPredef,cPredefAbs] + + justCheck ty te = check ty te >>= return . fst + + -- for record fields, which may be typed + inferM (mty, t) = do + (t', ty') <- case mty of + Just ty -> check ty t + _ -> infer t + return (Just ty',t') + + inferCase mty (patt,term) = do + arg <- maybe (inferPatt patt) return mty + cont <- pattContext env arg patt + i <- checkUpdates cont + (_,val) <- infer term + checkResets i + return (arg,val) + isConstPatt p = case p of + PC _ ps -> True --- all isConstPatt ps + PP _ _ ps -> True --- all isConstPatt ps + PR ps -> all (isConstPatt . snd) ps + PT _ p -> isConstPatt p + PString _ -> True + PInt _ -> True + PFloat _ -> True + PChar -> True + PChars _ -> True + PSeq p q -> isConstPatt p && isConstPatt q + PAlt p q -> isConstPatt p && isConstPatt q + PRep p -> isConstPatt p + PNeg p -> isConstPatt p + PAs _ p -> isConstPatt p + _ -> False + + inferPatt p = case p of + PP q c ps | q /= cPredef -> checkErr $ lookupResType gr q c >>= valTypeCnc + PAs _ p -> inferPatt p + PNeg p -> inferPatt p + PAlt p q -> checks [inferPatt p, inferPatt q] + PSeq _ _ -> return $ typeStr + PRep _ -> return $ typeStr + PChar -> return $ typeStr + PChars _ -> return $ typeStr + _ -> infer (patt2term p) >>= return . snd + + +-- type inference: Nothing, type checking: Just t +-- the latter permits matching with value type +getOverload :: SourceGrammar -> Maybe Type -> Term -> Check (Maybe (Term,Type)) +getOverload env@gr mt ot = case appForm ot of + (f@(Q m c), ts) -> case lookupOverload gr m c of + Ok typs -> do + ttys <- mapM infer ts + v <- matchOverload f typs ttys + return $ Just v + _ -> return Nothing + _ -> return Nothing + where + infer = inferLType env + matchOverload f typs ttys = do + let (tts,tys) = unzip ttys + let vfs = lookupOverloadInstance tys typs + let matches = [vf | vf@((v,_),_) <- vfs, matchVal mt v] + + case ([vf | (vf,True) <- matches],[vf | (vf,False) <- matches]) of + ([(val,fun)],_) -> return (mkApp fun tts, val) + ([],[(val,fun)]) -> do + checkWarn ("ignoring lock fields in resolving" +++ prt ot) + return (mkApp fun tts, val) + ([],[]) -> do + raise $ "no overload instance of" +++ prt f +++ + "for" +++ unwords (map (prtType env) tys) +++ "among" ++++ + unlines [" " ++ unwords (map (prtType env) ty) | (ty,_) <- typs] ++ + maybe [] (("with value type" +++) . prtType env) mt + + (vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of + ([(val,fun)],_) -> do + return (mkApp fun tts, val) + ([],[(val,fun)]) -> do + checkWarn ("ignoring lock fields in resolving" +++ prt ot) + return (mkApp fun tts, val) + +----- unsafely exclude irritating warning AR 24/5/2008 +----- checkWarn $ "WARNING: overloading of" +++ prt f +++ +----- "resolved by excluding partial applications:" ++++ +----- unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)] + + + _ -> raise $ "ambiguous overloading of" +++ prt f +++ + "for" +++ unwords (map (prtType env) tys) ++++ "with alternatives" ++++ + unlines [prtType env ty | (ty,_) <- if (null vfs1) then vfs2 else vfs2] + + matchVal mt v = elem mt [Nothing,Just v,Just (unlocked v)] + + unlocked v = case v of + RecType fs -> RecType $ filter (not . isLockLabel . fst) fs + _ -> v + ---- TODO: accept subtypes + ---- TODO: use a trie + lookupOverloadInstance tys typs = + [((mkFunType rest val, t),isExact) | + let lt = length tys, + (ty,(val,t)) <- typs, length ty >= lt, + let (pre,rest) = splitAt lt ty, + let isExact = pre == tys, + isExact || map unlocked pre == map unlocked tys + ] + + noProds vfs = [(v,f) | (v,f) <- vfs, noProd v] + + noProd ty = case ty of + Prod _ _ _ -> False + _ -> True + +checkLType :: SourceGrammar -> Term -> Type -> Check (Term, Type) +checkLType env trm typ0 = do + + typ <- comp typ0 + + case trm of + + Abs x c -> do + case typ of + Prod z a b -> do + checkUpdate (x,a) + (c',b') <- if isWildIdent z + then check c b + else do + b' <- checkIn "abs" $ substituteLType [(z,Vr x)] b + check c b' + checkReset + return $ (Abs x c', Prod x a b') + _ -> raise $ "product expected instead of" +++ prtType env typ + + App f a -> do + over <- getOverload env (Just typ) trm + case over of + Just trty -> return trty + _ -> do + (trm',ty') <- infer trm + termWith trm' $ checkEq typ ty' trm' + + Q _ _ -> do + over <- getOverload env (Just typ) trm + case over of + Just trty -> return trty + _ -> do + (trm',ty') <- infer trm + termWith trm' $ checkEq typ ty' trm' + + T _ [] -> + prtFail "found empty table in type" typ + T _ cs -> case typ of + Table arg val -> do + case allParamValues env arg of + Ok vs -> do + let ps0 = map fst cs + ps <- checkErr $ testOvershadow ps0 vs + if null ps + then return () + else checkWarn $ "WARNING: patterns never reached:" +++ + concat (intersperse ", " (map prt ps)) + + _ -> return () -- happens with variable types + cs' <- mapM (checkCase arg val) cs + return (T (TTyped arg) cs', typ) + _ -> raise $ "table type expected for table instead of" +++ prtType env typ + + R r -> case typ of --- why needed? because inference may be too difficult + RecType rr -> do + let (ls,_) = unzip rr -- labels of expected type + fsts <- mapM (checkM r) rr -- check that they are found in the record + return $ (R fsts, typ) -- normalize record + + _ -> prtFail "record type expected in type checking instead of" typ + + ExtR r s -> case typ of + _ | typ == typeType -> do + trm' <- comp trm + case trm' of + RecType _ -> termWith trm $ return typeType + ExtR (Vr _) (RecType _) -> termWith trm $ return typeType + -- ext t = t ** ... + _ -> prtFail "invalid record type extension" trm + RecType rr -> do + (r',ty,s') <- checks [ + do (r',ty) <- infer r + return (r',ty,s) + , + do (s',ty) <- infer s + return (s',ty,r) + ] + case ty of + RecType rr1 -> do + let (rr0,rr2) = recParts rr rr1 + r2 <- justCheck r' rr0 + s2 <- justCheck s' rr2 + return $ (ExtR r2 s2, typ) + _ -> raise ("record type expected in extension of" +++ prt r +++ + "but found" +++ prt ty) + + ExtR ty ex -> do + r' <- justCheck r ty + s' <- justCheck s ex + return $ (ExtR r' s', typ) --- is this all? + + _ -> prtFail "record extension not meaningful for" typ + + FV vs -> do + ttys <- mapM (flip check typ) vs +--- checkIfComplexVariantType trm typ + return (FV (map fst ttys), typ) --- typ' ? + + S tab arg -> checks [ do + (tab',ty) <- infer tab + ty' <- comp ty + case ty' of + Table p t -> do + (arg',val) <- check arg p + checkEq typ t trm + return (S tab' arg', t) + _ -> raise $ "table type expected for applied table instead of" +++ + prtType env ty' + , do + (arg',ty) <- infer arg + ty' <- comp ty + (tab',_) <- check tab (Table ty' typ) + return (S tab' arg', typ) + ] + Let (x,(mty,def)) body -> case mty of + Just ty -> do + (def',ty') <- check def ty + checkUpdate (x,ty') + body' <- justCheck body typ + checkReset + return (Let (x,(Just ty',def')) body', typ) + _ -> do + (def',ty) <- infer def -- tries to infer type of local constant + check (Let (x,(Just ty,def')) body) typ + + _ -> do + (trm',ty') <- infer trm + termWith trm' $ checkEq typ ty' trm' + where + cnc = env + infer = inferLType env + comp = computeLType env + + check = checkLType env + + justCheck ty te = check ty te >>= return . fst + + checkEq = checkEqLType env + + recParts rr t = (RecType rr1,RecType rr2) where + (rr1,rr2) = partition (flip elem (map fst t) . fst) rr + + checkM rms (l,ty) = case lookup l rms of + Just (Just ty0,t) -> do + checkEq ty ty0 t + (t',ty') <- check t ty + return (l,(Just ty',t')) + Just (_,t) -> do + (t',ty') <- check t ty + return (l,(Just ty',t')) + _ -> prtFail "cannot find value for label" l + + checkCase arg val (p,t) = do + cont <- pattContext env arg p + i <- checkUpdates cont + t' <- justCheck t val + checkResets i + return (p,t') + +pattContext :: LTEnv -> Type -> Patt -> Check Context +pattContext env typ p = case p of + PV x | not (isWildIdent x) -> return [(x,typ)] + PP q c ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006 + t <- checkErr $ lookupResType cnc q c + (cont,v) <- checkErr $ typeFormCnc t + checkCond ("wrong number of arguments for constructor in" +++ prt p) + (length cont == length ps) + checkEqLType env typ v (patt2term p) + mapM (uncurry (pattContext env)) (zip (map snd cont) ps) >>= return . concat + PR r -> do + typ' <- computeLType env typ + case typ' of + RecType t -> do + let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]] + ----- checkWarn $ prt p ++++ show pts ----- debug + mapM (uncurry (pattContext env)) pts >>= return . concat + _ -> prtFail "record type expected for pattern instead of" typ' + PT t p' -> do + checkEqLType env typ t (patt2term p') + pattContext env typ p' + + PAs x p -> do + g <- pattContext env typ p + return $ (x,typ):g + + PAlt p' q -> do + g1 <- pattContext env typ p' + g2 <- pattContext env typ q + let pts = [pt | pt <- g1, notElem pt g2] ++ [pt | pt <- g2, notElem pt g1] + checkCond + ("incompatible bindings of" +++ + unwords (nub (map (prt . fst) pts))+++ + "in pattern alterantives" +++ prt p) (null pts) + return g1 -- must be g1 == g2 + PSeq p q -> do + g1 <- pattContext env typ p + g2 <- pattContext env typ q + return $ g1 ++ g2 + PRep p' -> noBind typeStr p' + PNeg p' -> noBind typ p' + + _ -> return [] ---- check types! + where + cnc = env + noBind typ p' = do + co <- pattContext env typ p' + if not (null co) + then checkWarn ("no variable bound inside pattern" +++ prt p) + >> return [] + else return [] + +-- auxiliaries + +type LTEnv = SourceGrammar + +termWith :: Term -> Check Type -> Check (Term, Type) +termWith t ct = do + ty <- ct + return (t,ty) + +-- | light-weight substitution for dep. types +substituteLType :: Context -> Type -> Check Type +substituteLType g t = case t of + Vr x -> return $ maybe t id $ lookup x g + _ -> composOp (substituteLType g) t + +-- | compositional check\/infer of binary operations +check2 :: (Term -> Check Term) -> (Term -> Term -> Term) -> + Term -> Term -> Type -> Check (Term,Type) +check2 chk con a b t = do + a' <- chk a + b' <- chk b + return (con a' b', t) + +checkEqLType :: LTEnv -> Type -> Type -> Term -> Check Type +checkEqLType env t u trm = do + (b,t',u',s) <- checkIfEqLType env t u trm + case b of + True -> return t' + False -> raise $ s +++ "type of" +++ prt trm +++ + ": expected:" +++ prtType env t ++++ + "inferred:" +++ prtType env u + +checkIfEqLType :: LTEnv -> Type -> Type -> Term -> Check (Bool,Type,Type,String) +checkIfEqLType env t u trm = do + t' <- comp t + u' <- comp u + case t' == u' || alpha [] t' u' of + True -> return (True,t',u',[]) + -- forgive missing lock fields by only generating a warning. + --- better: use a flag to forgive? (AR 31/1/2006) + _ -> case missingLock [] t' u' of + Ok lo -> do + checkWarn $ "WARNING: missing lock field" +++ unwords (map prt lo) + return (True,t',u',[]) + Bad s -> return (False,t',u',s) + + where + + -- t is a subtype of u + --- quick hack version of TC.eqVal + alpha g t u = case (t,u) of + + -- error (the empty type!) is subtype of any other type + (_,u) | u == typeError -> True + + -- contravariance + (Prod x a b, Prod y c d) -> alpha g c a && alpha ((x,y):g) b d + + -- record subtyping + (RecType rs, RecType ts) -> all (\ (l,a) -> + any (\ (k,b) -> alpha g a b && l == k) ts) rs + (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s' + (ExtR r s, t) -> alpha g r t || alpha g s t + + -- the following say that Ints n is a subset of Int and of Ints m >= n + (t,u) | Just m <- isTypeInts t, Just n <- isTypeInts t -> m >= n + | Just _ <- isTypeInts t, u == typeInt -> True ---- check size! + | t == typeInt, Just _ <- isTypeInts u -> True ---- why this ???? AR 11/12/2005 + + ---- this should be made in Rename + (Q m a, Q n b) | a == b -> elem m (allExtendsPlus env n) + || elem n (allExtendsPlus env m) + || m == n --- for Predef + (QC m a, QC n b) | a == b -> elem m (allExtendsPlus env n) + || elem n (allExtendsPlus env m) + (QC m a, Q n b) | a == b -> elem m (allExtendsPlus env n) + || elem n (allExtendsPlus env m) + (Q m a, QC n b) | a == b -> elem m (allExtendsPlus env n) + || elem n (allExtendsPlus env m) + + (Table a b, Table c d) -> alpha g a c && alpha g b d + (Vr x, Vr y) -> x == y || elem (x,y) g || elem (y,x) g + _ -> t == u + --- the following should be one-way coercions only. AR 4/1/2001 + || elem t sTypes && elem u sTypes + || (t == typeType && u == typePType) + || (u == typeType && t == typePType) + + missingLock g t u = case (t,u) of + (RecType rs, RecType ts) -> + let + ls = [l | (l,a) <- rs, + not (any (\ (k,b) -> alpha g a b && l == k) ts)] + (locks,others) = partition isLockLabel ls + in case others of + _:_ -> Bad $ "missing record fields" +++ unwords (map prt others) + _ -> return locks + -- contravariance + (Prod x a b, Prod y c d) -> do + ls1 <- missingLock g c a + ls2 <- missingLock g b d + return $ ls1 ++ ls2 + + _ -> Bad "" + + sTypes = [typeStr, typeTok, typeString] + comp = computeLType env + +-- printing a type with a lock field lock_C as C +prtType :: LTEnv -> Type -> String +prtType env ty = case ty of + RecType fs -> case filter isLockLabel $ map fst fs of + [lock] -> (drop 5 $ prt lock) --- ++++ "Full form" +++ prt ty + _ -> prtt ty + Prod x a b -> prtType env a +++ "->" +++ prtType env b + _ -> prtt ty + where + prtt t = prt t + ---- use computeLType gr to check if really equal to the cat with lock + + +-- | linearization types and defaults +linTypeOfType :: SourceGrammar -> Ident -> Type -> Check (Context,Type) +linTypeOfType cnc m typ = do + (cont,cat) <- checkErr $ typeSkeleton typ + val <- lookLin cat + args <- mapM mkLinArg (zip [0..] cont) + return (args, val) + where + mkLinArg (i,(n,mc@(m,cat))) = do + val <- lookLin mc + let vars = mkRecType varLabel $ replicate n typeStr + symb = argIdent n cat i + rec <- if n==0 then return val else + checkErr $ errIn ("extending" +++ prt vars +++ "with" +++ prt val) $ + plusRecType vars val + return (symb,rec) + lookLin (_,c) = checks [ --- rather: update with defLinType ? + checkErr (lookupLincat cnc m c) >>= computeLType cnc + ,return defLinType + ] + +-- | dependency check, detecting circularities and returning topo-sorted list + +allOperDependencies :: Ident -> BinTree Ident Info -> [(Ident,[Ident])] +allOperDependencies m = allDependencies (==m) + +allDependencies :: (Ident -> Bool) -> BinTree Ident Info -> [(Ident,[Ident])] +allDependencies ism b = + [(f, nub (concatMap opty (pts i))) | (f,i) <- tree2list b] + where + opersIn t = case t of + Q n c | ism n -> [c] + QC n c | ism n -> [c] + _ -> collectOp opersIn t + opty (Yes ty) = opersIn ty + opty _ = [] + pts i = case i of + ResOper pty pt -> [pty,pt] + ResParam (Yes (ps,_)) -> [Yes t | (_,cont) <- ps, (_,t) <- cont] + CncCat pty _ _ -> [pty] + CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type)) + AbsFun pty ptr -> [pty] --- ptr is def, which can be mutual + AbsCat (Yes co) _ -> [Yes ty | (_,ty) <- co] + _ -> [] + +topoSortOpers :: [(Ident,[Ident])] -> Err [Ident] +topoSortOpers st = do + let eops = topoTest st + either + return + (\ops -> Bad ("circular definitions:" +++ unwords (map prt (head ops)))) + eops diff --git a/src/GF/Compile/Compute.hs b/src/GF/Compile/Compute.hs new file mode 100644 index 000000000..f35e7c6a9 --- /dev/null +++ b/src/GF/Compile/Compute.hs @@ -0,0 +1,429 @@ +---------------------------------------------------------------------- +-- | +-- Module : Compute +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/01 15:39:12 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.19 $ +-- +-- Computation of source terms. Used in compilation and in @cc@ command. +----------------------------------------------------------------------------- + +module GF.Compile.Compute (computeConcrete, computeTerm,computeConcreteRec) where + +import GF.Data.Operations +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Infra.Option +import GF.Data.Str +import GF.Grammar.PrGrammar +import GF.Infra.Modules +import GF.Grammar.Predef +import GF.Grammar.Macros +import GF.Grammar.Lookup +import GF.Compile.Refresh +import GF.Grammar.PatternMatch +import GF.Grammar.Lockfield (isLockLabel) ---- + +import GF.Grammar.AppPredefined + +import Data.List (nub,intersperse) +import Control.Monad (liftM2, liftM) + +-- | computation of concrete syntax terms into normal form +-- used mainly for partial evaluation +computeConcrete :: SourceGrammar -> Term -> Err Term +computeConcrete g t = {- refreshTerm t >>= -} computeTerm g [] t +computeConcreteRec g t = {- refreshTerm t >>= -} computeTermOpt True g [] t + +computeTerm :: SourceGrammar -> Substitution -> Term -> Err Term +computeTerm = computeTermOpt False + +-- rec=True is used if it cannot be assumed that looked-up constants +-- have already been computed (mainly with -optimize=noexpand in .gfr) + +computeTermOpt :: Bool -> SourceGrammar -> Substitution -> Term -> Err Term +computeTermOpt rec gr = comput True where + + comput full g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging + case t of + + Q p c | p == cPredef -> return t + | otherwise -> look p c + + -- if computed do nothing + Computed t' -> return $ unComputed t' + + Vr x -> do + t' <- maybe (prtBad ("no value given to variable") x) return $ lookup x g + case t' of + _ | t == t' -> return t + _ -> comp g t' + + -- Abs x@(IA _) b -> do + Abs x b | full -> do + let (xs,b1) = termFormCnc t + b' <- comp ([(x,Vr x) | x <- xs] ++ g) b1 + return $ mkAbs xs b' + -- b' <- comp (ext x (Vr x) g) b + -- return $ Abs x b' + Abs _ _ -> return t -- hnf + + Let (x,(_,a)) b -> do + a' <- comp g a + comp (ext x a' g) b + + Prod x a b -> do + a' <- comp g a + b' <- comp (ext x (Vr x) g) b + return $ Prod x a' b' + + -- beta-convert + App f a -> case appForm t of + (h,as) | length as > 1 -> do + h' <- hnf g h + as' <- mapM (comp g) as + case h' of + _ | not (null [() | FV _ <- as']) -> compApp g (mkApp h' as') + c@(QC _ _) -> do + return $ mkApp c as' + Q mod f | mod == cPredef -> do + (t',b) <- appPredefined (mkApp h' as') + if b then return t' else comp g t' + + Abs _ _ -> do + let (xs,b) = termFormCnc h' + let g' = (zip xs as') ++ g + let as2 = drop (length xs) as' + let xs2 = drop (length as') xs + b' <- comp g' (mkAbs xs2 b) + if null as2 then return b' else comp g (mkApp b' as2) + + _ -> compApp g (mkApp h' as') + _ -> compApp g t + + P t l | isLockLabel l -> return $ R [] + ---- a workaround 18/2/2005: take this away and find the reason + ---- why earlier compilation destroys the lock field + + + P t l -> do + t' <- comp g t + case t' of + FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . variants + R r -> maybe (prtBad "no value for label" l) (comp g . snd) $ + lookup l $ reverse r + + ExtR a (R b) -> + case comp g (P (R b) l) of + Ok v -> return v + _ -> comp g (P a l) + +--- { - --- this is incorrect, since b can contain the proper value + ExtR (R a) b -> -- NOT POSSIBLE both a and b records! + case comp g (P (R a) l) of + Ok v -> return v + _ -> comp g (P b l) +--- - } --- + + S (T i cs) e -> prawitz g i (flip P l) cs e + S (V i cs) e -> prawitzV g i (flip P l) cs e + + _ -> returnC $ P t' l + + PI t l i -> comp g $ P t l ----- + + S t v -> do + t' <- compTable g t + v' <- comp g v + t1 <- case t' of +---- V (RecType fs) _ -> uncurrySelect g fs t' v' +---- T (TComp (RecType fs)) _ -> uncurrySelect g fs t' v' + _ -> return $ S t' v' + compSelect g t1 + + -- normalize away empty tokens + K "" -> return Empty + + -- glue if you can + Glue x0 y0 -> do + x <- comp g x0 + y <- comp g y0 + case (x,y) of + (FV ks,_) -> do + kys <- mapM (comp g . flip Glue y) ks + return $ variants kys + (_,FV ks) -> do + xks <- mapM (comp g . Glue x) ks + return $ variants xks + + (S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e + (s, S (T i cs) e) -> prawitz g i (Glue s) cs e + (S (V i cs) e, s) -> prawitzV g i (flip Glue s) cs e + (s, S (V i cs) e) -> prawitzV g i (Glue s) cs e + (_,Empty) -> return x + (Empty,_) -> return y + (K a, K b) -> return $ K (a ++ b) + (_, Alts (d,vs)) -> do +---- (K a, Alts (d,vs)) -> do + let glx = Glue x + comp g $ Alts (glx d, [(glx v,c) | (v,c) <- vs]) + (Alts _, ka) -> checks [do + y' <- strsFromTerm ka +---- (Alts _, K a) -> checks [do + x' <- strsFromTerm x -- this may fail when compiling opers + return $ variants [ + foldr1 C (map K (str2strings (glueStr v u))) | v <- x', u <- y'] +---- foldr1 C (map K (str2strings (glueStr v (str a)))) | v <- x'] + ,return $ Glue x y + ] + (C u v,_) -> comp g $ C u (Glue v y) + + _ -> do + mapM_ checkNoArgVars [x,y] + r <- composOp (comp g) t + returnC r + + Alts _ -> do + r <- composOp (comp g) t + returnC r + + -- remove empty + C a b -> do + a' <- comp g a + b' <- comp g b + case (a',b') of + (Alts _, K a) -> checks [do + as <- strsFromTerm a' -- this may fail when compiling opers + return $ variants [ + foldr1 C (map K (str2strings (plusStr v (str a)))) | v <- as] + , + return $ C a' b' + ] + (Empty,_) -> returnC b' + (_,Empty) -> returnC a' + _ -> returnC $ C a' b' + + -- reduce free variation as much as you can + FV ts -> mapM (comp g) ts >>= returnC . variants + + -- merge record extensions if you can + ExtR r s -> do + r' <- comp g r + s' <- comp g s + case (r',s') of + (R rs, R ss) -> plusRecord r' s' + (RecType rs, RecType ss) -> plusRecType r' s' + _ -> return $ ExtR r' s' + + T _ _ -> compTable g t + V _ _ -> compTable g t + + -- otherwise go ahead + _ -> composOp (comp g) t >>= returnC + + where + + compApp g (App f a) = do + f' <- hnf g f + a' <- comp g a + case (f',a') of + (Abs x b, FV as) -> + mapM (\c -> comp (ext x c g) b) as >>= return . variants + (_, FV as) -> mapM (\c -> comp g (App f' c)) as >>= return . variants + (FV fs, _) -> mapM (\c -> comp g (App c a')) fs >>= return . variants + (Abs x b,_) -> comp (ext x a' g) b + + (QC _ _,_) -> returnC $ App f' a' + + (S (T i cs) e,_) -> prawitz g i (flip App a') cs e + (S (V i cs) e,_) -> prawitzV g i (flip App a') cs e + + _ -> do + (t',b) <- appPredefined (App f' a') + if b then return t' else comp g t' + + hnf = comput False + comp = comput True + + look p c + | rec = lookupResDef gr p c >>= comp [] + | otherwise = lookupResDef gr p c + + ext x a g = (x,a):g + + returnC = return --- . computed + + variants ts = case nub ts of + [t] -> t + ts -> FV ts + + isCan v = case v of + Con _ -> True + QC _ _ -> True + App f a -> isCan f && isCan a + R rs -> all (isCan . snd . snd) rs + _ -> False + + compPatternMacro p = case p of + PM m c -> case look m c of + Ok (EPatt p') -> compPatternMacro p' + _ -> prtBad "pattern expected as value of" p ---- should be in CheckGr + PAs x p -> do + p' <- compPatternMacro p + return $ PAs x p' + PAlt p q -> do + p' <- compPatternMacro p + q' <- compPatternMacro q + return $ PAlt p' q' + PSeq p q -> do + p' <- compPatternMacro p + q' <- compPatternMacro q + return $ PSeq p' q' + PRep p -> do + p' <- compPatternMacro p + return $ PRep p' + PNeg p -> do + p' <- compPatternMacro p + return $ PNeg p' + PR rs -> do + rs' <- mapPairsM compPatternMacro rs + return $ PR rs' + + _ -> return p + + compSelect g (S t' v') = case v' of + FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants + _ -> case t' of + FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants + + T _ [(PV IW,c)] -> comp g c --- an optimization + T _ [(PT _ (PV IW),c)] -> comp g c + + T _ [(PV z,c)] -> comp (ext z v' g) c --- another optimization + T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c + + -- course-of-values table: look up by index, no pattern matching needed + V ptyp ts -> do + vs <- allParamValues gr ptyp + case lookup v' (zip vs [0 .. length vs - 1]) of + Just i -> comp g $ ts !! i + _ -> return $ S t' v' -- if v' is not canonical + T _ cc -> case matchPattern cc v' of + Ok (c,g') -> comp (g' ++ g) c + _ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t + _ -> return $ S t' v' -- if v' is not canonical + + S (T i cs) e -> prawitz g i (flip S v') cs e + S (V i cs) e -> prawitzV g i (flip S v') cs e + _ -> returnC $ S t' v' + + -- case-expand tables + -- if already expanded, don't expand again + compTable g t = case t of + T i@(TComp ty) cs -> do + -- if there are no variables, don't even go inside + cs' <- if (null g) then return cs else mapPairsM (comp g) cs +---- return $ V ty (map snd cs') + return $ T i cs' + V ty cs -> do + ty' <- comp g ty + -- if there are no variables, don't even go inside + cs' <- if (null g) then return cs else mapM (comp g) cs + return $ V ty' cs' + + T i cs -> do + pty0 <- getTableType i + ptyp <- comp g pty0 + case allParamValues gr ptyp of + Ok vs -> do + + ps0 <- mapM (compPatternMacro . fst) cs + cs' <- mapM (compBranchOpt g) (zip ps0 (map snd cs)) + sts <- mapM (matchPattern cs') vs + ts <- mapM (\ (c,g') -> comp (g' ++ g) c) sts + ps <- mapM term2patt vs + let ps' = ps --- PT ptyp (head ps) : tail ps +---- return $ V ptyp ts -- to save space, just course of values + return $ T (TComp ptyp) (zip ps' ts) + _ -> do + cs' <- mapM (compBranch g) cs + return $ T i cs' -- happens with variable types + _ -> comp g t + + compBranch g (p,v) = do + let g' = contP p ++ g + v' <- comp g' v + return (p,v') + + compBranchOpt g c@(p,v) = case contP p of + [] -> return c + _ -> err (const (return c)) return $ compBranch g c + + contP p = case p of + PV x -> [(x,Vr x)] + PC _ ps -> concatMap contP ps + PP _ _ ps -> concatMap contP ps + PT _ p -> contP p + PR rs -> concatMap (contP . snd) rs + + PAs x p -> (x,Vr x) : contP p + + PSeq p q -> concatMap contP [p,q] + PAlt p q -> concatMap contP [p,q] + PRep p -> contP p + PNeg p -> contP p + + _ -> [] + + prawitz g i f cs e = do + cs' <- mapM (compBranch g) [(p, f v) | (p,v) <- cs] + return $ S (T i cs') e + prawitzV g i f cs e = do + cs' <- mapM (comp g) [(f v) | v <- cs] + return $ S (V i cs') e + +{- ---- + uncurrySelect g fs t v = do + ts <- mapM (allParamValues gr . snd) fs + vs <- mapM (comp g) [P v r | r <- map fst fs] + return $ reorderSelect t fs ts vs + + reorderSelect t fs pss vs = case (t,fs,pss,vs) of + (V _ ts, f:fs1, ps:pss1, v:vs1) -> + S (V (snd f) + [reorderSelect (V (RecType fs1) t) fs1 pss1 vs1 | + t <- segments (length ts `div` length ps) ts]) v + (T (TComp _) cs, f:fs1, ps:pss1, v:vs1) -> + S (T (TComp (snd f)) + [(p,reorderSelect (T (TComp (RecType fs1)) c) fs1 pss1 vs1) | + (ep,c) <- zip ps (segments (length cs `div` length ps) cs), + let Ok p = term2patt ep]) v + _ -> t + + segments i xs = + let (x0,xs1) = splitAt i xs in x0 : takeWhile (not . null) (segments i xs1) +-} + + +-- | argument variables cannot be glued +checkNoArgVars :: Term -> Err Term +checkNoArgVars t = case t of + Vr (IA _ _) -> Bad $ glueErrorMsg $ prt t + Vr (IAV _ _ _) -> Bad $ glueErrorMsg $ prt t + _ -> composOp checkNoArgVars t + +glueErrorMsg s = + "Cannot glue (+) term with run-time variable" +++ s ++ "." ++++ + "Use Prelude.bind instead." + +getArgType t = case t of + V ty _ -> return ty + T (TComp ty) _ -> return ty + _ -> prtBad "cannot get argument type of table" t + + + diff --git a/src/GF/Compile/Export.hs b/src/GF/Compile/Export.hs new file mode 100644 index 000000000..9e9a99e99 --- /dev/null +++ b/src/GF/Compile/Export.hs @@ -0,0 +1,61 @@ +module GF.Compile.Export where + +import PGF.CId +import PGF.Data (PGF(..)) +import PGF.Raw.Print (printTree) +import PGF.Raw.Convert (fromPGF) +import GF.Compile.GFCCtoHaskell +import GF.Compile.GFCCtoJS +import GF.Infra.Option +import GF.Speech.CFG +import GF.Speech.PGFToCFG +import GF.Speech.SRGS_XML +import GF.Speech.JSGF +import GF.Speech.GSL +import GF.Speech.VoiceXML +import GF.Speech.SLF +import GF.Speech.PrRegExp +import GF.Text.UTF8 + +import Data.Maybe +import System.FilePath + +-- top-level access to code generation + +exportPGF :: Options + -> OutputFormat + -> PGF + -> [(FilePath,String)] -- ^ List of recommended file names and contents. +exportPGF opts fmt pgf = + case fmt of + FmtPGF -> multi "pgf" printPGF + FmtJavaScript -> multi "js" pgf2js + FmtHaskell -> multi "hs" (grammar2haskell name) + FmtHaskell_GADT -> multi "hs" (grammar2haskellGADT name) + FmtBNF -> single "bnf" bnfPrinter + FmtSRGS_XML -> single "grxml" (srgsXmlPrinter sisr) + FmtJSGF -> single "jsgf" (jsgfPrinter sisr) + FmtGSL -> single "gsl" gslPrinter + FmtVoiceXML -> single "vxml" grammar2vxml + FmtSLF -> single ".slf" slfPrinter + FmtRegExp -> single ".rexp" regexpPrinter + FmtFA -> single ".dot" slfGraphvizPrinter + where + name = fromMaybe (prCId (absname pgf)) (moduleFlag optName opts) + sisr = flag optSISR opts + + multi :: String -> (PGF -> String) -> [(FilePath,String)] + multi ext pr = [(name <.> ext, pr pgf)] + + single :: String -> (PGF -> CId -> String) -> [(FilePath,String)] + single ext pr = [(prCId cnc <.> ext, pr pgf cnc) | cnc <- cncnames pgf] + +-- | Get the name of the concrete syntax to generate output from. +-- FIXME: there should be an option to change this. +outputConcr :: PGF -> CId +outputConcr pgf = case cncnames pgf of + [] -> error "No concrete syntax." + cnc:_ -> cnc + +printPGF :: PGF -> String +printPGF = encodeUTF8 . printTree . fromPGF diff --git a/src/GF/Compile/Extend.hs b/src/GF/Compile/Extend.hs new file mode 100644 index 000000000..8344a1696 --- /dev/null +++ b/src/GF/Compile/Extend.hs @@ -0,0 +1,138 @@ +---------------------------------------------------------------------- +-- | +-- Module : Extend +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/30 21:08:14 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.18 $ +-- +-- AR 14\/5\/2003 -- 11\/11 +-- +-- The top-level function 'extendModule' +-- extends a module symbol table by indirections to the module it extends +----------------------------------------------------------------------------- + +module GF.Compile.Extend (extendModule, extendMod + ) where + +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Grammar.PrGrammar +import GF.Infra.Modules +import GF.Compile.Update +import GF.Grammar.Macros +import GF.Data.Operations + +import Control.Monad + +extendModule :: [SourceModule] -> SourceModule -> Err SourceModule +extendModule ms (name,mod) = case mod of + + ---- Just to allow inheritance in incomplete concrete (which are not + ---- compiled anyway), extensions are not built for them. + ---- Should be replaced by real control. AR 4/2/2005 + ModMod m | mstatus m == MSIncomplete && isModCnc m -> return (name,mod) + + ModMod m -> do + mod' <- foldM extOne m (extend m) + return (name,ModMod mod') + where + extOne mo (n,cond) = do + (m0,isCompl) <- do + m <- lookupModMod (MGrammar ms) n + + -- test that the module types match, and find out if the old is complete + testErr (sameMType (mtype m) (mtype mo)) + ("illegal extension type to module" +++ prt name) + return (m, isCompleteModule m) + + -- build extension in a way depending on whether the old module is complete + js1 <- extendMod isCompl (n, isInherited cond) name (jments m0) (jments mo) + + -- if incomplete, throw away extension information + let es = extend mo + let es' = if isCompl then es else (filter ((/=n) . fst) es) + return $ mo {extend = es', jments = js1} + +-- | When extending a complete module: new information is inserted, +-- and the process is interrupted if unification fails. +-- If the extended module is incomplete, its judgements are just copied. +extendMod :: Bool -> (Ident,Ident -> Bool) -> Ident -> + BinTree Ident Info -> BinTree Ident Info -> + Err (BinTree Ident Info) +extendMod isCompl (name,cond) base old new = foldM try new $ tree2list old where + try t i@(c,_) | not (cond c) = return t + try t i@(c,_) = errIn ("constant" +++ prt c) $ + tryInsert (extendAnyInfo isCompl name base) indirIf t i + indirIf = if isCompl then indirInfo name else id + +indirInfo :: Ident -> Info -> Info +indirInfo n info = AnyInd b n' where + (b,n') = case info of + ResValue _ -> (True,n) + ResParam _ -> (True,n) + AbsFun _ (Yes EData) -> (True,n) + AnyInd b k -> (b,k) + _ -> (False,n) ---- canonical in Abs + +perhIndir :: Ident -> Perh a -> Perh a +perhIndir n p = case p of + Yes _ -> May n + _ -> p + +extendAnyInfo :: Bool -> Ident -> Ident -> Info -> Info -> Err Info +extendAnyInfo isc n o i j = + errIn ("building extension for" +++ prt n +++ "in" +++ prt o) $ case (i,j) of + (AbsCat mc1 mf1, AbsCat mc2 mf2) -> + liftM2 AbsCat (updn isc n mc1 mc2) (updn isc n mf1 mf2) --- add cstrs + (AbsFun mt1 md1, AbsFun mt2 md2) -> + liftM2 AbsFun (updn isc n mt1 mt2) (updn isc n md1 md2) --- add defs + (ResParam mt1, ResParam mt2) -> + liftM ResParam $ updn isc n mt1 mt2 + (ResValue mt1, ResValue mt2) -> + liftM ResValue $ updn isc n mt1 mt2 + (_, ResOverload ms t) | elem n ms -> + return $ ResOverload ms t + (ResOper mt1 m1, ResOper mt2 m2) -> ---- extendResOper n mt1 m1 mt2 m2 + liftM2 ResOper (updn isc n mt1 mt2) (updn isc n m1 m2) + (CncCat mc1 mf1 mp1, CncCat mc2 mf2 mp2) -> + liftM3 CncCat (updn isc n mc1 mc2) (updn isc n mf1 mf2) (updn isc n mp1 mp2) + (CncFun m mt1 md1, CncFun _ mt2 md2) -> + liftM2 (CncFun m) (updn isc n mt1 mt2) (updn isc n md1 md2) + +---- (AnyInd _ _, ResOper _ _) -> return j ---- + + (AnyInd b1 m1, AnyInd b2 m2) -> do + testErr (b1 == b2) "inconsistent indirection status" +---- commented out as work-around for a spurious problem in +---- TestResourceFre; should look at building of completion. 17/11/2004 + testErr (m1 == m2) $ + "different sources of indirection: " +++ show m1 +++ show m2 + return i + + _ -> Bad $ "cannot unify information in" ++++ show i ++++ "and" ++++ show j + +--- where + +updn isc n = if isc then (updatePerhaps n) else (updatePerhapsHard n) +updc isc n = if True then (updatePerhaps n) else (updatePerhapsHard n) + + + +{- ---- no more needed: this is done in Rebuild +-- opers declared in an interface and defined in an instance are a special case + +extendResOper n mt1 m1 mt2 m2 = case (m1,m2) of + (Nope,_) -> return $ ResOper (strip mt1) m2 + _ -> liftM2 ResOper (updatePerhaps n mt1 mt2) (updatePerhaps n m1 m2) + where + strip (Yes t) = Yes $ strp t + strip m = m + strp t = case t of + Q _ c -> Vr c + QC _ c -> Vr c + _ -> composSafeOp strp t +-} diff --git a/src/GF/Compile/GFCCtoHaskell.hs b/src/GF/Compile/GFCCtoHaskell.hs new file mode 100644 index 000000000..59db9c364 --- /dev/null +++ b/src/GF/Compile/GFCCtoHaskell.hs @@ -0,0 +1,213 @@ +---------------------------------------------------------------------- +-- | +-- Module : GFCCtoHaskell +-- Maintainer : Aarne Ranta +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/06/17 12:39:07 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.8 $ +-- +-- to write a GF abstract grammar into a Haskell module with translations from +-- data objects into GF trees. Example: GSyntax for Agda. +-- AR 11/11/1999 -- 7/12/2000 -- 18/5/2004 +----------------------------------------------------------------------------- + +module GF.Compile.GFCCtoHaskell (grammar2haskell, grammar2haskellGADT) where + +import PGF.CId +import PGF.Data +import PGF.Macros + +import GF.Data.Operations +import GF.Text.UTF8 + +import Data.List --(isPrefixOf, find, intersperse) +import qualified Data.Map as Map + +-- | the main function +grammar2haskell :: String -- ^ Module name. + -> PGF + -> String +grammar2haskell name gr = encodeUTF8 $ foldr (++++) [] $ + haskPreamble name ++ [datatypes gr', gfinstances gr'] + where gr' = hSkeleton gr + +grammar2haskellGADT :: String -> PGF -> String +grammar2haskellGADT name gr = encodeUTF8 $ foldr (++++) [] $ + ["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++ + haskPreamble name ++ [datatypesGADT gr', gfinstances gr'] + where gr' = hSkeleton gr + +-- | by this you can prefix all identifiers with stg; the default is 'G' +gId :: OIdent -> OIdent +gId i = 'G':i + +haskPreamble name = + [ + "module " ++ name ++ " where", + "", + "import PGF", + "----------------------------------------------------", + "-- automatic translation from GF to Haskell", + "----------------------------------------------------", + "", + "class Gf a where", + " gf :: a -> Tree", + " fg :: Tree -> a", + "", + predefInst "GString" "String" "Lit (LStr s)", + "", + predefInst "GInt" "Integer" "Lit (LInt s)", + "", + predefInst "GFloat" "Double" "Lit (LFlt s)", + "", + "----------------------------------------------------", + "-- below this line machine-generated", + "----------------------------------------------------", + "" + ] + +predefInst gtyp typ patt = + "newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ " deriving Show" +++++ + "instance Gf" +++ gtyp +++ "where" ++++ + " gf (" ++ gtyp +++ "s) =" +++ patt ++++ + " fg t =" ++++ + " case t of" ++++ + " " +++ patt +++ " ->" +++ gtyp +++ "s" ++++ + " _ -> error (\"no" +++ gtyp +++ "\" ++ show t)" + +type OIdent = String + +type HSkeleton = [(OIdent, [(OIdent, [OIdent])])] + +datatypes, gfinstances :: (String,HSkeleton) -> String +datatypes = (foldr (+++++) "") . (filter (/="")) . (map hDatatype) . snd +gfinstances (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (gfInstance m)) g + +hDatatype :: (OIdent, [(OIdent, [OIdent])]) -> String +gfInstance :: String -> (OIdent, [(OIdent, [OIdent])]) -> String + +hDatatype ("Cn",_) = "" --- +hDatatype (cat,[]) = "" +hDatatype (cat,rules) | isListCat (cat,rules) = + "newtype" +++ gId cat +++ "=" +++ gId cat +++ "[" ++ gId (elemCat cat) ++ "]" + +++ "deriving Show" +hDatatype (cat,rules) = + "data" +++ gId cat +++ "=" ++ + (if length rules == 1 then "" else "\n ") +++ + foldr1 (\x y -> x ++ "\n |" +++ y) + [gId f +++ foldr (+++) "" (map gId xx) | (f,xx) <- rules] ++++ + " deriving Show" + +-- GADT version of data types +datatypesGADT :: (String,HSkeleton) -> String +datatypesGADT (_,skel) = + unlines (concatMap hCatTypeGADT skel) + +++++ + "data Tree :: * -> * where" ++++ unlines (concatMap (map (" "++) . hDatatypeGADT) skel) + +hCatTypeGADT :: (OIdent, [(OIdent, [OIdent])]) -> [String] +hCatTypeGADT (cat,rules) + = ["type"+++gId cat+++"="+++"Tree"+++gId cat++"_", + "data"+++gId cat++"_"] + +hDatatypeGADT :: (OIdent, [(OIdent, [OIdent])]) -> [String] +hDatatypeGADT (cat, rules) + | isListCat (cat,rules) = [gId cat+++"::"+++"["++gId (elemCat cat)++"]" +++ "->" +++ t] + | otherwise = + [ gId f +++ "::" +++ concatMap (\a -> gId a +++ "-> ") args ++ t | (f,args) <- rules ] + where t = "Tree" +++ gId cat ++ "_" + +gfInstance m crs = hInstance m crs ++++ fInstance m crs + +----hInstance m ("Cn",_) = "" --- seems to belong to an old applic. AR 18/5/2004 +hInstance m (cat,[]) = "" +hInstance m (cat,rules) + | isListCat (cat,rules) = + "instance Gf" +++ gId cat +++ "where" ++++ + " gf (" ++ gId cat +++ "[" ++ concat (intersperse "," baseVars) ++ "])" + +++ "=" +++ mkRHS ("Base"++ec) baseVars ++++ + " gf (" ++ gId cat +++ "(x:xs)) = " + ++ mkRHS ("Cons"++ec) ["x",prParenth (gId cat+++"xs")] +-- no show for GADTs +-- ++++ " gf (" ++ gId cat +++ "xs) = error (\"Bad " ++ cat ++ " value: \" ++ show xs)" + | otherwise = + "instance Gf" +++ gId cat +++ "where\n" ++ + unlines [mkInst f xx | (f,xx) <- rules] + where + ec = elemCat cat + baseVars = mkVars (baseSize (cat,rules)) + mkInst f xx = let xx' = mkVars (length xx) in " gf " ++ + (if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++ + "=" +++ mkRHS f xx' + mkVars n = ["x" ++ show i | i <- [1..n]] + mkRHS f vars = "Fun (mkCId \"" ++ f ++ "\")" +++ + "[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]" + + +----fInstance m ("Cn",_) = "" --- +fInstance m (cat,[]) = "" +fInstance m (cat,rules) = + " fg t =" ++++ + " case t of" ++++ + unlines [mkInst f xx | (f,xx) <- rules] ++++ + " _ -> error (\"no" +++ cat ++ " \" ++ show t)" + where + mkInst f xx = + " Fun i " ++ + "[" ++ prTList "," xx' ++ "]" +++ + "| i == mkCId \"" ++ f ++ "\" ->" +++ mkRHS f xx' + where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]] + mkRHS f vars + | isListCat (cat,rules) = + if "Base" `isPrefixOf` f then + gId cat +++ "[" ++ prTList ", " [ "fg" +++ x | x <- vars ] ++ "]" + else + let (i,t) = (init vars,last vars) + in "let" +++ gId cat +++ "xs = fg " ++ t +++ "in" +++ + gId cat +++ prParenth (prTList ":" (["fg"+++v | v <- i] ++ ["xs"])) + | otherwise = + gId f +++ + prTList " " [prParenth ("fg" +++ x) | x <- vars] + + +--type HSkeleton = [(OIdent, [(OIdent, [OIdent])])] +hSkeleton :: PGF -> (String,HSkeleton) +hSkeleton gr = + (prCId (absname gr), + [(prCId c, [(prCId f, map prCId cs) | (f, (cs,_)) <- fs]) | + fs@((_, (_,c)):_) <- fns] + ) + where + fns = groupBy valtypg (sortBy valtyps (map jty (Map.assocs (funs (abstract gr))))) + valtyps (_, (_,x)) (_, (_,y)) = compare x y + valtypg (_, (_,x)) (_, (_,y)) = x == y + jty (f,(ty,_)) = (f,catSkeleton ty) + +updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton +updateSkeleton cat skel rule = + case skel of + (cat0,rules):rr | cat0 == cat -> (cat0, rule:rules) : rr + (cat0,rules):rr -> (cat0, rules) : updateSkeleton cat rr rule + +isListCat :: (OIdent, [(OIdent, [OIdent])]) -> Bool +isListCat (cat,rules) = "List" `isPrefixOf` cat && length rules == 2 + && ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs + where c = elemCat cat + fs = map fst rules + +-- | Gets the element category of a list category. +elemCat :: OIdent -> OIdent +elemCat = drop 4 + +isBaseFun :: OIdent -> Bool +isBaseFun f = "Base" `isPrefixOf` f + +isConsFun :: OIdent -> Bool +isConsFun f = "Cons" `isPrefixOf` f + +baseSize :: (OIdent, [(OIdent, [OIdent])]) -> Int +baseSize (_,rules) = length bs + where Just (_,bs) = find (("Base" `isPrefixOf`) . fst) rules diff --git a/src/GF/Compile/GFCCtoJS.hs b/src/GF/Compile/GFCCtoJS.hs new file mode 100644 index 000000000..8259e7385 --- /dev/null +++ b/src/GF/Compile/GFCCtoJS.hs @@ -0,0 +1,117 @@ +module GF.Compile.GFCCtoJS (pgf2js) where + +import PGF.CId +import PGF.Data +import qualified PGF.Macros as M +import qualified GF.JavaScript.AbsJS as JS +import qualified GF.JavaScript.PrintJS as JS + +import GF.Text.UTF8 +import GF.Data.ErrM +import GF.Infra.Option + +import Control.Monad (mplus) +import Data.Array (Array) +import qualified Data.Array as Array +import Data.Maybe (fromMaybe) +import qualified Data.Map as Map + +pgf2js :: PGF -> String +pgf2js pgf = + encodeUTF8 $ JS.printTree $ JS.Program [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident n) grammar]] + where + n = prCId $ absname pgf + as = abstract pgf + cs = Map.assocs (concretes pgf) + start = M.lookStartCat pgf + grammar = new "GFGrammar" [js_abstract, js_concrete] + js_abstract = abstract2js start as + js_concrete = JS.EObj $ map (concrete2js start n) cs + +abstract2js :: String -> Abstr -> JS.Expr +abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))] + +absdef2js :: (CId,(Type,Expr)) -> JS.Property +absdef2js (f,(typ,_)) = + let (args,cat) = M.catSkeleton typ in + JS.Prop (JS.IdentPropName (JS.Ident (prCId f))) (new "Type" [JS.EArray [JS.EStr (prCId x) | x <- args], JS.EStr (prCId cat)]) + +concrete2js :: String -> String -> (CId,Concr) -> JS.Property +concrete2js start n (c, cnc) = + JS.Prop l (new "GFConcrete" ([(JS.EObj $ ((map (cncdef2js n (prCId c)) ds) ++ litslins))] ++ + maybe [] (parser2js start) (parser cnc))) + where + l = JS.IdentPropName (JS.Ident (prCId c)) + ds = concatMap Map.assocs [lins cnc, opers cnc, lindefs cnc] + litslins = [JS.Prop (JS.StringPropName "Int") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]), + JS.Prop (JS.StringPropName "Float") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]), + JS.Prop (JS.StringPropName "String") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]])] + + +cncdef2js :: String -> String -> (CId,Term) -> JS.Property +cncdef2js n l (f, t) = JS.Prop (JS.IdentPropName (JS.Ident (prCId f))) (JS.EFun [children] [JS.SReturn (term2js n l t)]) + +term2js :: String -> String -> Term -> JS.Expr +term2js n l t = f t + where + f t = + case t of + R xs -> new "Arr" (map f xs) + P x y -> JS.ECall (JS.EMember (f x) (JS.Ident "sel")) [f y] + S xs -> mkSeq (map f xs) + K t -> tokn2js t + V i -> JS.EIndex (JS.EVar children) (JS.EInt i) + C i -> new "Int" [JS.EInt i] + F f -> JS.ECall (JS.EMember (JS.EIndex (JS.EMember (JS.EVar $ JS.Ident n) (JS.Ident "concretes")) (JS.EStr l)) (JS.Ident "rule")) [JS.EStr (prCId f), JS.EVar children] + FV xs -> new "Variants" (map f xs) + W str x -> new "Suffix" [JS.EStr str, f x] + TM _ -> new "Meta" [] + +tokn2js :: Tokn -> JS.Expr +tokn2js (KS s) = mkStr s +tokn2js (KP ss vs) = mkSeq (map mkStr ss) -- FIXME + +mkStr :: String -> JS.Expr +mkStr s = new "Str" [JS.EStr s] + +mkSeq :: [JS.Expr] -> JS.Expr +mkSeq [x] = x +mkSeq xs = new "Seq" xs + +argIdent :: Integer -> JS.Ident +argIdent n = JS.Ident ("x" ++ show n) + +children :: JS.Ident +children = JS.Ident "cs" + +-- Parser +parser2js :: String -> ParserInfo -> [JS.Expr] +parser2js start p = [new "Parser" [JS.EStr start, + JS.EArray $ map frule2js (Array.elems (allRules p)), + JS.EObj $ map cats (Map.assocs (startupCats p))]] + where + cats (c,is) = JS.Prop (JS.IdentPropName (JS.Ident (prCId c))) (JS.EArray (map JS.EInt is)) + +frule2js :: FRule -> JS.Expr +frule2js (FRule f ps args res lins) = new "Rule" [JS.EInt res, name2js (f,ps), JS.EArray (map JS.EInt args), lins2js lins] + +name2js :: (CId,[Profile]) -> JS.Expr +name2js (f,ps) | f == wildCId = fromProfile (head ps) + | otherwise = new "FunApp" $ [JS.EStr $ prCId f, JS.EArray (map fromProfile ps)] + where + fromProfile :: Profile -> JS.Expr + fromProfile [] = new "MetaVar" [] + fromProfile [x] = daughter x + fromProfile args = new "Unify" [JS.EArray (map daughter args)] + + daughter i = new "Arg" [JS.EInt i] + +lins2js :: Array FIndex (Array FPointPos FSymbol) -> JS.Expr +lins2js ls = JS.EArray [ JS.EArray [ sym2js s | s <- Array.elems l] | l <- Array.elems ls] + +sym2js :: FSymbol -> JS.Expr +sym2js (FSymCat l n) = new "ArgProj" [JS.EInt n, JS.EInt l] +sym2js (FSymTok t) = new "Terminal" [JS.EStr t] + +new :: String -> [JS.Expr] -> JS.Expr +new f xs = JS.ENew (JS.Ident f) xs diff --git a/src/GF/Compile/GenerateFCFG.hs b/src/GF/Compile/GenerateFCFG.hs new file mode 100644 index 000000000..c2854ef3d --- /dev/null +++ b/src/GF/Compile/GenerateFCFG.hs @@ -0,0 +1,526 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : Krasimir Angelov +-- Stability : (stable) +-- Portability : (portable) +-- +-- Converting SimpleGFC grammars to fast nonerasing MCFG grammar. +-- +-- the resulting grammars might be /very large/ +-- +-- the conversion is only equivalent if the GFC grammar has a context-free backbone. +----------------------------------------------------------------------------- + + +module GF.Compile.GenerateFCFG + (convertConcrete) where + +import PGF.CId +import PGF.Data +import PGF.Macros --hiding (prt) +import PGF.Parsing.FCFG.Utilities + +import GF.Data.BacktrackM +import GF.Data.SortedList +import GF.Data.Utilities (updateNthM, sortNub) + +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Data.List as List +import qualified Data.ByteString.Char8 as BS +import Data.Array +import Data.Maybe +import Control.Monad + +---------------------------------------------------------------------- +-- main conversion function + +convertConcrete :: Abstr -> Concr -> FGrammar +convertConcrete abs cnc = fixHoasFuns $ convert abs_defs' conc' cats' + where abs_defs = Map.assocs (funs abs) + conc = Map.union (opers cnc) (lins cnc) -- "union big+small most efficient" + cats = lincats cnc + (abs_defs',conc',cats') = expandHOAS abs_defs conc cats + +expandHOAS :: [(CId,(Type,Expr))] -> TermMap -> TermMap -> ([(CId,(Type,Expr))],TermMap,TermMap) +expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns, + Map.unions [lins, hoLins, varLins], + Map.unions [lincats, hoLincats, varLincat]) + where + -- replace higher-order fun argument types with new categories + funs' = [(f,(fixType ty,e)) | (f,(ty,e)) <- funs] + where + fixType :: Type -> Type + fixType ty = let (ats,rt) = typeSkeleton ty in cftype (map catName ats) rt + + hoTypes :: [(Int,CId)] + hoTypes = sortNub [(n,c) | (_,(ty,_)) <- funs, (n,c) <- fst (typeSkeleton ty), n > 0] + hoCats = sortNub (map snd hoTypes) + -- for each Cat with N bindings, we add a new category _NCat + -- each new category contains a single function __NCat : Cat -> _Var -> ... -> _Var -> _NCat + hoFuns = [(funName ty,(cftype (c : replicate n varCat) (catName ty),EEq [])) | ty@(n,c) <- hoTypes] + -- lincats for the new categories + hoLincats = Map.fromList [(catName ty, modifyRec (++ replicate n (S [])) (lincatOf c)) | ty@(n,c) <- hoTypes] + -- linearizations of the new functions, lin __NCat v_0 ... v_n-1 x = { s1 = x.s1; ...; sk = x.sk; $0 = v_0.s ... + hoLins = Map.fromList [ (funName ty, mkLin c n) | ty@(n,c) <- hoTypes] + where mkLin c n = modifyRec (\fs -> [P (V 0) (C j) | j <- [0..length fs-1]] ++ [P (V i) (C 0) | i <- [1..n]]) (lincatOf c) + -- for each Cat, we a add a fun _Var_Cat : _Var -> Cat + varFuns = [(varFunName cat, (cftype [varCat] cat,EEq [])) | cat <- hoCats] + -- linearizations of the _Var_Cat functions + varLins = Map.fromList [(varFunName cat, R [P (V 0) (C 0)]) | cat <- hoCats] + -- lincat for the _Var category + varLincat = Map.singleton varCat (R [S []]) + + lincatOf c = fromMaybe (error $ "No lincat for " ++ prCId c) $ Map.lookup c lincats + + modifyRec :: ([Term] -> [Term]) -> Term -> Term + modifyRec f (R xs) = R (f xs) + modifyRec _ t = error $ "Not a record: " ++ show t + + varCat = mkCId "_Var" + + catName :: (Int,CId) -> CId + catName (0,c) = c + catName (n,c) = mkCId ("_" ++ show n ++ prCId c) + + funName :: (Int,CId) -> CId + funName (n,c) = mkCId ("__" ++ show n ++ prCId c) + + varFunName :: CId -> CId + varFunName c = mkCId ("_Var_" ++ prCId c) + +-- replaces __NCat with _B and _Var_Cat with _. +-- the temporary names are just there to avoid name collisions. +fixHoasFuns :: FGrammar -> FGrammar +fixHoasFuns (rs, cs) = ([FRule (fixName n) ps args cat lins | FRule n ps args cat lins <- rs], cs) + where fixName (CId n) | BS.pack "__" `BS.isPrefixOf` n = (mkCId "_B") + | BS.pack "_Var_" `BS.isPrefixOf` n = wildCId + fixName n = n + +convert :: [(CId,(Type,Expr))] -> TermMap -> TermMap -> FGrammar +convert abs_defs cnc_defs cat_defs = getFGrammar (loop frulesEnv) + where + srules = [ + (XRule id args res (map findLinType args) (findLinType res) term) | + (id, (ty,_)) <- abs_defs, let (args,res) = catSkeleton ty, + term <- Map.lookup id cnc_defs] + + findLinType id = fromMaybe (error $ "No lincat for " ++ show id) (Map.lookup id cat_defs) + + (xrulesMap,frulesEnv) = List.foldl' helper (Map.empty,emptyFRulesEnv) srules + where + helper (xrulesMap,frulesEnv) rule@(XRule id abs_args abs_res cnc_args cnc_res term) = + let xrulesMap' = Map.insertWith (++) abs_res [rule] xrulesMap + frulesEnv' = List.foldl' (\env selector -> convertRule cnc_defs selector rule env) + frulesEnv + (mkSingletonSelectors cnc_defs cnc_res) + in xrulesMap' `seq` frulesEnv' `seq` (xrulesMap',frulesEnv') + + loop frulesEnv = + let (todo, frulesEnv') = takeToDoRules xrulesMap frulesEnv + in case todo of + [] -> frulesEnv' + _ -> loop $! List.foldl' (\env (srules,selector) -> + List.foldl' (\env srule -> convertRule cnc_defs selector srule env) env srules) frulesEnv' todo + +convertRule :: TermMap -> TermSelector -> XRule -> FRulesEnv -> FRulesEnv +convertRule cnc_defs selector (XRule fun args cat ctypes ctype term) frulesEnv = + foldBM addRule + frulesEnv + (convertTerm cnc_defs selector term [([],[])]) + (protoFCat cat, map (\scat -> (protoFCat scat,[])) args, ctype, ctypes) + where + addRule linRec (newCat', newArgs', _, _) env0 = + let (env1, newCat) = genFCatHead env0 newCat' + (env2, newArgs,idxArgs) = foldr (\((xcat@(PFCat cat rcs tcs),xpaths),ctype,idx) (env,args,all_args) -> + let xargs = xcat:[PFCat cat [path] tcs | path <- reverse xpaths] + (env1, xargs1) = List.mapAccumL (genFCatArg cnc_defs ctype) env xargs + in case xcat of + PFCat _ [] _ -> (env , args, all_args) + _ -> (env1,xargs1++args,(idx,zip xargs1 xargs):all_args)) (env1,[],[]) (zip3 newArgs' ctypes [0..]) + + newLinRec = listArray (0,length linRec-1) [translateLin idxArgs path linRec | path <- case newCat' of {PFCat _ rcs _ -> rcs}] + + (_,newProfile) = List.mapAccumL accumProf 0 newArgs' + where + accumProf nr (PFCat _ [] _,_ ) = (nr, [] ) + accumProf nr (_ ,xpaths) = (nr+cnt+1, [nr..nr+cnt]) + where cnt = length xpaths + + rule = FRule fun newProfile newArgs newCat newLinRec + in addFRule env2 rule + +translateLin idxArgs lbl' [] = array (0,-1) [] +translateLin idxArgs lbl' ((lbl,syms) : lins) + | lbl' == lbl = listArray (0,length syms-1) (map instSym syms) + | otherwise = translateLin idxArgs lbl' lins + where + instSym = either (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok + instCat lbl nr xnr nr' ((idx,xargs):idxArgs) + | nr == idx = let (fcat, PFCat _ rcs _) = xargs !! xnr + in FSymCat (index lbl rcs 0) (nr'+xnr) + | otherwise = instCat lbl nr xnr (nr'+length xargs) idxArgs + + index lbl' (lbl:lbls) idx + | lbl' == lbl = idx + | otherwise = index lbl' lbls $! (idx+1) + + +---------------------------------------------------------------------- +-- term conversion + +type CnvMonad a = BacktrackM Env a + +type FPath = [FIndex] +type Env = (ProtoFCat, [(ProtoFCat,[FPath])], Term, [Term]) +type LinRec = [(FPath, [Either (FPath, FIndex, Int) FToken])] + +type TermMap = Map.Map CId Term + +convertTerm :: TermMap -> TermSelector -> Term -> LinRec -> CnvMonad LinRec +convertTerm cnc_defs selector (V nr) ((lbl_path,lin) : lins) = convertArg selector nr [] lbl_path lin lins +convertTerm cnc_defs selector (C nr) ((lbl_path,lin) : lins) = convertCon selector nr lbl_path lin lins +convertTerm cnc_defs selector (R record) ((lbl_path,lin) : lins) = convertRec cnc_defs selector 0 record lbl_path lin lins + +convertTerm cnc_defs selector (P term sel) lins = do nr <- evalTerm cnc_defs [] sel + convertTerm cnc_defs (TuplePrj nr selector) term lins +convertTerm cnc_defs selector (FV vars) lins = do term <- member vars + convertTerm cnc_defs selector term lins +convertTerm cnc_defs selector (S ts) ((lbl_path,lin) : lins) = do projectHead lbl_path + foldM (\lins t -> convertTerm cnc_defs selector t lins) ((lbl_path,lin) : lins) (reverse ts) +convertTerm cnc_defs selector (K (KS str)) ((lbl_path,lin) : lins) = + do projectHead lbl_path + return ((lbl_path,Right str : lin) : lins) +convertTerm cnc_defs selector (K (KP strs vars))((lbl_path,lin) : lins) = + do projectHead lbl_path + toks <- member (strs:[strs' | Alt strs' _ <- vars]) + return ((lbl_path, map Right toks ++ lin) : lins) +convertTerm cnc_defs selector (F id) lins = do term <- Map.lookup id cnc_defs + convertTerm cnc_defs selector term lins +convertTerm cnc_defs selector (W s t) ((lbl_path,lin) : lins) = do + ss <- case t of + R ss -> return ss + F f -> do + t <- Map.lookup f cnc_defs + case t of + R ss -> return ss + convertRec cnc_defs selector 0 [K (KS (s ++ s1)) | K (KS s1) <- ss] lbl_path lin lins +convertTerm cnc_defs selector x lins = error ("convertTerm ("++show x++")") + + +convertArg (TupleSel record) nr path lbl_path lin lins = + foldM (\lins (lbl, selector) -> convertArg selector nr (lbl:path) (lbl:lbl_path) lin lins) lins record +convertArg (TuplePrj lbl selector) nr path lbl_path lin lins = + convertArg selector nr (lbl:path) lbl_path lin lins +convertArg (ConSel indices) nr path lbl_path lin lins = do + index <- member indices + restrictHead lbl_path index + restrictArg nr path index + return lins +convertArg StrSel nr path lbl_path lin lins = do + projectHead lbl_path + xnr <- projectArg nr path + return ((lbl_path, Left (path, nr, xnr) : lin) : lins) + +convertCon (ConSel indices) index lbl_path lin lins = do + guard (index `elem` indices) + restrictHead lbl_path index + return lins +convertCon x _ _ _ _ = error $ "SimpleToFCFG,convertCon: " ++ show x + +convertRec cnc_defs selector index [] lbl_path lin lins = return lins +convertRec cnc_defs selector@(TupleSel fields) index (val:record) lbl_path lin lins = select fields + where + select [] = convertRec cnc_defs selector (index+1) record lbl_path lin lins + select ((index',sub_sel) : fields) + | index == index' = do lins <- convertTerm cnc_defs sub_sel val ((index:lbl_path,lin) : lins) + convertRec cnc_defs selector (index+1) record lbl_path lin lins + | otherwise = select fields +convertRec cnc_defs (TuplePrj index' sub_sel) index record lbl_path lin lins = do + convertTerm cnc_defs sub_sel (record !! (index'-index)) ((lbl_path,lin) : lins) + + +------------------------------------------------------------ +-- eval a term to ground terms + +evalTerm :: TermMap -> FPath -> Term -> CnvMonad FIndex +evalTerm cnc_defs path (V nr) = do term <- readArgCType nr + unifyPType nr (reverse path) (selectTerm path term) +evalTerm cnc_defs path (C nr) = return nr +evalTerm cnc_defs path (R record) = case path of + (index:path) -> evalTerm cnc_defs path (record !! index) +evalTerm cnc_defs path (P term sel) = do index <- evalTerm cnc_defs [] sel + evalTerm cnc_defs (index:path) term +evalTerm cnc_defs path (FV terms) = member terms >>= evalTerm cnc_defs path +evalTerm cnc_defs path (F id) = do term <- Map.lookup id cnc_defs + evalTerm cnc_defs path term +evalTerm cnc_defs path x = error ("evalTerm ("++show x++")") + +unifyPType :: FIndex -> FPath -> Term -> CnvMonad FIndex +unifyPType nr path (C max_index) = + do (_, args, _, _) <- readState + let (PFCat _ _ tcs,_) = args !! nr + case lookup path tcs of + Just index -> return index + Nothing -> do index <- member [0..max_index] + restrictArg nr path index + return index +unifyPType nr path t = error $ "unifyPType " ++ show t ---- AR 2/10/2007 + +selectTerm :: FPath -> Term -> Term +selectTerm [] term = term +selectTerm (index:path) (R record) = selectTerm path (record !! index) + + +---------------------------------------------------------------------- +-- FRulesEnv + +data FRulesEnv = FRulesEnv {-# UNPACK #-} !Int FCatSet [FRule] +type FCatSet = Map.Map CId (Map.Map [FPath] (Map.Map [(FPath,FIndex)] (Either FCat FCat))) + +data ProtoFCat = PFCat CId [FPath] [(FPath,FIndex)] + +protoFCat :: CId -> ProtoFCat +protoFCat cat = PFCat cat [] [] + +emptyFRulesEnv = FRulesEnv 0 (ins fcatString (mkCId "String") [[0]] [] $ + ins fcatInt (mkCId "Int") [[0]] [] $ + ins fcatFloat (mkCId "Float") [[0]] [] $ + ins fcatVar (mkCId "_Var") [[0]] [] $ + Map.empty) [] + where + ins fcat cat rcs tcs fcatSet = + Map.insertWith (\_ -> Map.insertWith (\_ -> Map.insert tcs right_fcat) rcs tmap_s) cat rmap_s fcatSet + where + right_fcat = Right fcat + tmap_s = Map.singleton tcs right_fcat + rmap_s = Map.singleton rcs tmap_s + +addFRule :: FRulesEnv -> FRule -> FRulesEnv +addFRule (FRulesEnv last_id fcatSet rules) rule = FRulesEnv last_id fcatSet (rule:rules) + +getFGrammar :: FRulesEnv -> FGrammar +getFGrammar (FRulesEnv last_id fcatSet rules) = (rules, Map.map getFCatList fcatSet) + where + getFCatList rcs = Map.fold (\tcs lst -> Map.fold (\x lst -> either id id x : lst) lst tcs) [] rcs + +genFCatHead :: FRulesEnv -> ProtoFCat -> (FRulesEnv, FCat) +genFCatHead env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs tcs) = + case Map.lookup cat fcatSet >>= Map.lookup rcs >>= Map.lookup tcs of + Just (Left fcat) -> (FRulesEnv last_id (ins fcat) rules, fcat) + Just (Right fcat) -> (env, fcat) + Nothing -> let fcat = last_id+1 + in (FRulesEnv fcat (ins fcat) rules, fcat) + where + ins fcat = Map.insertWith (\_ -> Map.insertWith (\_ -> Map.insert tcs right_fcat) rcs tmap_s) cat rmap_s fcatSet + where + right_fcat = Right fcat + tmap_s = Map.singleton tcs right_fcat + rmap_s = Map.singleton rcs tmap_s + +genFCatArg :: TermMap -> Term -> FRulesEnv -> ProtoFCat -> (FRulesEnv, FCat) +genFCatArg cnc_defs ctype env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs tcs) = + case Map.lookup cat fcatSet >>= Map.lookup rcs of + Just tmap -> case Map.lookup tcs tmap of + Just (Left fcat) -> (env, fcat) + Just (Right fcat) -> (env, fcat) + Nothing -> ins tmap + Nothing -> ins Map.empty + where + ins tmap = + let fcat = last_id+1 + (either_fcat,last_id1,tmap1,rules1) + = foldBM (\tcs st (either_fcat,last_id,tmap,rules) -> + let (last_id1,tmap1,fcat_arg) = addArg tcs last_id tmap + rule = FRule wildCId [[0]] [fcat_arg] fcat + (listArray (0,length rcs-1) [listArray (0,0) [FSymCat lbl 0] | lbl <- [0..length rcs-1]]) + in if st + then (Right fcat, last_id1,tmap1,rule:rules) + else (either_fcat,last_id, tmap, rules)) + (Left fcat,fcat,Map.insert tcs either_fcat tmap,rules) + (gen_tcs ctype [] []) + False + rmap1 = Map.singleton rcs tmap1 + in (FRulesEnv last_id1 (Map.insertWith (\_ -> Map.insert rcs tmap1) cat rmap1 fcatSet) rules1, fcat) + where + addArg tcs last_id tmap = + case Map.lookup tcs tmap of + Just (Left fcat) -> (last_id, tmap, fcat) + Just (Right fcat) -> (last_id, tmap, fcat) + Nothing -> let fcat = last_id+1 + in (fcat, Map.insert tcs (Left fcat) tmap, fcat) + + gen_tcs :: Term -> FPath -> [(FPath,FIndex)] -> BacktrackM Bool [(FPath,FIndex)] + gen_tcs (R record) path acc = foldM (\acc (label,ctype) -> gen_tcs ctype (label:path) acc) acc (zip [0..] record) + gen_tcs (S _) path acc = return acc + gen_tcs (C max_index) path acc = + case List.lookup path tcs of + Just index -> return $! addConstraint path index acc + Nothing -> do writeState True + index <- member [0..max_index] + return $! addConstraint path index acc + where + addConstraint path0 index0 (c@(path,index) : cs) + | path0 > path = c:addConstraint path0 index0 cs + addConstraint path0 index0 cs = (path0,index0) : cs + gen_tcs (F id) path acc = case Map.lookup id cnc_defs of + Just term -> gen_tcs term path acc + Nothing -> error ("unknown identifier: "++prCId id) + + + +------------------------------------------------------------ +-- TODO queue organization + +type XRulesMap = Map.Map CId [XRule] +data XRule = XRule CId {- function -} + [CId] {- argument types -} + CId {- result type -} + [Term] {- argument lin-types representation -} + Term {- result lin-type representation -} + Term {- body -} + +takeToDoRules :: XRulesMap -> FRulesEnv -> ([([XRule], TermSelector)], FRulesEnv) +takeToDoRules xrulesMap (FRulesEnv last_id fcatSet rules) = (todo,FRulesEnv last_id fcatSet' rules) + where + (todo,fcatSet') = + Map.mapAccumWithKey (\todo cat rmap -> + let (todo1,rmap1) = Map.mapAccumWithKey (\todo rcs tmap -> + let (tcss,tmap') = Map.mapAccumWithKey (\tcss tcs either_xcat -> + case either_xcat of + Left xcat -> (tcs:tcss,Right xcat) + Right xcat -> ( tcss,either_xcat)) [] tmap + in case tcss of + [] -> ( todo,tmap ) + _ -> ((srules,mkSelector rcs tcss) : todo,tmap')) todo rmap + mb_srules = Map.lookup cat xrulesMap + Just srules = mb_srules + + in case mb_srules of + Just srules -> (todo1,rmap1) + Nothing -> (todo ,rmap1)) [] fcatSet + + +------------------------------------------------------------ +-- The TermSelector + +data TermSelector + = TupleSel [(FIndex, TermSelector)] + | TuplePrj FIndex TermSelector + | ConSel [FIndex] + | StrSel + deriving Show + +mkSingletonSelectors :: TermMap + -> Term -- ^ Type representation term + -> [TermSelector] -- ^ list of selectors containing just one string field +mkSingletonSelectors cnc_defs term = sels0 + where + (sels0,tcss0) = loop [] ([],[]) term + + loop path st (R record) = List.foldl' (\st (index,term) -> loop (index:path) st term) st (zip [0..] record) + loop path (sels,tcss) (C i) = ( sels,map ((,) path) [0..i] : tcss) + loop path (sels,tcss) (S _) = (mkSelector [path] tcss0 : sels, tcss) + loop path (sels,tcss) (F id) = case Map.lookup id cnc_defs of + Just term -> loop path (sels,tcss) term + Nothing -> error ("unknown identifier: "++prCId id) + +mkSelector :: [FPath] -> [[(FPath,FIndex)]] -> TermSelector +mkSelector rcs tcss = + List.foldl' addRestriction (case xs of + (path:xs) -> List.foldl' addProjection (path2selector StrSel path) xs) ys + where + xs = [ reverse path | path <- rcs] + ys = [(reverse path,term) | tcs <- tcss, (path,term) <- tcs] + + addRestriction :: TermSelector -> (FPath,FIndex) -> TermSelector + addRestriction (ConSel indices) ([] ,n_index) = ConSel (add indices) + where + add [] = [n_index] + add (index':indices) + | n_index == index' = index': indices + | otherwise = index':add indices + addRestriction (TupleSel fields) (index : path,n_index) = TupleSel (add fields) + where + add [] = [(index,path2selector (ConSel [n_index]) path)] + add (field@(index',sub_sel):fields) + | index == index' = (index',addRestriction sub_sel (path,n_index)):fields + | otherwise = field : add fields + + addProjection :: TermSelector -> FPath -> TermSelector + addProjection StrSel [] = StrSel + addProjection (TupleSel fields) (index : path) = TupleSel (add fields) + where + add [] = [(index,path2selector StrSel path)] + add (field@(index',sub_sel):fields) + | index == index' = (index',addProjection sub_sel path):fields + | otherwise = field : add fields + + path2selector base [] = base + path2selector base (index : path) = TupleSel [(index,path2selector base path)] + +------------------------------------------------------------ +-- updating the MCF rule + +readArgCType :: FIndex -> CnvMonad Term +readArgCType nr = do (_, _, _, ctypes) <- readState + return (ctypes !! nr) + +restrictArg :: FIndex -> FPath -> FIndex -> CnvMonad () +restrictArg nr path index = do + (head, args, ctype, ctypes) <- readState + args' <- updateNthM (\(xcat,xs) -> do xcat <- restrictProtoFCat path index xcat + return (xcat,xs) ) nr args + writeState (head, args', ctype, ctypes) + +projectArg :: FIndex -> FPath -> CnvMonad Int +projectArg nr path = do + (head, args, ctype, ctypes) <- readState + (xnr,args') <- updateArgs nr args + writeState (head, args', ctype, ctypes) + return xnr + where + updateArgs :: FIndex -> [(ProtoFCat,[FPath])] -> CnvMonad (Int,[(ProtoFCat,[FPath])]) + updateArgs 0 ((a@(PFCat _ rcs _),xpaths) : as) + | path `elem` rcs = return (length xpaths+1,(a,path:xpaths):as) + | otherwise = do a <- projectProtoFCat path a + return (0,(a,xpaths):as) + updateArgs n (a : as) = do + (xnr,as) <- updateArgs (n-1) as + return (xnr,a:as) + +readHeadCType :: CnvMonad Term +readHeadCType = do (_, _, ctype, _) <- readState + return ctype + +restrictHead :: FPath -> FIndex -> CnvMonad () +restrictHead path term + = do (head, args, ctype, ctypes) <- readState + head' <- restrictProtoFCat path term head + writeState (head', args, ctype, ctypes) + +projectHead :: FPath -> CnvMonad () +projectHead path + = do (head, args, ctype, ctypes) <- readState + head' <- projectProtoFCat path head + writeState (head', args, ctype, ctypes) + +restrictProtoFCat :: FPath -> FIndex -> ProtoFCat -> CnvMonad ProtoFCat +restrictProtoFCat path0 index0 (PFCat cat rcs tcs) = do + tcs <- addConstraint tcs + return (PFCat cat rcs tcs) + where + addConstraint (c@(path,index) : cs) + | path0 > path = liftM (c:) (addConstraint cs) + | path0 == path = guard (index0 == index) >> + return (c : cs) + addConstraint cs = return ((path0,index0) : cs) + +projectProtoFCat :: FPath -> ProtoFCat -> CnvMonad ProtoFCat +projectProtoFCat path0 (PFCat cat rcs tcs) = do + return (PFCat cat (addConstraint rcs) tcs) + where + addConstraint (path : rcs) + | path0 > path = path : addConstraint rcs + | path0 == path = path : rcs + addConstraint rcs = path0 : rcs diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs new file mode 100644 index 000000000..e0343e8d6 --- /dev/null +++ b/src/GF/Compile/GeneratePMCFG.hs @@ -0,0 +1,356 @@ +{-# OPTIONS -fbang-patterns #-} +---------------------------------------------------------------------- +-- | +-- Maintainer : Krasimir Angelov +-- Stability : (stable) +-- Portability : (portable) +-- +-- Converting SimpleGFC grammars to fast nonerasing MCFG grammar. +-- +-- the resulting grammars might be /very large/ +-- +-- the conversion is only equivalent if the GFC grammar has a context-free backbone. +----------------------------------------------------------------------------- + + +module GF.Compile.GeneratePMCFG + (convertConcrete) where + +import PGF.CId +import PGF.Data +import PGF.Macros --hiding (prt) +import PGF.Parsing.FCFG.Utilities + +import GF.Data.BacktrackM +import GF.Data.SortedList +import GF.Data.Utilities (updateNthM, sortNub) + +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Data.List as List +import qualified Data.ByteString.Char8 as BS +import Data.Array +import Data.Maybe +import Control.Monad +import Debug.Trace + +---------------------------------------------------------------------- +-- main conversion function + +convertConcrete :: Abstr -> Concr -> FGrammar +convertConcrete abs cnc = fixHoasFuns $ convert abs_defs' conc' cats' + where abs_defs = Map.assocs (funs abs) + conc = Map.union (opers cnc) (lins cnc) -- "union big+small most efficient" + cats = lincats cnc + (abs_defs',conc',cats') = expandHOAS abs_defs conc cats + +expandHOAS :: [(CId,(Type,Expr))] -> TermMap -> TermMap -> ([(CId,(Type,Expr))],TermMap,TermMap) +expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns, + Map.unions [lins, hoLins, varLins], + Map.unions [lincats, hoLincats, varLincat]) + where + -- replace higher-order fun argument types with new categories + funs' = [(f,(fixType ty,e)) | (f,(ty,e)) <- funs] + where + fixType :: Type -> Type + fixType ty = let (ats,rt) = typeSkeleton ty in cftype (map catName ats) rt + + hoTypes :: [(Int,CId)] + hoTypes = sortNub [(n,c) | (_,(ty,_)) <- funs, (n,c) <- fst (typeSkeleton ty), n > 0] + hoCats = sortNub (map snd hoTypes) + -- for each Cat with N bindings, we add a new category _NCat + -- each new category contains a single function __NCat : Cat -> _Var -> ... -> _Var -> _NCat + hoFuns = [(funName ty,(cftype (c : replicate n varCat) (catName ty),EEq [])) | ty@(n,c) <- hoTypes] + -- lincats for the new categories + hoLincats = Map.fromList [(catName ty, modifyRec (++ replicate n (S [])) (lincatOf c)) | ty@(n,c) <- hoTypes] + -- linearizations of the new functions, lin __NCat v_0 ... v_n-1 x = { s1 = x.s1; ...; sk = x.sk; $0 = v_0.s ... + hoLins = Map.fromList [ (funName ty, mkLin c n) | ty@(n,c) <- hoTypes] + where mkLin c n = modifyRec (\fs -> [P (V 0) (C j) | j <- [0..length fs-1]] ++ [P (V i) (C 0) | i <- [1..n]]) (lincatOf c) + -- for each Cat, we a add a fun _Var_Cat : _Var -> Cat + varFuns = [(varFunName cat, (cftype [varCat] cat,EEq [])) | cat <- hoCats] + -- linearizations of the _Var_Cat functions + varLins = Map.fromList [(varFunName cat, R [P (V 0) (C 0)]) | cat <- hoCats] + -- lincat for the _Var category + varLincat = Map.singleton varCat (R [S []]) + + lincatOf c = fromMaybe (error $ "No lincat for " ++ prCId c) $ Map.lookup c lincats + + modifyRec :: ([Term] -> [Term]) -> Term -> Term + modifyRec f (R xs) = R (f xs) + modifyRec _ t = error $ "Not a record: " ++ show t + + varCat = mkCId "_Var" + + catName :: (Int,CId) -> CId + catName (0,c) = c + catName (n,c) = mkCId ("_" ++ show n ++ prCId c) + + funName :: (Int,CId) -> CId + funName (n,c) = mkCId ("__" ++ show n ++ prCId c) + + varFunName :: CId -> CId + varFunName c = mkCId ("_Var_" ++ prCId c) + +-- replaces __NCat with _B and _Var_Cat with _. +-- the temporary names are just there to avoid name collisions. +fixHoasFuns :: FGrammar -> FGrammar +fixHoasFuns (!rs, !cs) = ([FRule (fixName n) ps args cat lins | FRule n ps args cat lins <- rs], cs) + where fixName (CId n) | BS.pack "__" `BS.isPrefixOf` n = (mkCId "_B") + | BS.pack "_Var_" `BS.isPrefixOf` n = wildCId + fixName n = n + +convert :: [(CId,(Type,Expr))] -> TermMap -> TermMap -> FGrammar +convert abs_defs cnc_defs cat_defs = getFGrammar (List.foldl' (convertRule cnc_defs) emptyFRulesEnv srules) + where + srules = [ + (XRule id args res (map findLinType args) (findLinType res) term) | + (id, (ty,_)) <- abs_defs, let (args,res) = catSkeleton ty, + term <- Map.lookup id cnc_defs] + + findLinType id = fromMaybe (error $ "No lincat for " ++ show id) (Map.lookup id cat_defs) + + +convertRule :: TermMap -> FRulesEnv -> XRule -> FRulesEnv +convertRule cnc_defs frulesEnv (XRule fun args cat ctypes ctype term) = + foldBM addRule + frulesEnv + (convertTerm cnc_defs [] ctype term [([],[])]) + (protoFCat cnc_defs cat ctype, zipWith (protoFCat cnc_defs) args ctypes) + where + addRule linRec (newCat', newArgs') env0 = + let (env1, newCat) = genFCatHead env0 newCat' + (env2, newArgs) = List.mapAccumL (genFCatArg cnc_defs) env1 newArgs' + + newLinRec = mkArray (map (mkArray . snd) linRec) + mkArray lst = listArray (0,length lst-1) lst + + rule = FRule fun [] newArgs newCat newLinRec + in addFRule env2 rule + +---------------------------------------------------------------------- +-- term conversion + +type CnvMonad a = BacktrackM Env a + +type FPath = [FIndex] +data ProtoFCat = PFCat CId [FPath] [(FPath,FIndex)] Term +type Env = (ProtoFCat, [ProtoFCat]) +type LinRec = [(FPath, [FSymbol])] +data XRule = XRule CId {- function -} + [CId] {- argument types -} + CId {- result type -} + [Term] {- argument lin-types representation -} + Term {- result lin-type representation -} + Term {- body -} + +protoFCat :: TermMap -> CId -> Term -> ProtoFCat +protoFCat cnc_defs cat ctype = PFCat cat (getRCS cnc_defs ctype) [] ctype + +type TermMap = Map.Map CId Term + +convertTerm :: TermMap -> FPath -> Term -> Term -> LinRec -> CnvMonad LinRec +convertTerm cnc_defs sel ctype (V nr) ((lbl_path,lin) : lins) = convertArg ctype nr (reverse sel) lbl_path lin lins +convertTerm cnc_defs sel ctype (C nr) ((lbl_path,lin) : lins) = convertCon ctype nr (reverse sel) lbl_path lin lins +convertTerm cnc_defs sel ctype (R record) ((lbl_path,lin) : lins) = convertRec cnc_defs sel ctype record lbl_path lin lins +convertTerm cnc_defs sel ctype (P term p) lins = do nr <- evalTerm cnc_defs [] p + convertTerm cnc_defs (nr:sel) ctype term lins +convertTerm cnc_defs sel ctype (FV vars) lins = do term <- member vars + convertTerm cnc_defs sel ctype term lins +convertTerm cnc_defs sel ctype (S ts) ((lbl_path,lin) : lins) = foldM (\lins t -> convertTerm cnc_defs sel ctype t lins) ((lbl_path,lin) : lins) (reverse ts) +convertTerm cnc_defs sel ctype (K (KS str)) ((lbl_path,lin) : lins) = return ((lbl_path,FSymTok str : lin) : lins) +convertTerm cnc_defs sel ctype (K (KP strs vars))((lbl_path,lin) : lins) = + do toks <- member (strs:[strs' | Alt strs' _ <- vars]) + return ((lbl_path, map FSymTok toks ++ lin) : lins) +convertTerm cnc_defs sel ctype (F id) lins = do term <- Map.lookup id cnc_defs + convertTerm cnc_defs sel ctype term lins +convertTerm cnc_defs sel ctype (W s t) ((lbl_path,lin) : lins) = do + ss <- case t of + R ss -> return ss + F f -> do + t <- Map.lookup f cnc_defs + case t of + R ss -> return ss + convertRec cnc_defs sel ctype [K (KS (s ++ s1)) | K (KS s1) <- ss] lbl_path lin lins +convertTerm cnc_defs sel ctype x lins = error ("convertTerm ("++show x++")") + + +convertArg (R record) nr path lbl_path lin lins = + foldM (\lins (lbl, ctype) -> convertArg ctype nr (lbl:path) (lbl:lbl_path) lin lins) lins (zip [0..] record) +convertArg (C max) nr path lbl_path lin lins = do + index <- member [0..max] + restrictHead lbl_path index + restrictArg nr path index + return lins +convertArg (S _) nr path lbl_path lin lins = do + (_, args) <- readState + let PFCat cat rcs tcs _ = args !! nr + return ((lbl_path, FSymCat (index path rcs 0) nr : lin) : lins) + where + index lbl' (lbl:lbls) idx + | lbl' == lbl = idx + | otherwise = index lbl' lbls $! (idx+1) + + +convertCon (C max) index [] lbl_path lin lins = do + guard (index <= max) + restrictHead lbl_path index + return lins +convertCon x _ _ _ _ _ = error $ "SimpleToFCFG,convertCon: " ++ show x + +convertRec cnc_defs [] (R ctypes) record lbl_path lin lins = + foldM (\lins (index,ctype,val) -> convertTerm cnc_defs [] ctype val ((index:lbl_path,lin) : lins)) + lins + (zip3 [0..] ctypes record) +convertRec cnc_defs (index:sub_sel) ctype record lbl_path lin lins = do + convertTerm cnc_defs sub_sel ctype (record !! index) ((lbl_path,lin) : lins) + + +------------------------------------------------------------ +-- eval a term to ground terms + +evalTerm :: TermMap -> FPath -> Term -> CnvMonad FIndex +evalTerm cnc_defs path (V nr) = do (_, args) <- readState + let PFCat _ _ _ ctype = args !! nr + unifyPType nr (reverse path) (selectTerm path ctype) +evalTerm cnc_defs path (C nr) = return nr +evalTerm cnc_defs path (R record) = case path of + (index:path) -> evalTerm cnc_defs path (record !! index) +evalTerm cnc_defs path (P term sel) = do index <- evalTerm cnc_defs [] sel + evalTerm cnc_defs (index:path) term +evalTerm cnc_defs path (FV terms) = member terms >>= evalTerm cnc_defs path +evalTerm cnc_defs path (F id) = do term <- Map.lookup id cnc_defs + evalTerm cnc_defs path term +evalTerm cnc_defs path x = error ("evalTerm ("++show x++")") + +unifyPType :: FIndex -> FPath -> Term -> CnvMonad FIndex +unifyPType nr path (C max_index) = + do (_, args) <- readState + let PFCat _ _ tcs _ = args !! nr + case lookup path tcs of + Just index -> return index + Nothing -> do index <- member [0..max_index] + restrictArg nr path index + return index +unifyPType nr path t = error $ "unifyPType " ++ show t ---- AR 2/10/2007 + +selectTerm :: FPath -> Term -> Term +selectTerm [] term = term +selectTerm (index:path) (R record) = selectTerm path (record !! index) + + +---------------------------------------------------------------------- +-- FRulesEnv + +data FRulesEnv = FRulesEnv {-# UNPACK #-} !Int FCatSet [FRule] +type FCatSet = Map.Map CId (Map.Map [(FPath,FIndex)] FCat) + +emptyFRulesEnv = FRulesEnv 0 (ins fcatString (mkCId "String") [] $ + ins fcatInt (mkCId "Int") [] $ + ins fcatFloat (mkCId "Float") [] $ + ins fcatVar (mkCId "_Var") [] $ + Map.empty) [] + where + ins fcat cat tcs fcatSet = + Map.insertWith (\_ -> Map.insert tcs fcat) cat tmap_s fcatSet + where + tmap_s = Map.singleton tcs fcat + +addFRule :: FRulesEnv -> FRule -> FRulesEnv +addFRule (FRulesEnv last_id fcatSet rules) rule = FRulesEnv last_id fcatSet (rule:rules) + +getFGrammar :: FRulesEnv -> FGrammar +getFGrammar (FRulesEnv last_id fcatSet rules) = (rules, Map.map Map.elems fcatSet) + +genFCatHead :: FRulesEnv -> ProtoFCat -> (FRulesEnv, FCat) +genFCatHead env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs tcs _) = + case Map.lookup cat fcatSet >>= Map.lookup tcs of + Just fcat -> (env, fcat) + Nothing -> let fcat = last_id+1 + in (FRulesEnv fcat (ins fcat) rules, fcat) + where + ins fcat = Map.insertWith (\_ -> Map.insert tcs fcat) cat tmap_s fcatSet + where + tmap_s = Map.singleton tcs fcat + +genFCatArg :: TermMap -> FRulesEnv -> ProtoFCat -> (FRulesEnv, FCat) +genFCatArg cnc_defs env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs tcs ctype) = + case Map.lookup cat fcatSet of + Just tmap -> case Map.lookup tcs tmap of + Just fcat -> (env, fcat) + Nothing -> ins tmap + Nothing -> ins Map.empty + where + ins tmap = + let fcat = last_id+1 + (last_id1,tmap1,rules1) + = foldBM (\tcs st (last_id,tmap,rules) -> + let (last_id1,tmap1,fcat_arg) = addArg tcs last_id tmap + rule = FRule wildCId [[0]] [fcat_arg] fcat + (listArray (0,length rcs-1) [listArray (0,0) [FSymCat lbl 0] | lbl <- [0..length rcs-1]]) + in if st + then (last_id1,tmap1,rule:rules) + else (last_id, tmap, rules)) + (fcat,Map.insert tcs fcat tmap,rules) + (gen_tcs ctype [] []) + False + in (FRulesEnv last_id1 (Map.insert cat tmap1 fcatSet) rules1, fcat) + where + addArg tcs last_id tmap = + case Map.lookup tcs tmap of + Just fcat -> (last_id, tmap, fcat) + Nothing -> let fcat = last_id+1 + in (fcat, Map.insert tcs fcat tmap, fcat) + + gen_tcs :: Term -> FPath -> [(FPath,FIndex)] -> BacktrackM Bool [(FPath,FIndex)] + gen_tcs (R record) path acc = foldM (\acc (label,ctype) -> gen_tcs ctype (label:path) acc) acc (zip [0..] record) + gen_tcs (S _) path acc = return acc + gen_tcs (C max_index) path acc = + case List.lookup path tcs of + Just index -> return $! addConstraint path index acc + Nothing -> do writeState True + index <- member [0..max_index] + return $! addConstraint path index acc + where + addConstraint path0 index0 (c@(path,index) : cs) + | path0 > path = c:addConstraint path0 index0 cs + addConstraint path0 index0 cs = (path0,index0) : cs + gen_tcs (F id) path acc = case Map.lookup id cnc_defs of + Just term -> gen_tcs term path acc + Nothing -> error ("unknown identifier: "++prCId id) + + +getRCS :: TermMap -> Term -> [FPath] +getRCS cnc_defs = loop [] [] + where + loop path rcs (R record) = List.foldl' (\rcs (index,term) -> loop (index:path) rcs term) rcs (zip [0..] record) + loop path rcs (C i) = rcs + loop path rcs (S _) = path:rcs + loop path rcs (F id) = case Map.lookup id cnc_defs of + Just term -> loop path rcs term + Nothing -> error ("unknown identifier: "++show id) + +------------------------------------------------------------ +-- updating the MCF rule + +restrictArg :: FIndex -> FPath -> FIndex -> CnvMonad () +restrictArg nr path index = do + (head, args) <- readState + args' <- updateNthM (restrictProtoFCat path index) nr args + writeState (head, args') + +restrictHead :: FPath -> FIndex -> CnvMonad () +restrictHead path term + = do (head, args) <- readState + head' <- restrictProtoFCat path term head + writeState (head', args) + +restrictProtoFCat :: FPath -> FIndex -> ProtoFCat -> CnvMonad ProtoFCat +restrictProtoFCat path0 index0 (PFCat cat rcs tcs ctype) = do + tcs <- addConstraint tcs + return (PFCat cat rcs tcs ctype) + where + addConstraint (c@(path,index) : cs) + | path0 > path = liftM (c:) (addConstraint cs) + | path0 == path = guard (index0 == index) >> + return (c : cs) + addConstraint cs = return ((path0,index0) : cs) diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs new file mode 100644 index 000000000..a8eb8b749 --- /dev/null +++ b/src/GF/Compile/GetGrammar.hs @@ -0,0 +1,55 @@ +---------------------------------------------------------------------- +-- | +-- Module : GetGrammar +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/15 17:56:13 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.16 $ +-- +-- this module builds the internal GF grammar that is sent to the type checker +----------------------------------------------------------------------------- + +module GF.Compile.GetGrammar where + +import GF.Data.Operations +import qualified GF.Source.ErrM as E + +import GF.Infra.UseIO +import GF.Infra.Modules +import GF.Grammar.Grammar +import qualified GF.Source.AbsGF as A +import GF.Source.SourceToGrammar +---- import Macros +---- import Rename +import GF.Infra.Option +--- import Custom +import GF.Source.ParGF +import qualified GF.Source.LexGF as L + +import GF.Compile.ReadFiles + +import Data.Char (toUpper) +import Data.List (nub) +import qualified Data.ByteString.Char8 as BS +import Control.Monad (foldM) +import System.Cmd (system) + +getSourceModule :: Options -> FilePath -> IOE SourceModule +getSourceModule opts file0 = do + file <- foldM runPreprocessor file0 (moduleFlag optPreprocessors opts) + string <- readFileIOE file + let tokens = myLexer string + mo1 <- ioeErr $ pModDef tokens + ioeErr $ transModDef mo1 + +-- FIXME: should use System.IO.openTempFile +runPreprocessor :: FilePath -> String -> IOE FilePath +runPreprocessor file0 p = + do let tmp = "_gf_preproc.tmp" + cmd = p +++ file0 ++ ">" ++ tmp + ioeIO $ system cmd + -- ioeIO $ putStrLn $ "preproc" +++ cmd + return tmp diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs new file mode 100644 index 000000000..d14a914f1 --- /dev/null +++ b/src/GF/Compile/GrammarToGFCC.hs @@ -0,0 +1,561 @@ +{-# LANGUAGE PatternGuards #-} +module GF.Compile.GrammarToGFCC (prGrammar2gfcc,mkCanon2gfcc,addParsers) where + +import GF.Compile.Export +import GF.Compile.OptimizeGF (unshareModule) +import qualified GF.Compile.GenerateFCFG as FCFG +import qualified GF.Compile.GeneratePMCFG as PMCFG + +import PGF.CId +import PGF.BuildParser (buildParserInfo) +import qualified PGF.Macros as CM +import qualified PGF.Data as C +import qualified PGF.Data as D +import GF.Grammar.Predef +import GF.Grammar.PrGrammar +import GF.Grammar.Grammar +import qualified GF.Grammar.Lookup as Look +import qualified GF.Grammar.Abstract as A +import qualified GF.Grammar.Macros as GM +import qualified GF.Compile.Compute as Compute ---- +import qualified GF.Infra.Modules as M +import qualified GF.Infra.Option as O + +import GF.Infra.Ident +import GF.Infra.Option +import GF.Data.Operations +import GF.Text.UTF8 + +import Data.List +import Data.Char (isDigit,isSpace) +import qualified Data.Map as Map +import qualified Data.ByteString.Char8 as BS +import Debug.Trace ---- + +-- when developing, swap commenting + +--traceD s t = trace s t +traceD s t = t + + +-- the main function: generate PGF from GF. + +prGrammar2gfcc :: Options -> String -> SourceGrammar -> (String,String) +prGrammar2gfcc opts cnc gr = (abs,printPGF gc) where + (abs,gc) = mkCanon2gfcc opts cnc gr + +mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.PGF) +mkCanon2gfcc opts cnc gr = + (prIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon abs) gr) + where + abs = err error id $ M.abstractOfConcrete gr (identC (BS.pack cnc)) + pars = mkParamLincat gr + +-- Adds parsers for all concretes +addParsers :: D.PGF -> D.PGF +addParsers pgf = pgf { D.concretes = Map.map conv (D.concretes pgf) } + where + conv cnc = cnc { D.parser = Just (buildParserInfo fcfg) } + where + fcfg + | Map.lookup (mkCId "erasing") (D.cflags cnc) == Just "on" = PMCFG.convertConcrete (D.abstract pgf) cnc + | otherwise = FCFG.convertConcrete (D.abstract pgf) cnc + + +-- Generate PGF from GFCM. +-- this assumes a grammar translated by canon2canon + +canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> SourceGrammar -> D.PGF +canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = + (if dump opts DumpCanon then trace (prGrammar cgr) else id) $ + D.PGF an cns gflags abs cncs + where + -- abstract + an = (i2i a) + cns = map (i2i . fst) cms + abs = D.Abstr aflags funs cats catfuns + gflags = Map.empty + aflags = Map.fromList [(mkCId f,x) | (f,x) <- moduleOptionsGFO (M.flags abm)] + mkDef pty = case pty of + Yes t -> mkExp t + _ -> CM.primNotion + + -- concretes + lfuns = [(f', (mkType ty, mkDef pty)) | + (f,AbsFun (Yes ty) pty) <- tree2list (M.jments abm), let f' = i2i f] + funs = Map.fromAscList lfuns + lcats = [(i2i c, mkContext cont) | + (c,AbsCat (Yes cont) _) <- tree2list (M.jments abm)] + cats = Map.fromAscList lcats + catfuns = Map.fromList + [(cat,[f | (f, (C.DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats] + + cncs = Map.fromList [mkConcr lang (i2i lang) mo | (lang,M.ModMod mo) <- cms] + mkConcr lang0 lang mo = + (lang,D.Concr flags lins opers lincats lindefs printnames params fcfg) + where + js = tree2list (M.jments mo) + flags = Map.fromList [(mkCId f,x) | (f,x) <- moduleOptionsGFO (M.flags mo)] + opers = Map.fromAscList [] -- opers will be created as optimization + utf = if moduleFlag optEncoding (moduleOptions (M.flags mo)) == UTF_8 + then D.convertStringsInTerm decodeUTF8 else id + lins = Map.fromAscList + [(i2i f, utf (mkTerm tr)) | (f,CncFun _ (Yes tr) _) <- js] + lincats = Map.fromAscList + [(i2i c, mkCType ty) | (c,CncCat (Yes ty) _ _) <- js] + lindefs = Map.fromAscList + [(i2i c, mkTerm tr) | (c,CncCat _ (Yes tr) _) <- js] + printnames = Map.union + (Map.fromAscList [(i2i f, mkTerm tr) | (f,CncFun _ _ (Yes tr)) <- js]) + (Map.fromAscList [(i2i f, mkTerm tr) | (f,CncCat _ _ (Yes tr)) <- js]) + params = Map.fromAscList + [(i2i c, pars lang0 c) | (c,CncCat (Yes ty) _ _) <- js] + fcfg = Nothing + +i2i :: Ident -> CId +i2i = CId . ident2bs + +mkType :: A.Type -> C.Type +mkType t = case GM.typeForm t of + Ok (hyps,(_,cat),args) -> C.DTyp (mkContext hyps) (i2i cat) (map mkExp args) + +mkExp :: A.Term -> C.Expr +mkExp t = case t of + A.Eqs eqs -> C.EEq [C.Equ (map mkPatt ps) (mkExp e) | (ps,e) <- eqs] + _ -> case GM.termForm t of + Ok (xs,c,args) -> mkAbs xs (mkApp c (map mkExp args)) + where + mkAbs xs t = foldr (C.EAbs . i2i) t xs + mkApp c args = case c of + Q _ c -> foldl C.EApp (C.EVar (i2i c)) args + QC _ c -> foldl C.EApp (C.EVar (i2i c)) args + Vr x -> C.EVar (i2i x) + EInt i -> C.ELit (C.LInt i) + EFloat f -> C.ELit (C.LFlt f) + K s -> C.ELit (C.LStr s) + Meta (MetaSymb i) -> C.EMeta i + _ -> C.EMeta 0 + mkPatt p = case p of + A.PP _ c ps -> foldl C.EApp (C.EVar (i2i c)) (map mkPatt ps) + A.PV x -> C.EVar (i2i x) + A.PW -> C.EVar wildCId + A.PInt i -> C.ELit (C.LInt i) + +mkContext :: A.Context -> [C.Hypo] +mkContext hyps = [C.Hyp (i2i x) (mkType ty) | (x,ty) <- hyps] + +mkTerm :: Term -> C.Term +mkTerm tr = case tr of + Vr (IA _ i) -> C.V i + Vr (IAV _ _ i) -> C.V i + Vr (IC s) | isDigit (BS.last s) -> + C.V ((read . BS.unpack . snd . BS.spanEnd isDigit) s) + ---- from gf parser of gfc + EInt i -> C.C $ fromInteger i + R rs -> C.R [mkTerm t | (_, (_,t)) <- rs] + P t l -> C.P (mkTerm t) (C.C (mkLab l)) + TSh _ _ -> error $ show tr + T _ cs -> C.R [mkTerm t | (_,t) <- cs] ------ + V _ cs -> C.R [mkTerm t | t <- cs] + S t p -> C.P (mkTerm t) (mkTerm p) + C s t -> C.S $ concatMap flats [mkTerm x | x <- [s,t]] + FV ts -> C.FV [mkTerm t | t <- ts] + K s -> C.K (C.KS s) +----- K (KP ss _) -> C.K (C.KP ss []) ---- TODO: prefix variants + Empty -> C.S [] + App _ _ -> prtTrace tr $ C.C 66661 ---- for debugging + Abs _ t -> mkTerm t ---- only on toplevel + Alts (td,tvs) -> + C.K (C.KP (strings td) [C.Alt (strings u) (strings v) | (u,v) <- tvs]) + _ -> prtTrace tr $ C.S [C.K (C.KS (A.prt tr +++ "66662"))] ---- for debugging + where + mkLab (LIdent l) = case BS.unpack l of + '_':ds -> (read ds) :: Int + _ -> prtTrace tr $ 66663 + strings t = case t of + K s -> [s] + C u v -> strings u ++ strings v + Strs ss -> concatMap strings ss + _ -> prtTrace tr $ ["66660"] + flats t = case t of + C.S ts -> concatMap flats ts + _ -> [t] + +-- encoding PGF-internal lincats as terms +mkCType :: Type -> C.Term +mkCType t = case t of + EInt i -> C.C $ fromInteger i + RecType rs -> C.R [mkCType t | (_, t) <- rs] + Table pt vt -> case pt of + EInt i -> C.R $ replicate (1 + fromInteger i) $ mkCType vt + RecType rs -> mkCType $ foldr Table vt (map snd rs) + Sort s | s == cStr -> C.S [] --- Str only + _ | Just i <- GM.isTypeInts t -> C.C $ fromInteger i + _ -> error $ "mkCType " ++ show t + +-- encoding showable lincats (as in source gf) as terms +mkParamLincat :: SourceGrammar -> Ident -> Ident -> C.Term +mkParamLincat sgr lang cat = errVal (C.R [C.S []]) $ do + typ <- Look.lookupLincat sgr lang cat + mkPType typ + where + mkPType typ = case typ of + RecType lts -> do + ts <- mapM (mkPType . snd) lts + return $ C.R [ C.P (kks $ prt_ l) t | ((l,_),t) <- zip lts ts] + Table (RecType lts) v -> do + ps <- mapM (mkPType . snd) lts + v' <- mkPType v + return $ foldr (\p v -> C.S [p,v]) v' ps + Table p v -> do + p' <- mkPType p + v' <- mkPType v + return $ C.S [p',v'] + Sort s | s == cStr -> return $ C.S [] + _ -> return $ + C.FV $ map (kks . filter showable . prt_) $ + errVal [] $ Look.allParamValues sgr typ + showable c = not (isSpace c) ---- || (c == ' ') -- to eliminate \n in records + kks = C.K . C.KS + +-- return just one module per language + +reorder :: Ident -> SourceGrammar -> SourceGrammar +reorder abs cg = M.MGrammar $ + (abs, M.ModMod $ + M.Module M.MTAbstract M.MSComplete aflags [] [] adefs poss): + [(c, M.ModMod $ + M.Module (M.MTConcrete abs) M.MSComplete fs [] [] (sorted2tree js) poss) + | (c,(fs,js)) <- cncs] + where + poss = emptyBinTree -- positions no longer needed + mos = M.allModMod cg + adefs = sorted2tree $ sortIds $ + predefADefs ++ Look.allOrigInfos cg abs + predefADefs = + [(c, AbsCat (Yes []) Nope) | c <- [cFloat,cInt,cString]] + aflags = + concatModuleOptions [M.flags mo | (_,mo) <- M.allModMod cg, M.isModAbs mo] + + cncs = sortIds [(lang, concr lang) | lang <- M.allConcretes cg abs] + concr la = (flags, + sortIds (predefCDefs ++ jments)) where + jments = Look.allOrigInfos cg la + flags = concatModuleOptions + [M.flags mo | + (i,mo) <- mos, M.isModCnc mo, + Just r <- [lookup i (M.allExtendSpecs cg la)]] + + predefCDefs = + [(c, CncCat (Yes GM.defLinType) Nope Nope) | c <- [cInt,cFloat,cString]] + + sortIds = sortBy (\ (f,_) (g,_) -> compare f g) + + +-- one grammar per language - needed for symtab generation +repartition :: Ident -> SourceGrammar -> [SourceGrammar] +repartition abs cg = [M.partOfGrammar cg (lang,mo) | + let mos = M.allModMod cg, + lang <- M.allConcretes cg abs, + let mo = errVal + (error ("no module found for " ++ A.prt lang)) $ M.lookupModule cg lang + ] + + +-- translate tables and records to arrays, parameters and labels to indices + +canon2canon :: Ident -> SourceGrammar -> SourceGrammar +canon2canon abs = + recollect . map cl2cl . repartition abs . purgeGrammar abs + where + recollect = M.MGrammar . nubBy (\ (i,_) (j,_) -> i==j) . concatMap M.modules + cl2cl = M.MGrammar . js2js . map (c2c p2p) . M.modules + + js2js ms = map (c2c (j2j (M.MGrammar ms))) ms + + c2c f2 (c,m) = case m of + M.ModMod mo -> + (c, M.ModMod $ M.replaceJudgements mo $ mapTree f2 (M.jments mo)) + _ -> (c,m) + j2j cg (f,j) = case j of + CncFun x (Yes tr) z -> (f,CncFun x (Yes ({-trace ("+ " ++ prt f)-} (t2t tr))) z) + CncCat (Yes ty) (Yes x) y -> (f,CncCat (Yes (ty2ty ty)) (Yes (t2t x)) y) + _ -> (f,j) + where + t2t = term2term cg pv + ty2ty = type2type cg pv + pv@(labels,untyps,typs) = trs $ paramValues cg + + -- flatten record arguments of param constructors + p2p (f,j) = case j of + ResParam (Yes (ps,v)) -> + (f,ResParam (Yes ([(c,concatMap unRec cont) | (c,cont) <- ps],Nothing))) + _ -> (f,j) + unRec (x,ty) = case ty of + RecType fs -> [ity | (_,typ) <- fs, ity <- unRec (identW,typ)] + _ -> [(x,ty)] + +---- + trs v = traceD (tr v) v + + tr (labels,untyps,typs) = + ("LABELS:" ++++ + unlines [A.prt c ++ "." ++ unwords (map A.prt l) +++ "=" +++ show i | + ((c,l),i) <- Map.toList labels]) ++++ + ("UNTYPS:" ++++ unlines [A.prt t +++ "=" +++ show i | + (t,i) <- Map.toList untyps]) ++++ + ("TYPS:" ++++ unlines [A.prt t +++ "=" +++ show (Map.assocs i) | + (t,i) <- Map.toList typs]) +---- + +purgeGrammar :: Ident -> SourceGrammar -> SourceGrammar +purgeGrammar abstr gr = + (M.MGrammar . list . map unopt . filter complete . purge . M.modules) gr + where + list ms = traceD ("MODULES" +++ unwords (map (prt . fst) ms)) ms + purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst) + needed = nub $ concatMap (requiredCanModules isSingle gr) acncs + acncs = abstr : M.allConcretes gr abstr + isSingle = True + complete (i,M.ModMod m) = M.isCompleteModule m --- not . isIncompleteCanon + unopt = unshareModule gr -- subexp elim undone when compiled + +type ParamEnv = + (Map.Map (Ident,[Label]) (Type,Integer), -- numbered labels + Map.Map Term Integer, -- untyped terms to values + Map.Map Type (Map.Map Term Integer)) -- types to their terms to values + +--- gathers those param types that are actually used in lincats and lin terms +paramValues :: SourceGrammar -> ParamEnv +paramValues cgr = (labels,untyps,typs) where + partyps = nub $ + --- [App (Q (IC "Predef") (IC "Ints")) (EInt i) | i <- [1,9]] ---linTypeInt + [ty | + (_,(_,CncCat (Yes ty0) _ _)) <- jments, + ty <- typsFrom ty0 + ] ++ [ + Q m ty | + (m,(ty,ResParam _)) <- jments + ] ++ [ty | + (_,(_,CncFun _ (Yes tr) _)) <- jments, + ty <- err (const []) snd $ appSTM (typsFromTrm tr) [] + ] + params = [(ty, errVal (traceD ("UNKNOWN PARAM TYPE" +++ show ty) []) $ + Look.allParamValues cgr ty) | ty <- partyps] + typsFrom ty = unlockTy ty : case ty of + Table p t -> typsFrom p ++ typsFrom t + RecType ls -> concat [typsFrom t | (_, t) <- ls] + _ -> [] + + typsFromTrm :: Term -> STM [Type] Term + typsFromTrm tr = case tr of + R fs -> mapM_ (typsFromField . snd) fs >> return tr + where + typsFromField (mty, t) = case mty of + Just x -> updateSTM (x:) >> typsFromTrm t + _ -> typsFromTrm t + V ty ts -> updateSTM (ty:) >> mapM_ typsFromTrm ts >> return tr + T (TTyped ty) cs -> + updateSTM (ty:) >> mapM_ typsFromTrm [t | (_, t) <- cs] >> return tr + T (TComp ty) cs -> + updateSTM (ty:) >> mapM_ typsFromTrm [t | (_, t) <- cs] >> return tr + _ -> GM.composOp typsFromTrm tr + + jments = + [(m,j) | (m,mo) <- M.allModMod cgr, j <- tree2list $ M.jments mo] + typs = + Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params] + untyps = + Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs] + lincats = + [(cat,[f | let RecType fs = GM.defLinType, f <- fs]) | cat <- [cInt,cFloat, cString]] ++ + reverse ---- TODO: really those lincats that are reached + ---- reverse is enough to expel overshadowed ones... + [(cat,ls) | (_,(cat,CncCat (Yes ty) _ _)) <- jments, + RecType ls <- [unlockTy ty]] + labels = Map.fromList $ concat + [((cat,[lab]),(typ,i)): + [((cat,[LVar v]),(typ,toInteger (mx + v))) | v <- [0,1]] ++ ---- 1 or 2 vars + [((cat,[lab,lab2]),(ty,j)) | + rs <- getRec typ, ((lab2, ty),j) <- zip rs [0..]] + | + (cat,ls) <- lincats, ((lab, typ),i) <- zip ls [0..], let mx = length ls] + -- go to tables recursively + ---- TODO: even go to deeper records + where + getRec typ = case typ of + RecType rs -> [rs] ---- [unlockTyp rs] -- (sort (unlockTyp ls)) + Table _ t -> getRec t + _ -> [] + +type2type :: SourceGrammar -> ParamEnv -> Type -> Type +type2type cgr env@(labels,untyps,typs) ty = case ty of + RecType rs -> + RecType [(mkLab i, t2t t) | (i,(l, t)) <- zip [0..] (unlockTyp rs)] + Table pt vt -> Table (t2t pt) (t2t vt) + QC _ _ -> look ty + _ -> ty + where + t2t = type2type cgr env + look ty = EInt $ (+ (-1)) $ toInteger $ case Map.lookup ty typs of + Just vs -> length $ Map.assocs vs + _ -> trace ("unknown partype " ++ show ty) 66669 + +term2term :: SourceGrammar -> ParamEnv -> Term -> Term +term2term cgr env@(labels,untyps,typs) tr = case tr of + App _ _ -> mkValCase (unrec tr) + QC _ _ -> mkValCase tr + R rs -> R [(mkLab i, (Nothing, t2t t)) | + (i,(l,(_,t))) <- zip [0..] (GM.sortRec (unlock rs))] + P t l -> r2r tr + PI t l i -> EInt $ toInteger i + + T (TWild _) _ -> error $ "wild" +++ prt tr + T (TComp ty) cs -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc + T (TTyped ty) cs -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc + V ty ts -> mkCurry $ V ty [t2t t | t <- ts] + S t p -> mkCurrySel (t2t t) (t2t p) + + _ -> GM.composSafeOp t2t tr + where + t2t = term2term cgr env + + unrec t = case t of + App f (R fs) -> GM.mkApp (unrec f) [unrec u | (_,(_,u)) <- fs] + _ -> GM.composSafeOp unrec t + + mkValCase tr = case appSTM (doVar tr) [] of + Ok (tr', st@(_:_)) -> t2t $ comp $ foldr mkCase tr' st + _ -> valNum $ comp tr + + --- this is mainly needed for parameter record projections + ---- was: + comp t = errVal t $ Compute.computeConcreteRec cgr t + compt t = case t of + T (TComp typ) ts -> comp $ V typ (map (comp . snd) ts) ---- should... + T (TTyped typ) ts -> comp $ V typ (map (comp . snd) ts) ---- should + V typ ts -> V typ (map comp ts) + S tb (FV ts) -> FV $ map (comp . S tb) ts + S tb@(V typ ts) v0 -> err error id $ do + let v = comp v0 + let mv1 = Map.lookup v untyps + case mv1 of + Just v1 -> return $ (comp . (ts !!) . fromInteger) v1 + _ -> return (S (comp tb) v) + + R r -> R [(l,(ty,comp t)) | (l,(ty,t)) <- r] + P (R r) l -> maybe t (comp . snd) $ lookup l r + _ -> GM.composSafeOp comp t + + doVar :: Term -> STM [((Type,[Term]),(Term,Term))] Term + doVar tr = case getLab tr of + Ok (cat, lab) -> do + k <- readSTM >>= return . length + let tr' = Vr $ identC $ (BS.pack (show k)) ----- + + let tyvs = case Map.lookup (cat,lab) labels of + Just (ty,_) -> case Map.lookup ty typs of + Just vs -> (ty,[t | + (t,_) <- sortBy (\x y -> compare (snd x) (snd y)) + (Map.assocs vs)]) + _ -> error $ "doVar1" +++ A.prt ty + _ -> error $ "doVar2" +++ A.prt tr +++ show (cat,lab) ---- debug + updateSTM ((tyvs, (tr', tr)):) + return tr' + _ -> GM.composOp doVar tr + + r2r tr@(P (S (V ty ts) v) l) = t2t $ S (V ty [comp (P t l) | t <- ts]) v + + r2r tr@(P p _) = case getLab tr of + Ok (cat,labs) -> P (t2t p) . mkLab $ + maybe (prtTrace tr $ 66664) snd $ + Map.lookup (cat,labs) labels + _ -> K ((A.prt tr +++ prtTrace tr "66665")) + + -- this goes recursively into tables (ignored) and records (accumulated) + getLab tr = case tr of + Vr (IA cat _) -> return (identC cat,[]) + Vr (IAV cat _ _) -> return (identC cat,[]) + Vr (IC s) -> return (identC cat,[]) where + cat = BS.takeWhile (/='_') s ---- also to match IAVs; no _ in a cat tolerated + ---- init (reverse (dropWhile (/='_') (reverse s))) ---- from gf parser +---- Vr _ -> error $ "getLab " ++ show tr + P p lab2 -> do + (cat,labs) <- getLab p + return (cat,labs++[lab2]) + S p _ -> getLab p + _ -> Bad "getLab" + + + mkCase ((ty,vs),(x,p)) tr = + S (V ty [mkBranch x v tr | v <- vs]) p + mkBranch x t tr = case tr of + _ | tr == x -> t + _ -> GM.composSafeOp (mkBranch x t) tr + + valNum tr = maybe (valNumFV $ tryFV tr) EInt $ Map.lookup tr untyps + where + tryFV tr = case GM.appForm tr of + (c@(QC _ _), ts) -> [GM.mkApp c ts' | ts' <- combinations (map tryFV ts)] + (FV ts,_) -> ts + _ -> [tr] + valNumFV ts = case ts of + [tr] -> error ("valNum" +++ prt tr) ----- prtTrace tr $ K "66667" + _ -> FV $ map valNum ts + + mkCurry trm = case trm of + V (RecType [(_,ty)]) ts -> V ty ts + V (RecType ((_,ty):ltys)) ts -> + V ty [mkCurry (V (RecType ltys) cs) | + cs <- chop (product (map (lengthtyp . snd) ltys)) ts] + _ -> trm + lengthtyp ty = case Map.lookup ty typs of + Just m -> length (Map.assocs m) + _ -> error $ "length of type " ++ show ty + chop i xs = case splitAt i xs of + (xs1,[]) -> [xs1] + (xs1,xs2) -> xs1:chop i xs2 + + + mkCurrySel t p = S t p -- done properly in CheckGFCC + + +mkLab k = LIdent (BS.pack ("_" ++ show k)) + +-- remove lock fields; in fact, any empty records and record types +unlock = filter notlock where + notlock (l,(_, t)) = case t of --- need not look at l + R [] -> False + RecType [] -> False + _ -> True + +unlockTyp = filter notlock + +notlock (l, t) = case t of --- need not look at l + RecType [] -> False + _ -> True + +unlockTy ty = case ty of + RecType ls -> RecType $ GM.sortRec [(l, unlockTy t) | (l,t) <- ls, notlock (l,t)] + _ -> GM.composSafeOp unlockTy ty + + +prtTrace tr n = + trace ("-- INTERNAL COMPILER ERROR" +++ A.prt tr ++++ show n) n +prTrace tr n = trace ("-- OBSERVE" +++ A.prt tr +++ show n +++ show tr) n + + +-- | this function finds out what modules are really needed in the canonical gr. +-- its argument is typically a concrete module name +requiredCanModules :: (Ord i, Show i) => Bool -> M.MGrammar i a -> i -> [i] +requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where + exts = M.allExtends gr c + ops = if isSingle + then map fst (M.modules gr) + else iterFix (concatMap more) $ exts + more i = errVal [] $ do + m <- M.lookupModMod gr i + return $ M.extends m ++ [o | o <- map M.openedModule (M.opens m)] + notReuse i = errVal True $ do + m <- M.lookupModMod gr i + return $ M.isModRes m -- to exclude reused Cnc and Abs from required diff --git a/src/GF/Compile/ModDeps.hs b/src/GF/Compile/ModDeps.hs new file mode 100644 index 000000000..b5b1b798c --- /dev/null +++ b/src/GF/Compile/ModDeps.hs @@ -0,0 +1,153 @@ +---------------------------------------------------------------------- +-- | +-- Module : ModDeps +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/11 23:24:34 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.14 $ +-- +-- Check correctness of module dependencies. Incomplete. +-- +-- AR 13\/5\/2003 +----------------------------------------------------------------------------- + +module GF.Compile.ModDeps (mkSourceGrammar, + moduleDeps, + openInterfaces, + requiredCanModules + ) where + +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Infra.Option +import GF.Grammar.PrGrammar +import GF.Compile.Update +import GF.Grammar.Lookup +import GF.Infra.Modules + +import GF.Data.Operations + +import Control.Monad +import Data.List + +-- | to check uniqueness of module names and import names, the +-- appropriateness of import and extend types, +-- to build a dependency graph of modules, and to sort them topologically +mkSourceGrammar :: [(Ident,SourceModInfo)] -> Err SourceGrammar +mkSourceGrammar ms = do + let ns = map fst ms + checkUniqueErr ns + mapM (checkUniqueImportNames ns . snd) ms + deps <- moduleDeps ms + deplist <- either + return + (\ms -> Bad $ "circular modules" +++ unwords (map show ms)) $ + topoTest deps + return $ MGrammar [(m, maybe undefined id $ lookup m ms) | IdentM m _ <- deplist] + +checkUniqueErr :: (Show i, Eq i) => [i] -> Err () +checkUniqueErr ms = do + let msg = checkUnique ms + if null msg then return () else Bad $ unlines msg + +-- | check that import names don't clash with module names +checkUniqueImportNames :: [Ident] -> SourceModInfo -> Err () +checkUniqueImportNames ns mo = case mo of + ModMod m -> test [n | OQualif _ n v <- opens m, n /= v] + _ -> return () --- Bad $ "bug: ModDeps does not treat" +++ show mo + where + + test ms = testErr (all (`notElem` ns) ms) + ("import names clashing with module names among" +++ + unwords (map prt ms)) + +type Dependencies = [(IdentM Ident,[IdentM Ident])] + +-- | to decide what modules immediately depend on what, and check if the +-- dependencies are appropriate +moduleDeps :: [(Ident,SourceModInfo)] -> Err Dependencies +moduleDeps ms = mapM deps ms where + deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of + ModMod m -> case mtype m of + MTConcrete a -> do + aty <- lookupModuleType gr a + testErr (aty == MTAbstract) "the of-module is not an abstract syntax" + chDep (IdentM c (MTConcrete a)) + (extends m) (MTConcrete a) (opens m) MTResource + t -> chDep (IdentM c t) (extends m) t (opens m) t + + chDep it es ety os oty = do + ests <- mapM (lookupModuleType gr) es + testErr (all (compatMType ety) ests) "inappropriate extension module type" +---- osts <- mapM (lookupModuleType gr . openedModule) os +---- testErr (all (compatOType oty) osts) "inappropriate open module type" + let ab = case it of + IdentM _ (MTConcrete a) -> [IdentM a MTAbstract] + _ -> [] ---- + return (it, ab ++ + [IdentM e ety | e <- es] ++ + [IdentM (openedModule o) oty | o <- os]) + + -- check for superficial compatibility, not submodule relation etc: what can be extended + compatMType mt0 mt = case (mt0,mt) of + (MTResource, MTConcrete _) -> True + (MTInstance _, MTConcrete _) -> True + (MTInterface, MTAbstract) -> True + (MTConcrete _, MTConcrete _) -> True + (MTInstance _, MTInstance _) -> True + (MTReuse _, MTReuse _) -> True + (MTInstance _, MTResource) -> True + (MTResource, MTInstance _) -> True + ---- some more? + _ -> mt0 == mt + -- in the same way; this defines what can be opened + compatOType mt0 mt = case mt0 of + MTAbstract -> mt == MTAbstract + MTTransfer _ _ -> mt == MTAbstract + _ -> case mt of + MTResource -> True + MTReuse _ -> True + MTInterface -> True + MTInstance _ -> True + _ -> False + + gr = MGrammar ms --- hack + +openInterfaces :: Dependencies -> Ident -> Err [Ident] +openInterfaces ds m = do + let deps = [(i,ds) | (IdentM i _,ds) <- ds] + let more (c,_) = [(i,mt) | Just is <- [lookup c deps], IdentM i mt <- is] + let mods = iterFix (concatMap more) (more (m,undefined)) + return $ [i | (i,MTInterface) <- mods] + +-- | this function finds out what modules are really needed in the canonical gr. +-- its argument is typically a concrete module name +requiredCanModules :: (Ord i, Show i) => Bool -> MGrammar i a -> i -> [i] +requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where + exts = allExtends gr c + ops = if isSingle + then map fst (modules gr) + else iterFix (concatMap more) $ exts + more i = errVal [] $ do + m <- lookupModMod gr i + return $ extends m ++ [o | o <- map openedModule (opens m)] + notReuse i = errVal True $ do + m <- lookupModMod gr i + return $ isModRes m -- to exclude reused Cnc and Abs from required + + +{- +-- to test +exampleDeps = [ + (ir "Nat",[ii "Gen", ir "Adj"]), + (ir "Adj",[ii "Num", ii "Gen", ir "Nou"]), + (ir "Nou",[ii "Cas"]) + ] + +ii s = IdentM (IC s) MTInterface +ir s = IdentM (IC s) MTResource +-} + diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs new file mode 100644 index 000000000..83cbeb57a --- /dev/null +++ b/src/GF/Compile/Optimize.hs @@ -0,0 +1,235 @@ +{-# LANGUAGE PatternGuards #-} +---------------------------------------------------------------------- +-- | +-- Module : Optimize +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/09/16 13:56:13 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.18 $ +-- +-- Top-level partial evaluation for GF source modules. +----------------------------------------------------------------------------- + +module GF.Compile.Optimize (optimizeModule) where + +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Infra.Modules +import GF.Grammar.PrGrammar +import GF.Grammar.Macros +import GF.Grammar.Lookup +import GF.Grammar.Predef +import GF.Compile.Refresh +import GF.Compile.Compute +import GF.Compile.BackOpt +import GF.Compile.CheckGrammar +import GF.Compile.Update + +import GF.Data.Operations +import GF.Infra.CheckM +import GF.Infra.Option + +import Control.Monad +import Data.List +import qualified Data.Set as Set + +import Debug.Trace + + +-- conditional trace + +prtIf :: (Print a) => Bool -> a -> a +prtIf b t = if b then trace (" " ++ prt t) t else t + +-- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005. + +type EEnv = () --- not used + +-- only do this for resource: concrete is optimized in gfc form +optimizeModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> + (Ident,SourceModInfo) -> Err ((Ident,SourceModInfo),EEnv) +optimizeModule opts mse@(ms,eenv) mo@(_,mi) = case mi of + ModMod m0 | mstatus m0 == MSComplete && isModRes m0 -> do + (mo1,_) <- evalModule oopts mse mo + let mo2 = shareModule optim mo1 + return (mo2,eenv) + _ -> evalModule oopts mse mo + where + oopts = addOptions opts (moduleOptions (flagsModule mo)) + optim = moduleFlag optOptimizations oopts + +evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> + Err ((Ident,SourceModInfo),EEnv) +evalModule oopts (ms,eenv) mo@(name,mod) = case mod of + + ModMod m0 | mstatus m0 == MSComplete -> case mtype m0 of + _ | isModRes m0 -> do + let deps = allOperDependencies name (jments m0) + ids <- topoSortOpers deps + MGrammar (mod' : _) <- foldM evalOp gr ids + return $ (mod',eenv) + + MTConcrete a -> do + js' <- mapMTree (evalCncInfo oopts gr name a) (jments m0) + return $ ((name, ModMod (replaceJudgements m0 js')),eenv) + + _ -> return $ ((name,mod),eenv) + _ -> return $ ((name,mod),eenv) + where + gr0 = MGrammar $ ms + gr = MGrammar $ (name,mod) : ms + + evalOp g@(MGrammar ((_, ModMod m) : _)) i = do + info <- lookupTree prt i $ jments m + info' <- evalResInfo oopts gr (i,info) + return $ updateRes g name i info' + +-- | only operations need be compiled in a resource, and this is local to each +-- definition since the module is traversed in topological order +evalResInfo :: Options -> SourceGrammar -> (Ident,Info) -> Err Info +evalResInfo oopts gr (c,info) = case info of + + ResOper pty pde -> eIn "operation" $ do + pde' <- case pde of + Yes de | optres -> liftM yes $ comp de + _ -> return pde + return $ ResOper pty pde' + + _ -> return info + where + comp = if optres then computeConcrete gr else computeConcreteRec gr + eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":") + optim = moduleFlag optOptimizations oopts + optres = OptExpand `Set.member` optim + + +evalCncInfo :: + Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err (Ident,Info) +evalCncInfo opts gr cnc abs (c,info) = do + + seq (prtIf (verbAtLeast opts Verbose) c) $ return () + + errIn ("optimizing" +++ prt c) $ case info of + + CncCat ptyp pde ppr -> do + pde' <- case (ptyp,pde) of + (Yes typ, Yes de) -> + liftM yes $ pEval ([(varStr, typeStr)], typ) de + (Yes typ, Nope) -> + liftM yes $ mkLinDefault gr typ >>= partEval noOptions gr ([(varStr, typeStr)],typ) + (May b, Nope) -> + return $ May b + _ -> return pde -- indirection + + ppr' <- liftM yes $ evalPrintname gr c ppr (yes $ K $ prt c) + + return (c, CncCat ptyp pde' ppr') + + CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr -> --trace (prt c) $ + eIn ("linearization in type" +++ prt (mkProd (cont,val,[])) ++++ "of function") $ do + pde' <- case pde of + Yes de -> do + liftM yes $ pEval ty de + + _ -> return pde + ppr' <- liftM yes $ evalPrintname gr c ppr pde' + return $ (c, CncFun mt pde' ppr') -- only cat in type actually needed + + _ -> return (c,info) + where + pEval = partEval opts gr + eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":") + +-- | the main function for compiling linearizations +partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term +partEval opts gr (context, val) trm = errIn ("parteval" +++ prt_ trm) $ do + let vars = map fst context + args = map Vr vars + subst = [(v, Vr v) | v <- vars] + trm1 = mkApp trm args + trm2 <- computeTerm gr subst trm1 + trm3 <- if rightType trm2 + then computeTerm gr subst trm2 + else recordExpand val trm2 >>= computeTerm gr subst + return $ mkAbs vars trm3 + where + -- don't eta expand records of right length (correct by type checking) + rightType (R rs) = case val of + RecType ts -> length rs == length ts + _ -> False + rightType _ = False + + + + +-- here we must be careful not to reduce +-- variants {{s = "Auto" ; g = N} ; {s = "Wagen" ; g = M}} +-- {s = variants {"Auto" ; "Wagen"} ; g = variants {N ; M}} ; + +recordExpand :: Type -> Term -> Err Term +recordExpand typ trm = case unComputed typ of + RecType tys -> case trm of + FV rs -> return $ FV [R [assign lab (P r lab) | (lab,_) <- tys] | r <- rs] + _ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys] + _ -> return trm + + +-- | auxiliaries for compiling the resource + +mkLinDefault :: SourceGrammar -> Type -> Err Term +mkLinDefault gr typ = do + case unComputed typ of + RecType lts -> mapPairsM mkDefField lts >>= (return . Abs varStr . R . mkAssign) + _ -> liftM (Abs varStr) $ mkDefField typ +---- _ -> prtBad "linearization type must be a record type, not" typ + where + mkDefField typ = case unComputed typ of + Table p t -> do + t' <- mkDefField t + let T _ cs = mkWildCases t' + return $ T (TWild p) cs + Sort s | s == cStr -> return $ Vr varStr + QC q p -> lookupFirstTag gr q p + RecType r -> do + let (ls,ts) = unzip r + ts' <- mapM mkDefField ts + return $ R $ [assign l t | (l,t) <- zip ls ts'] + _ | Just _ <- isTypeInts typ -> return $ EInt 0 -- exists in all as first val + _ -> prtBad "linearization type field cannot be" typ + +-- | Form the printname: if given, compute. If not, use the computed +-- lin for functions, cat name for cats (dispatch made in evalCncDef above). +--- We cannot use linearization at this stage, since we do not know the +--- defaults we would need for question marks - and we're not yet in canon. +evalPrintname :: SourceGrammar -> Ident -> MPr -> Perh Term -> Err Term +evalPrintname gr c ppr lin = + case ppr of + Yes pr -> comp pr + _ -> case lin of + Yes t -> return $ K $ clean $ prt $ oneBranch t ---- stringFromTerm + _ -> return $ K $ prt c ---- + where + comp = computeConcrete gr + + oneBranch t = case t of + Abs _ b -> oneBranch b + R (r:_) -> oneBranch $ snd $ snd r + T _ (c:_) -> oneBranch $ snd c + V _ (c:_) -> oneBranch c + FV (t:_) -> oneBranch t + C x y -> C (oneBranch x) (oneBranch y) + S x _ -> oneBranch x + P x _ -> oneBranch x + Alts (d,_) -> oneBranch d + _ -> t + + --- very unclean cleaner + clean s = case s of + '+':'+':' ':cs -> clean cs + '"':cs -> clean cs + c:cs -> c: clean cs + _ -> s + diff --git a/src/GF/Compile/OptimizeGF.hs b/src/GF/Compile/OptimizeGF.hs new file mode 100644 index 000000000..41b828aa3 --- /dev/null +++ b/src/GF/Compile/OptimizeGF.hs @@ -0,0 +1,277 @@ +---------------------------------------------------------------------- +-- | +-- Module : OptimizeGF +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:21:33 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.6 $ +-- +-- Optimizations on GF source code: sharing, parametrization, value sets. +-- +-- optimization: sharing branches in tables. AR 25\/4\/2003. +-- following advice of Josef Svenningsson +----------------------------------------------------------------------------- + +module GF.Compile.OptimizeGF ( + optModule,unshareModule,unsubexpModule,unoptModule,subexpModule,shareModule + ) where + +import GF.Grammar.Grammar +import GF.Grammar.Lookup +import GF.Infra.Ident +import qualified GF.Grammar.Macros as C +import GF.Grammar.PrGrammar (prt) +import qualified GF.Infra.Modules as M +import GF.Data.Operations + +import Control.Monad +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.ByteString.Char8 as BS +import Data.List + +optModule :: (Ident, SourceModInfo) -> (Ident, SourceModInfo) +optModule = subexpModule . shareModule + +shareModule = processModule optim + +unoptModule :: SourceGrammar -> (Ident, SourceModInfo) -> (Ident, SourceModInfo) +unoptModule gr = unshareModule gr . unsubexpModule + +unshareModule :: SourceGrammar -> (Ident, SourceModInfo) -> (Ident, SourceModInfo) +unshareModule gr = processModule (const (unoptim gr)) + +processModule :: + (Ident -> Term -> Term) -> (Ident, SourceModInfo) -> (Ident, SourceModInfo) +processModule opt (i,m) = case m of + M.ModMod mo -> + (i,M.ModMod (M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo)))) + _ -> (i,m) + +shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (opt c t)) m) +shareInfo opt (c, CncFun kxs (Yes t) m) = (c,CncFun kxs (Yes (opt c t)) m) +shareInfo opt (c, ResOper ty (Yes t)) = (c,ResOper ty (Yes (opt c t))) +shareInfo _ i = i + +-- the function putting together optimizations +optim :: Ident -> Term -> Term +optim c = values . factor c 0 + +-- we need no counter to create new variable names, since variables are +-- local to tables (only true in GFC) --- + +-- factor parametric branches + +factor :: Ident -> Int -> Term -> Term +factor c i t = case t of + T _ [_] -> t + T _ [] -> t + T (TComp ty) cs -> + T (TTyped ty) $ factors i [(p, factor c (i+1) v) | (p, v) <- cs] + _ -> C.composSafeOp (factor c i) t + where + + factors i psvs = -- we know psvs has at least 2 elements + let p = qqIdent c i + vs' = map (mkFun p) psvs + in if allEqs vs' + then mkCase p vs' + else psvs + + mkFun p (patt, val) = replace (C.patt2term patt) (Vr p) val + + allEqs (v:vs) = all (==v) vs + + mkCase p (v:_) = [(PV p, v)] + +--- we hope this will be fresh and don't check... in GFC would be safe + +qqIdent c i = identC (BS.pack ("q_" ++ prt c ++ "__" ++ show i)) + + +-- we need to replace subterms + +replace :: Term -> Term -> Term -> Term +replace old new trm = case trm of + + -- these are the important cases, since they can correspond to patterns + QC _ _ | trm == old -> new + App t ts | trm == old -> new + App t ts -> App (repl t) (repl ts) + R _ | isRec && trm == old -> new + _ -> C.composSafeOp repl trm + where + repl = replace old new + isRec = case trm of + R _ -> True + _ -> False + +-- It is very important that this is performed only after case +-- expansion since otherwise the order and number of values can +-- be incorrect. Guaranteed by the TComp flag. + +values :: Term -> Term +values t = case t of + T ty [(ps,t)] -> T ty [(ps,values t)] -- don't destroy parametrization + T (TComp ty) cs -> V ty [values t | (_, t) <- cs] + T (TTyped ty) cs -> V ty [values t | (_, t) <- cs] + ---- why are these left? + ---- printing with GrammarToSource does not preserve the distinction + _ -> C.composSafeOp values t + + +-- to undo the effect of factorization + +unoptim :: SourceGrammar -> Term -> Term +unoptim gr = unfactor gr + +unfactor :: SourceGrammar -> Term -> Term +unfactor gr t = case t of + T (TTyped ty) [(PV x,u)] -> V ty [restore x v (unfac u) | v <- vals ty] + _ -> C.composSafeOp unfac t + where + unfac = unfactor gr + vals = err error id . allParamValues gr + restore x u t = case t of + Vr y | y == x -> u + _ -> C.composSafeOp (restore x u) t + + +---------------------------------------------------------------------- + +{- +This module implements a simple common subexpression elimination + for gfc grammars, to factor out shared subterms in lin rules. +It works in three phases: + + (1) collectSubterms collects recursively all subterms of forms table and (P x..y) + from lin definitions (experience shows that only these forms + tend to get shared) and counts how many times they occur + (2) addSubexpConsts takes those subterms t that occur more than once + and creates definitions of form "oper A''n = t" where n is a + fresh number; notice that we assume no ids of this form are in + scope otherwise + (3) elimSubtermsMod goes through lins and the created opers by replacing largest + possible subterms by the newly created identifiers + +The optimization is invoked in gf by the flag i -subs. + +If an application does not support GFC opers, the effect of this +optimization can be undone by the function unSubelimCanon. + +The function unSubelimCanon can be used to diagnostisize how much +cse is possible in the grammar. It is used by the flag pg -printer=subs. + +-} + +subexpModule :: SourceModule -> SourceModule +subexpModule (n,m) = errVal (n,m) $ case m of + M.ModMod mo -> do + let ljs = tree2list (M.jments mo) + (tree,_) <- appSTM (getSubtermsMod n ljs) (Map.empty,0) + js2 <- liftM buildTree $ addSubexpConsts n tree $ ljs + return (n,M.ModMod (M.replaceJudgements mo js2)) + _ -> return (n,m) + +unsubexpModule :: SourceModule -> SourceModule +unsubexpModule sm@(i,m) = case m of + M.ModMod mo | hasSub ljs -> + (i, M.ModMod (M.replaceJudgements mo + (rebuild (map unparInfo ljs)))) + where ljs = tree2list (M.jments mo) + _ -> (i,m) + where + -- perform this iff the module has opers + hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs] + unparInfo (c,info) = case info of + CncFun xs (Yes t) m -> [(c, CncFun xs (Yes (unparTerm t)) m)] + ResOper (Yes (EInt 8)) _ -> [] -- subexp-generated opers + ResOper pty (Yes t) -> [(c, ResOper pty (Yes (unparTerm t)))] + _ -> [(c,info)] + unparTerm t = case t of + Q m c | isOperIdent c -> --- name convention of subexp opers + errVal t $ liftM unparTerm $ lookupResDef gr m c + _ -> C.composSafeOp unparTerm t + gr = M.MGrammar [sm] + rebuild = buildTree . concat + +-- implementation + +type TermList = Map Term (Int,Int) -- number of occs, id +type TermM a = STM (TermList,Int) a + +addSubexpConsts :: + Ident -> Map Term (Int,Int) -> [(Ident,Info)] -> Err [(Ident,Info)] +addSubexpConsts mo tree lins = do + let opers = [oper id trm | (trm,(_,id)) <- list] + mapM mkOne $ opers ++ lins + where + + mkOne (f,def) = case def of + CncFun xs (Yes trm) pn -> do + trm' <- recomp f trm + return (f,CncFun xs (Yes trm') pn) + ResOper ty (Yes trm) -> do + trm' <- recomp f trm + return (f,ResOper ty (Yes trm')) + _ -> return (f,def) + recomp f t = case Map.lookup t tree of + Just (_,id) | operIdent id /= f -> return $ Q mo (operIdent id) + _ -> C.composOp (recomp f) t + + list = Map.toList tree + + oper id trm = (operIdent id, ResOper (Yes (EInt 8)) (Yes trm)) + --- impossible type encoding generated opers + +getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (Map Term (Int,Int)) +getSubtermsMod mo js = do + mapM (getInfo (collectSubterms mo)) js + (tree0,_) <- readSTM + return $ Map.filter (\ (nu,_) -> nu > 1) tree0 + where + getInfo get fi@(f,i) = case i of + CncFun xs (Yes trm) pn -> do + get trm + return $ fi + ResOper ty (Yes trm) -> do + get trm + return $ fi + _ -> return fi + +collectSubterms :: Ident -> Term -> TermM Term +collectSubterms mo t = case t of + App f a -> do + collect f + collect a + add t + T ty cs -> do + let (_,ts) = unzip cs + mapM collect ts + add t + V ty ts -> do + mapM collect ts + add t +---- K (KP _ _) -> add t + _ -> C.composOp (collectSubterms mo) t + where + collect = collectSubterms mo + add t = do + (ts,i) <- readSTM + let + ((count,id),next) = case Map.lookup t ts of + Just (nu,id) -> ((nu+1,id), i) + _ -> ((1, i ), i+1) + writeSTM (Map.insert t (count,id) ts, next) + return t --- only because of composOp + +operIdent :: Int -> Ident +operIdent i = identC (operPrefix `BS.append` (BS.pack (show i))) --- + +isOperIdent :: Ident -> Bool +isOperIdent id = BS.isPrefixOf operPrefix (ident2bs id) + +operPrefix = BS.pack ("A''") diff --git a/src/GF/Compile/OptimizeGFCC.hs b/src/GF/Compile/OptimizeGFCC.hs new file mode 100644 index 000000000..c73d5bbcb --- /dev/null +++ b/src/GF/Compile/OptimizeGFCC.hs @@ -0,0 +1,124 @@ +module GF.Compile.OptimizeGFCC where + +import PGF.CId +import PGF.Data + +import GF.Data.Operations + +import Data.List +import qualified Data.Map as Map + + +-- back-end optimization: +-- suffix analysis followed by common subexpression elimination + +optPGF :: PGF -> PGF +optPGF = cseOptimize . suffixOptimize + +suffixOptimize :: PGF -> PGF +suffixOptimize pgf = pgf { + concretes = Map.map opt (concretes pgf) + } + where + opt cnc = cnc { + lins = Map.map optTerm (lins cnc), + lindefs = Map.map optTerm (lindefs cnc), + printnames = Map.map optTerm (printnames cnc) + } + +cseOptimize :: PGF -> PGF +cseOptimize pgf = pgf { + concretes = Map.map subex (concretes pgf) + } + +-- analyse word form lists into prefix + suffixes +-- suffix sets can later be shared by subex elim + +optTerm :: Term -> Term +optTerm tr = case tr of + R ts@(_:_:_) | all isK ts -> mkSuff $ optToks [s | K (KS s) <- ts] + R ts -> R $ map optTerm ts + P t v -> P (optTerm t) v + _ -> tr + where + optToks ss = prf : suffs where + prf = pref (head ss) (tail ss) + suffs = map (drop (length prf)) ss + pref cand ss = case ss of + s1:ss2 -> if isPrefixOf cand s1 then pref cand ss2 else pref (init cand) ss + _ -> cand + isK t = case t of + K (KS _) -> True + _ -> False + mkSuff ("":ws) = R (map (K . KS) ws) + mkSuff (p:ws) = W p (R (map (K . KS) ws)) + + +-- common subexpression elimination + +---subex :: [(CId,Term)] -> [(CId,Term)] +subex :: Concr -> Concr +subex cnc = err error id $ do + (tree,_) <- appSTM (getSubtermsMod cnc) (Map.empty,0) + return $ addSubexpConsts tree cnc + +type TermList = Map.Map Term (Int,Int) -- number of occs, id +type TermM a = STM (TermList,Int) a + +addSubexpConsts :: TermList -> Concr -> Concr +addSubexpConsts tree cnc = cnc { + opers = Map.fromList [(f,recomp f trm) | (f,trm) <- ops], + lins = rec lins, + lindefs = rec lindefs, + printnames = rec printnames + } + where + ops = [(fid id, trm) | (trm,(_,id)) <- Map.assocs tree] + mkOne (f,trm) = (f, recomp f trm) + recomp f t = case Map.lookup t tree of + Just (_,id) | fid id /= f -> F $ fid id -- not to replace oper itself + _ -> case t of + R ts -> R $ map (recomp f) ts + S ts -> S $ map (recomp f) ts + W s t -> W s (recomp f t) + P t p -> P (recomp f t) (recomp f p) + _ -> t + fid n = mkCId $ "_" ++ show n + rec field = Map.fromAscList [(f,recomp f trm) | (f,trm) <- Map.assocs (field cnc)] + + +getSubtermsMod :: Concr -> TermM TermList +getSubtermsMod cnc = do + mapM getSubterms (Map.assocs (lins cnc)) + mapM getSubterms (Map.assocs (lindefs cnc)) + mapM getSubterms (Map.assocs (printnames cnc)) + (tree0,_) <- readSTM + return $ Map.filter (\ (nu,_) -> nu > 1) tree0 + where + getSubterms (f,trm) = collectSubterms trm >> return () + +collectSubterms :: Term -> TermM () +collectSubterms t = case t of + R ts -> do + mapM collectSubterms ts + add t + S ts -> do + mapM collectSubterms ts + add t + W s u -> do + collectSubterms u + add t + P p u -> do + collectSubterms p + collectSubterms u + add t + _ -> return () + where + add t = do + (ts,i) <- readSTM + let + ((count,id),next) = case Map.lookup t ts of + Just (nu,id) -> ((nu+1,id), i) + _ -> ((1, i ), i+1) + writeSTM (Map.insert t (count,id) ts, next) + diff --git a/src/GF/Compile/ReadFiles.hs b/src/GF/Compile/ReadFiles.hs new file mode 100644 index 000000000..cd2faec15 --- /dev/null +++ b/src/GF/Compile/ReadFiles.hs @@ -0,0 +1,195 @@ +---------------------------------------------------------------------- +-- | +-- Module : ReadFiles +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/11 23:24:34 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.26 $ +-- +-- Decide what files to read as function of dependencies and time stamps. +-- +-- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004 +-- +-- to find all files that have to be read, put them in dependency order, and +-- decide which files need recompilation. Name @file.gf@ is returned for them, +-- and @file.gfo@ otherwise. +----------------------------------------------------------------------------- + +module GF.Compile.ReadFiles + ( getAllFiles,ModName,ModEnv,importsOfModule, + gfoFile,gfFile,isGFO, + getOptionsFromFile) where + +import GF.Infra.UseIO +import GF.Infra.Option +import GF.Data.Operations +import GF.Source.AbsGF hiding (FileName) +import GF.Source.LexGF +import GF.Source.ParGF + +import Control.Monad +import Data.Char +import Data.List +import qualified Data.ByteString.Char8 as BS +import qualified Data.Map as Map +import System.Time +import System.Directory +import System.FilePath + +type ModName = String +type ModEnv = Map.Map ModName (ClockTime,[ModName]) + + +-- | Returns a list of all files to be compiled in topological order i.e. +-- the low level (leaf) modules are first. +getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath] +getAllFiles opts ps env file = do + -- read module headers from all files recursively + ds <- liftM reverse $ get [] [] (justModuleName file) + ioeIO $ putIfVerb opts $ "all modules:" +++ show [name | (name,_,_,_,_) <- ds] + return $ paths ds + where + -- construct list of paths to read + paths cs = [mk (p </> f) | (f,st,_,_,p) <- cs, mk <- mkFile st] + where + mkFile CSComp = [gfFile ] + mkFile CSRead = [gfoFile] + mkFile _ = [] + + -- | traverses the dependency graph and returns a topologicaly sorted + -- list of ModuleInfo. An error is raised if there is circular dependency + get :: [ModName] -- ^ keeps the current path in the dependency graph to avoid cycles + -> [ModuleInfo] -- ^ a list of already traversed modules + -> ModName -- ^ the current module + -> IOE [ModuleInfo] -- ^ the final + get trc ds name + | name `elem` trc = ioeErr $ Bad $ "circular modules" +++ unwords trc + | (not . null) [n | (n,_,_,_,_) <- ds, name == n] --- file already read + = return ds + | otherwise = do + (name,st0,t0,imps,p) <- findModule name + ds <- foldM (get (name:trc)) ds imps + let (st,t) | (not . null) [f | (f,CSComp,_,_,_) <- ds, elem f imps] + = (CSComp,Nothing) + | otherwise = (st0,t0) + return ((name,st,t,imps,p):ds) + + -- searches for module in the search path and if it is found + -- returns 'ModuleInfo'. It fails if there is no such module + findModule :: ModName -> IOE ModuleInfo + findModule name = do + (file,gfTime,gfoTime) <- do + mb_gfFile <- ioeIO $ getFilePathMsg "" ps (gfFile name) + case mb_gfFile of + Just gfFile -> do gfTime <- ioeIO $ getModificationTime gfFile + mb_gfoTime <- ioeIO $ catch (liftM Just $ getModificationTime (replaceExtension gfFile "gfo")) + (\_->return Nothing) + return (gfFile, Just gfTime, mb_gfoTime) + Nothing -> do mb_gfoFile <- ioeIO $ getFilePathMsg "" ps (gfoFile name) + case mb_gfoFile of + Just gfoFile -> do gfoTime <- ioeIO $ getModificationTime gfoFile + return (gfoFile, Nothing, Just gfoTime) + Nothing -> ioeErr $ Bad ("File " ++ gfFile name ++ " does not exist.") + + + let mb_envmod = Map.lookup name env + (st,t) = selectFormat opts (fmap fst mb_envmod) gfTime gfoTime + + imps <- if st == CSEnv + then return (maybe [] snd mb_envmod) + else do s <- ioeIO $ BS.readFile file + (mname,imps) <- ioeErr ((liftM importsOfModule . pModHeader . myLexer) s) + ioeErr $ testErr (mname == name) + ("module name" +++ mname +++ "differs from file name" +++ name) + return imps + + return (name,st,t,imps,dropFileName file) + + +isGFO :: FilePath -> Bool +isGFO = (== ".gfo") . takeExtensions + +gfoFile :: FilePath -> FilePath +gfoFile f = addExtension f "gfo" + +gfFile :: FilePath -> FilePath +gfFile f = addExtension f "gf" + + +-- From the given Options and the time stamps computes +-- whether the module have to be computed, read from .gfo or +-- the environment version have to be used +selectFormat :: Options -> Maybe ClockTime -> Maybe ClockTime -> Maybe ClockTime -> (CompStatus,Maybe ClockTime) +selectFormat opts mtenv mtgf mtgfo = + case (mtenv,mtgfo,mtgf) of + (_,_,Just tgf) | fromSrc -> (CSComp,Nothing) + (Just tenv,_,_) | fromComp -> (CSEnv, Just tenv) + (_,Just tgfo,_) | fromComp -> (CSRead,Just tgfo) + (Just tenv,_,Just tgf) | tenv > tgf -> (CSEnv, Just tenv) + (_,Just tgfo,Just tgf) | tgfo > tgf -> (CSRead,Just tgfo) + (Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist + (_,_, Nothing) -> (CSRead,Nothing) -- source does not exist + _ -> (CSComp,Nothing) + where + fromComp = flag optRecomp opts == NeverRecomp + fromSrc = flag optRecomp opts == AlwaysRecomp + + +-- internal module dep information + + +data CompStatus = + CSComp -- compile: read gf + | CSRead -- read gfo + | CSEnv -- gfo is in env + deriving Eq + +type ModuleInfo = (ModName,CompStatus,Maybe ClockTime,[ModName],InitPath) + + +importsOfModule :: ModDef -> (ModName,[ModName]) +importsOfModule (MModule _ typ body) = modType typ (modBody body []) + where + modType (MTAbstract m) xs = (modName m,xs) + modType (MTResource m) xs = (modName m,xs) + modType (MTInterface m) xs = (modName m,xs) + modType (MTConcrete m m2) xs = (modName m,modName m2:xs) + modType (MTInstance m m2) xs = (modName m,modName m2:xs) + modType (MTTransfer m o1 o2) xs = (modName m,open o1 (open o2 xs)) + + modBody (MBody e o _) xs = extend e (opens o xs) + modBody (MNoBody is) xs = foldr include xs is + modBody (MWith i os) xs = include i (foldr open xs os) + modBody (MWithBody i os o _) xs = include i (foldr open (opens o xs) os) + modBody (MWithE is i os) xs = foldr include (include i (foldr open xs os)) is + modBody (MWithEBody is i os o _) xs = foldr include (include i (foldr open (opens o xs) os)) is + modBody (MReuse m) xs = modName m:xs + modBody (MUnion is) xs = foldr include xs is + + include (IAll m) xs = modName m:xs + include (ISome m _) xs = modName m:xs + include (IMinus m _) xs = modName m:xs + + open (OName n) xs = modName n:xs + open (OQualQO _ n) xs = modName n:xs + open (OQual _ _ n) xs = modName n:xs + + extend NoExt xs = xs + extend (Ext is) xs = foldr include xs is + + opens NoOpens xs = xs + opens (OpenIn os) xs = foldr open xs os + + modName (PIdent (_,s)) = BS.unpack s + + +-- | options can be passed to the compiler by comments in @--#@, in the main file +getOptionsFromFile :: FilePath -> IOE Options +getOptionsFromFile file = do + s <- ioeIO $ readFileIfStrict file + let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s + fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls + ioeErr $ liftM moduleOptions $ parseModuleOptions fs diff --git a/src/GF/Compile/Rebuild.hs b/src/GF/Compile/Rebuild.hs new file mode 100644 index 000000000..ec9076e1c --- /dev/null +++ b/src/GF/Compile/Rebuild.hs @@ -0,0 +1,104 @@ +---------------------------------------------------------------------- +-- | +-- Module : Rebuild +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/30 21:08:14 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.14 $ +-- +-- Rebuild a source module from incomplete and its with-instance. +----------------------------------------------------------------------------- + +module GF.Compile.Rebuild (rebuildModule) where + +import GF.Grammar.Grammar +import GF.Compile.ModDeps +import GF.Grammar.PrGrammar +import GF.Grammar.Lookup +import GF.Compile.Extend +import GF.Grammar.Macros + +import GF.Infra.Ident +import GF.Infra.Modules +import GF.Infra.Option +import GF.Data.Operations + +import Data.List (nub) + +-- | rebuilding instance + interface, and "with" modules, prior to renaming. +-- AR 24/10/2003 +rebuildModule :: [SourceModule] -> SourceModule -> Err SourceModule +rebuildModule ms mo@(i,mi) = do + let gr = MGrammar ms +---- deps <- moduleDeps ms +---- is <- openInterfaces deps i + let is = [] ---- the method above is buggy: try "i -src" for two grs. AR 8/3/2005 + mi' <- case mi of + + -- add the information given in interface into an instance module + ModMod m -> do + testErr (null is || mstatus m == MSIncomplete) + ("module" +++ prt i +++ + "has open interfaces and must therefore be declared incomplete") + case mtype m of + MTInstance i0 -> do + m1 <- lookupModMod gr i0 + testErr (isModRes m1) ("interface expected instead of" +++ prt i0) + m' <- do + js' <- extendMod False (i0,const True) i (jments m1) (jments m) + --- to avoid double inclusions, in instance I of I0 = J0 ** ... + case extends m of + [] -> return $ replaceJudgements m js' + j0s -> do + m0s <- mapM (lookupModMod gr) j0s + let notInM0 c _ = all (not . isInBinTree c . jments) m0s + let js2 = filterBinTree notInM0 js' + return $ (replaceJudgements m js2) + {positions = + buildTree (tree2list (positions m1) ++ + tree2list (positions m))} + return $ ModMod m' + _ -> return mi + + -- add the instance opens to an incomplete module "with" instances + -- ModWith mt stat ext me ops -> do + ModWith (Module mt stat fs_ me ops_ js_ ps_) (ext,incl) ops -> do + let insts = [(inf,inst) | OQualif _ inf inst <- ops] + let infs = map fst insts + let stat' = ifNull MSComplete (const MSIncomplete) + [i | i <- is, notElem i infs] + testErr (stat' == MSComplete || stat == MSIncomplete) + ("module" +++ prt i +++ "remains incomplete") + Module mt0 _ fs me' ops0 js ps0 <- lookupModMod gr ext + let ops1 = nub $ + ops_ ++ -- N.B. js has been name-resolved already + ops ++ [o | o <- ops0, notElem (openedModule o) infs] + ++ [oQualif i i | i <- map snd insts] ---- + ++ [oSimple i | i <- map snd insts] ---- + + --- check if me is incomplete + let fs1 = addModuleOptions fs fs_ -- new flags have priority + let js0 = [ci | ci@(c,_) <- tree2list js, isInherited incl c] + let js1 = buildTree (tree2list js_ ++ js0) + let ps1 = buildTree (tree2list ps_ ++ tree2list ps0) + return $ ModMod $ Module mt0 stat' fs1 me ops1 js1 ps1 + ---- (mapTree (qualifInstanceInfo insts) js) -- not needed + + _ -> return mi + return (i,mi') + +checkCompleteInstance :: SourceRes -> SourceRes -> Err () +checkCompleteInstance abs cnc = ifNull (return ()) (Bad . unlines) $ + checkComplete [f | (f, ResOper (Yes _) _) <- abs'] cnc' + where + abs' = tree2list $ jments abs + cnc' = jments cnc + checkComplete sought given = foldr ckOne [] sought + where + ckOne f = if isInBinTree f given + then id + else (("Error: no definition given to" +++ prt f):) + diff --git a/src/GF/Compile/Refresh.hs b/src/GF/Compile/Refresh.hs new file mode 100644 index 000000000..39fb57db0 --- /dev/null +++ b/src/GF/Compile/Refresh.hs @@ -0,0 +1,133 @@ +---------------------------------------------------------------------- +-- | +-- Module : Refresh +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:27 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.6 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Compile.Refresh (refreshTerm, refreshTermN, + refreshModule + ) where + +import GF.Data.Operations +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Infra.Modules +import GF.Grammar.Macros +import Control.Monad + +refreshTerm :: Term -> Err Term +refreshTerm = refreshTermN 0 + +refreshTermN :: Int -> Term -> Err Term +refreshTermN i e = liftM snd $ refreshTermKN i e + +refreshTermKN :: Int -> Term -> Err (Int,Term) +refreshTermKN i e = liftM (\ (t,(_,i)) -> (i,t)) $ + appSTM (refresh e) (initIdStateN i) + +refresh :: Term -> STM IdState Term +refresh e = case e of + + Vr x -> liftM Vr (lookVar x) + Abs x b -> liftM2 Abs (refVarPlus x) (refresh b) + + Prod x a b -> do + a' <- refresh a + x' <- refVar x + b' <- refresh b + return $ Prod x' a' b' + + Let (x,(mt,a)) b -> do + a' <- refresh a + mt' <- case mt of + Just t -> refresh t >>= (return . Just) + _ -> return mt + x' <- refVar x + b' <- refresh b + return (Let (x',(mt',a')) b') + + R r -> liftM R $ refreshRecord r + + ExtR r s -> liftM2 ExtR (refresh r) (refresh s) + + T i cc -> liftM2 T (refreshTInfo i) (mapM refreshCase cc) + + _ -> composOp refresh e + +refreshCase :: (Patt,Term) -> STM IdState (Patt,Term) +refreshCase (p,t) = liftM2 (,) (refreshPatt p) (refresh t) + +refreshPatt p = case p of + PV x -> liftM PV (refVar x) + PC c ps -> liftM (PC c) (mapM refreshPatt ps) + PP q c ps -> liftM (PP q c) (mapM refreshPatt ps) + PR r -> liftM PR (mapPairsM refreshPatt r) + PT t p' -> liftM2 PT (refresh t) (refreshPatt p') + + PAs x p' -> liftM2 PAs (refVar x) (refreshPatt p') + + PSeq p' q' -> liftM2 PSeq (refreshPatt p') (refreshPatt q') + PAlt p' q' -> liftM2 PAlt (refreshPatt p') (refreshPatt q') + PRep p' -> liftM PRep (refreshPatt p') + PNeg p' -> liftM PNeg (refreshPatt p') + + _ -> return p + +refreshRecord r = case r of + [] -> return r + (x,(mt,a)):b -> do + a' <- refresh a + mt' <- case mt of + Just t -> refresh t >>= (return . Just) + _ -> return mt + b' <- refreshRecord b + return $ (x,(mt',a')) : b' + +refreshTInfo i = case i of + TTyped t -> liftM TTyped $ refresh t + TComp t -> liftM TComp $ refresh t + TWild t -> liftM TWild $ refresh t + _ -> return i + +-- for abstract syntax + +refreshEquation :: Equation -> Err ([Patt],Term) +refreshEquation pst = err Bad (return . fst) (appSTM (refr pst) initIdState) where + refr (ps,t) = liftM2 (,) (mapM refreshPatt ps) (refresh t) + +-- for concrete and resource in grammar, before optimizing + +refreshGrammar :: SourceGrammar -> Err SourceGrammar +refreshGrammar = liftM (MGrammar . snd) . foldM refreshModule (0,[]) . modules + +refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule]) +refreshModule (k,ms) mi@(i,m) = case m of + ModMod mo | (isModCnc mo || isModRes mo) -> do + (k',js') <- foldM refreshRes (k,[]) $ tree2list $ jments mo + return (k', (i, ModMod(replaceJudgements mo (buildTree js'))) : ms) + _ -> return (k, mi:ms) + where + refreshRes (k,cs) ci@(c,info) = case info of + ResOper ptyp (Yes trm) -> do ---- refresh ptyp + (k',trm') <- refreshTermKN k trm + return $ (k', (c, ResOper ptyp (Yes trm')):cs) + ResOverload os tyts -> do + (k',tyts') <- liftM (\ (t,(_,i)) -> (i,t)) $ + appSTM (mapPairsM refresh tyts) (initIdStateN k) + return $ (k', (c, ResOverload os tyts'):cs) + CncCat mt (Yes trm) pn -> do ---- refresh mt, pn + (k',trm') <- refreshTermKN k trm + return $ (k', (c, CncCat mt (Yes trm') pn):cs) + CncFun mt (Yes trm) pn -> do ---- refresh pn + (k',trm') <- refreshTermKN k trm + return $ (k', (c, CncFun mt (Yes trm') pn):cs) + _ -> return (k, ci:cs) + diff --git a/src/GF/Compile/RemoveLiT.hs b/src/GF/Compile/RemoveLiT.hs new file mode 100644 index 000000000..d06b80400 --- /dev/null +++ b/src/GF/Compile/RemoveLiT.hs @@ -0,0 +1,64 @@ +---------------------------------------------------------------------- +-- | +-- Module : RemoveLiT +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:21:45 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.6 $ +-- +-- remove obsolete (Lin C) expressions before doing anything else. AR 21/6/2003 +-- +-- What the program does is replace the occurrences of Lin C with the actual +-- definition T given in lincat C = T ; with {s : Str} if no lincat is found. +-- The procedure is uncertain, if T contains another Lin. +----------------------------------------------------------------------------- + +module GF.Compile.RemoveLiT (removeLiT) where + +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Infra.Modules +import GF.Grammar.Macros +import GF.Grammar.Lookup +import GF.Grammar.Predef + +import GF.Data.Operations + +import Control.Monad + +removeLiT :: SourceGrammar -> Err SourceGrammar +removeLiT gr = liftM MGrammar $ mapM (remlModule gr) (modules gr) + +remlModule :: SourceGrammar -> (Ident,SourceModInfo) -> Err (Ident,SourceModInfo) +remlModule gr mi@(name,mod) = case mod of + ModMod mo -> do + js1 <- mapMTree (remlResInfo gr) (jments mo) + let mod2 = ModMod $ mo {jments = js1} + return $ (name,mod2) + _ -> return mi + +remlResInfo :: SourceGrammar -> (Ident,Info) -> Err (Ident,Info) +remlResInfo gr mi@(i,info) = case info of + ResOper pty ptr -> liftM ((,) i) $ liftM2 ResOper (ren pty) (ren ptr) + CncCat pty ptr ppr -> liftM ((,) i) $ liftM3 CncCat (ren pty) (ren ptr) (ren ppr) + CncFun mt ptr ppr -> liftM ((,) i) $ liftM2 (CncFun mt) (ren ptr) (ren ppr) + _ -> return mi + where + ren = remlPerh gr + +remlPerh gr pt = case pt of + Yes t -> liftM Yes $ remlTerm gr t + _ -> return pt + +remlTerm :: SourceGrammar -> Term -> Err Term +remlTerm gr trm = case trm of + LiT c -> look c >>= remlTerm gr + _ -> composOp (remlTerm gr) trm + where + look c = err (const $ return defLinType) return $ lookupLincat gr m c + m = case [cnc | (cnc,ModMod m) <- modules gr, isModCnc m] of + cnc:_ -> cnc -- actually there is always exactly one + _ -> cCNC diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs new file mode 100644 index 000000000..7b4d09277 --- /dev/null +++ b/src/GF/Compile/Rename.hs @@ -0,0 +1,338 @@ +---------------------------------------------------------------------- +-- | +-- Module : Rename +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/30 18:39:44 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.19 $ +-- +-- AR 14\/5\/2003 +-- The top-level function 'renameGrammar' does several things: +-- +-- - extends each module symbol table by indirections to extended module +-- +-- - changes unqualified and as-qualified imports to absolutely qualified +-- +-- - goes through the definitions and resolves names +-- +-- Dependency analysis between modules has been performed before this pass. +-- Hence we can proceed by @fold@ing "from left to right". +----------------------------------------------------------------------------- + +module GF.Compile.Rename (renameGrammar, + renameSourceTerm, + renameModule + ) where + +import GF.Grammar.Grammar +import GF.Grammar.Values +import GF.Grammar.Predef +import GF.Infra.Modules +import GF.Infra.Ident +import GF.Grammar.Macros +import GF.Grammar.PrGrammar +import GF.Grammar.AppPredefined +import GF.Grammar.Lookup +import GF.Compile.Extend +import GF.Data.Operations + +import Control.Monad +import Data.List (nub) +import Debug.Trace (trace) + +renameGrammar :: SourceGrammar -> Err SourceGrammar +renameGrammar g = liftM (MGrammar . reverse) $ foldM renameModule [] (modules g) + +-- | this gives top-level access to renaming term input in the cc command +renameSourceTerm :: SourceGrammar -> Ident -> Term -> Err Term +renameSourceTerm g m t = do + mo <- lookupErr m (modules g) + status <- buildStatus g m mo + renameTerm status [] t + +renameModule :: [SourceModule] -> SourceModule -> Err [SourceModule] +renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of + ModMod mo -> do + let js1 = jments mo + status <- buildStatus (MGrammar ms) name mod + js2 <- mapsErrTree (renameInfo mo status) js1 + let mod2 = ModMod $ mo {opens = map forceQualif (opens mo), jments = js2} + return $ (name,mod2) : ms + +type Status = (StatusTree, [(OpenSpec Ident, StatusTree)]) + +type StatusTree = BinTree Ident StatusInfo + +type StatusInfo = Ident -> Term + +renameIdentTerm :: Status -> Term -> Err Term +renameIdentTerm env@(act,imps) t = + errIn ("atomic term" +++ prt t +++ "given" +++ unwords (map (prt . fst) qualifs)) $ + case t of + Vr c -> ident predefAbs c + Cn c -> ident (\_ s -> Bad s) c + Q m' c | m' == cPredef {- && isInPredefined c -} -> return t + Q m' c -> do + m <- lookupErr m' qualifs + f <- lookupTree prt c m + return $ f c + QC m' c | m' == cPredef {- && isInPredefined c -} -> return t + QC m' c -> do + m <- lookupErr m' qualifs + f <- lookupTree prt c m + return $ f c + _ -> return t + where + opens = [st | (OSimple _ _,st) <- imps] + qualifs = [(m, st) | (OQualif _ m _, st) <- imps] ++ + [(m, st) | (OSimple _ m, st) <- imps] -- qualif is always possible + + -- this facility is mainly for BWC with GF1: you need not import PredefAbs + predefAbs c s + | isPredefCat c = return $ Q cPredefAbs c + | otherwise = Bad s + + ident alt c = case lookupTree prt c act of + Ok f -> return $ f c + _ -> case lookupTreeManyAll prt opens c of + [f] -> return $ f c + [] -> alt c ("constant not found:" +++ prt c) + fs -> case nub [f c | f <- fs] of + [tr] -> return tr + ts@(t:_) -> trace ("WARNING: conflict" +++ unwords (map prt ts)) (return t) + -- a warning will be generated in CheckGrammar, and the head returned + -- in next V: + -- Bad $ "conflicting imports:" +++ unwords (map prt ts) + + +--- | would it make sense to optimize this by inlining? +renameIdentPatt :: Status -> Patt -> Err Patt +renameIdentPatt env p = do + let t = patt2term p + t' <- renameIdentTerm env t + term2patt t' + +info2status :: Maybe Ident -> (Ident,Info) -> (Ident,StatusInfo) +info2status mq (c,i) = (c, case i of + AbsFun _ (Yes EData) -> maybe Con QC mq + ResValue _ -> maybe Con QC mq + ResParam _ -> maybe Con QC mq + AnyInd True m -> maybe Con (const (QC m)) mq + AnyInd False m -> maybe Cn (const (Q m)) mq + _ -> maybe Cn Q mq + ) + +tree2status :: OpenSpec Ident -> BinTree Ident Info -> BinTree Ident StatusInfo +tree2status o = case o of + OSimple _ i -> mapTree (info2status (Just i)) + OQualif _ i j -> mapTree (info2status (Just j)) + +buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status +buildStatus gr c mo = let mo' = self2status c mo in case mo of + ModMod m -> do + let gr1 = MGrammar $ (c,mo) : modules gr + ops = [OSimple OQNormal e | e <- allExtends gr1 c] ++ allOpens m + mods <- mapM (lookupModule gr1 . openedModule) ops + let sts = map modInfo2status $ zip ops mods + return $ if isModCnc m + then (emptyBinTree, reverse sts) -- the module itself does not define any names + else (mo',reverse sts) -- so the empty ident is not needed + +modInfo2status :: (OpenSpec Ident,SourceModInfo) -> (OpenSpec Ident, StatusTree) +modInfo2status (o,i) = (o,case i of + ModMod m -> tree2status o (jments m) + ) + +self2status :: Ident -> SourceModInfo -> StatusTree +self2status c i = mapTree (info2status (Just c)) js where -- qualify internal + js = case i of + ModMod m + | isModTrans m -> sorted2tree $ filter noTrans $ tree2list $ jments m + | otherwise -> jments m + noTrans (_,d) = case d of -- to enable other than transfer js in transfer module + AbsTrans _ -> False + _ -> True + +forceQualif o = case o of + OSimple q i -> OQualif q i i + OQualif q _ i -> OQualif q i i + +renameInfo :: Module Ident Info -> Status -> (Ident,Info) -> Err (Ident,Info) +renameInfo mo status (i,info) = errIn + ("renaming definition of" +++ prt i +++ showPosition mo i) $ + liftM ((,) i) $ case info of + AbsCat pco pfs -> liftM2 AbsCat (renPerh (renameContext status) pco) + (renPerh (mapM rent) pfs) + AbsFun pty ptr -> liftM2 AbsFun (ren pty) (ren ptr) + AbsTrans f -> liftM AbsTrans (rent f) + + ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr) + ResOverload os tysts -> + liftM (ResOverload os) (mapM (pairM rent) tysts) + + ResParam (Yes (pp,m)) -> do + pp' <- mapM (renameParam status) pp + return $ ResParam $ Yes (pp',m) + ResValue (Yes (t,m)) -> do + t' <- rent t + return $ ResValue $ Yes (t',m) + CncCat pty ptr ppr -> liftM3 CncCat (ren pty) (ren ptr) (ren ppr) + CncFun mt ptr ppr -> liftM2 (CncFun mt) (ren ptr) (ren ppr) + _ -> return info + where + ren = renPerh rent + rent = renameTerm status [] + +renPerh ren pt = case pt of + Yes t -> liftM Yes $ ren t + _ -> return pt + +renameTerm :: Status -> [Ident] -> Term -> Err Term +renameTerm env vars = ren vars where + ren vs trm = case trm of + Abs x b -> liftM (Abs x) (ren (x:vs) b) + Prod x a b -> liftM2 (Prod x) (ren vs a) (ren (x:vs) b) + Typed a b -> liftM2 Typed (ren vs a) (ren vs b) + Vr x + | elem x vs -> return trm + | otherwise -> renid trm + Cn _ -> renid trm + Con _ -> renid trm + Q _ _ -> renid trm + QC _ _ -> renid trm + Eqs eqs -> liftM Eqs $ mapM (renameEquation env vars) eqs + T i cs -> do + i' <- case i of + TTyped ty -> liftM TTyped $ ren vs ty -- the only annotation in source + _ -> return i + liftM (T i') $ mapM (renCase vs) cs + + Let (x,(m,a)) b -> do + m' <- case m of + Just ty -> liftM Just $ ren vs ty + _ -> return m + a' <- ren vs a + b' <- ren (x:vs) b + return $ Let (x,(m',a')) b' + + P t@(Vr r) l -- for constant t we know it is projection + | elem r vs -> return trm -- var proj first + | otherwise -> case renid (Q r (label2ident l)) of -- qualif second + Ok t -> return t + _ -> case liftM (flip P l) $ renid t of + Ok t -> return t -- const proj last + _ -> prtBad "unknown qualified constant" trm + + EPatt p -> do + (p',_) <- renpatt p + return $ EPatt p' + + _ -> composOp (ren vs) trm + + renid = renameIdentTerm env + renCase vs (p,t) = do + (p',vs') <- renpatt p + t' <- ren (vs' ++ vs) t + return (p',t') + renpatt = renamePattern env + +-- | vars not needed in env, since patterns always overshadow old vars +renamePattern :: Status -> Patt -> Err (Patt,[Ident]) +renamePattern env patt = case patt of + + PMacro c -> do + c' <- renid $ Vr c + case c' of + Q p d -> renp $ PM p d + _ -> prtBad "unresolved pattern" patt + + PC c ps -> do + c' <- renameIdentTerm env $ Cn c + case c' of + QC p d -> renp $ PP p d ps +-- Q p d -> renp $ PP p d ps --- why this? AR 15/3/2008 + _ -> prtBad "unresolved pattern" c' ---- (PC c ps', concat vs) + + PP p c ps -> do + + (p', c') <- case renameIdentTerm env (QC p c) of + Ok (QC p' c') -> return (p',c') + _ -> return (p,c) --- temporarily, for bw compat + psvss <- mapM renp ps + let (ps',vs) = unzip psvss + return (PP p' c' ps', concat vs) + + PM p c -> do + (p', c') <- case renameIdentTerm env (Q p c) of + Ok (Q p' c') -> return (p',c') + _ -> prtBad "not a pattern macro" patt + return (PM p' c', []) + + PV x -> case renid (Vr x) of + Ok (QC m c) -> return (PP m c [],[]) + _ -> return (patt, [x]) + + PR r -> do + let (ls,ps) = unzip r + psvss <- mapM renp ps + let (ps',vs') = unzip psvss + return (PR (zip ls ps'), concat vs') + + PAlt p q -> do + (p',vs) <- renp p + (q',ws) <- renp q + return (PAlt p' q', vs ++ ws) + + PSeq p q -> do + (p',vs) <- renp p + (q',ws) <- renp q + return (PSeq p' q', vs ++ ws) + + PRep p -> do + (p',vs) <- renp p + return (PRep p', vs) + + PNeg p -> do + (p',vs) <- renp p + return (PNeg p', vs) + + PAs x p -> do + (p',vs) <- renp p + return (PAs x p', x:vs) + + _ -> return (patt,[]) + + where + renp = renamePattern env + renid = renameIdentTerm env + +renameParam :: Status -> (Ident, Context) -> Err (Ident, Context) +renameParam env (c,co) = do + co' <- renameContext env co + return (c,co') + +renameContext :: Status -> Context -> Err Context +renameContext b = renc [] where + renc vs cont = case cont of + (x,t) : xts + | isWildIdent x -> do + t' <- ren vs t + xts' <- renc vs xts + return $ (x,t') : xts' + | otherwise -> do + t' <- ren vs t + let vs' = x:vs + xts' <- renc vs' xts + return $ (x,t') : xts' + _ -> return cont + ren = renameTerm b + +-- | vars not needed in env, since patterns always overshadow old vars +renameEquation :: Status -> [Ident] -> Equation -> Err Equation +renameEquation b vs (ps,t) = do + (ps',vs') <- liftM unzip $ mapM (renamePattern b) ps + t' <- renameTerm b (concat vs' ++ vs) t + return (ps',t') diff --git a/src/GF/Compile/TC.hs b/src/GF/Compile/TC.hs new file mode 100644 index 000000000..c0c8a83ae --- /dev/null +++ b/src/GF/Compile/TC.hs @@ -0,0 +1,292 @@ +---------------------------------------------------------------------- +-- | +-- Module : TC +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/10/02 20:50:19 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.11 $ +-- +-- Thierry Coquand's type checking algorithm that creates a trace +----------------------------------------------------------------------------- + +module GF.Compile.TC (AExp(..), + Theory, + checkExp, + inferExp, + checkEqs, + eqVal, + whnf + ) where + +import GF.Data.Operations +import GF.Grammar.Predef +import GF.Grammar.Abstract + +import Control.Monad +import Data.List (sortBy) + +data AExp = + AVr Ident Val + | ACn QIdent Val + | AType + | AInt Integer + | AFloat Double + | AStr String + | AMeta MetaSymb Val + | AApp AExp AExp Val + | AAbs Ident Val AExp + | AProd Ident AExp AExp + | AEqs [([Exp],AExp)] --- not used + | AData Val + deriving (Eq,Show) + +type Theory = QIdent -> Err Val + +lookupConst :: Theory -> QIdent -> Err Val +lookupConst th f = th f + +lookupVar :: Env -> Ident -> Err Val +lookupVar g x = maybe (prtBad "unknown variable" x) return $ lookup x ((IW,uVal):g) +-- wild card IW: no error produced, ?0 instead. + +type TCEnv = (Int,Env,Env) + +emptyTCEnv :: TCEnv +emptyTCEnv = (0,[],[]) + +whnf :: Val -> Err Val +whnf v = ---- errIn ("whnf" +++ prt v) $ ---- debug + case v of + VApp u w -> do + u' <- whnf u + w' <- whnf w + app u' w' + VClos env e -> eval env e + _ -> return v + +app :: Val -> Val -> Err Val +app u v = case u of + VClos env (Abs x e) -> eval ((x,v):env) e + _ -> return $ VApp u v + +eval :: Env -> Exp -> Err Val +eval env e = ---- errIn ("eval" +++ prt e +++ "in" +++ prEnv env) $ + case e of + Vr x -> lookupVar env x + Q m c -> return $ VCn (m,c) + QC m c -> return $ VCn (m,c) ---- == Q ? + Sort c -> return $ VType --- the only sort is Type + App f a -> join $ liftM2 app (eval env f) (eval env a) + _ -> return $ VClos env e + +eqVal :: Int -> Val -> Val -> Err [(Val,Val)] +eqVal k u1 u2 = ---- errIn (prt u1 +++ "<>" +++ prBracket (show k) +++ prt u2) $ + do + w1 <- whnf u1 + w2 <- whnf u2 + let v = VGen k + case (w1,w2) of + (VApp f1 a1, VApp f2 a2) -> liftM2 (++) (eqVal k f1 f2) (eqVal k a1 a2) + (VClos env1 (Abs x1 e1), VClos env2 (Abs x2 e2)) -> + eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2) + (VClos env1 (Prod x1 a1 e1), VClos env2 (Prod x2 a2 e2)) -> + liftM2 (++) + (eqVal k (VClos env1 a1) (VClos env2 a2)) + (eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2)) + (VGen i _, VGen j _) -> return [(w1,w2) | i /= j] + (VCn (_, i), VCn (_,j)) -> return [(w1,w2) | i /= j] + --- thus ignore qualifications; valid because inheritance cannot + --- be qualified. Simplifies annotation. AR 17/3/2005 + _ -> return [(w1,w2) | w1 /= w2] +-- invariant: constraints are in whnf + +checkType :: Theory -> TCEnv -> Exp -> Err (AExp,[(Val,Val)]) +checkType th tenv e = checkExp th tenv e vType + +checkExp :: Theory -> TCEnv -> Exp -> Val -> Err (AExp, [(Val,Val)]) +checkExp th tenv@(k,rho,gamma) e ty = do + typ <- whnf ty + let v = VGen k + case e of + Meta m -> return $ (AMeta m typ,[]) + EData -> return $ (AData typ,[]) + + Abs x t -> case typ of + VClos env (Prod y a b) -> do + a' <- whnf $ VClos env a --- + (t',cs) <- checkExp th + (k+1,(x,v x):rho, (x,a'):gamma) t (VClos ((y,v x):env) b) + return (AAbs x a' t', cs) + _ -> prtBad ("function type expected for" +++ prt e +++ "instead of") typ + +-- {- --- to get deprec when checkEqs works (15/9/2005) + Eqs es -> do + bcs <- mapM (\b -> checkBranch th tenv b typ) es + let (bs,css) = unzip bcs + return (AEqs bs, concat css) +-- - } + Prod x a b -> do + testErr (typ == vType) "expected Type" + (a',csa) <- checkType th tenv a + (b',csb) <- checkType th (k+1, (x,v x):rho, (x,VClos rho a):gamma) b + return (AProd x a' b', csa ++ csb) + + _ -> checkInferExp th tenv e typ + +checkInferExp :: Theory -> TCEnv -> Exp -> Val -> Err (AExp, [(Val,Val)]) +checkInferExp th tenv@(k,_,_) e typ = do + (e',w,cs1) <- inferExp th tenv e + cs2 <- eqVal k w typ + return (e',cs1 ++ cs2) + +inferExp :: Theory -> TCEnv -> Exp -> Err (AExp, Val, [(Val,Val)]) +inferExp th tenv@(k,rho,gamma) e = case e of + Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x + Q m c | m == cPredefAbs && isPredefCat c + -> return (ACn (m,c) vType, vType, []) + | otherwise -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c) + QC m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c) ---- + EInt i -> return (AInt i, valAbsInt, []) + EFloat i -> return (AFloat i, valAbsFloat, []) + K i -> return (AStr i, valAbsString, []) + Sort _ -> return (AType, vType, []) + App f t -> do + (f',w,csf) <- inferExp th tenv f + typ <- whnf w + case typ of + VClos env (Prod x a b) -> do + (a',csa) <- checkExp th tenv t (VClos env a) + b' <- whnf $ VClos ((x,VClos rho t):env) b + return $ (AApp f' a' b', b', csf ++ csa) + _ -> prtBad ("Prod expected for function" +++ prt f +++ "instead of") typ + _ -> prtBad "cannot infer type of expression" e + +checkEqs :: Theory -> TCEnv -> (Fun,Trm) -> Val -> Err [(Val,Val)] +checkEqs th tenv@(k,rho,gamma) (fun@(m,f),def) val = case def of + Eqs es -> liftM concat $ mapM checkBranch es + _ -> liftM snd $ checkExp th tenv def val + where + checkBranch (ps,df) = + let + (ps',_,vars) = foldr p2t ([],0,[]) ps + fps = mkApp (Q m f) ps' + in errIn ("branch" +++ prt fps) $ do + (aexp, typ, cs1) <- inferExp th tenv fps + let + bds = binds vars aexp + tenv' = (k, rho, bds ++ gamma) + (_,cs2) <- errIn (show bds) $ checkExp th tenv' df typ + return $ (cs1 ++ cs2) + p2t p (ps,i,g) = case p of + PW -> (Meta (MetaSymb i) : ps, i+1, g) + PV IW -> (Meta (MetaSymb i) : ps, i+1, g) + PV x -> (Meta (MetaSymb i) : ps, i+1,upd x i g) + PString s -> ( K s : ps, i, g) + PInt n -> (EInt n : ps, i, g) + PFloat n -> (EFloat n : ps, i, g) + PP m c xs -> (mkApp (qq (m,c)) xss : ps, i', g') + where (xss,i',g') = foldr p2t ([],i,g) xs + _ -> error $ "undefined p2t case" +++ prt p +++ "in checkBranch" + upd x i g = (x,i) : g --- to annotate pattern variables: treat as metas + + -- notice: in vars, the sequence 0.. is sorted. In subst aexp, all + -- this occurs and nothing else. + binds vars aexp = [(x,v) | ((x,_),v) <- zip vars metas] where + metas = map snd $ sortBy (\ (x,_) (y,_) -> compare x y) $ subst aexp + subst aexp = case aexp of + AMeta (MetaSymb i) v -> [(i,v)] + AApp c a _ -> subst c ++ subst a + _ -> [] -- never matter in patterns + +checkBranch :: Theory -> TCEnv -> Equation -> Val -> Err (([Exp],AExp),[(Val,Val)]) +checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $ + chB tenv' ps' ty + where + + (ps',_,rho2,k') = ps2ts k ps + tenv' = (k, rho2++rho, gamma) ---- k' ? + (k,rho,gamma) = tenv + + chB tenv@(k,rho,gamma) ps ty = case ps of + p:ps2 -> do + typ <- whnf ty + case typ of + VClos env (Prod y a b) -> do + a' <- whnf $ VClos env a + (p', sigma, binds, cs1) <- checkP tenv p y a' + let tenv' = (length binds, sigma ++ rho, binds ++ gamma) + ((ps',exp),cs2) <- chB tenv' ps2 (VClos ((y,p'):env) b) + return ((p:ps',exp), cs1 ++ cs2) -- don't change the patt + _ -> prtBad ("Product expected for definiens" +++prt t +++ "instead of") typ + [] -> do + (e,cs) <- checkExp th tenv t ty + return (([],e),cs) + checkP env@(k,rho,gamma) t x a = do + (delta,cs) <- checkPatt th env t a + let sigma = [(x, VGen i x) | ((x,_),i) <- zip delta [k..]] + return (VClos sigma t, sigma, delta, cs) + + ps2ts k = foldr p2t ([],0,[],k) + p2t p (ps,i,g,k) = case p of + PW -> (Meta (MetaSymb i) : ps, i+1,g,k) + PV IW -> (Meta (MetaSymb i) : ps, i+1,g,k) + PV x -> (Vr x : ps, i, upd x k g,k+1) + PString s -> (K s : ps, i, g, k) + PInt n -> (EInt n : ps, i, g, k) + PFloat n -> (EFloat n : ps, i, g, k) + PP m c xs -> (mkApp (qq (m,c)) xss : ps, j, g',k') + where (xss,j,g',k') = foldr p2t ([],i,g,k) xs + _ -> error $ "undefined p2t case" +++ prt p +++ "in checkBranch" + + upd x k g = (x, VGen k x) : g --- hack to recognize pattern variables + + +checkPatt :: Theory -> TCEnv -> Exp -> Val -> Err (Binds,[(Val,Val)]) +checkPatt th tenv exp val = do + (aexp,_,cs) <- checkExpP tenv exp val + let binds = extrBinds aexp + return (binds,cs) + where + extrBinds aexp = case aexp of + AVr i v -> [(i,v)] + AApp f a _ -> extrBinds f ++ extrBinds a + _ -> [] -- no other cases are possible + +--- ad hoc, to find types of variables + checkExpP tenv@(k,rho,gamma) exp val = case exp of + Meta m -> return $ (AMeta m val, val, []) + Vr x -> return $ (AVr x val, val, []) + EInt i -> return (AInt i, valAbsInt, []) + EFloat i -> return (AFloat i, valAbsFloat, []) + K s -> return (AStr s, valAbsString, []) + + Q m c -> do + typ <- lookupConst th (m,c) + return $ (ACn (m,c) typ, typ, []) + QC m c -> do + typ <- lookupConst th (m,c) + return $ (ACn (m,c) typ, typ, []) ---- + App f t -> do + (f',w,csf) <- checkExpP tenv f val + typ <- whnf w + case typ of + VClos env (Prod x a b) -> do + (a',_,csa) <- checkExpP tenv t (VClos env a) + b' <- whnf $ VClos ((x,VClos rho t):env) b + return $ (AApp f' a' b', b', csf ++ csa) + _ -> prtBad ("Prod expected for function" +++ prt f +++ "instead of") typ + _ -> prtBad "cannot typecheck pattern" exp + +-- auxiliaries + +noConstr :: Err Val -> Err (Val,[(Val,Val)]) +noConstr er = er >>= (\v -> return (v,[])) + +mkAnnot :: (Val -> AExp) -> Err (Val,[(Val,Val)]) -> Err (AExp,Val,[(Val,Val)]) +mkAnnot a ti = do + (v,cs) <- ti + return (a v, v, cs) + diff --git a/src/GF/Compile/TypeCheck.hs b/src/GF/Compile/TypeCheck.hs new file mode 100644 index 000000000..2d58a33ee --- /dev/null +++ b/src/GF/Compile/TypeCheck.hs @@ -0,0 +1,118 @@ +---------------------------------------------------------------------- +-- | +-- Module : TypeCheck +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/09/15 16:22:02 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.16 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Compile.TypeCheck (-- * top-level type checking functions; TC should not be called directly. + checkContext, + checkTyp, + checkEquation, + checkConstrs, + ) where + +import GF.Data.Operations +import GF.Data.Zipper + +import GF.Grammar.Abstract +import GF.Compile.Refresh +import GF.Grammar.LookAbs +import qualified GF.Grammar.Lookup as Lookup --- +import GF.Grammar.Unify --- + +import GF.Compile.TC + +import Control.Monad (foldM, liftM, liftM2) +import Data.List (nub) --- + +-- | invariant way of creating TCEnv from context +initTCEnv gamma = + (length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma) + +-- interface to TC type checker + +type2val :: Type -> Val +type2val = VClos [] + +aexp2tree :: (AExp,[(Val,Val)]) -> Err Tree +aexp2tree (aexp,cs) = do + (bi,at,vt,ts) <- treeForm aexp + ts' <- mapM aexp2tree [(t,[]) | t <- ts] + return $ Tr (N (bi,at,vt,(cs,[]),False),ts') + where + treeForm a = case a of + AAbs x v b -> do + (bi, at, vt, args) <- treeForm b + v' <- whnf v ---- should not be needed... + return ((x,v') : bi, at, vt, args) + AApp c a v -> do + (_,at,_,args) <- treeForm c + v' <- whnf v ---- + return ([],at,v',args ++ [a]) + AVr x v -> do + v' <- whnf v ---- + return ([],AtV x,v',[]) + ACn c v -> do + v' <- whnf v ---- + return ([],AtC c,v',[]) + AInt i -> do + return ([],AtI i,valAbsInt,[]) + AFloat i -> do + return ([],AtF i,valAbsFloat,[]) + AStr s -> do + return ([],AtL s,valAbsString,[]) + AMeta m v -> do + v' <- whnf v ---- + return ([],AtM m,v',[]) + _ -> Bad "illegal tree" -- AProd + +cont2exp :: Context -> Exp +cont2exp c = mkProd (c, eType, []) -- to check a context + +cont2val :: Context -> Val +cont2val = type2val . cont2exp + +-- some top-level batch-mode checkers for the compiler + +justTypeCheck :: Grammar -> Exp -> Val -> Err Constraints +justTypeCheck gr e v = do + (_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v + return $ filter notJustMeta constrs0 +---- return $ fst $ splitConstraintsSrc gr constrs0 +---- this change was to force proper tc of abstract modules. +---- May not be quite right. AR 13/9/2005 + +notJustMeta (c,k) = case (c,k) of + (VClos g1 (Meta m1), VClos g2 (Meta m2)) -> False + _ -> True + +grammar2theory :: Grammar -> Theory +grammar2theory gr (m,f) = case lookupFunType gr m f of + Ok t -> return $ type2val t + Bad s -> case lookupCatContext gr m f of + Ok cont -> return $ cont2val cont + _ -> Bad s + +checkContext :: Grammar -> Context -> [String] +checkContext st = checkTyp st . cont2exp + +checkTyp :: Grammar -> Type -> [String] +checkTyp gr typ = err singleton prConstrs $ justTypeCheck gr typ vType + +checkEquation :: Grammar -> Fun -> Trm -> [String] +checkEquation gr (m,fun) def = err singleton id $ do + typ <- lookupFunType gr m fun + cs <- justTypeCheck gr def (vClos typ) + let cs1 = filter notJustMeta cs + return $ ifNull [] (singleton . prConstraints) cs1 + +checkConstrs :: Grammar -> Cat -> [Ident] -> [String] +checkConstrs gr cat _ = [] ---- check constructors! diff --git a/src/GF/Compile/Update.hs b/src/GF/Compile/Update.hs new file mode 100644 index 000000000..82d7a609e --- /dev/null +++ b/src/GF/Compile/Update.hs @@ -0,0 +1,135 @@ +---------------------------------------------------------------------- +-- | +-- Module : Update +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/30 18:39:44 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.8 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Compile.Update (updateRes, buildAnyTree, combineAnyInfos, unifyAnyInfo, + -- * these auxiliaries should be somewhere else + -- since they don't use the info types + groupInfos, sortInfos, combineInfos, unifyInfos, + tryInsert, unifAbsDefs, unifConstrs + ) where + +import GF.Infra.Ident +import GF.Grammar.Grammar +import GF.Grammar.PrGrammar +import GF.Infra.Modules + +import GF.Data.Operations + +import Data.List +import Control.Monad + +-- | update a resource module by adding a new or changing an old definition +updateRes :: SourceGrammar -> Ident -> Ident -> Info -> SourceGrammar +updateRes gr@(MGrammar ms) m i info = MGrammar $ map upd ms where + upd (n,mod) + | n /= m = (n,mod) + | n == m = case mod of + ModMod r -> (m,ModMod $ updateModule r i info) + _ -> (n,mod) --- no error msg + +-- | combine a list of definitions into a balanced binary search tree +buildAnyTree :: [(Ident,Info)] -> Err (BinTree Ident Info) +buildAnyTree ias = do + ias' <- combineAnyInfos ias + return $ buildTree ias' + + +-- | unifying information for abstract, resource, and concrete +combineAnyInfos :: [(Ident,Info)] -> Err [(Ident,Info)] +combineAnyInfos = combineInfos unifyAnyInfo + +unifyAnyInfo :: Ident -> Info -> Info -> Err Info +unifyAnyInfo c i j = errIn ("combining information for" +++ prt c) $ case (i,j) of + (AbsCat mc1 mf1, AbsCat mc2 mf2) -> + liftM2 AbsCat (unifPerhaps mc1 mc2) (unifConstrs mf1 mf2) -- adding constrs + (AbsFun mt1 md1, AbsFun mt2 md2) -> + liftM2 AbsFun (unifPerhaps mt1 mt2) (unifAbsDefs md1 md2) -- adding defs + + (ResParam mt1, ResParam mt2) -> liftM ResParam $ unifPerhaps mt1 mt2 + (ResOper mt1 m1, ResOper mt2 m2) -> + liftM2 ResOper (unifPerhaps mt1 mt2) (unifPerhaps m1 m2) + + (CncCat mc1 mf1 mp1, CncCat mc2 mf2 mp2) -> + liftM3 CncCat (unifPerhaps mc1 mc2) (unifPerhaps mf1 mf2) (unifPerhaps mp1 mp2) + (CncFun m mt1 md1, CncFun _ mt2 md2) -> + liftM2 (CncFun m) (unifPerhaps mt1 mt2) (unifPerhaps md1 md2) ---- adding defs +-- for bw compatibility with unspecified printnames in old GF + (CncFun Nothing Nope (Yes pr),_) -> + unifyAnyInfo c (CncCat Nope Nope (Yes pr)) j + (_,CncFun Nothing Nope (Yes pr)) -> + unifyAnyInfo c i (CncCat Nope Nope (Yes pr)) + + _ -> Bad $ "cannot unify informations in" ++++ show i ++++ "and" ++++ show j + +--- these auxiliaries should be somewhere else since they don't use the info types + +groupInfos :: Eq a => [(a,b)] -> [[(a,b)]] +groupInfos = groupBy (\i j -> fst i == fst j) + +sortInfos :: Ord a => [(a,b)] -> [(a,b)] +sortInfos = sortBy (\i j -> compare (fst i) (fst j)) + +combineInfos :: Ord a => (a -> b -> b -> Err b) -> [(a,b)] -> Err [(a,b)] +combineInfos f ris = do + let riss = groupInfos $ sortInfos ris + mapM (unifyInfos f) riss + +unifyInfos :: (a -> b -> b -> Err b) -> [(a,b)] -> Err (a,b) +unifyInfos _ [] = Bad "empty info list" +unifyInfos unif ris = do + let c = fst $ head ris + let infos = map snd ris + let ([i],is) = splitAt 1 infos + info <- foldM (unif c) i is + return (c,info) + + +tryInsert :: Ord a => (b -> b -> Err b) -> (b -> b) -> + BinTree a b -> (a,b) -> Err (BinTree a b) +tryInsert unif indir tree z@(x, info) = case justLookupTree x tree of + Ok info0 -> do + info1 <- unif info info0 + return $ updateTree (x,info1) tree + _ -> return $ updateTree (x,indir info) tree + +{- ---- +case tree of + NT -> return $ BT (x, indir info) NT NT + BT c@(a,info0) left right + | x < a -> do + left' <- tryInsert unif indir left z + return $ BT c left' right + | x > a -> do + right' <- tryInsert unif indir right z + return $ BT c left right' + | x == a -> do + info' <- unif info info0 + return $ BT (x,info') left right +-} + +--- addToMaybeList m c = maybe (return c) (\old -> return (c ++ old)) m + +unifAbsDefs :: Perh Term -> Perh Term -> Err (Perh Term) +unifAbsDefs p1 p2 = case (p1,p2) of + (Nope, _) -> return p2 + (_, Nope) -> return p1 + (Yes (Eqs bs), Yes (Eqs ds)) -> return $ yes $ Eqs $ bs ++ ds --- order! + _ -> Bad "update conflict for definitions" + +unifConstrs :: Perh [Term] -> Perh [Term] -> Err (Perh [Term]) +unifConstrs p1 p2 = case (p1,p2) of + (Nope, _) -> return p2 + (_, Nope) -> return p1 + (Yes bs, Yes ds) -> return $ yes $ bs ++ ds + _ -> Bad "update conflict for constructors" diff --git a/src/GF/Data/Assoc.hs b/src/GF/Data/Assoc.hs new file mode 100644 index 000000000..f775319ea --- /dev/null +++ b/src/GF/Data/Assoc.hs @@ -0,0 +1,143 @@ +---------------------------------------------------------------------- +-- | +-- Module : Assoc +-- Maintainer : Peter Ljunglöf +-- Stability : Stable +-- Portability : Haskell 98 +-- +-- > CVS $Date: 2005/05/09 09:28:44 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.4 $ +-- +-- Association lists, or finite maps, +-- including sets as maps with result type @()@. +-- function names stolen from module @Array@. +-- /O(log n)/ key lookup +----------------------------------------------------------------------------- + +module GF.Data.Assoc ( Assoc, + Set, + emptyAssoc, + emptySet, + listAssoc, + listSet, + accumAssoc, + aAssocs, + aElems, + assocMap, + assocFilter, + lookupAssoc, + lookupWith, + (?), + (?=) + ) where + +import GF.Data.SortedList + +infixl 9 ?, ?= + +-- | a set is a finite map with empty values +type Set a = Assoc a () + +emptyAssoc :: Ord a => Assoc a b +emptySet :: Ord a => Set a + +-- | creating a finite map from a sorted key-value list +listAssoc :: Ord a => SList (a, b) -> Assoc a b + +-- | creating a set from a sorted list +listSet :: Ord a => SList a -> Set a + +-- | building a finite map from a list of keys and 'b's, +-- and a function that combines a sorted list of 'b's into a value +accumAssoc :: (Ord a, Ord c) => (SList c -> b) -> [(a, c)] -> Assoc a b + +-- | all key-value pairs from an association list +aAssocs :: Ord a => Assoc a b -> SList (a, b) + +-- | all keys from an association list +aElems :: Ord a => Assoc a b -> SList a + +-- fmap :: Ord a => (b -> b') -> Assoc a b -> Assoc a b' + +-- | mapping values to other values. +-- the mapping function can take the key as information +assocMap :: Ord a => (a -> b -> b') -> Assoc a b -> Assoc a b' + +assocFilter :: Ord a => (b -> Bool) -> Assoc a b -> Assoc a b +assocFilter pred = listAssoc . filter (pred . snd) . aAssocs + +-- | monadic lookup function, +-- returning failure if the key does not exist +lookupAssoc :: (Ord a, Monad m) => Assoc a b -> a -> m b + +-- | if the key does not exist, +-- the first argument is returned +lookupWith :: Ord a => b -> Assoc a b -> a -> b + +-- | if the values are monadic, we can return the value type +(?) :: (Ord a, Monad m) => Assoc a (m b) -> a -> m b + +-- | checking wheter the map contains a given key +(?=) :: Ord a => Assoc a b -> a -> Bool + + +------------------------------------------------------------ + +data Assoc a b = ANil | ANode (Assoc a b) a b (Assoc a b) + deriving (Eq, Ord, Show) + +emptyAssoc = ANil +emptySet = emptyAssoc + +listAssoc as = assoc + where (assoc, []) = sl2bst (length as) as + sl2bst 0 xs = (ANil, xs) + sl2bst 1 (x:xs) = (ANode ANil (fst x) (snd x) ANil, xs) + sl2bst n xs = (ANode left (fst x) (snd x) right, zs) + where llen = (n-1) `div` 2 + rlen = n - 1 - llen + (left, x:ys) = sl2bst llen xs + (right, zs) = sl2bst rlen ys + +listSet as = listAssoc (zip as (repeat ())) + +accumAssoc join = listAssoc . map (mapSnd join) . groupPairs . nubsort + where mapSnd f (a, b) = (a, f b) + +aAssocs as = prs as [] + where prs ANil = id + prs (ANode left a b right) = prs left . ((a,b) :) . prs right + +aElems = map fst . aAssocs + + +instance Ord a => Functor (Assoc a) where + fmap f = assocMap (const f) + +assocMap f ANil = ANil +assocMap f (ANode left a b right) = ANode (assocMap f left) a (f a b) (assocMap f right) + + +lookupAssoc ANil _ = fail "key not found" +lookupAssoc (ANode left a b right) a' = case compare a a' of + GT -> lookupAssoc left a' + LT -> lookupAssoc right a' + EQ -> return b + +lookupWith z ANil _ = z +lookupWith z (ANode left a b right) a' = case compare a a' of + GT -> lookupWith z left a' + LT -> lookupWith z right a' + EQ -> b + +(?) = lookupWith (fail "key not found") + +(?=) = \assoc -> maybe False (const True) . lookupAssoc assoc + + + + + + + diff --git a/src/GF/Data/BacktrackM.hs b/src/GF/Data/BacktrackM.hs new file mode 100644 index 000000000..790d11a83 --- /dev/null +++ b/src/GF/Data/BacktrackM.hs @@ -0,0 +1,93 @@ +---------------------------------------------------------------------- +-- | +-- Module : BacktrackM +-- Maintainer : PL +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:00 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.4 $ +-- +-- Backtracking state monad, with r\/o environment +----------------------------------------------------------------------------- + +{-# OPTIONS_GHC -fglasgow-exts #-} +module GF.Data.BacktrackM ( -- * the backtracking state monad + BacktrackM, + -- * controlling the monad + failure, + (|||), + -- * handling the state & environment + readState, + writeState, + -- * monad specific utilities + member, + -- * running the monad + foldBM, runBM, + foldSolutions, solutions, + foldFinalStates, finalStates + ) where + +import Data.List +import Control.Monad + +---------------------------------------------------------------------- +-- Combining endomorphisms and continuations +-- a la Ralf Hinze + +-- BacktrackM = state monad transformer over the backtracking monad + +newtype BacktrackM s a = BM (forall b . (a -> s -> b -> b) -> s -> b -> b) + +-- * running the monad + +runBM :: BacktrackM s a -> s -> [(s,a)] +runBM (BM m) s = m (\x s xs -> (s,x) : xs) s [] + +foldBM :: (a -> s -> b -> b) -> b -> BacktrackM s a -> s -> b +foldBM f b (BM m) s = m f s b + +foldSolutions :: (a -> b -> b) -> b -> BacktrackM s a -> s -> b +foldSolutions f b (BM m) s = m (\x s b -> f x b) s b + +solutions :: BacktrackM s a -> s -> [a] +solutions = foldSolutions (:) [] + +foldFinalStates :: (s -> b -> b) -> b -> BacktrackM s () -> s -> b +foldFinalStates f b (BM m) s = m (\x s b -> f s b) s b + +finalStates :: BacktrackM s () -> s -> [s] +finalStates bm = map fst . runBM bm + + +-- * handling the state & environment + +readState :: BacktrackM s s +readState = BM (\c s b -> c s s b) + +writeState :: s -> BacktrackM s () +writeState s = BM (\c _ b -> c () s b) + +instance Monad (BacktrackM s) where + return a = BM (\c s b -> c a s b) + BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b) + where unBM (BM m) = m + fail _ = failure + +-- * controlling the monad + +failure :: BacktrackM s a +failure = BM (\c s b -> b) + +(|||) :: BacktrackM s a -> BacktrackM s a -> BacktrackM s a +(BM f) ||| (BM g) = BM (\c s b -> g c s $! f c s b) + +instance MonadPlus (BacktrackM s) where + mzero = failure + mplus = (|||) + +-- * specific functions on the backtracking monad + +member :: [a] -> BacktrackM s a +member xs = BM (\c s b -> foldl' (\b x -> c x s b) b xs) diff --git a/src/GF/Data/ErrM.hs b/src/GF/Data/ErrM.hs new file mode 100644 index 000000000..e8cea12d4 --- /dev/null +++ b/src/GF/Data/ErrM.hs @@ -0,0 +1,38 @@ +---------------------------------------------------------------------- +-- | +-- Module : ErrM +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:00 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.5 $ +-- +-- hack for BNFC generated files. AR 21/9/2003 +----------------------------------------------------------------------------- + +module GF.Data.ErrM (Err(..)) where + +import Control.Monad (MonadPlus(..)) + +-- | like @Maybe@ type with error msgs +data Err a = Ok a | Bad String + deriving (Read, Show, Eq) + +instance Monad Err where + return = Ok + fail = Bad + Ok a >>= f = f a + Bad s >>= f = Bad s + +-- | added 2\/10\/2003 by PEB +instance Functor Err where + fmap f (Ok a) = Ok (f a) + fmap f (Bad s) = Bad s + +-- | added by KJ +instance MonadPlus Err where + mzero = Bad "error (no reason given)" + mplus (Ok a) _ = Ok a + mplus (Bad s) b = b diff --git a/src/GF/Data/MultiMap.hs b/src/GF/Data/MultiMap.hs new file mode 100644 index 000000000..e565f433b --- /dev/null +++ b/src/GF/Data/MultiMap.hs @@ -0,0 +1,47 @@ +module GF.Data.MultiMap where + +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Prelude hiding (map) +import qualified Prelude + +type MultiMap k a = Map k (Set a) + +empty :: MultiMap k a +empty = Map.empty + +keys :: MultiMap k a -> [k] +keys = Map.keys + +elems :: MultiMap k a -> [a] +elems = concatMap Set.toList . Map.elems + +(!) :: Ord k => MultiMap k a -> k -> [a] +m ! k = Set.toList $ Map.findWithDefault Set.empty k m + +member :: (Ord k, Ord a) => k -> a -> MultiMap k a -> Bool +member k x m = x `Set.member` Map.findWithDefault Set.empty k m + +insert :: (Ord k, Ord a) => k -> a -> MultiMap k a -> MultiMap k a +insert k x m = Map.insertWith Set.union k (Set.singleton x) m + +insert' :: (Ord k, Ord a) => k -> a -> MultiMap k a -> Maybe (MultiMap k a) +insert' k x m | member k x m = Nothing -- FIXME: inefficient + | otherwise = Just (insert k x m) + +union :: (Ord k, Ord a) => MultiMap k a -> MultiMap k a -> MultiMap k a +union = Map.unionWith Set.union + +size :: MultiMap k a -> Int +size = sum . Prelude.map Set.size . Map.elems + +map :: (Ord a, Ord b) => (a -> b) -> MultiMap k a -> MultiMap k b +map f = Map.map (Set.map f) + +fromList :: (Ord k, Ord a) => [(k,a)] -> MultiMap k a +fromList xs = Map.fromListWith Set.union [(k, Set.singleton x) | (k,x) <- xs] + +toList :: MultiMap k a -> [(k,a)] +toList m = [(k,x) | (k,s) <- Map.toList m, x <- Set.toList s]
\ No newline at end of file diff --git a/src/GF/Data/Operations.hs b/src/GF/Data/Operations.hs new file mode 100644 index 000000000..253723876 --- /dev/null +++ b/src/GF/Data/Operations.hs @@ -0,0 +1,676 @@ +---------------------------------------------------------------------- +-- | +-- Module : Operations +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/11 16:12:41 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.22 $ +-- +-- some auxiliary GF operations. AR 19\/6\/1998 -- 6\/2\/2001 +-- +-- Copyright (c) Aarne Ranta 1998-2000, under GNU General Public License (see GPL) +----------------------------------------------------------------------------- + +module GF.Data.Operations (-- * misc functions + ifNull, onSnd, + + -- * the Error monad + Err(..), err, maybeErr, testErr, errVal, errIn, derrIn, + performOps, repeatUntilErr, repeatUntil, okError, isNotError, + showBad, lookupErr, lookupErrMsg, lookupDefault, updateLookupList, + mapPairListM, mapPairsM, pairM, mapErr, mapErrN, foldErr, + (!?), errList, singleton, mapsErr, mapsErrTree, + + -- ** checking + checkUnique, titleIfNeeded, errMsg, errAndMsg, + + -- * a three-valued maybe type to express indirections + Perhaps(..), yes, may, nope, + mapP, + unifPerhaps, updatePerhaps, updatePerhapsHard, + + -- * binary search trees; now with FiniteMap + BinTree, emptyBinTree, isInBinTree, justLookupTree, + lookupTree, lookupTreeMany, lookupTreeManyAll, updateTree, + buildTree, filterBinTree, + sorted2tree, mapTree, mapMTree, tree2list, + + + -- * parsing + WParser, wParseResults, paragraphs, + + -- * printing + indent, (+++), (++-), (++++), (+++++), + prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly, + prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes, + numberedParagraphs, prConjList, prIfEmpty, wrapLines, + + -- ** LaTeX code producing functions + dollar, mbox, ital, boldf, verbat, mkLatexFile, + begindocument, enddocument, + + -- * extra + sortByLongest, combinations, mkTextFile, initFilePath, + + -- * topological sorting with test of cyclicity + topoTest, topoSort, cyclesIn, + + -- * the generic fix point iterator + iterFix, + + -- * association lists + updateAssoc, removeAssoc, + + -- * chop into separator-separated parts + chunks, readIntArg, subSequences, + + -- * state monad with error; from Agda 6\/11\/2001 + STM(..), appSTM, stm, stmr, readSTM, updateSTM, writeSTM, done, + + -- * error monad class + ErrorMonad(..), checkAgain, checks, allChecks, doUntil + + ) where + +import Data.Char (isSpace, toUpper, isSpace, isDigit) +import Data.List (nub, sortBy, sort, deleteBy, nubBy) +--import Data.FiniteMap +import Control.Monad (liftM,liftM2, MonadPlus, mzero, mplus) + +import GF.Data.ErrM + +infixr 5 +++ +infixr 5 ++- +infixr 5 ++++ +infixr 5 +++++ +infixl 9 !? + +ifNull :: b -> ([a] -> b) -> [a] -> b +ifNull b f xs = if null xs then b else f xs + +onSnd :: (a -> b) -> (c,a) -> (c,b) +onSnd f (x, y) = (x, f y) + +-- the Error monad + +-- | analogue of @maybe@ +err :: (String -> b) -> (a -> b) -> Err a -> b +err d f e = case e of + Ok a -> f a + Bad s -> d s + +-- | add msg s to @Maybe@ failures +maybeErr :: String -> Maybe a -> Err a +maybeErr s = maybe (Bad s) Ok + +testErr :: Bool -> String -> Err () +testErr cond msg = if cond then return () else Bad msg + +errVal :: a -> Err a -> a +errVal a = err (const a) id + +errIn :: String -> Err a -> Err a +errIn msg = err (\s -> Bad (s ++++ "OCCURRED IN" ++++ msg)) return + +-- | used for extra error reports when developing GF +derrIn :: String -> Err a -> Err a +derrIn m = errIn m -- id + +performOps :: [a -> Err a] -> a -> Err a +performOps ops a = case ops of + f:fs -> f a >>= performOps fs + [] -> return a + +repeatUntilErr :: (a -> Bool) -> (a -> Err a) -> a -> Err a +repeatUntilErr cond f a = if cond a then return a else f a >>= repeatUntilErr cond f + +repeatUntil :: (a -> Bool) -> (a -> a) -> a -> a +repeatUntil cond f a = if cond a then a else repeatUntil cond f (f a) + +okError :: Err a -> a +-- okError = err (error "no result Ok") id +okError = err (error . ("Bad result occurred" ++++)) id + +isNotError :: Err a -> Bool +isNotError = err (const False) (const True) + +showBad :: Show a => String -> a -> Err b +showBad s a = Bad (s +++ show a) + +lookupErr :: (Eq a,Show a) => a -> [(a,b)] -> Err b +lookupErr a abs = maybeErr ("Unknown" +++ show a) (lookup a abs) + +lookupErrMsg :: (Eq a,Show a) => String -> a -> [(a,b)] -> Err b +lookupErrMsg m a abs = maybeErr (m +++ "gave unknown" +++ show a) (lookup a abs) + +lookupDefault :: Eq a => b -> a -> [(a,b)] -> b +lookupDefault d x l = maybe d id $ lookup x l + +updateLookupList :: Eq a => (a,b) -> [(a,b)] -> [(a,b)] +updateLookupList ab abs = insert ab [] abs where + insert c cc [] = cc ++ [c] + insert (a,b) cc ((a',b'):cc') = if a == a' + then cc ++ [(a,b)] ++ cc' + else insert (a,b) (cc ++ [(a',b')]) cc' + +mapPairListM :: Monad m => ((a,b) -> m c) -> [(a,b)] -> m [(a,c)] +mapPairListM f xys = mapM (\ p@(x,_) -> liftM ((,) x) (f p)) xys + +mapPairsM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)] +mapPairsM f xys = mapM (\ (x,y) -> liftM ((,) x) (f y)) xys + +pairM :: Monad a => (b -> a c) -> (b,b) -> a (c,c) +pairM op (t1,t2) = liftM2 (,) (op t1) (op t2) + +-- | like @mapM@, but continue instead of halting with 'Err' +mapErr :: (a -> Err b) -> [a] -> Err ([b], String) +mapErr f xs = Ok (ys, unlines ss) + where + (ys,ss) = ([y | Ok y <- fxs], [s | Bad s <- fxs]) + fxs = map f xs + +-- | alternative variant, peb 9\/6-04 +mapErrN :: Int -> (a -> Err b) -> [a] -> Err ([b], String) +mapErrN maxN f xs = Ok (ys, unlines (errHdr : ss2)) + where + (ys, ss) = ([y | Ok y <- fxs], [s | Bad s <- fxs]) + errHdr = show nss ++ " errors occured" ++ + if nss > maxN then ", showing the first " ++ show maxN else "" + ss2 = map ("* "++) $ take maxN ss + nss = length ss + fxs = map f xs + + +-- | like @foldM@, but also return the latest value if fails +foldErr :: (a -> b -> Err a) -> a -> [b] -> Err (a, Maybe String) +foldErr f s xs = case xs of + [] -> return (s,Nothing) + x:xx -> case f s x of + Ok v -> foldErr f v xx + Bad m -> return $ (s, Just m) + +-- @!!@ with the error monad +(!?) :: [a] -> Int -> Err a +xs !? i = foldr (const . return) (Bad "too few elements in list") $ drop i xs + +errList :: Err [a] -> [a] +errList = errVal [] + +singleton :: a -> [a] +singleton = (:[]) + +-- checking + +checkUnique :: (Show a, Eq a) => [a] -> [String] +checkUnique ss = ["overloaded" +++ show s | s <- nub overloads] where + overloads = filter overloaded ss + overloaded s = length (filter (==s) ss) > 1 + +titleIfNeeded :: a -> [a] -> [a] +titleIfNeeded a [] = [] +titleIfNeeded a as = a:as + +errMsg :: Err a -> [String] +errMsg (Bad m) = [m] +errMsg _ = [] + +errAndMsg :: Err a -> Err (a,[String]) +errAndMsg (Bad m) = Bad m +errAndMsg (Ok a) = return (a,[]) + +-- | a three-valued maybe type to express indirections +data Perhaps a b = Yes a | May b | Nope deriving (Show,Read,Eq,Ord) + +yes :: a -> Perhaps a b +yes = Yes + +may :: b -> Perhaps a b +may = May + +nope :: Perhaps a b +nope = Nope + +mapP :: (a -> c) -> Perhaps a b -> Perhaps c b +mapP f p = case p of + Yes a -> Yes (f a) + May b -> May b + Nope -> Nope + +-- | this is what happens when matching two values in the same module +unifPerhaps :: (Eq a, Eq b, Show a, Show b) => + Perhaps a b -> Perhaps a b -> Err (Perhaps a b) +unifPerhaps p1 p2 = case (p1,p2) of + (Nope, _) -> return p2 + (_, Nope) -> return p1 + _ -> if p1==p2 then return p1 + else Bad ("update conflict between" ++++ show p1 ++++ show p2) + +-- | this is what happens when updating a module extension +updatePerhaps :: (Eq a,Eq b, Show a, Show b) => + b -> Perhaps a b -> Perhaps a b -> Err (Perhaps a b) +updatePerhaps old p1 p2 = case (p1,p2) of + (Yes a, Nope) -> return $ may old + (May older,Nope) -> return $ may older + (_, May a) -> Bad "strange indirection" + _ -> unifPerhaps p1 p2 + +-- | here the value is copied instead of referred to; used for oper types +updatePerhapsHard :: (Eq a, Eq b, Show a, Show b) => b -> + Perhaps a b -> Perhaps a b -> Err (Perhaps a b) +updatePerhapsHard old p1 p2 = case (p1,p2) of + (Yes a, Nope) -> return $ yes a + (May older,Nope) -> return $ may older + (_, May a) -> Bad "strange indirection" + _ -> unifPerhaps p1 p2 + +-- binary search trees +--- FiniteMap implementation is slower in crucial tests + +data BinTree a b = NT | BT (a,b) !(BinTree a b) !(BinTree a b) deriving (Show) +-- type BinTree a b = FiniteMap a b + +emptyBinTree :: BinTree a b +emptyBinTree = NT +-- emptyBinTree = emptyFM + +isInBinTree :: (Ord a) => a -> BinTree a b -> Bool +isInBinTree x = err (const False) (const True) . justLookupTree x +-- isInBinTree = elemFM + +justLookupTree :: (Monad m,Ord a) => a -> BinTree a b -> m b +justLookupTree = lookupTree (const []) + +lookupTree :: (Monad m,Ord a) => (a -> String) -> a -> BinTree a b -> m b +lookupTree pr x tree = case tree of + NT -> fail ("no occurrence of element" +++ pr x) + BT (a,b) left right + | x < a -> lookupTree pr x left + | x > a -> lookupTree pr x right + | x == a -> return b +--lookupTree pr x tree = case lookupFM tree x of +-- Just y -> return y +-- _ -> fail ("no occurrence of element" +++ pr x) + +lookupTreeMany :: Ord a => (a -> String) -> [BinTree a b] -> a -> Err b +lookupTreeMany pr (t:ts) x = case lookupTree pr x t of + Ok v -> return v + _ -> lookupTreeMany pr ts x +lookupTreeMany pr [] x = Bad $ "failed to find" +++ pr x + +lookupTreeManyAll :: Ord a => (a -> String) -> [BinTree a b] -> a -> [b] +lookupTreeManyAll pr (t:ts) x = case lookupTree pr x t of + Ok v -> v : lookupTreeManyAll pr ts x + _ -> lookupTreeManyAll pr ts x +lookupTreeManyAll pr [] x = [] + +-- | destructive update +updateTree :: (Ord a) => (a,b) -> BinTree a b -> BinTree a b +-- updateTree (a,b) tr = addToFM tr a b +updateTree = updateTreeGen True + +-- | destructive or not +updateTreeGen :: (Ord a) => Bool -> (a,b) -> BinTree a b -> BinTree a b +updateTreeGen destr z@(x,y) tree = case tree of + NT -> BT z NT NT + BT c@(a,b) left right + | x < a -> let left' = updateTree z left in BT c left' right + | x > a -> let right' = updateTree z right in BT c left right' + | otherwise -> if destr + then BT z left right -- removing the old value of a + else tree -- retaining the old value if one exists + +buildTree :: (Ord a) => [(a,b)] -> BinTree a b +buildTree = sorted2tree . sortBy fs where + fs (x,_) (y,_) + | x < y = LT + | x > y = GT + | True = EQ +-- buildTree = listToFM + +sorted2tree :: Ord a => [(a,b)] -> BinTree a b +sorted2tree [] = NT +sorted2tree xs = BT x (sorted2tree t1) (sorted2tree t2) where + (t1,(x:t2)) = splitAt (length xs `div` 2) xs +--sorted2tree = listToFM + +--- dm less general than orig +mapTree :: ((a,b) -> (a,c)) -> BinTree a b -> BinTree a c +mapTree f NT = NT +mapTree f (BT a left right) = BT (f a) (mapTree f left) (mapTree f right) +--mapTree f = mapFM (\k v -> snd (f (k,v))) + +--- fm less efficient than orig? +mapMTree :: (Ord a,Monad m) => ((a,b) -> m (a,c)) -> BinTree a b -> m (BinTree a c) +mapMTree f NT = return NT +mapMTree f (BT a left right) = do + a' <- f a + left' <- mapMTree f left + right' <- mapMTree f right + return $ BT a' left' right' +--mapMTree f t = liftM listToFM $ mapM f $ fmToList t + +filterBinTree :: Ord a => (a -> b -> Bool) -> BinTree a b -> BinTree a b +-- filterFM f t +filterBinTree f = sorted2tree . filter (uncurry f) . tree2list + +tree2list :: BinTree a b -> [(a,b)] -- inorder +tree2list NT = [] +tree2list (BT z left right) = tree2list left ++ [z] ++ tree2list right +--tree2list = fmToList + +-- parsing + +type WParser a b = [a] -> [(b,[a])] -- old Wadler style parser + +wParseResults :: WParser a b -> [a] -> [b] +wParseResults p aa = [b | (b,[]) <- p aa] + +paragraphs :: String -> [String] +paragraphs = map unlines . chop . lines where + chop [] = [] + chop ss = let (ps,rest) = break empty ss in ps : chop (dropWhile empty rest) + empty = all isSpace + +-- printing + +indent :: Int -> String -> String +indent i s = replicate i ' ' ++ s + +(+++), (++-), (++++), (+++++) :: String -> String -> String +a +++ b = a ++ " " ++ b +a ++- "" = a +a ++- b = a +++ b +a ++++ b = a ++ "\n" ++ b +a +++++ b = a ++ "\n\n" ++ b + +prUpper :: String -> String +prUpper s = s1 ++ s2' where + (s1,s2) = span isSpace s + s2' = case s2 of + c:t -> toUpper c : t + _ -> s2 + +prReplicate :: Int -> String -> String +prReplicate n s = concat (replicate n s) + +prTList :: String -> [String] -> String +prTList t ss = case ss of + [] -> "" + [s] -> s + s:ss -> s ++ t ++ prTList t ss + +prQuotedString :: String -> String +prQuotedString x = "\"" ++ restoreEscapes x ++ "\"" + +prParenth :: String -> String +prParenth s = if s == "" then "" else "(" ++ s ++ ")" + +prCurly, prBracket :: String -> String +prCurly s = "{" ++ s ++ "}" +prBracket s = "[" ++ s ++ "]" + +prArgList, prSemicList, prCurlyList :: [String] -> String +prArgList = prParenth . prTList "," +prSemicList = prTList " ; " +prCurlyList = prCurly . prSemicList + +restoreEscapes :: String -> String +restoreEscapes s = + case s of + [] -> [] + '"' : t -> '\\' : '"' : restoreEscapes t + '\\': t -> '\\' : '\\' : restoreEscapes t + c : t -> c : restoreEscapes t + +numberedParagraphs :: [[String]] -> [String] +numberedParagraphs t = case t of + [] -> [] + p:[] -> p + _ -> concat [(show n ++ ".") : s | (n,s) <- zip [1..] t] + +prConjList :: String -> [String] -> String +prConjList c [] = "" +prConjList c [s] = s +prConjList c [s,t] = s +++ c +++ t +prConjList c (s:tt) = s ++ "," +++ prConjList c tt + +prIfEmpty :: String -> String -> String -> String -> String +prIfEmpty em _ _ [] = em +prIfEmpty em nem1 nem2 s = nem1 ++ s ++ nem2 + +-- | Thomas Hallgren's wrap lines +wrapLines :: Int -> String -> String +wrapLines n "" = "" +wrapLines n s@(c:cs) = + if isSpace c + then c:wrapLines (n+1) cs + else case lex s of + [(w,rest)] -> if n'>=76 + then '\n':w++wrapLines l rest + else w++wrapLines n' rest + where n' = n+l + l = length w + _ -> s -- give up!! + +--- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id + +-- LaTeX code producing functions +dollar, mbox, ital, boldf, verbat :: String -> String +dollar s = '$' : s ++ "$" +mbox s = "\\mbox{" ++ s ++ "}" +ital s = "{\\em" +++ s ++ "}" +boldf s = "{\\bf" +++ s ++ "}" +verbat s = "\\verbat!" ++ s ++ "!" + +mkLatexFile :: String -> String +mkLatexFile s = begindocument +++++ s +++++ enddocument + +begindocument, enddocument :: String +begindocument = + "\\documentclass[a4paper,11pt]{article}" ++++ -- M.F. 25/01-02 + "\\setlength{\\parskip}{2mm}" ++++ + "\\setlength{\\parindent}{0mm}" ++++ + "\\setlength{\\oddsidemargin}{0mm}" ++++ + ("\\setlength{\\evensidemargin}{"++"-2mm}") ++++ -- peb 27/5-04: to prevent hugs-mode + ("\\setlength{\\topmargin}{"++"-8mm}") ++++ -- from treating the rest as comments + "\\setlength{\\textheight}{240mm}" ++++ + "\\setlength{\\textwidth}{158mm}" ++++ + "\\begin{document}\n" +enddocument = + "\n\\end{document}\n" + + +sortByLongest :: [[a]] -> [[a]] +sortByLongest = sortBy longer where + longer x y + | x' > y' = LT + | x' < y' = GT + | True = EQ + where + x' = length x + y' = length y + +-- | 'combinations' is the same as @sequence@!!! +-- peb 30\/5-04 +combinations :: [[a]] -> [[a]] +combinations t = case t of + [] -> [[]] + aa:uu -> [a:u | a <- aa, u <- combinations uu] + + +mkTextFile :: String -> IO () +mkTextFile name = do + s <- readFile name + let s' = prelude name ++ "\n\n" ++ heading name ++ "\n" ++ object s + writeFile (name ++ ".hs") s' + where + prelude name = "module " ++ name ++ " where" + heading name = "txt" ++ name ++ " =" + object s = mk s ++ " \"\"" + mk s = unlines [" \"" ++ escs line ++ "\" ++ \"\\n\" ++" | line <- lines s] + escs s = case s of + c:cs | elem c "\"\\" -> '\\' : c : escs cs + c:cs -> c : escs cs + _ -> s + +initFilePath :: FilePath -> FilePath +initFilePath f = reverse (dropWhile (/='/') (reverse f)) + +-- | topological sorting with test of cyclicity +topoTest :: Eq a => [(a,[a])] -> Either [a] [[a]] +topoTest g = if length g' == length g then Left g' else Right (cyclesIn g ++[[]]) + where + g' = topoSort g + +cyclesIn :: Eq a => [(a,[a])] -> [[a]] +cyclesIn deps = nubb $ clean $ filt $ iterFix findDep immediate where + immediate = [[y,x] | (x,xs) <- deps, y <- xs] + findDep chains = [y:x:chain | + x:chain <- chains, (x',xs) <- deps, x' == x, y <- xs, + notElem y (init chain)] + + clean = map remdup + nubb = nubBy (\x y -> y == reverse x) + filt = filter (\xs -> last xs == head xs) + remdup (x:xs) = x : remdup xs' where xs' = dropWhile (==x) xs + remdup [] = [] + + +-- | topological sorting +topoSort :: Eq a => [(a,[a])] -> [a] +topoSort g = reverse $ tsort 0 [ffs | ffs@(f,_) <- g, inDeg f == 0] [] where + tsort _ [] r = r + tsort k (ffs@(f,fs) : cs) r + | elem f r = tsort k cs r + | k > lx = r + | otherwise = tsort (k+1) cs (f : tsort (k+1) (info fs) r) + info hs = [(f,fs) | (f,fs) <- g, elem f hs] + inDeg f = length [t | (h,hs) <- g, t <- hs, t == f] + lx = length g + +-- | the generic fix point iterator +iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a] +iterFix more start = iter start start + where + iter old new = if (null new') + then old + else iter (new' ++ old) new' + where + new' = filter (`notElem` old) (more new) + +-- association lists + +updateAssoc :: Eq a => (a,b) -> [(a,b)] -> [(a,b)] +updateAssoc ab@(a,b) as = case as of + (x,y): xs | x == a -> (a,b):xs + xy : xs -> xy : updateAssoc ab xs + [] -> [ab] + +removeAssoc :: Eq a => a -> [(a,b)] -> [(a,b)] +removeAssoc a = filter ((/=a) . fst) + +-- | chop into separator-separated parts +chunks :: Eq a => a -> [a] -> [[a]] +chunks sep ws = case span (/= sep) ws of + (a,_:b) -> a : bs where bs = chunks sep b + (a, []) -> if null a then [] else [a] + +readIntArg :: String -> Int +readIntArg n = if (not (null n) && all isDigit n) then read n else 0 + + +-- state monad with error; from Agda 6/11/2001 + +newtype STM s a = STM (s -> Err (a,s)) + +appSTM :: STM s a -> s -> Err (a,s) +appSTM (STM f) s = f s + +stm :: (s -> Err (a,s)) -> STM s a +stm = STM + +stmr :: (s -> (a,s)) -> STM s a +stmr f = stm (\s -> return (f s)) + +instance Monad (STM s) where + return a = STM (\s -> return (a,s)) + STM c >>= f = STM (\s -> do + (x,s') <- c s + let STM f' = f x + f' s') + +readSTM :: STM s s +readSTM = stmr (\s -> (s,s)) + +updateSTM :: (s -> s) -> STM s () +updateSTM f = stmr (\s -> ((),f s)) + +writeSTM :: s -> STM s () +writeSTM s = stmr (const ((),s)) + +done :: Monad m => m () +done = return () + +class Monad m => ErrorMonad m where + raise :: String -> m a + handle :: m a -> (String -> m a) -> m a + handle_ :: m a -> m a -> m a + handle_ a b = a `handle` (\_ -> b) + +instance ErrorMonad Err where + raise = Bad + handle a@(Ok _) _ = a + handle (Bad i) f = f i + +instance ErrorMonad (STM s) where + raise msg = STM (\s -> raise msg) + handle (STM f) g = STM (\s -> (f s) + `handle` (\e -> let STM g' = (g e) in + g' s)) + +-- error recovery with multiple reporting AR 30/5/2008 +mapsErr :: (a -> Err b) -> [a] -> Err [b] + +mapsErr f = seqs . map f where + seqs es = case es of + Ok v : ms -> case seqs ms of + Ok vs -> return (v : vs) + b -> b + Bad s : ms -> case seqs ms of + Ok vs -> Bad s + Bad ss -> Bad (s +++++ ss) + [] -> return [] + +mapsErrTree :: (Ord a) => ((a,b) -> Err (a,c)) -> BinTree a b -> Err (BinTree a c) +mapsErrTree f t = mapsErr f (tree2list t) >>= return . sorted2tree + + +-- | if the first check fails try another one +checkAgain :: ErrorMonad m => m a -> m a -> m a +checkAgain c1 c2 = handle_ c1 c2 + +checks :: ErrorMonad m => [m a] -> m a +checks [] = raise "no chance to pass" +checks cs = foldr1 checkAgain cs + +allChecks :: ErrorMonad m => [m a] -> m [a] +allChecks ms = case ms of + (m: ms) -> let rs = allChecks ms in handle_ (liftM2 (:) m rs) rs + _ -> return [] + +doUntil :: ErrorMonad m => (a -> Bool) -> [m a] -> m a +doUntil cond ms = case ms of + a:as -> do + v <- a + if cond v then return v else doUntil cond as + _ -> raise "no result" + +-- subsequences sorted from longest to shortest ; their number is 2^n +subSequences :: [a] -> [[a]] +subSequences = sortBy (\x y -> compare (length y) (length x)) . subs where + subs xs = case xs of + [] -> [[]] + x:xs -> let xss = subs xs in [x:y | y <- xss] ++ xss diff --git a/src/GF/Data/SortedList.hs b/src/GF/Data/SortedList.hs new file mode 100644 index 000000000..d77ff68d4 --- /dev/null +++ b/src/GF/Data/SortedList.hs @@ -0,0 +1,127 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : Peter Ljunglöf +-- Stability : stable +-- Portability : portable +-- +-- > CVS $Date: 2005/04/21 16:22:08 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.3 $ +-- +-- Sets as sorted lists +-- +-- * /O(n)/ union, difference and intersection +-- +-- * /O(n log n)/ creating a set from a list (=sorting) +-- +-- * /O(n^2)/ fixed point iteration +----------------------------------------------------------------------------- + +module GF.Data.SortedList + ( -- * type declarations + SList, SMap, + -- * set operations + nubsort, union, + (<++>), (<\\>), (<**>), + limit, + hasCommonElements, subset, + -- * map operations + groupPairs, groupUnion, + unionMap, mergeMap + ) where + +import Data.List (groupBy) +import GF.Data.Utilities (split, foldMerge) + +-- | The list must be sorted and contain no duplicates. +type SList a = [a] + +-- | A sorted map also has unique keys, +-- i.e. 'map fst m :: SList a', if 'm :: SMap a b' +type SMap a b = SList (a, b) + +-- | Group a set of key-value pairs into a sorted map +groupPairs :: Ord a => SList (a, b) -> SMap a (SList b) +groupPairs = map mapFst . groupBy eqFst + where mapFst as = (fst (head as), map snd as) + eqFst a b = fst a == fst b + +-- | Group a set of key-(sets-of-values) pairs into a sorted map +groupUnion :: (Ord a, Ord b) => SList (a, SList b) -> SMap a (SList b) +groupUnion = map unionSnd . groupPairs + where unionSnd (a, bs) = (a, union bs) + +-- | True is the two sets has common elements +hasCommonElements :: Ord a => SList a -> SList a -> Bool +hasCommonElements as bs = not (null (as <**> bs)) + +-- | True if the first argument is a subset of the second argument +subset :: Ord a => SList a -> SList a -> Bool +xs `subset` ys = null (xs <\\> ys) + +-- | Create a set from any list. +-- This function can also be used as an alternative to @nub@ in @List.hs@ +nubsort :: Ord a => [a] -> SList a +nubsort = union . map return + +-- | the union of a list of sorted maps +unionMap :: Ord a => (b -> b -> b) + -> [SMap a b] -> SMap a b +unionMap plus = foldMerge (mergeMap plus) [] + +-- | merging two sorted maps +mergeMap :: Ord a => (b -> b -> b) + -> SMap a b -> SMap a b -> SMap a b +mergeMap plus [] abs = abs +mergeMap plus abs [] = abs +mergeMap plus abs@(ab@(a,bs):abs') cds@(cd@(c,ds):cds') + = case compare a c of + EQ -> (a, plus bs ds) : mergeMap plus abs' cds' + LT -> ab : mergeMap plus abs' cds + GT -> cd : mergeMap plus abs cds' + +-- | The union of a list of sets +union :: Ord a => [SList a] -> SList a +union = foldMerge (<++>) [] + +-- | The union of two sets +(<++>) :: Ord a => SList a -> SList a -> SList a +[] <++> bs = bs +as <++> [] = as +as@(a:as') <++> bs@(b:bs') = case compare a b of + LT -> a : (as' <++> bs) + GT -> b : (as <++> bs') + EQ -> a : (as' <++> bs') + +-- | The difference of two sets +(<\\>) :: Ord a => SList a -> SList a -> SList a +[] <\\> bs = [] +as <\\> [] = as +as@(a:as') <\\> bs@(b:bs') = case compare a b of + LT -> a : (as' <\\> bs) + GT -> (as <\\> bs') + EQ -> (as' <\\> bs') + +-- | The intersection of two sets +(<**>) :: Ord a => SList a -> SList a -> SList a +[] <**> bs = [] +as <**> [] = [] +as@(a:as') <**> bs@(b:bs') = case compare a b of + LT -> (as' <**> bs) + GT -> (as <**> bs') + EQ -> a : (as' <**> bs') + +-- | A fixed point iteration +limit :: Ord a => (a -> SList a) -- ^ The iterator function + -> SList a -- ^ The initial set + -> SList a -- ^ The result of the iteration +limit more start = limit' start start + where limit' chart agenda | null new' = chart + | otherwise = limit' (chart <++> new') new' + where new = union (map more agenda) + new'= new <\\> chart + + + + + diff --git a/src/GF/Data/Str.hs b/src/GF/Data/Str.hs new file mode 100644 index 000000000..6f65764c7 --- /dev/null +++ b/src/GF/Data/Str.hs @@ -0,0 +1,134 @@ +---------------------------------------------------------------------- +-- | +-- Module : Str +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:09 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.8 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Data.Str ( + Str (..), Tok (..), --- constructors needed in PrGrammar + str2strings, str2allStrings, str, sstr, sstrV, + isZeroTok, prStr, plusStr, glueStr, + strTok, + allItems +) where + +import GF.Data.Operations +import Data.List (isPrefixOf, isSuffixOf, intersperse) + +-- | abstract token list type. AR 2001, revised and simplified 20\/4\/2003 +newtype Str = Str [Tok] deriving (Read, Show, Eq, Ord) + +-- | notice that having both pre and post would leave to inconsistent situations: +-- +-- > pre {"x" ; "y" / "a"} ++ post {"b" ; "a" / "x"} +-- +-- always violates a condition expressed by the one or the other +data Tok = + TK String + | TN Ss [(Ss, [String])] -- ^ variants depending on next string +--- | TP Ss [(Ss, [String])] -- variants depending on previous string + deriving (Eq, Ord, Show, Read) + + +-- | a variant can itself be a token list, but for simplicity only a list of strings +-- i.e. not itself containing variants +type Ss = [String] + +-- matching functions in both ways + +matchPrefix :: Ss -> [(Ss,[String])] -> [String] -> Ss +matchPrefix s vs t = + head $ [u | + (u,as) <- vs, + any (\c -> isPrefixOf c (concat (unmarkup t))) as + ] ++ [s] + +matchSuffix :: String -> Ss -> [(Ss,[String])] -> Ss +matchSuffix t s vs = + head ([u | (u,as) <- vs, any (\c -> isSuffixOf c t) as] ++ [s]) + +unmarkup :: [String] -> [String] +unmarkup = filter (not . isXMLtag) where + isXMLtag s = case s of + '<':cs@(_:_) -> last cs == '>' + _ -> False + +str2strings :: Str -> Ss +str2strings (Str st) = alls st where + alls st = case st of + TK s : ts -> s : alls ts + TN ds vs : ts -> matchPrefix ds vs t ++ t where t = alls ts +---- u :TP ds vs: ts -> [u] ++ matchSuffix u ds vs ++ alls ts + [] -> [] + +str2allStrings :: Str -> [Ss] +str2allStrings (Str st) = alls st where + alls st = case st of + TK s : ts -> [s : t | t <- alls ts] + TN ds vs : [] -> [ds ++ v | v <- map fst vs] + TN ds vs : ts -> [matchPrefix ds vs t ++ t | t <- alls ts] + [] -> [[]] + +sstr :: Str -> String +sstr = unwords . str2strings + +-- | to handle a list of variants +sstrV :: [Str] -> String +sstrV ss = case ss of + [] -> "*" + _ -> unwords $ intersperse "/" $ map (unwords . str2strings) ss + +str :: String -> Str +str s = if null s then Str [] else Str [itS s] + +itS :: String -> Tok +itS s = TK s + +isZeroTok :: Str -> Bool +isZeroTok t = case t of + Str [] -> True + Str [TK []] -> True + _ -> False + +strTok :: Ss -> [(Ss,[String])] -> Str +strTok ds vs = Str [TN ds vs] + +prStr :: Str -> String +prStr = prQuotedString . sstr + +plusStr :: Str -> Str -> Str +plusStr (Str ss) (Str tt) = Str (ss ++ tt) + +glueStr :: Str -> Str -> Str +glueStr (Str ss) (Str tt) = Str $ case (ss,tt) of + ([],_) -> tt + (_,[]) -> ss + _ -> init ss ++ glueIt (last ss) (head tt) ++ tail tt + where + glueIt t u = case (t,u) of + (TK s, TK s') -> return $ TK $ s ++ s' + (TN ds vs, TN es ws) -> return $ TN (glues (matchPrefix ds vs es) es) + [(glues (matchPrefix ds vs w) w,cs) | (w,cs) <- ws] + (TN ds vs, TK s) -> map TK $ glues (matchPrefix ds vs [s]) [s] + (TK s, TN es ws) -> return $ TN (glues [s] es) [(glues [s] w, c) | (w,c) <- ws] + +glues :: [[a]] -> [[a]] -> [[a]] +glues ss tt = case (ss,tt) of + ([],_) -> tt + (_,[]) -> ss + _ -> init ss ++ [last ss ++ head tt] ++ tail tt + +-- | to create the list of all lexical items +allItems :: Str -> [String] +allItems (Str s) = concatMap allOne s where + allOne t = case t of + TK s -> [s] + TN ds vs -> ds ++ concatMap fst vs diff --git a/src/GF/Data/Utilities.hs b/src/GF/Data/Utilities.hs new file mode 100644 index 000000000..74d3ef81e --- /dev/null +++ b/src/GF/Data/Utilities.hs @@ -0,0 +1,190 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : PL +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/10/26 18:47:16 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.6 $ +-- +-- Basic functions not in the standard libraries +----------------------------------------------------------------------------- + + +module GF.Data.Utilities where + +import Data.Maybe +import Data.List +import Control.Monad (MonadPlus(..),liftM) + +-- * functions on lists + +sameLength :: [a] -> [a] -> Bool +sameLength [] [] = True +sameLength (_:xs) (_:ys) = sameLength xs ys +sameLength _ _ = False + +notLongerThan, longerThan :: Int -> [a] -> Bool +notLongerThan n = null . snd . splitAt n +longerThan n = not . notLongerThan n + +lookupList :: Eq a => a -> [(a, b)] -> [b] +lookupList a [] = [] +lookupList a (p:ps) | a == fst p = snd p : lookupList a ps + | otherwise = lookupList a ps + +split :: [a] -> ([a], [a]) +split (x : y : as) = (x:xs, y:ys) + where (xs, ys) = split as +split as = (as, []) + +splitBy :: (a -> Bool) -> [a] -> ([a], [a]) +splitBy p [] = ([], []) +splitBy p (a : as) = if p a then (a:xs, ys) else (xs, a:ys) + where (xs, ys) = splitBy p as + +foldMerge :: (a -> a -> a) -> a -> [a] -> a +foldMerge merge zero = fm + where fm [] = zero + fm [a] = a + fm abs = let (as, bs) = split abs in fm as `merge` fm bs + +select :: [a] -> [(a, [a])] +select [] = [] +select (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- select xs ] + +updateNth :: (a -> a) -> Int -> [a] -> [a] +updateNth update 0 (a : as) = update a : as +updateNth update n (a : as) = a : updateNth update (n-1) as + +updateNthM :: Monad m => (a -> m a) -> Int -> [a] -> m [a] +updateNthM update 0 (a : as) = liftM (:as) (update a) +updateNthM update n (a : as) = liftM (a:) (updateNthM update (n-1) as) + +-- | Like 'init', but returns the empty list when the input is empty. +safeInit :: [a] -> [a] +safeInit [] = [] +safeInit xs = init xs + +-- | Like 'nub', but more efficient as it uses sorting internally. +sortNub :: Ord a => [a] -> [a] +sortNub = map head . group . sort + +-- | Like 'nubBy', but more efficient as it uses sorting internally. +sortNubBy :: (a -> a -> Ordering) -> [a] -> [a] +sortNubBy f = map head . sortGroupBy f + +-- | Sorts and then groups elements given and ordering of the +-- elements. +sortGroupBy :: (a -> a -> Ordering) -> [a] -> [[a]] +sortGroupBy f = groupBy (compareEq f) . sortBy f + +-- | Take the union of a list of lists. +unionAll :: Eq a => [[a]] -> [a] +unionAll = nub . concat + +-- | Like 'lookup', but fails if the argument is not found, +-- instead of returning Nothing. +lookup' :: (Show a, Eq a) => a -> [(a,b)] -> b +lookup' x = fromMaybe (error $ "Not found: " ++ show x) . lookup x + +-- | Like 'find', but fails if nothing is found. +find' :: (a -> Bool) -> [a] -> a +find' p = fromJust . find p + +-- | Set a value in a lookup table. +tableSet :: Eq a => a -> b -> [(a,b)] -> [(a,b)] +tableSet x y [] = [(x,y)] +tableSet x y (p@(x',_):xs) | x' == x = (x,y):xs + | otherwise = p:tableSet x y xs + +-- | Group tuples by their first elements. +buildMultiMap :: Ord a => [(a,b)] -> [(a,[b])] +buildMultiMap = map (\g -> (fst (head g), map snd g) ) + . sortGroupBy (compareBy fst) + +-- | Replace all occurences of an element by another element. +replace :: Eq a => a -> a -> [a] -> [a] +replace x y = map (\z -> if z == x then y else z) + +-- * equality functions + +-- | Use an ordering function as an equality predicate. +compareEq :: (a -> a -> Ordering) -> a -> a -> Bool +compareEq f x y = case f x y of + EQ -> True + _ -> False + +-- * ordering functions + +compareBy :: Ord b => (a -> b) -> a -> a -> Ordering +compareBy f = both f compare + +both :: (a -> b) -> (b -> b -> c) -> a -> a -> c +both f g x y = g (f x) (f y) + +-- * functions on pairs + +mapFst :: (a -> a') -> (a, b) -> (a', b) +mapFst f (a, b) = (f a, b) + +mapSnd :: (b -> b') -> (a, b) -> (a, b') +mapSnd f (a, b) = (a, f b) + +-- * functions on monads + +-- | Return the given value if the boolean is true, els return 'mzero'. +whenMP :: MonadPlus m => Bool -> a -> m a +whenMP b x = if b then return x else mzero + +-- * functions on Maybes + +-- | Returns true if the argument is Nothing or Just [] +nothingOrNull :: Maybe [a] -> Bool +nothingOrNull = maybe True null + +-- * functions on functions + +-- | Apply all the functions in the list to the argument. +foldFuns :: [a -> a] -> a -> a +foldFuns fs x = foldl (flip ($)) x fs + +-- | Fixpoint iteration. +fix :: Eq a => (a -> a) -> a -> a +fix f x = let x' = f x in if x' == x then x else fix f x' + +-- * functions on strings + +-- | Join a number of lists by using the given glue +-- between the lists. +join :: [a] -- ^ glue + -> [[a]] -- ^ lists to join + -> [a] +join g = concat . intersperse g + +-- * ShowS-functions + +nl :: ShowS +nl = showChar '\n' + +sp :: ShowS +sp = showChar ' ' + +wrap :: String -> ShowS -> String -> ShowS +wrap o s c = showString o . s . showString c + +concatS :: [ShowS] -> ShowS +concatS = foldr (.) id + +unwordsS :: [ShowS] -> ShowS +unwordsS = joinS " " + +unlinesS :: [ShowS] -> ShowS +unlinesS = joinS "\n" + +joinS :: String -> [ShowS] -> ShowS +joinS glue = concatS . intersperse (showString glue) + + + diff --git a/src/GF/Data/XML.hs b/src/GF/Data/XML.hs new file mode 100644 index 000000000..0c2efb7dc --- /dev/null +++ b/src/GF/Data/XML.hs @@ -0,0 +1,53 @@ +---------------------------------------------------------------------- +-- | +-- Module : XML +-- +-- Utilities for creating XML documents. +---------------------------------------------------------------------- +module GF.Data.XML (XML(..), Attr, comments, showXMLDoc, showsXMLDoc, showsXML, bottomUpXML) where + +import GF.Data.Utilities + +data XML = Data String | CData String | Tag String [Attr] [XML] | ETag String [Attr] | Comment String | Empty + deriving (Ord,Eq,Show) + +type Attr = (String,String) + +comments :: [String] -> [XML] +comments = map Comment + +showXMLDoc :: XML -> String +showXMLDoc xml = showsXMLDoc xml "" + +showsXMLDoc :: XML -> ShowS +showsXMLDoc xml = showString header . showsXML xml + where header = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>" + +showsXML :: XML -> ShowS +showsXML (Data s) = showString s +showsXML (CData s) = showString "<![CDATA[" . showString s .showString "]]>" +showsXML (ETag t as) = showChar '<' . showString t . showsAttrs as . showString "/>" +showsXML (Tag t as cs) = + showChar '<' . showString t . showsAttrs as . showChar '>' + . concatS (map showsXML cs) . showString "</" . showString t . showChar '>' +showsXML (Comment c) = showString "<!-- " . showString c . showString " -->" +showsXML (Empty) = id + +showsAttrs :: [Attr] -> ShowS +showsAttrs = concatS . map (showChar ' ' .) . map showsAttr + +showsAttr :: Attr -> ShowS +showsAttr (n,v) = showString n . showString "=\"" . showString (escape v) . showString "\"" + +escape :: String -> String +escape = concatMap escChar + where + escChar '<' = "<" + escChar '>' = ">" + escChar '&' = "&" + escChar '"' = """ + escChar c = [c] + +bottomUpXML :: (XML -> XML) -> XML -> XML +bottomUpXML f (Tag n attrs cs) = f (Tag n attrs (map (bottomUpXML f) cs)) +bottomUpXML f x = f x diff --git a/src/GF/Data/Zipper.hs b/src/GF/Data/Zipper.hs new file mode 100644 index 000000000..a4491f76e --- /dev/null +++ b/src/GF/Data/Zipper.hs @@ -0,0 +1,257 @@ +---------------------------------------------------------------------- +-- | +-- Module : Zipper +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/06/11 20:27:05 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.9 $ +-- +-- Gérard Huet's zipper (JFP 7 (1997)). AR 10\/8\/2001 +----------------------------------------------------------------------------- + +module GF.Data.Zipper (-- * types + Tr(..), + Path(..), + Loc(..), + -- * basic (original) functions + leaf, + goLeft, goRight, goUp, goDown, + changeLoc, + changeNode, + forgetNode, + -- * added sequential representation + goAhead, + goBack, + -- ** n-ary versions + goAheadN, + goBackN, + -- * added mappings between locations and trees + loc2tree, + loc2treeMarked, + tree2loc, + goRoot, + goLast, + goPosition, + getPosition, + keepPosition, + -- * added some utilities + traverseCollect, + scanTree, + mapTr, + mapTrM, + mapPath, + mapPathM, + mapLoc, + mapLocM, + foldTr, + foldTrM, + mapSubtrees, + mapSubtreesM, + changeRoot, + nthSubtree, + arityTree + ) where + +import GF.Data.Operations + +newtype Tr a = Tr (a,[Tr a]) deriving (Show,Eq) + +data Path a = + Top + | Node ([Tr a], (Path a, a), [Tr a]) + deriving Show + +leaf :: a -> Tr a +leaf a = Tr (a,[]) + +newtype Loc a = Loc (Tr a, Path a) deriving Show + +goLeft, goRight, goUp, goDown :: Loc a -> Err (Loc a) +goLeft (Loc (t,p)) = case p of + Top -> Bad "left of top" + Node (l:left, upv, right) -> return $ Loc (l, Node (left,upv,t:right)) + Node _ -> Bad "left of first" +goRight (Loc (t,p)) = case p of + Top -> Bad "right of top" + Node (left, upv, r:right) -> return $ Loc (r, Node (t:left,upv,right)) + Node _ -> Bad "right of first" +goUp (Loc (t,p)) = case p of + Top -> Bad "up of top" + Node (left, (up,v), right) -> + return $ Loc (Tr (v, reverse left ++ (t:right)), up) +goDown (Loc (t,p)) = case t of + Tr (v,(t1:trees)) -> return $ Loc (t1,Node ([],(p,v),trees)) + _ -> Bad "down of empty" + +changeLoc :: Loc a -> Tr a -> Err (Loc a) +changeLoc (Loc (_,p)) t = return $ Loc (t,p) + +changeNode :: (a -> a) -> Loc a -> Loc a +changeNode f (Loc (Tr (n,ts),p)) = Loc (Tr (f n, ts),p) + +forgetNode :: Loc a -> Err (Loc a) +forgetNode (Loc (Tr (n,[t]),p)) = return $ Loc (t,p) +forgetNode _ = Bad $ "not a one-branch tree" + +-- added sequential representation + +-- | a successor function +goAhead :: Loc a -> Err (Loc a) +goAhead s@(Loc (t,p)) = case (t,p) of + (Tr (_,_:_),Node (_,_,_:_)) -> goDown s + (Tr (_,[]), _) -> upsRight s + (_, _) -> goDown s + where + upsRight t = case goRight t of + Ok t' -> return t' + Bad _ -> goUp t >>= upsRight + +-- | a predecessor function +goBack :: Loc a -> Err (Loc a) +goBack s@(Loc (t,p)) = case goLeft s of + Ok s' -> downRight s' + _ -> goUp s + where + downRight s = case goDown s of + Ok s' -> case goRight s' of + Ok s'' -> downRight s'' + _ -> downRight s' + _ -> return s + +-- n-ary versions + +goAheadN :: Int -> Loc a -> Err (Loc a) +goAheadN i st + | i < 1 = return st + | otherwise = goAhead st >>= goAheadN (i-1) + +goBackN :: Int -> Loc a -> Err (Loc a) +goBackN i st + | i < 1 = return st + | otherwise = goBack st >>= goBackN (i-1) + +-- added mappings between locations and trees + +loc2tree :: Loc a -> Tr a +loc2tree (Loc (t,p)) = case p of + Top -> t + Node (left,(p',v),right) -> + loc2tree (Loc (Tr (v, reverse left ++ (t : right)),p')) + +loc2treeMarked :: Loc a -> Tr (a, Bool) +loc2treeMarked (Loc (Tr (a,ts),p)) = + loc2tree (Loc (Tr (mark a, map (mapTr nomark) ts), mapPath nomark p)) + where + (mark, nomark) = (\a -> (a,True), \a -> (a, False)) + +tree2loc :: Tr a -> Loc a +tree2loc t = Loc (t,Top) + +goRoot :: Loc a -> Loc a +goRoot = tree2loc . loc2tree + +goLast :: Loc a -> Err (Loc a) +goLast = rep goAhead where + rep f s = err (const (return s)) (rep f) (f s) + +goPosition :: [Int] -> Loc a -> Err (Loc a) +goPosition p = go p . goRoot where + go [] s = return s + go (p:ps) s = goDown s >>= apply p goRight >>= go ps + +getPosition :: Loc a -> [Int] +getPosition = reverse . getp where + getp (Loc (t,p)) = case p of + Top -> [] + Node (left,(p',v),_) -> length left : getp (Loc (Tr (v, []),p')) + +keepPosition :: (Loc a -> Err (Loc a)) -> (Loc a -> Err (Loc a)) +keepPosition f s = do + let p = getPosition s + s' <- f s + goPosition p s' + +apply :: Monad m => Int -> (a -> m a) -> a -> m a +apply n f a = case n of + 0 -> return a + _ -> f a >>= apply (n-1) f + +-- added some utilities + +traverseCollect :: Path a -> [a] +traverseCollect p = reverse $ case p of + Top -> [] + Node (_, (p',v), _) -> v : traverseCollect p' + +scanTree :: Tr a -> [a] +scanTree (Tr (a,ts)) = a : concatMap scanTree ts + +mapTr :: (a -> b) -> Tr a -> Tr b +mapTr f (Tr (x,ts)) = Tr (f x, map (mapTr f) ts) + +mapTrM :: Monad m => (a -> m b) -> Tr a -> m (Tr b) +mapTrM f (Tr (x,ts)) = do + fx <- f x + fts <- mapM (mapTrM f) ts + return $ Tr (fx,fts) + +mapPath :: (a -> b) -> Path a -> Path b +mapPath f p = case p of + Node (ts1, (p,v), ts2) -> + Node (map (mapTr f) ts1, (mapPath f p, f v), map (mapTr f) ts2) + Top -> Top + +mapPathM :: Monad m => (a -> m b) -> Path a -> m (Path b) +mapPathM f p = case p of + Node (ts1, (p,v), ts2) -> do + ts1' <- mapM (mapTrM f) ts1 + p' <- mapPathM f p + v' <- f v + ts2' <- mapM (mapTrM f) ts2 + return $ Node (ts1', (p',v'), ts2') + Top -> return Top + +mapLoc :: (a -> b) -> Loc a -> Loc b +mapLoc f (Loc (t,p)) = Loc (mapTr f t, mapPath f p) + +mapLocM :: Monad m => (a -> m b) -> Loc a -> m (Loc b) +mapLocM f (Loc (t,p)) = do + t' <- mapTrM f t + p' <- mapPathM f p + return $ (Loc (t',p')) + +foldTr :: (a -> [b] -> b) -> Tr a -> b +foldTr f (Tr (x,ts)) = f x (map (foldTr f) ts) + +foldTrM :: Monad m => (a -> [b] -> m b) -> Tr a -> m b +foldTrM f (Tr (x,ts)) = do + fts <- mapM (foldTrM f) ts + f x fts + +mapSubtrees :: (Tr a -> Tr a) -> Tr a -> Tr a +mapSubtrees f t = let Tr (x,ts) = f t in Tr (x, map (mapSubtrees f) ts) + +mapSubtreesM :: Monad m => (Tr a -> m (Tr a)) -> Tr a -> m (Tr a) +mapSubtreesM f t = do + Tr (x,ts) <- f t + ts' <- mapM (mapSubtreesM f) ts + return $ Tr (x, ts') + +-- | change the root without moving the pointer +changeRoot :: (a -> a) -> Loc a -> Loc a +changeRoot f loc = case loc of + Loc (Tr (a,ts),Top) -> Loc (Tr (f a,ts),Top) + Loc (t, Node (left,pv,right)) -> Loc (t, Node (left,chPath pv,right)) + where + chPath pv = case pv of + (Top,a) -> (Top, f a) + (Node (left,pv,right),v) -> (Node (left, chPath pv,right),v) + +nthSubtree :: Int -> Tr a -> Err (Tr a) +nthSubtree n (Tr (a,ts)) = ts !? n + +arityTree :: Tr a -> Int +arityTree (Tr (_,ts)) = length ts diff --git a/src/GF/Devel/README-testgf3 b/src/GF/Devel/README-testgf3 new file mode 100644 index 000000000..0d1b6e80a --- /dev/null +++ b/src/GF/Devel/README-testgf3 @@ -0,0 +1,49 @@ +GF3, the next version of GF +Aarne Ranta + + +Version 1: 20/2/2008 + +To compile: + + make testgf3 + +To run: + + testgf3 <options> + +Options: + + -src -- read from source + -doemit -- emit gfn files + +More options (debugging flags): + + -show_gf -- show compiled source module after parsing + -show_extend -- ... after extension + -show_rename -- ... after renaming + -show_typecheck -- ... after type checking + -show_refreshing -- ... after refreshing variables + -show_optimize -- ... after partial evaluation + -show_factorize -- ... after factoring optimization + -show_all -- show all phases + + -1 -- stop after parsing + -2 -- ... extending + -3 -- ... renaming + -4 -- ... type checking + -5 -- ... refreshing + +==Compiler Phases== + +LexGF +ParGF +SourceToGF +Extend +Rename +CheckGrammar +Refresh +Optimize +Factorize +GFtoGFCC + diff --git a/src/GF/Devel/gf-code.txt b/src/GF/Devel/gf-code.txt new file mode 100644 index 000000000..e8954bedf --- /dev/null +++ b/src/GF/Devel/gf-code.txt @@ -0,0 +1,66 @@ +Guide to GF Implementation Code +Aarne Ranta + + + +This document describes the code in GF grammar compiler and interactive +environment. It is aimed to cover well the implementation of the forthcoming +GF3. In comparison to GF 2.8, this implementation uses +- the same source language, GF (only slightly modified) +- a different run-time target language, GFCC (instead of GFCM) +- a different separate compilation target language (a fragment GF itself, + instead of GFC) +- a different internal representation of source code + + +Apart from GFCC, the goal of GF3 is simplification and consolidation, rather +than innovation. This is shown in particular in the abolition of GFC, and in +the streamlined internal source code format. The insight needed to achieve +these simplifications would not have been possible (at least for us) without +years of experimenting with the more messy formats; those formats moreover +grew organically when features were added to the GF language, and the old +implementation was thus a result of evolution rather than careful planning. + +GF3 is planned to be released in an Alpha version in the end of 2007, its +sources forming a part of GF release 2.9. + +There are currently two versions of GF3, as regards executables and ``make`` +items: +- ``gf3``, using the old internal representation of source language, and + integrating a compiler from GF to GFCC and an interpreter of GFCC +- ``testgf3``, using the new formats everywhere but implementing the compiler + only; this program does not yet yield reasonable output + + +The descriptions below will target the newest ideas, that is, ``textgf3`` +whenever it differs from ``gf3``. + + +==The structure of the code== + +Code that is not shared with GF 2.8 is located in subdirectories of +``GF/Devel/``. Those subdirectories will, however, be moved one level +up. Currently they include +- ``GF/Devel/Grammar``: the datatypes and basic operations of source code +- ``GF/Devel/Compile``: the phases of compiling GF to GFCC + + +The other directories involved are +- ``GF/GFCC``: data types and functionalities of GFCC +- ``GF/Infra``: infrastructure utilities for the implementation +- ``GF/Data``: datastructures belonging to infrastructure + + +==The source code implementation== + +==The compiler== + +==The GFCC interpreter== + +==The GF command interpreter== + + + + + + diff --git a/src/GF/Devel/gf3.txt b/src/GF/Devel/gf3.txt new file mode 100644 index 000000000..56feeba2a --- /dev/null +++ b/src/GF/Devel/gf3.txt @@ -0,0 +1,84 @@ +GF Version 3.0 +Aarne Ranta +7 November 2007 + + +This document summarizes the goals and status of the forthcoming +GF version 3.0. + +==Overview== + +GF 3 results from the following needs: +- refactor GF to make it more maintainable +- provide a simple command-line batch compiler +- replace gfc by the much simpler gfcc format for embedded grammars + + +The current implementation of GF 3 has three binaries: +- gfc, batch compiler, for building grammar applications +- gfi, interpreter for gfcc grammars, for using grammars +- gf, interactive compiler with interpreter, for developing grammars + + +Thus, roughly, gf = gfc + gfi. + +Question: should we have, like current GF, just one binary, gf, and +implement the others by shell scripts calling gf with suitable options? +- +: one binary is less code altogether +- +: one binary is easier to distribute and update +- -: each of the components is less code by itself +- -: many users might only need either the compiler or the interpreter +- -: those users could avoid installation problems such as readline + + +There are some analogies in other languages: + + || GF | Haskell | Java || + | gfc | ghc | javac | + | gfi | ghci* | java | + | gf | ghci* | - | + +In Haskell, ghci makes more than gfi since it reads source files, but +less than gf since it does not compile them to externally usable target +code. + + + + +==Status of code and functionalities== + +GF executable v. 2.8 +- gf: 263 modules, executable 7+ MB (on MacOS i386) + + +Current status of GF 3.0 alpha: +- gf3: 94 modules, executable 4+ MB +- gfc: 71 modules, executable 3+ MB +- gfi: 35 modules, executable 1+ MB + + +Missing functionalities +- in gfc: + - input formats: cf, ebnf, gfe, old gf + - output formats: speech grammars, bnfc + - integrating options for input, output, and debugging information + (as described in Devel/GFC/Options.hs) + + +- in gfi: + - command cc (computing with resource) + - morphological analysis, linearization with tables + - quizzes, treebanks + - syntax editor + - readline + + +==Additional feature options== + +Native Haskell readline + +Binary formats for gfo and gfcc + +Parallel compilation on multicore machines + + diff --git a/src/GF/Grammar/API.hs b/src/GF/Grammar/API.hs new file mode 100644 index 000000000..182b5e94e --- /dev/null +++ b/src/GF/Grammar/API.hs @@ -0,0 +1,75 @@ +module GF.Grammar.API ( + Grammar, + emptyGrammar, + pTerm, + prTerm, + checkTerm, + computeTerm, + showTerm, + TermPrintStyle(..), + pTermPrintStyle + ) where + +import GF.Source.ParGF +import GF.Source.SourceToGrammar (transExp) +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Infra.Modules (greatestResource) +import GF.Compile.GetGrammar +import GF.Grammar.Macros +import GF.Grammar.PrGrammar + +import GF.Compile.Rename (renameSourceTerm) +import GF.Compile.CheckGrammar (justCheckLTerm) +import GF.Compile.Compute (computeConcrete) + +import GF.Data.Operations +import GF.Infra.Option + +import qualified Data.ByteString.Char8 as BS + +type Grammar = SourceGrammar + +emptyGrammar :: Grammar +emptyGrammar = emptySourceGrammar + +pTerm :: String -> Err Term +pTerm s = do + e <- pExp $ myLexer (BS.pack s) + transExp e + +prTerm :: Term -> String +prTerm = prt + +checkTerm :: Grammar -> Term -> Err Term +checkTerm gr t = do + mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr + checkTermAny gr mo t + +checkTermAny :: Grammar -> Ident -> Term -> Err Term +checkTermAny gr m t = do + t1 <- renameSourceTerm gr m t + justCheckLTerm gr t1 + +computeTerm :: Grammar -> Term -> Err Term +computeTerm = computeConcrete + +showTerm :: TermPrintStyle -> Term -> String +showTerm style t = + case style of + TermPrintTable -> unlines [p +++ s | (p,s) <- prTermTabular t] + TermPrintAll -> unlines [ s | (p,s) <- prTermTabular t] + TermPrintUnqual -> prt_ t + TermPrintDefault -> prt t + + +data TermPrintStyle = TermPrintTable | TermPrintAll | TermPrintUnqual | TermPrintDefault + deriving (Show,Eq) + +pTermPrintStyle s = case s of + "table" -> TermPrintTable + "all" -> TermPrintAll + "unqual" -> TermPrintUnqual + _ -> TermPrintDefault + + diff --git a/src/GF/Grammar/Abstract.hs b/src/GF/Grammar/Abstract.hs new file mode 100644 index 000000000..c03783a52 --- /dev/null +++ b/src/GF/Grammar/Abstract.hs @@ -0,0 +1,38 @@ +---------------------------------------------------------------------- +-- | +-- Module : Abstract +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:18 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.4 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Grammar.Abstract ( + +module GF.Grammar.Grammar, +module GF.Grammar.Values, +module GF.Grammar.Macros, +module GF.Infra.Ident, +module GF.Grammar.MMacros, +module GF.Grammar.PrGrammar, + +Grammar + + ) where + +import GF.Grammar.Grammar +import GF.Grammar.Values +import GF.Grammar.Macros +import GF.Infra.Ident +import GF.Grammar.MMacros +import GF.Grammar.PrGrammar + +type Grammar = SourceGrammar --- + + + diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs new file mode 100644 index 000000000..cfb6baf1d --- /dev/null +++ b/src/GF/Grammar/AppPredefined.hs @@ -0,0 +1,158 @@ +---------------------------------------------------------------------- +-- | +-- Module : AppPredefined +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/10/06 14:21:34 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.13 $ +-- +-- Predefined function type signatures and definitions. +----------------------------------------------------------------------------- + +module GF.Grammar.AppPredefined (isInPredefined, typPredefined, appPredefined + ) where + +import GF.Infra.Ident +import GF.Data.Operations +import GF.Grammar.Predef +import GF.Grammar.Grammar +import GF.Grammar.Macros +import GF.Grammar.PrGrammar (prt,prt_,prtBad) +import qualified Data.ByteString.Char8 as BS + +-- predefined function type signatures and definitions. AR 12/3/2003. + +isInPredefined :: Ident -> Bool +isInPredefined = err (const True) (const False) . typPredefined + +typPredefined :: Ident -> Err Type +typPredefined f + | f == cInt = return typePType + | f == cFloat = return typePType + | f == cErrorType = return typeType + | f == cInts = return $ mkFunType [typeInt] typePType + | f == cPBool = return typePType + | f == cError = return $ mkFunType [typeStr] typeError -- non-can. of empty set + | f == cPFalse = return $ typePBool + | f == cPTrue = return $ typePBool + | f == cDp = return $ mkFunType [typeInt,typeTok] typeTok + | f == cDrop = return $ mkFunType [typeInt,typeTok] typeTok + | f == cEqInt = return $ mkFunType [typeInt,typeInt] typePBool + | f == cLessInt = return $ mkFunType [typeInt,typeInt] typePBool + | f == cEqStr = return $ mkFunType [typeTok,typeTok] typePBool + | f == cLength = return $ mkFunType [typeTok] typeInt + | f == cOccur = return $ mkFunType [typeTok,typeTok] typePBool + | f == cOccurs = return $ mkFunType [typeTok,typeTok] typePBool + | f == cPlus = return $ mkFunType [typeInt,typeInt] (typeInt) +---- "read" -> (P : Type) -> Tok -> P + | f == cShow = return $ mkProd -- (P : PType) -> P -> Tok + ([(varP,typePType),(identW,Vr varP)],typeStr,[]) + | f == cToStr = return $ mkProd -- (L : Type) -> L -> Str + ([(varL,typeType),(identW,Vr varL)],typeStr,[]) + | f == cMapStr = return $ mkProd -- (L : Type) -> (Str -> Str) -> L -> L + ([(varL,typeType),(identW,mkFunType [typeStr] typeStr),(identW,Vr varL)],Vr varL,[]) + | f == cTake = return $ mkFunType [typeInt,typeTok] typeTok + | f == cTk = return $ mkFunType [typeInt,typeTok] typeTok + | otherwise = prtBad "unknown in Predef:" f + +varL :: Ident +varL = identC (BS.pack "L") + +varP :: Ident +varP = identC (BS.pack "P") + +appPredefined :: Term -> Err (Term,Bool) +appPredefined t = case t of + App f x0 -> do + (x,_) <- appPredefined x0 + case f of + -- one-place functions + Q mod f | mod == cPredef -> + case x of + (K s) | f == cLength -> retb $ EInt $ toInteger $ length s + _ -> retb t + + -- two-place functions + App (Q mod f) z0 | mod == cPredef -> do + (z,_) <- appPredefined z0 + case (norm z, norm x) of + (EInt i, K s) | f == cDrop -> retb $ K (drop (fi i) s) + (EInt i, K s) | f == cTake -> retb $ K (take (fi i) s) + (EInt i, K s) | f == cTk -> retb $ K (take (max 0 (length s - fi i)) s) + (EInt i, K s) | f == cDp -> retb $ K (drop (max 0 (length s - fi i)) s) + (K s, K t) | f == cEqStr -> retb $ if s == t then predefTrue else predefFalse + (K s, K t) | f == cOccur -> retb $ if substring s t then predefTrue else predefFalse + (K s, K t) | f == cOccurs -> retb $ if any (flip elem t) s then predefTrue else predefFalse + (EInt i, EInt j) | f == cEqInt -> retb $ if i==j then predefTrue else predefFalse + (EInt i, EInt j) | f == cLessInt -> retb $ if i<j then predefTrue else predefFalse + (EInt i, EInt j) | f == cPlus -> retb $ EInt $ i+j + (_, t) | f == cShow -> retb $ foldr C Empty $ map K $ words $ prt t + (_, K s) | f == cRead -> retb $ Cn (identC (BS.pack s)) --- because of K, only works for atomic tags + (_, t) | f == cToStr -> trm2str t >>= retb + _ -> retb t ---- prtBad "cannot compute predefined" t + + -- three-place functions + App (App (Q mod f) z0) y0 | mod == cPredef -> do + (y,_) <- appPredefined y0 + (z,_) <- appPredefined z0 + case (z, y, x) of + (ty,op,t) | f == cMapStr -> retf $ mapStr ty op t + _ -> retb t ---- prtBad "cannot compute predefined" t + + _ -> retb t ---- prtBad "cannot compute predefined" t + _ -> retb t + ---- should really check the absence of arg variables + where + retb t = return (retc t,True) -- no further computing needed + retf t = return (retc t,False) -- must be computed further + retc t = case t of + K [] -> t + K s -> foldr1 C (map K (words s)) + _ -> t + norm t = case t of + Empty -> K [] + C u v -> case (norm u,norm v) of + (K x,K y) -> K (x +++ y) + _ -> t + _ -> t + fi = fromInteger + +-- read makes variables into constants + +predefTrue = Q cPredef cPTrue +predefFalse = Q cPredef cPFalse + +substring :: String -> String -> Bool +substring s t = case (s,t) of + (c:cs, d:ds) -> (c == d && substring cs ds) || substring s ds + ([],_) -> True + _ -> False + +trm2str :: Term -> Err Term +trm2str t = case t of + R ((_,(_,s)):_) -> trm2str s + T _ ((_,s):_) -> trm2str s + TSh _ ((_,s):_) -> trm2str s + V _ (s:_) -> trm2str s + C _ _ -> return $ t + K _ -> return $ t + S c _ -> trm2str c + Empty -> return $ t + _ -> prtBad "cannot get Str from term" t + +-- simultaneous recursion on type and term: type arg is essential! +-- But simplify the task by assuming records are type-annotated +-- (this has been done in type checking) +mapStr :: Type -> Term -> Term -> Term +mapStr ty f t = case (ty,t) of + _ | elem ty [typeStr,typeTok] -> App f t + (_, R ts) -> R [(l,mapField v) | (l,v) <- ts] + (Table a b,T ti cs) -> T ti [(p,mapStr b f v) | (p,v) <- cs] + _ -> t + where + mapField (mty,te) = case mty of + Just ty -> (mty,mapStr ty f te) + _ -> (mty,te) diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs new file mode 100644 index 000000000..4210358f1 --- /dev/null +++ b/src/GF/Grammar/Grammar.hs @@ -0,0 +1,264 @@ +---------------------------------------------------------------------- +-- | +-- Module : Grammar +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:20 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.8 $ +-- +-- GF source abstract syntax used internally in compilation. +-- +-- AR 23\/1\/2000 -- 30\/5\/2001 -- 4\/5\/2003 +----------------------------------------------------------------------------- + +module GF.Grammar.Grammar (SourceGrammar, + emptySourceGrammar, + SourceModInfo, + SourceModule, + SourceAbs, + SourceRes, + SourceCnc, + Info(..), + PValues, + Perh, + MPr, + Type, + Cat, + Fun, + QIdent, + Term(..), + Patt(..), + TInfo(..), + Label(..), + MetaSymb(..), + Decl, + Context, + Equation, + Labelling, + Assign, + Case, + Cases, + LocalDef, + Param, + Altern, + Substitution, + Branch(..), + Con, + Trm, + wildPatt, + varLabel, tupleLabel, linLabel, theLinLabel, + ident2label, label2ident + ) where + +import GF.Data.Str +import GF.Infra.Ident +import GF.Infra.Option --- +import GF.Infra.Modules + +import GF.Data.Operations + +import qualified Data.ByteString.Char8 as BS + +-- | grammar as presented to the compiler +type SourceGrammar = MGrammar Ident Info + +emptySourceGrammar = MGrammar [] + +type SourceModInfo = ModInfo Ident Info + +type SourceModule = (Ident, SourceModInfo) + +type SourceAbs = Module Ident Info +type SourceRes = Module Ident Info +type SourceCnc = Module Ident Info + +-- this is created in CheckGrammar, and so are Val and PVal +type PValues = [Term] + +-- | the constructors are judgements in +-- +-- - abstract syntax (/ABS/) +-- +-- - resource (/RES/) +-- +-- - concrete syntax (/CNC/) +-- +-- and indirection to module (/INDIR/) +data Info = +-- judgements in abstract syntax + AbsCat (Perh Context) (Perh [Term]) -- ^ (/ABS/) constructors; must be 'Id' or 'QId' + | AbsFun (Perh Type) (Perh Term) -- ^ (/ABS/) 'Yes f' = canonical + | AbsTrans Term -- ^ (/ABS/) + +-- judgements in resource + | ResParam (Perh ([Param],Maybe PValues)) -- ^ (/RES/) + | ResValue (Perh (Type,Maybe Int)) -- ^ (/RES/) to mark parameter constructors for lookup + | ResOper (Perh Type) (Perh Term) -- ^ (/RES/) + + | ResOverload [Ident] [(Type,Term)] -- ^ (/RES/) idents: modules inherited + +-- judgements in concrete syntax + | CncCat (Perh Type) (Perh Term) MPr -- ^ (/CNC/) lindef ini'zed, + | CncFun (Maybe (Ident,(Context,Type))) (Perh Term) MPr -- (/CNC/) type info added at 'TC' + +-- indirection to module Ident + | AnyInd Bool Ident -- ^ (/INDIR/) the 'Bool' says if canonical + deriving (Read, Show) + +-- | to express indirection to other module +type Perh a = Perhaps a Ident + +-- | printname +type MPr = Perhaps Term Ident + +type Type = Term +type Cat = QIdent +type Fun = QIdent + +type QIdent = (Ident,Ident) + +data Term = + Vr Ident -- ^ variable + | Cn Ident -- ^ constant + | Con Ident -- ^ constructor + | EData -- ^ to mark in definition that a fun is a constructor + | Sort Ident -- ^ basic type + | EInt Integer -- ^ integer literal + | EFloat Double -- ^ floating point literal + | K String -- ^ string literal or token: @\"foo\"@ + | Empty -- ^ the empty string @[]@ + + | App Term Term -- ^ application: @f a@ + | Abs Ident Term -- ^ abstraction: @\x -> b@ + | Meta MetaSymb -- ^ metavariable: @?i@ (only parsable: ? = ?0) + | Prod Ident Term Term -- ^ function type: @(x : A) -> B@ + | Eqs [Equation] -- ^ abstraction by cases: @fn {x y -> b ; z u -> c}@ + -- only used in internal representation + | Typed Term Term -- ^ type-annotated term +-- +-- /below this, the constructors are only for concrete syntax/ + | Example Term String -- ^ example-based term: @in M.C "foo" + | RecType [Labelling] -- ^ record type: @{ p : A ; ...}@ + | R [Assign] -- ^ record: @{ p = a ; ...}@ + | P Term Label -- ^ projection: @r.p@ + | PI Term Label Int -- ^ index-annotated projection + | ExtR Term Term -- ^ extension: @R ** {x : A}@ (both types and terms) + + | Table Term Term -- ^ table type: @P => A@ + | T TInfo [Case] -- ^ table: @table {p => c ; ...}@ + | TSh TInfo [Cases] -- ^ table with disjunctive patters (only back end opt) + | V Type [Term] -- ^ table given as course of values: @table T [c1 ; ... ; cn]@ + | S Term Term -- ^ selection: @t ! p@ + | Val Type Int -- ^ parameter value number: @T # i# + + | Let LocalDef Term -- ^ local definition: @let {t : T = a} in b@ + + | Alias Ident Type Term -- ^ constant and its definition, used in inlining + + | Q Ident Ident -- ^ qualified constant from a package + | QC Ident Ident -- ^ qualified constructor from a package + + | C Term Term -- ^ concatenation: @s ++ t@ + | Glue Term Term -- ^ agglutination: @s + t@ + + | EPatt Patt -- ^ pattern (in macro definition): # p + | EPattType Term -- ^ pattern type: pattern T + + | FV [Term] -- ^ alternatives in free variation: @variants { s ; ... }@ + + | Alts (Term, [(Term, Term)]) -- ^ alternatives by prefix: @pre {t ; s\/c ; ...}@ + | Strs [Term] -- ^ conditioning prefix strings: @strs {s ; ...}@ +-- +-- /below this, the last three constructors are obsolete/ + | LiT Ident -- ^ linearization type + | Ready Str -- ^ result of compiling; not to be parsed ... + | Computed Term -- ^ result of computing: not to be reopened nor parsed + + deriving (Read, Show, Eq, Ord) + +data Patt = + PC Ident [Patt] -- ^ constructor pattern: @C p1 ... pn@ @C@ + | PP Ident Ident [Patt] -- ^ package constructor pattern: @P.C p1 ... pn@ @P.C@ + | PV Ident -- ^ variable pattern: @x@ + | PW -- ^ wild card pattern: @_@ + | PR [(Label,Patt)] -- ^ record pattern: @{r = p ; ...}@ -- only concrete + | PString String -- ^ string literal pattern: @\"foo\"@ -- only abstract + | PInt Integer -- ^ integer literal pattern: @12@ -- only abstract + | PFloat Double -- ^ float literal pattern: @1.2@ -- only abstract + | PT Type Patt -- ^ type-annotated pattern + + | PVal Type Int -- ^ parameter value number: @T # i# + + | PAs Ident Patt -- ^ as-pattern: x@p + + -- regular expression patterns + | PNeg Patt -- ^ negated pattern: -p + | PAlt Patt Patt -- ^ disjunctive pattern: p1 | p2 + | PSeq Patt Patt -- ^ sequence of token parts: p + q + | PRep Patt -- ^ repetition of token part: p* + | PChar -- ^ string of length one: ? + | PChars [Char] -- ^ character list: ["aeiou"] + | PMacro Ident -- #p + | PM Ident Ident -- #m.p + + deriving (Read, Show, Eq, Ord) + +-- | to guide computation and type checking of tables +data TInfo = + TRaw -- ^ received from parser; can be anything + | TTyped Type -- ^ type annontated, but can be anything + | TComp Type -- ^ expanded + | TWild Type -- ^ just one wild card pattern, no need to expand + deriving (Read, Show, Eq, Ord) + +-- | record label +data Label = + LIdent BS.ByteString + | LVar Int + deriving (Read, Show, Eq, Ord) + +newtype MetaSymb = MetaSymb Int deriving (Read, Show, Eq, Ord) + +type Decl = (Ident,Term) -- (x:A) (_:A) A +type Context = [Decl] -- (x:A)(y:B) (x,y:A) (_,_:A) +type Equation = ([Patt],Term) + +type Labelling = (Label, Term) +type Assign = (Label, (Maybe Type, Term)) +type Case = (Patt, Term) +type Cases = ([Patt], Term) +type LocalDef = (Ident, (Maybe Type, Term)) + +type Param = (Ident, Context) +type Altern = (Term, [(Term, Term)]) + +type Substitution = [(Ident, Term)] + +-- | branches à la Alfa +newtype Branch = Branch (Con,([Ident],Term)) deriving (Eq, Ord,Show,Read) +type Con = Ident --- + +varLabel :: Int -> Label +varLabel = LVar + +tupleLabel, linLabel :: Int -> Label +tupleLabel i = LIdent $! BS.pack ('p':show i) +linLabel i = LIdent $! BS.pack ('s':show i) + +theLinLabel :: Label +theLinLabel = LIdent (BS.singleton 's') + +ident2label :: Ident -> Label +ident2label c = LIdent (ident2bs c) + +label2ident :: Label -> Ident +label2ident (LIdent s) = identC s +label2ident (LVar i) = identC (BS.pack ('$':show i)) + +wildPatt :: Patt +wildPatt = PV identW + +type Trm = Term diff --git a/src/GF/Grammar/Lockfield.hs b/src/GF/Grammar/Lockfield.hs new file mode 100644 index 000000000..12b78ab9b --- /dev/null +++ b/src/GF/Grammar/Lockfield.hs @@ -0,0 +1,51 @@ +---------------------------------------------------------------------- +-- | +-- Module : Lockfield +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/11 23:24:34 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.7 $ +-- +-- Creating and using lock fields in reused resource grammars. +-- +-- AR 8\/2\/2005 detached from 'compile/MkResource' +----------------------------------------------------------------------------- + +module GF.Grammar.Lockfield (lockRecType, unlockRecord, lockLabel, isLockLabel) where + +import qualified Data.ByteString.Char8 as BS + +import GF.Infra.Ident +import GF.Grammar.Grammar +import GF.Grammar.Macros +import GF.Grammar.PrGrammar + +import GF.Data.Operations + +lockRecType :: Ident -> Type -> Err Type +lockRecType c t@(RecType rs) = + let lab = lockLabel c in + return $ if elem lab (map fst rs) || elem (prt c) ["String","Int"] + then t --- don't add an extra copy of lock field, nor predef cats + else RecType (rs ++ [(lockLabel c, RecType [])]) +lockRecType c t = plusRecType t $ RecType [(lockLabel c, RecType [])] + +unlockRecord :: Ident -> Term -> Err Term +unlockRecord c ft = do + let (xs,t) = termFormCnc ft + t' <- plusRecord t $ R [(lockLabel c, (Just (RecType []),R []))] + return $ mkAbs xs t' + +lockLabel :: Ident -> Label +lockLabel c = LIdent $! BS.append lockPrefix (ident2bs c) + +isLockLabel :: Label -> Bool +isLockLabel l = case l of + LIdent c -> BS.isPrefixOf lockPrefix c + _ -> False + + +lockPrefix = BS.pack "lock_" diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs new file mode 100644 index 000000000..f9a251eb1 --- /dev/null +++ b/src/GF/Grammar/LookAbs.hs @@ -0,0 +1,53 @@ +---------------------------------------------------------------------- +-- | +-- Module : LookAbs +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/28 16:42:48 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.14 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Grammar.LookAbs ( + lookupFunType, + lookupCatContext + ) where + +import GF.Data.Operations +import GF.Grammar.Abstract +import GF.Infra.Ident + +import GF.Infra.Modules + +import Data.List (nub) +import Control.Monad + +-- | this is needed at compile time +lookupFunType :: Grammar -> Ident -> Ident -> Err Type +lookupFunType gr m c = do + mi <- lookupModule gr m + case mi of + ModMod mo -> do + info <- lookupIdentInfo mo c + case info of + AbsFun (Yes t) _ -> return t + AnyInd _ n -> lookupFunType gr n c + _ -> prtBad "cannot find type of" c + _ -> Bad $ prt m +++ "is not an abstract module" + +-- | this is needed at compile time +lookupCatContext :: Grammar -> Ident -> Ident -> Err Context +lookupCatContext gr m c = do + mi <- lookupModule gr m + case mi of + ModMod mo -> do + info <- lookupIdentInfo mo c + case info of + AbsCat (Yes co) _ -> return co + AnyInd _ n -> lookupCatContext gr n c + _ -> prtBad "unknown category" c + _ -> Bad $ prt m +++ "is not an abstract module" diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs new file mode 100644 index 000000000..a4208b21b --- /dev/null +++ b/src/GF/Grammar/Lookup.hs @@ -0,0 +1,269 @@ +{-# LANGUAGE PatternGuards #-} +---------------------------------------------------------------------- +-- | +-- Module : Lookup +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/10/27 13:21:53 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.15 $ +-- +-- Lookup in source (concrete and resource) when compiling. +-- +-- lookup in resource and concrete in compiling; for abstract, use 'Look' +----------------------------------------------------------------------------- + +module GF.Grammar.Lookup ( + lookupResDef, + lookupResDefKind, + lookupResType, + lookupOverload, + lookupParams, + lookupParamValues, + lookupFirstTag, + lookupValueIndex, + lookupIndexValue, + allOrigInfos, + allParamValues, + lookupAbsDef, + lookupLincat, + opersForType + ) where + +import GF.Data.Operations +import GF.Grammar.Abstract +import GF.Infra.Modules +import GF.Grammar.Predef +import GF.Grammar.Lockfield + +import Data.List (nub,sortBy) +import Control.Monad + +-- whether lock fields are added in reuse +lock c = lockRecType c -- return +unlock c = unlockRecord c -- return + +lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term +lookupResDef gr m c = liftM fst $ lookupResDefKind gr m c + +-- 0 = oper, 1 = lin, 2 = canonical. v > 0 means: no need to be recomputed +lookupResDefKind :: SourceGrammar -> Ident -> Ident -> Err (Term,Int) +lookupResDefKind gr m c + | isPredefCat c = return (Q cPredefAbs c,2) --- need this in gf3 12/6/2008 + | otherwise = look True m c where + look isTop m c = do + mi <- lookupModule gr m + case mi of + ModMod mo -> do + info <- lookupIdentInfoIn mo m c + case info of + ResOper _ (Yes t) -> return (qualifAnnot m t, 0) + ResOper _ Nope -> return (Q m c, 0) ---- if isTop then lookExt m c + ---- else prtBad "cannot find in exts" c + + CncCat (Yes ty) _ _ -> liftM (flip (,) 1) $ lock c ty + CncCat _ _ _ -> liftM (flip (,) 1) $ lock c defLinType + CncFun (Just (cat,_)) (Yes tr) _ -> liftM (flip (,) 1) $ unlock cat tr + + CncFun _ (Yes tr) _ -> liftM (flip (,) 1) (return tr) ---- $ unlock c tr + + AnyInd _ n -> look False n c + ResParam _ -> return (QC m c,2) + ResValue _ -> return (QC m c,2) + _ -> Bad $ prt c +++ "is not defined in resource" +++ prt m + _ -> Bad $ prt m +++ "is not a resource" + lookExt m c = + checks ([look False n c | n <- allExtensions gr m] ++ [return (Q m c,3)]) + +lookupResType :: SourceGrammar -> Ident -> Ident -> Err Type +lookupResType gr m c = do + mi <- lookupModule gr m + case mi of + ModMod mo -> do + info <- lookupIdentInfo mo c + case info of + ResOper (Yes t) _ -> return $ qualifAnnot m t + ResOper (May n) _ -> lookupResType gr n c + + -- used in reused concrete + CncCat _ _ _ -> return typeType + CncFun (Just (cat,(cont@(_:_),val))) _ _ -> do + val' <- lock cat val + return $ mkProd (cont, val', []) + CncFun _ _ _ -> lookFunType m m c + AnyInd _ n -> lookupResType gr n c + ResParam _ -> return $ typePType + ResValue (Yes (t,_)) -> return $ qualifAnnotPar m t + _ -> Bad $ prt c +++ "has no type defined in resource" +++ prt m + _ -> Bad $ prt m +++ "is not a resource" + where + lookFunType e m c = do + a <- abstractOfConcrete gr m + lookFun e m c a + lookFun e m c a = do + mu <- lookupModMod gr a + info <- lookupIdentInfo mu c + case info of + AbsFun (Yes ty) _ -> return $ redirectTerm e ty + AbsCat _ _ -> return typeType + AnyInd _ n -> lookFun e m c n + _ -> prtBad "cannot find type of reused function" c + +lookupOverload :: SourceGrammar -> Ident -> Ident -> Err [([Type],(Type,Term))] +lookupOverload gr m c = do + mi <- lookupModule gr m + case mi of + ModMod mo -> do + info <- lookupIdentInfo mo c + case info of + ResOverload os tysts -> do + tss <- mapM (\x -> lookupOverload gr x c) os + return $ [(map snd args,(val,tr)) | + (ty,tr) <- tysts, Ok (args,val) <- [typeFormCnc ty]] ++ + concat tss + + AnyInd _ n -> lookupOverload gr n c + _ -> Bad $ prt c +++ "is not an overloaded operation" + _ -> Bad $ prt m +++ "is not a resource" + +lookupOrigInfo :: SourceGrammar -> Ident -> Ident -> Err Info +lookupOrigInfo gr m c = do + mi <- lookupModule gr m + case mi of + ModMod mo -> do + info <- lookupIdentInfo mo c + case info of + AnyInd _ n -> lookupOrigInfo gr n c + i -> return i + _ -> Bad $ prt m +++ "is not run-time module" + +lookupParams :: SourceGrammar -> Ident -> Ident -> Err ([Param],Maybe PValues) +lookupParams gr = look True where + look isTop m c = do + mi <- lookupModule gr m + case mi of + ModMod mo -> do + info <- lookupIdentInfo mo c + case info of + ResParam (Yes psm) -> return psm + AnyInd _ n -> look False n c + _ -> Bad $ prt c +++ "has no parameters defined in resource" +++ prt m + _ -> Bad $ prt m +++ "is not a resource" + lookExt m c = + checks [look False n c | n <- allExtensions gr m] + +lookupParamValues :: SourceGrammar -> Ident -> Ident -> Err [Term] +lookupParamValues gr m c = do + (ps,mpv) <- lookupParams gr m c + case mpv of + Just ts -> return ts + _ -> liftM concat $ mapM mkPar ps + where + mkPar (f,co) = do + vs <- liftM combinations $ mapM (\ (_,ty) -> allParamValues gr ty) co + return $ map (mkApp (QC m f)) vs + +lookupFirstTag :: SourceGrammar -> Ident -> Ident -> Err Term +lookupFirstTag gr m c = do + vs <- lookupParamValues gr m c + case vs of + v:_ -> return v + _ -> prtBad "no parameter values given to type" c + +lookupValueIndex :: SourceGrammar -> Type -> Term -> Err Term +lookupValueIndex gr ty tr = do + ts <- allParamValues gr ty + case lookup tr $ zip ts [0..] of + Just i -> return $ Val ty i + _ -> Bad $ "no index for" +++ prt tr +++ "in" +++ prt ty + +lookupIndexValue :: SourceGrammar -> Type -> Int -> Err Term +lookupIndexValue gr ty i = do + ts <- allParamValues gr ty + if i < length ts + then return $ ts !! i + else Bad $ "no value for index" +++ show i +++ "in" +++ prt ty + +allOrigInfos :: SourceGrammar -> Ident -> [(Ident,Info)] +allOrigInfos gr m = errVal [] $ do + mi <- lookupModule gr m + case mi of + ModMod mo -> return [(c,i) | (c,_) <- tree2list (jments mo), Ok i <- [look c]] + where + look = lookupOrigInfo gr m + +allParamValues :: SourceGrammar -> Type -> Err [Term] +allParamValues cnc ptyp = case ptyp of + _ | Just n <- isTypeInts ptyp -> return [EInt i | i <- [0..n]] + QC p c -> lookupParamValues cnc p c + Q p c -> lookupResDef cnc p c >>= allParamValues cnc + RecType r -> do + let (ls,tys) = unzip $ sortByFst r + tss <- mapM allPV tys + return [R (zipAssign ls ts) | ts <- combinations tss] + _ -> prtBad "cannot find parameter values for" ptyp + where + allPV = allParamValues cnc + -- to normalize records and record types + sortByFst = sortBy (\ x y -> compare (fst x) (fst y)) + +qualifAnnot :: Ident -> Term -> Term +qualifAnnot _ = id +-- Using this we wouldn't have to annotate constants defined in a module itself. +-- But things are simpler if we do (cf. Zinc). +-- Change Rename.self2status to change this behaviour. + +-- we need this for lookup in ResVal +qualifAnnotPar m t = case t of + Cn c -> Q m c + Con c -> QC m c + _ -> composSafeOp (qualifAnnotPar m) t + +lookupAbsDef :: SourceGrammar -> Ident -> Ident -> Err (Maybe Term) +lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do + mi <- lookupModule gr m + case mi of + ModMod mo -> do + info <- lookupIdentInfo mo c + case info of + AbsFun _ (Yes t) -> return $ return t + AnyInd _ n -> lookupAbsDef gr n c + _ -> return Nothing + _ -> Bad $ prt m +++ "is not an abstract module" + +lookupLincat :: SourceGrammar -> Ident -> Ident -> Err Type +lookupLincat gr m c | isPredefCat c = return defLinType --- ad hoc; not needed? +lookupLincat gr m c = do + mi <- lookupModule gr m + case mi of + ModMod mo -> do + info <- lookupIdentInfo mo c + case info of + CncCat (Yes t) _ _ -> return t + AnyInd _ n -> lookupLincat gr n c + _ -> Bad $ prt c +++ "has no linearization type in" +++ prt m + _ -> Bad $ prt m +++ "is not concrete" + + +-- The first type argument is uncomputed, usually a category symbol. +-- This is a hack to find implicit (= reused) opers. + +opersForType :: SourceGrammar -> Type -> Type -> [(QIdent,Term)] +opersForType gr orig val = + [((i,f),ty) | (i,m) <- allModMod gr, (f,ty) <- opers i m val] where + opers i m val = + [(f,ty) | + (f,ResOper (Yes ty) _) <- tree2list $ jments m, + Ok valt <- [valTypeCnc ty], + elem valt [val,orig] + ] ++ + let cat = err error snd (valCat orig) in --- ignore module + [(f,ty) | + Ok a <- [abstractOfConcrete gr i >>= lookupModMod gr], + (f, AbsFun (Yes ty0) _) <- tree2list $ jments a, + let ty = redirectTerm i ty0, + Ok valt <- [valCat ty], + cat == snd valt --- + ] diff --git a/src/GF/Grammar/MMacros.hs b/src/GF/Grammar/MMacros.hs new file mode 100644 index 000000000..f2a0f2cb2 --- /dev/null +++ b/src/GF/Grammar/MMacros.hs @@ -0,0 +1,339 @@ +---------------------------------------------------------------------- +-- | +-- Module : MMacros +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/10 12:49:13 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.9 $ +-- +-- some more abstractions on grammars, esp. for Edit +----------------------------------------------------------------------------- + +module GF.Grammar.MMacros where + +import GF.Data.Operations +import GF.Data.Zipper + +import GF.Grammar.Grammar +import GF.Grammar.PrGrammar +import GF.Infra.Ident +import GF.Compile.Refresh +import GF.Grammar.Values +----import GrammarST +import GF.Grammar.Macros + +import Control.Monad +import qualified Data.ByteString.Char8 as BS + +nodeTree :: Tree -> TrNode +argsTree :: Tree -> [Tree] + +nodeTree (Tr (n,_)) = n +argsTree (Tr (_,ts)) = ts + +isFocusNode :: TrNode -> Bool +bindsNode :: TrNode -> Binds +atomNode :: TrNode -> Atom +valNode :: TrNode -> Val +constrsNode :: TrNode -> Constraints +metaSubstsNode :: TrNode -> MetaSubst + +isFocusNode (N (_,_,_,_,b)) = b +bindsNode (N (b,_,_,_,_)) = b +atomNode (N (_,a,_,_,_)) = a +valNode (N (_,_,v,_,_)) = v +constrsNode (N (_,_,_,(c,_),_)) = c +metaSubstsNode (N (_,_,_,(_,m),_)) = m + +atomTree :: Tree -> Atom +valTree :: Tree -> Val + +atomTree = atomNode . nodeTree +valTree = valNode . nodeTree + +mkNode :: Binds -> Atom -> Val -> (Constraints, MetaSubst) -> TrNode +mkNode binds atom vtyp cs = N (binds,atom,vtyp,cs,False) + +type Var = Ident +type Meta = MetaSymb + +metasTree :: Tree -> [Meta] +metasTree = concatMap metasNode . scanTree where + metasNode n = [m | AtM m <- [atomNode n]] ++ map fst (metaSubstsNode n) + +varsTree :: Tree -> [(Var,Val)] +varsTree t = [(x,v) | N (_,AtV x,v,_,_) <- scanTree t] + +constrsTree :: Tree -> Constraints +constrsTree = constrsNode . nodeTree + +allConstrsTree :: Tree -> Constraints +allConstrsTree = concatMap constrsNode . scanTree + +changeConstrs :: (Constraints -> Constraints) -> TrNode -> TrNode +changeConstrs f (N (b,a,v,(c,m),x)) = N (b,a,v,(f c, m),x) + +changeMetaSubst :: (MetaSubst -> MetaSubst) -> TrNode -> TrNode +changeMetaSubst f (N (b,a,v,(c,m),x)) = N (b,a,v,(c, f m),x) + +changeAtom :: (Atom -> Atom) -> TrNode -> TrNode +changeAtom f (N (b,a,v,(c,m),x)) = N (b,f a,v,(c, m),x) + +-- * on the way to Edit + +uTree :: Tree +uTree = Tr (uNode, []) -- unknown tree + +uNode :: TrNode +uNode = mkNode [] uAtom uVal ([],[]) + + +uAtom :: Atom +uAtom = AtM meta0 + +mAtom :: Atom +mAtom = AtM meta0 + +uVal :: Val +uVal = vClos uExp + +vClos :: Exp -> Val +vClos = VClos [] + +uExp :: Exp +uExp = Meta meta0 + +mExp, mExp0 :: Exp +mExp = Meta meta0 +mExp0 = mExp + +meta2exp :: MetaSymb -> Exp +meta2exp = Meta + +atomC :: Fun -> Atom +atomC = AtC + +funAtom :: Atom -> Err Fun +funAtom a = case a of + AtC f -> return f + _ -> prtBad "not function head" a + +atomIsMeta :: Atom -> Bool +atomIsMeta atom = case atom of + AtM _ -> True + _ -> False + +getMetaAtom :: Atom -> Err Meta +getMetaAtom a = case a of + AtM m -> return m + _ -> Bad "the active node is not meta" + +cat2val :: Context -> Cat -> Val +cat2val cont cat = vClos $ mkApp (qq cat) [mkMeta i | i <- [1..length cont]] + +val2cat :: Val -> Err Cat +val2cat v = val2exp v >>= valCat + +substTerm :: [Ident] -> Substitution -> Term -> Term +substTerm ss g c = case c of + Vr x -> maybe c id $ lookup x g + App f a -> App (substTerm ss g f) (substTerm ss g a) + Abs x b -> let y = mkFreshVarX ss x in + Abs y (substTerm (y:ss) ((x, Vr y):g) b) + Prod x a b -> let y = mkFreshVarX ss x in + Prod y (substTerm ss g a) (substTerm (y:ss) ((x,Vr y):g) b) + _ -> c + +metaSubstExp :: MetaSubst -> [(Meta,Exp)] +metaSubstExp msubst = [(m, errVal (meta2exp m) (val2expSafe v)) | (m,v) <- msubst] + +-- * belong here rather than to computation + +substitute :: [Var] -> Substitution -> Exp -> Err Exp +substitute v s = return . substTerm v s + +alphaConv :: [Var] -> (Var,Var) -> Exp -> Err Exp --- +alphaConv oldvars (x,x') = substitute (x:x':oldvars) [(x,Vr x')] + +alphaFresh :: [Var] -> Exp -> Err Exp +alphaFresh vs = refreshTermN $ maxVarIndex vs + +-- | done in a state monad +alphaFreshAll :: [Var] -> [Exp] -> Err [Exp] +alphaFreshAll vs = mapM $ alphaFresh vs + +-- | for display +val2exp :: Val -> Err Exp +val2exp = val2expP False + +-- | for type checking +val2expSafe :: Val -> Err Exp +val2expSafe = val2expP True + +val2expP :: Bool -> Val -> Err Exp +val2expP safe v = case v of + + VClos g@(_:_) e@(Meta _) -> if safe + then prtBad "unsafe value substitution" v + else substVal g e + VClos g e -> substVal g e + VApp f c -> liftM2 App (val2expP safe f) (val2expP safe c) + VCn c -> return $ qq c + VGen i x -> if safe + then prtBad "unsafe val2exp" v + else return $ Vr $ x --- in editing, no alpha conversions presentv + where + substVal g e = mapPairsM (val2expP safe) g >>= return . (\s -> substTerm [] s e) + +isConstVal :: Val -> Bool +isConstVal v = case v of + VApp f c -> isConstVal f && isConstVal c + VCn _ -> True + VClos [] e -> null $ freeVarsExp e + _ -> False --- could be more liberal + +mkProdVal :: Binds -> Val -> Err Val --- +mkProdVal bs v = do + bs' <- mapPairsM val2exp bs + v' <- val2exp v + return $ vClos $ foldr (uncurry Prod) v' bs' + +freeVarsExp :: Exp -> [Ident] +freeVarsExp e = case e of + Vr x -> [x] + App f c -> freeVarsExp f ++ freeVarsExp c + Abs x b -> filter (/=x) (freeVarsExp b) + Prod x a b -> freeVarsExp a ++ filter (/=x) (freeVarsExp b) + _ -> [] --- thus applies to abstract syntax only + +ident2string :: Ident -> String +ident2string = prIdent + +tree :: (TrNode,[Tree]) -> Tree +tree = Tr + +eqCat :: Cat -> Cat -> Bool +eqCat = (==) + +addBinds :: Binds -> Tree -> Tree +addBinds b (Tr (N (b0,at,t,c,x),ts)) = Tr (N (b ++ b0,at,t,c,x),ts) + +bodyTree :: Tree -> Tree +bodyTree (Tr (N (_,a,t,c,x),ts)) = Tr (N ([],a,t,c,x),ts) + +refreshMetas :: [Meta] -> Exp -> Exp +refreshMetas metas = fst . rms minMeta where + rms meta trm = case trm of + Meta m -> (Meta meta, nextMeta meta) + App f a -> let (f',msf) = rms meta f + (a',msa) = rms msf a + in (App f' a', msa) + Prod x a b -> + let (a',msa) = rms meta a + (b',msb) = rms msa b + in (Prod x a' b', msb) + Abs x b -> let (b',msb) = rms meta b in (Abs x b', msb) + _ -> (trm,meta) + minMeta = int2meta $ + if null metas then 0 else (maximum (map metaSymbInt metas) + 1) + +ref2exp :: [Var] -> Type -> Ref -> Err Exp +ref2exp bounds typ ref = do + cont <- contextOfType typ + xx0 <- mapM (typeSkeleton . snd) cont + let (xxs,cs) = unzip [(length hs, c) | (hs,c) <- xx0] + args = [mkAbs xs mExp | i <- xxs, let xs = mkFreshVars i bounds] + return $ mkApp ref args + -- no refreshment of metas + +-- | invariant: only 'Con' or 'Var' +type Ref = Exp + +fun2wrap :: [Var] -> ((Fun,Int),Type) -> Exp -> Err Exp +fun2wrap oldvars ((fun,i),typ) exp = do + cont <- contextOfType typ + args <- mapM mkArg (zip [0..] (map snd cont)) + return $ mkApp (qq fun) args + where + mkArg (n,c) = do + cont <- contextOfType c + let vars = mkFreshVars (length cont) oldvars + return $ mkAbs vars $ if n==i then exp else mExp + +-- | weak heuristics: sameness of value category +compatType :: Val -> Type -> Bool +compatType v t = errVal True $ do + cat1 <- val2cat v + cat2 <- valCat t + return $ cat1 == cat2 + +--- + +mkJustProd :: Context -> Term -> Term +mkJustProd cont typ = mkProd (cont,typ,[]) + +int2var :: Int -> Ident +int2var = identC . BS.pack . ('$':) . show + +meta0 :: Meta +meta0 = int2meta 0 + +termMeta0 :: Term +termMeta0 = Meta meta0 + +identVar :: Term -> Err Ident +identVar (Vr x) = return x +identVar _ = Bad "not a variable" + + +-- | light-weight rename for user interaction; also change names of internal vars +qualifTerm :: Ident -> Term -> Term +qualifTerm m = qualif [] where + qualif xs t = case t of + Abs x b -> let x' = chV x in Abs x' $ qualif (x':xs) b + Prod x a b -> Prod x (qualif xs a) $ qualif (x:xs) b + Vr x -> let x' = chV x in if (elem x' xs) then (Vr x') else (Q m x) + Cn c -> Q m c + Con c -> QC m c + _ -> composSafeOp (qualif xs) t + chV x = string2var $ ident2bs x + +string2var :: BS.ByteString -> Ident +string2var s = case BS.unpack s of + c:'_':i -> identV (BS.singleton c) (readIntArg i) --- + _ -> identC s + +-- | reindex variables so that they tell nesting depth level +reindexTerm :: Term -> Term +reindexTerm = qualif (0,[]) where + qualif dg@(d,g) t = case t of + Abs x b -> let x' = ind x d in Abs x' $ qualif (d+1, (x,x'):g) b + Prod x a b -> let x' = ind x d in Prod x' (qualif dg a) $ qualif (d+1, (x,x'):g) b + Vr x -> Vr $ look x g + _ -> composSafeOp (qualif dg) t + look x = maybe x id . lookup x --- if x is not in scope it is unchanged + ind x d = identC $ ident2bs x `BS.append` BS.singleton '_' `BS.append` BS.pack (show d) + + +-- this method works for context-free abstract syntax +-- and is meant to be used in simple embedded GF applications + +exp2tree :: Exp -> Err Tree +exp2tree e = do + (bs,f,xs) <- termForm e + cont <- case bs of + [] -> return [] + _ -> prtBad "cannot convert bindings in" e + at <- case f of + Q m c -> return $ AtC (m,c) + QC m c -> return $ AtC (m,c) + Meta m -> return $ AtM m + K s -> return $ AtL s + EInt n -> return $ AtI n + EFloat n -> return $ AtF n + _ -> prtBad "cannot convert to atom" f + ts <- mapM exp2tree xs + return $ Tr (N (cont,at,uVal,([],[]),True),ts) diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs new file mode 100644 index 000000000..be03c02a7 --- /dev/null +++ b/src/GF/Grammar/Macros.hs @@ -0,0 +1,733 @@ +---------------------------------------------------------------------- +-- | +-- Module : Macros +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/11 16:38:00 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.24 $ +-- +-- Macros for constructing and analysing source code terms. +-- +-- operations on terms and types not involving lookup in or reference to grammars +-- +-- AR 7\/12\/1999 - 9\/5\/2000 -- 4\/6\/2001 +----------------------------------------------------------------------------- + +module GF.Grammar.Macros where + +import GF.Data.Operations +import GF.Data.Str +import GF.Infra.Ident +import GF.Grammar.Grammar +import GF.Grammar.Values +import GF.Grammar.Predef +import GF.Grammar.PrGrammar + +import Control.Monad (liftM, liftM2) +import Data.Char (isDigit) +import Data.List (sortBy) + +firstTypeForm :: Type -> Err (Context, Type) +firstTypeForm t = case t of + Prod x a b -> do + (x', val) <- firstTypeForm b + return ((x,a):x',val) + _ -> return ([],t) + +qTypeForm :: Type -> Err (Context, Cat, [Term]) +qTypeForm t = case t of + Prod x a b -> do + (x', cat, args) <- qTypeForm b + return ((x,a):x', cat, args) + App c a -> do + (_,cat, args) <- qTypeForm c + return ([],cat,args ++ [a]) + Q m c -> + return ([],(m,c),[]) + QC m c -> + return ([],(m,c),[]) + _ -> + prtBad "no normal form of type" t + +qq :: QIdent -> Term +qq (m,c) = Q m c + +typeForm :: Type -> Err (Context, Cat, [Term]) +typeForm = qTypeForm ---- no need to distinguish any more + +typeFormCnc :: Type -> Err (Context, Type) +typeFormCnc t = case t of + Prod x a b -> do + (x', v) <- typeFormCnc b + return ((x,a):x',v) + _ -> return ([],t) + +valCat :: Type -> Err Cat +valCat typ = + do (_,cat,_) <- typeForm typ + return cat + +valType :: Type -> Err Type +valType typ = + do (_,cat,xx) <- typeForm typ --- not optimal to do in this way + return $ mkApp (qq cat) xx + +valTypeCnc :: Type -> Err Type +valTypeCnc typ = + do (_,ty) <- typeFormCnc typ + return ty + +typeRawSkeleton :: Type -> Err ([(Int,Type)],Type) +typeRawSkeleton typ = + do (cont,typ) <- typeFormCnc typ + args <- mapM (typeRawSkeleton . snd) cont + return ([(length c, v) | (c,v) <- args], typ) + +type MCat = (Ident,Ident) + +getMCat :: Term -> Err MCat +getMCat t = case t of + Q m c -> return (m,c) + QC m c -> return (m,c) + Sort c -> return (identW, c) + App f _ -> getMCat f + _ -> prtBad "no qualified constant" t + +typeSkeleton :: Type -> Err ([(Int,MCat)],MCat) +typeSkeleton typ = do + (cont,val) <- typeRawSkeleton typ + cont' <- mapPairsM getMCat cont + val' <- getMCat val + return (cont',val') + +catSkeleton :: Type -> Err ([MCat],MCat) +catSkeleton typ = + do (args,val) <- typeSkeleton typ + return (map snd args, val) + +funsToAndFrom :: Type -> (MCat, [(MCat,[Int])]) +funsToAndFrom t = errVal undefined $ do --- + (cs,v) <- catSkeleton t + let cis = zip cs [0..] + return $ (v, [(c,[i | (c',i) <- cis, c' == c]) | c <- cs]) + +typeFormConcrete :: Type -> Err (Context, Type) +typeFormConcrete t = case t of + Prod x a b -> do + (x', typ) <- typeFormConcrete b + return ((x,a):x', typ) + _ -> return ([],t) + +isRecursiveType :: Type -> Bool +isRecursiveType t = errVal False $ do + (cc,c) <- catSkeleton t -- thus recursivity on Cat level + return $ any (== c) cc + +isHigherOrderType :: Type -> Bool +isHigherOrderType t = errVal True $ do -- pessimistic choice + co <- contextOfType t + return $ not $ null [x | (x,Prod _ _ _) <- co] + +contextOfType :: Type -> Err Context +contextOfType typ = case typ of + Prod x a b -> liftM ((x,a):) $ contextOfType b + _ -> return [] + +unComputed :: Term -> Term +unComputed t = case t of + Computed v -> unComputed v + _ -> t --- composSafeOp unComputed t + + +{- +--- defined (better) in compile/PrOld + +stripTerm :: Term -> Term +stripTerm t = case t of + Q _ c -> Cn c + QC _ c -> Cn c + T ti psts -> T ti [(stripPatt p, stripTerm v) | (p,v) <- psts] + _ -> composSafeOp stripTerm t + where + stripPatt p = errVal p $ term2patt $ stripTerm $ patt2term p +-} + +computed :: Term -> Term +computed = Computed + +termForm :: Term -> Err ([(Ident)], Term, [Term]) +termForm t = case t of + Abs x b -> + do (x', fun, args) <- termForm b + return (x:x', fun, args) + App c a -> + do (_,fun, args) <- termForm c + return ([],fun,args ++ [a]) + _ -> + return ([],t,[]) + +termFormCnc :: Term -> ([(Ident)], Term) +termFormCnc t = case t of + Abs x b -> (x:xs, t') where (xs,t') = termFormCnc b + _ -> ([],t) + +appForm :: Term -> (Term, [Term]) +appForm t = case t of + App c a -> (fun, args ++ [a]) where (fun, args) = appForm c + _ -> (t,[]) + +varsOfType :: Type -> [Ident] +varsOfType t = case t of + Prod x _ b -> x : varsOfType b + _ -> [] + +mkProdSimple :: Context -> Term -> Term +mkProdSimple c t = mkProd (c,t,[]) + +mkProd :: (Context, Term, [Term]) -> Term +mkProd ([],typ,args) = mkApp typ args +mkProd ((x,a):dd, typ, args) = Prod x a (mkProd (dd, typ, args)) + +mkTerm :: ([(Ident)], Term, [Term]) -> Term +mkTerm (xx,t,aa) = mkAbs xx (mkApp t aa) + +mkApp :: Term -> [Term] -> Term +mkApp = foldl App + +mkAbs :: [Ident] -> Term -> Term +mkAbs xx t = foldr Abs t xx + +appCons :: Ident -> [Term] -> Term +appCons = mkApp . Cn + +mkLet :: [LocalDef] -> Term -> Term +mkLet defs t = foldr Let t defs + +mkLetUntyped :: Context -> Term -> Term +mkLetUntyped defs = mkLet [(x,(Nothing,t)) | (x,t) <- defs] + +isVariable :: Term -> Bool +isVariable (Vr _ ) = True +isVariable _ = False + +eqIdent :: Ident -> Ident -> Bool +eqIdent = (==) + +uType :: Type +uType = Cn cUndefinedType + +assign :: Label -> Term -> Assign +assign l t = (l,(Nothing,t)) + +assignT :: Label -> Type -> Term -> Assign +assignT l a t = (l,(Just a,t)) + +unzipR :: [Assign] -> ([Label],[Term]) +unzipR r = (ls, map snd ts) where (ls,ts) = unzip r + +mkAssign :: [(Label,Term)] -> [Assign] +mkAssign lts = [assign l t | (l,t) <- lts] + +zipAssign :: [Label] -> [Term] -> [Assign] +zipAssign ls ts = [assign l t | (l,t) <- zip ls ts] + +mapAssignM :: Monad m => (Term -> m c) -> [Assign] -> m [(Label,(Maybe c,c))] +mapAssignM f = mapM (\ (ls,tv) -> liftM ((,) ls) (g tv)) + where g (t,v) = liftM2 (,) (maybe (return Nothing) (liftM Just . f) t) (f v) + +mkRecordN :: Int -> (Int -> Label) -> [Term] -> Term +mkRecordN int lab typs = R [ assign (lab i) t | (i,t) <- zip [int..] typs] + +mkRecord :: (Int -> Label) -> [Term] -> Term +mkRecord = mkRecordN 0 + +mkRecTypeN :: Int -> (Int -> Label) -> [Type] -> Type +mkRecTypeN int lab typs = RecType [ (lab i, t) | (i,t) <- zip [int..] typs] + +mkRecType :: (Int -> Label) -> [Type] -> Type +mkRecType = mkRecTypeN 0 + +record2subst :: Term -> Err Substitution +record2subst t = case t of + R fs -> return [(identC x, t) | (LIdent x,(_,t)) <- fs] + _ -> prtBad "record expected, found" t + +typeType, typePType, typeStr, typeTok, typeStrs :: Term + +typeType = Sort cType +typePType = Sort cPType +typeStr = Sort cStr +typeTok = Sort cTok +typeStrs = Sort cStrs + +typeString, typeFloat, typeInt :: Term +typeInts :: Integer -> Term +typePBool :: Term +typeError :: Term + +typeString = cnPredef cString +typeInt = cnPredef cInt +typeFloat = cnPredef cFloat +typeInts i = App (cnPredef cInts) (EInt i) +typePBool = cnPredef cPBool +typeError = cnPredef cErrorType + +isTypeInts :: Term -> Maybe Integer +isTypeInts (App c (EInt i)) | c == cnPredef cInts = Just i +isTypeInts _ = Nothing + +isPredefConstant :: Term -> Bool +isPredefConstant t = case t of + Q mod _ | mod == cPredef || mod == cPredefAbs -> True + _ -> False + +cnPredef :: Ident -> Term +cnPredef f = Q cPredef f + +mkSelects :: Term -> [Term] -> Term +mkSelects t tt = foldl S t tt + +mkTable :: [Term] -> Term -> Term +mkTable tt t = foldr Table t tt + +mkCTable :: [Ident] -> Term -> Term +mkCTable ids v = foldr ccase v ids where + ccase x t = T TRaw [(PV x,t)] + +mkDecl :: Term -> Decl +mkDecl typ = (identW, typ) + +eqStrIdent :: Ident -> Ident -> Bool +eqStrIdent = (==) + +tuple2record :: [Term] -> [Assign] +tuple2record ts = [assign (tupleLabel i) t | (i,t) <- zip [1..] ts] + +tuple2recordType :: [Term] -> [Labelling] +tuple2recordType ts = [(tupleLabel i, t) | (i,t) <- zip [1..] ts] + +tuple2recordPatt :: [Patt] -> [(Label,Patt)] +tuple2recordPatt ts = [(tupleLabel i, t) | (i,t) <- zip [1..] ts] + +mkCases :: Ident -> Term -> Term +mkCases x t = T TRaw [(PV x, t)] + +mkWildCases :: Term -> Term +mkWildCases = mkCases identW + +mkFunType :: [Type] -> Type -> Type +mkFunType tt t = mkProd ([(identW, ty) | ty <- tt], t, []) -- nondep prod + +plusRecType :: Type -> Type -> Err Type +plusRecType t1 t2 = case (unComputed t1, unComputed t2) of + (RecType r1, RecType r2) -> case + filter (`elem` (map fst r1)) (map fst r2) of + [] -> return (RecType (r1 ++ r2)) + ls -> Bad $ "clashing labels" +++ unwords (map prt ls) + _ -> Bad ("cannot add record types" +++ prt t1 +++ "and" +++ prt t2) + +plusRecord :: Term -> Term -> Err Term +plusRecord t1 t2 = + case (t1,t2) of + (R r1, R r2 ) -> return (R ([(l,v) | -- overshadowing of old fields + (l,v) <- r1, not (elem l (map fst r2)) ] ++ r2)) + (_, FV rs) -> mapM (plusRecord t1) rs >>= return . FV + (FV rs,_ ) -> mapM (`plusRecord` t2) rs >>= return . FV + _ -> Bad ("cannot add records" +++ prt t1 +++ "and" +++ prt t2) + +-- | default linearization type +defLinType :: Type +defLinType = RecType [(theLinLabel, typeStr)] + +-- | refreshing variables +mkFreshVar :: [Ident] -> Ident +mkFreshVar olds = varX (maxVarIndex olds + 1) + +-- | trying to preserve a given symbol +mkFreshVarX :: [Ident] -> Ident -> Ident +mkFreshVarX olds x = if (elem x olds) then (varX (maxVarIndex olds + 1)) else x + +maxVarIndex :: [Ident] -> Int +maxVarIndex = maximum . ((-1):) . map varIndex + +mkFreshVars :: Int -> [Ident] -> [Ident] +mkFreshVars n olds = [varX (maxVarIndex olds + i) | i <- [1..n]] + +-- | quick hack for refining with var in editor +freshAsTerm :: String -> Term +freshAsTerm s = Vr (varX (readIntArg s)) + +-- | create a terminal for concrete syntax +string2term :: String -> Term +string2term = K + +int2term :: Integer -> Term +int2term = EInt + +float2term :: Double -> Term +float2term = EFloat + +-- | create a terminal from identifier +ident2terminal :: Ident -> Term +ident2terminal = K . prIdent + +symbolOfIdent :: Ident -> String +symbolOfIdent = prIdent + +symid :: Ident -> String +symid = symbolOfIdent + +justIdentOf :: Term -> Maybe Ident +justIdentOf (Vr x) = Just x +justIdentOf (Cn x) = Just x +justIdentOf _ = Nothing + +isMeta :: Term -> Bool +isMeta (Meta _) = True +isMeta _ = False + +mkMeta :: Int -> Term +mkMeta = Meta . MetaSymb + +nextMeta :: MetaSymb -> MetaSymb +nextMeta = int2meta . succ . metaSymbInt + +int2meta :: Int -> MetaSymb +int2meta = MetaSymb + +metaSymbInt :: MetaSymb -> Int +metaSymbInt (MetaSymb k) = k + +freshMeta :: [MetaSymb] -> MetaSymb +freshMeta ms = MetaSymb (minimum [n | n <- [0..length ms], + notElem n (map metaSymbInt ms)]) + +mkFreshMetasInTrm :: [MetaSymb] -> Trm -> Trm +mkFreshMetasInTrm metas = fst . rms minMeta where + rms meta trm = case trm of + Meta m -> (Meta (MetaSymb meta), meta + 1) + App f a -> let (f',msf) = rms meta f + (a',msa) = rms msf a + in (App f' a', msa) + Prod x a b -> + let (a',msa) = rms meta a + (b',msb) = rms msa b + in (Prod x a' b', msb) + Abs x b -> let (b',msb) = rms meta b in (Abs x b', msb) + _ -> (trm,meta) + minMeta = if null metas then 0 else (maximum (map metaSymbInt metas) + 1) + +-- | decides that a term has no metavariables +isCompleteTerm :: Term -> Bool +isCompleteTerm t = case t of + Meta _ -> False + Abs _ b -> isCompleteTerm b + App f a -> isCompleteTerm f && isCompleteTerm a + _ -> True + +linTypeStr :: Type +linTypeStr = mkRecType linLabel [typeStr] -- default lintype {s :: Str} + +linAsStr :: String -> Term +linAsStr s = mkRecord linLabel [K s] -- default linearization {s = s} + +term2patt :: Term -> Err Patt +term2patt trm = case termForm trm of + Ok ([], Vr x, []) -> return (PV x) + Ok ([], Val ty x, []) -> return (PVal ty x) + Ok ([], Con c, aa) -> do + aa' <- mapM term2patt aa + return (PC c aa') + Ok ([], QC p c, aa) -> do + aa' <- mapM term2patt aa + return (PP p c aa') + + Ok ([], Q p c, []) -> do + return (PM p c) + + Ok ([], R r, []) -> do + let (ll,aa) = unzipR r + aa' <- mapM term2patt aa + return (PR (zip ll aa')) + Ok ([],EInt i,[]) -> return $ PInt i + Ok ([],EFloat i,[]) -> return $ PFloat i + Ok ([],K s, []) -> return $ PString s + +--- encodings due to excessive use of term-patt convs. AR 7/1/2005 + Ok ([], Cn id, [Vr a,b]) | id == cAs -> do + b' <- term2patt b + return (PAs a b') + Ok ([], Cn id, [a]) | id == cNeg -> do + a' <- term2patt a + return (PNeg a') + Ok ([], Cn id, [a]) | id == cRep -> do + a' <- term2patt a + return (PRep a') + Ok ([], Cn id, []) | id == cRep -> do + return PChar + Ok ([], Cn id,[K s]) | id == cChars -> do + return $ PChars s + Ok ([], Cn id, [a,b]) | id == cSeq -> do + a' <- term2patt a + b' <- term2patt b + return (PSeq a' b') + Ok ([], Cn id, [a,b]) | id == cAlt -> do + a' <- term2patt a + b' <- term2patt b + return (PAlt a' b') + + Ok ([], Cn c, []) -> do + return (PMacro c) + + _ -> prtBad "no pattern corresponds to term" trm + +patt2term :: Patt -> Term +patt2term pt = case pt of + PV x -> Vr x + PW -> Vr identW --- not parsable, should not occur + PVal t i -> Val t i + PMacro c -> Cn c + PM p c -> Q p c + + PC c pp -> mkApp (Con c) (map patt2term pp) + PP p c pp -> mkApp (QC p c) (map patt2term pp) + + PR r -> R [assign l (patt2term p) | (l,p) <- r] + PT _ p -> patt2term p + PInt i -> EInt i + PFloat i -> EFloat i + PString s -> K s + + PAs x p -> appCons cAs [Vr x, patt2term p] --- an encoding + PChar -> appCons cChar [] --- an encoding + PChars s -> appCons cChars [K s] --- an encoding + PSeq a b -> appCons cSeq [(patt2term a), (patt2term b)] --- an encoding + PAlt a b -> appCons cAlt [(patt2term a), (patt2term b)] --- an encoding + PRep a -> appCons cRep [(patt2term a)] --- an encoding + PNeg a -> appCons cNeg [(patt2term a)] --- an encoding + + +redirectTerm :: Ident -> Term -> Term +redirectTerm n t = case t of + QC _ f -> QC n f + Q _ f -> Q n f + _ -> composSafeOp (redirectTerm n) t + +-- | to gather ultimate cases in a table; preserves pattern list +allCaseValues :: Term -> [([Patt],Term)] +allCaseValues trm = case unComputed trm of + T _ cs -> [(p:ps, t) | (p,t0) <- cs, (ps,t) <- allCaseValues t0] + _ -> [([],trm)] + +-- | to get a string from a term that represents a sequence of terminals +strsFromTerm :: Term -> Err [Str] +strsFromTerm t = case unComputed t of + K s -> return [str s] + Empty -> return [str []] + C s t -> do + s' <- strsFromTerm s + t' <- strsFromTerm t + return [plusStr x y | x <- s', y <- t'] + Glue s t -> do + s' <- strsFromTerm s + t' <- strsFromTerm t + return [glueStr x y | x <- s', y <- t'] + Alts (d,vs) -> do + d0 <- strsFromTerm d + v0 <- mapM (strsFromTerm . fst) vs + c0 <- mapM (strsFromTerm . snd) vs + let vs' = zip v0 c0 + return [strTok (str2strings def) vars | + def <- d0, + vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | + vv <- combinations v0] + ] + FV ts -> mapM strsFromTerm ts >>= return . concat + Strs ts -> mapM strsFromTerm ts >>= return . concat + Ready ss -> return [ss] + Alias _ _ d -> strsFromTerm d --- should not be needed... + _ -> prtBad "cannot get Str from term" t + +-- | to print an Str-denoting term as a string; if the term is of wrong type, the error msg +stringFromTerm :: Term -> String +stringFromTerm = err id (ifNull "" (sstr . head)) . strsFromTerm + + +-- | to define compositional term functions +composSafeOp :: (Term -> Term) -> Term -> Term +composSafeOp op trm = case composOp (mkMonadic op) trm of + Ok t -> t + _ -> error "the operation is safe isn't it ?" + where + mkMonadic f = return . f + +-- | to define compositional term functions +composOp :: Monad m => (Term -> m Term) -> Term -> m Term +composOp co trm = + case trm of + App c a -> + do c' <- co c + a' <- co a + return (App c' a') + Abs x b -> + do b' <- co b + return (Abs x b') + Prod x a b -> + do a' <- co a + b' <- co b + return (Prod x a' b') + S c a -> + do c' <- co c + a' <- co a + return (S c' a') + Table a c -> + do a' <- co a + c' <- co c + return (Table a' c') + R r -> + do r' <- mapAssignM co r + return (R r') + RecType r -> + do r' <- mapPairListM (co . snd) r + return (RecType r') + P t i -> + do t' <- co t + return (P t' i) + PI t i j -> + do t' <- co t + return (PI t' i j) + ExtR a c -> + do a' <- co a + c' <- co c + return (ExtR a' c') + + T i cc -> + do cc' <- mapPairListM (co . snd) cc + i' <- changeTableType co i + return (T i' cc') + + TSh i cc -> + do cc' <- mapPairListM (co . snd) cc + i' <- changeTableType co i + return (TSh i' cc') + + Eqs cc -> + do cc' <- mapPairListM (co . snd) cc + return (Eqs cc') + + V ty vs -> + do ty' <- co ty + vs' <- mapM co vs + return (V ty' vs') + + Val ty i -> + do ty' <- co ty + return (Val ty' i) + + Let (x,(mt,a)) b -> + do a' <- co a + mt' <- case mt of + Just t -> co t >>= (return . Just) + _ -> return mt + b' <- co b + return (Let (x,(mt',a')) b') + Alias c ty d -> + do v <- co d + ty' <- co ty + return $ Alias c ty' v + C s1 s2 -> + do v1 <- co s1 + v2 <- co s2 + return (C v1 v2) + Glue s1 s2 -> + do v1 <- co s1 + v2 <- co s2 + return (Glue v1 v2) + Alts (t,aa) -> + do t' <- co t + aa' <- mapM (pairM co) aa + return (Alts (t',aa')) + FV ts -> mapM co ts >>= return . FV + Strs tt -> mapM co tt >>= return . Strs + + EPattType ty -> + do ty' <- co ty + return (EPattType ty') + + _ -> return trm -- covers K, Vr, Cn, Sort, EPatt + +getTableType :: TInfo -> Err Type +getTableType i = case i of + TTyped ty -> return ty + TComp ty -> return ty + TWild ty -> return ty + _ -> Bad "the table is untyped" + +changeTableType :: Monad m => (Type -> m Type) -> TInfo -> m TInfo +changeTableType co i = case i of + TTyped ty -> co ty >>= return . TTyped + TComp ty -> co ty >>= return . TComp + TWild ty -> co ty >>= return . TWild + _ -> return i + +collectOp :: (Term -> [a]) -> Term -> [a] +collectOp co trm = case trm of + App c a -> co c ++ co a + Abs _ b -> co b + Prod _ a b -> co a ++ co b + S c a -> co c ++ co a + Table a c -> co a ++ co c + ExtR a c -> co a ++ co c + R r -> concatMap (\ (_,(mt,a)) -> maybe [] co mt ++ co a) r + RecType r -> concatMap (co . snd) r + P t i -> co t + T _ cc -> concatMap (co . snd) cc -- not from patterns --- nor from type annot + TSh _ cc -> concatMap (co . snd) cc -- not from patterns --- nor from type annot + V _ cc -> concatMap co cc --- nor from type annot + Let (x,(mt,a)) b -> maybe [] co mt ++ co a ++ co b + C s1 s2 -> co s1 ++ co s2 + Glue s1 s2 -> co s1 ++ co s2 + Alts (t,aa) -> let (x,y) = unzip aa in co t ++ concatMap co (x ++ y) + FV ts -> concatMap co ts + Strs tt -> concatMap co tt + _ -> [] -- covers K, Vr, Cn, Sort, Ready + +-- | to find the word items in a term +wordsInTerm :: Term -> [String] +wordsInTerm trm = filter (not . null) $ case trm of + K s -> [s] + S c _ -> wo c + Alts (t,aa) -> wo t ++ concatMap (wo . fst) aa + Ready s -> allItems s + _ -> collectOp wo trm + where wo = wordsInTerm + +noExist :: Term +noExist = FV [] + +defaultLinType :: Type +defaultLinType = mkRecType linLabel [typeStr] + +metaTerms :: [Term] +metaTerms = map (Meta . MetaSymb) [0..] + +-- | from GF1, 20\/9\/2003 +isInOneType :: Type -> Bool +isInOneType t = case t of + Prod _ a b -> a == b + _ -> False + +-- normalize records and record types; put s first + +sortRec :: [(Label,a)] -> [(Label,a)] +sortRec = sortBy ordLabel where + ordLabel (r1,_) (r2,_) = case (prt r1, prt r2) of + ("s",_) -> LT + (_,"s") -> GT + (s1,s2) -> compare s1 s2 + + + diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs new file mode 100644 index 000000000..b96d35b93 --- /dev/null +++ b/src/GF/Grammar/PatternMatch.hs @@ -0,0 +1,155 @@ +---------------------------------------------------------------------- +-- | +-- Module : PatternMatch +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/10/12 12:38:29 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.7 $ +-- +-- pattern matching for both concrete and abstract syntax. AR -- 16\/6\/2003 +----------------------------------------------------------------------------- + +module GF.Grammar.PatternMatch (matchPattern, + testOvershadow, + findMatch + ) where + +import GF.Data.Operations +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Grammar.Macros +import GF.Grammar.PrGrammar + +import Data.List +import Control.Monad + + +matchPattern :: [(Patt,Term)] -> Term -> Err (Term, Substitution) +matchPattern pts term = + if not (isInConstantForm term) + then prtBad "variables occur in" term + else + errIn ("trying patterns" +++ unwords (intersperse "," (map (prt . fst) pts))) $ + findMatch [([p],t) | (p,t) <- pts] [term] + +testOvershadow :: [Patt] -> [Term] -> Err [Patt] +testOvershadow pts vs = do + let numpts = zip pts [0..] + let cases = [(p,EInt i) | (p,i) <- numpts] + ts <- mapM (liftM fst . matchPattern cases) vs + return $ [p | (p,i) <- numpts, notElem i [i | EInt i <- ts] ] + +findMatch :: [([Patt],Term)] -> [Term] -> Err (Term, Substitution) +findMatch cases terms = case cases of + [] -> Bad $"no applicable case for" +++ unwords (intersperse "," (map prt terms)) + (patts,_):_ | length patts /= length terms -> + Bad ("wrong number of args for patterns :" +++ + unwords (map prt patts) +++ "cannot take" +++ unwords (map prt terms)) + (patts,val):cc -> case mapM tryMatch (zip patts terms) of + Ok substs -> return (val, concat substs) + _ -> findMatch cc terms + +tryMatch :: (Patt, Term) -> Err [(Ident, Term)] +tryMatch (p,t) = do + t' <- termForm t + trym p t' + where + isInConstantFormt = True -- tested already + trym p t' = + case (p,t') of + (PVal _ i, (_,Val _ j,_)) + | i == j -> return [] + | otherwise -> Bad $ "no match of values" + (_,(x,Empty,y)) -> trym p (x,K [],y) -- because "" = [""] = [] + (PV IW, _) | isInConstantFormt -> return [] -- optimization with wildcard + (PV x, _) | isInConstantFormt -> return [(x,t)] + (PString s, ([],K i,[])) | s==i -> return [] + (PInt s, ([],EInt i,[])) | s==i -> return [] + (PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding? + (PC p pp, ([], Con f, tt)) | + p `eqStrIdent` f && length pp == length tt -> + do matches <- mapM tryMatch (zip pp tt) + return (concat matches) + + (PP q p pp, ([], QC r f, tt)) | + -- q `eqStrIdent` r && --- not for inherited AR 10/10/2005 + p `eqStrIdent` f && length pp == length tt -> + do matches <- mapM tryMatch (zip pp tt) + return (concat matches) + ---- hack for AppPredef bug + (PP q p pp, ([], Q r f, tt)) | + -- q `eqStrIdent` r && --- + p `eqStrIdent` f && length pp == length tt -> + do matches <- mapM tryMatch (zip pp tt) + return (concat matches) + + (PR r, ([],R r',[])) | + all (`elem` map fst r') (map fst r) -> + do matches <- mapM tryMatch + [(p,snd a) | (l,p) <- r, let Just a = lookup l r'] + return (concat matches) + (PT _ p',_) -> trym p' t' + (_, ([],Alias _ _ d,[])) -> tryMatch (p,d) + +-- (PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do + + (PAs x p',_) -> do + subst <- trym p' t' + return $ (x,t) : subst + + (PAlt p1 p2,_) -> checks [trym p1 t', trym p2 t'] + + (PNeg p',_) -> case tryMatch (p',t) of + Bad _ -> return [] + _ -> prtBad "no match with negative pattern" p + + (PSeq p1 p2, ([],K s, [])) -> do + let cuts = [splitAt n s | n <- [0 .. length s]] + matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts] + return (concat matches) + + (PRep p1, ([],K s, [])) -> checks [ + trym (foldr (const (PSeq p1)) (PString "") + [1..n]) t' | n <- [0 .. length s] + ] >> + return [] + + (PChar, ([],K [_], [])) -> return [] + (PChars cs, ([],K [c], [])) | elem c cs -> return [] + + _ -> prtBad "no match in case expr for" t + +isInConstantForm :: Term -> Bool +isInConstantForm trm = case trm of + Cn _ -> True + Con _ -> True + Q _ _ -> True + QC _ _ -> True + Abs _ _ -> True + App c a -> isInConstantForm c && isInConstantForm a + R r -> all (isInConstantForm . snd . snd) r + K _ -> True + Empty -> True + Alias _ _ t -> isInConstantForm t + EInt _ -> True + _ -> False ---- isInArgVarForm trm + +varsOfPatt :: Patt -> [Ident] +varsOfPatt p = case p of + PV x -> [x | not (isWildIdent x)] + PC _ ps -> concat $ map varsOfPatt ps + PP _ _ ps -> concat $ map varsOfPatt ps + PR r -> concat $ map (varsOfPatt . snd) r + PT _ q -> varsOfPatt q + _ -> [] + +-- | to search matching parameter combinations in tables +isMatchingForms :: [Patt] -> [Term] -> Bool +isMatchingForms ps ts = all match (zip ps ts') where + match (PC c cs, (Cn d, ds)) = c == d && isMatchingForms cs ds + match _ = True + ts' = map appForm ts + diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs new file mode 100644 index 000000000..c1593dd63 --- /dev/null +++ b/src/GF/Grammar/PrGrammar.hs @@ -0,0 +1,279 @@ +---------------------------------------------------------------------- +-- | +-- Module : PrGrammar +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/09/04 11:45:38 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.16 $ +-- +-- AR 7\/12\/1999 - 1\/4\/2000 - 10\/5\/2003 +-- +-- printing and prettyprinting class +-- +-- 8\/1\/2004: +-- Usually followed principle: 'prt_' for displaying in the editor, 'prt' +-- in writing grammars to a file. For some constructs, e.g. 'prMarkedTree', +-- only the former is ever needed. +----------------------------------------------------------------------------- + +module GF.Grammar.PrGrammar (Print(..), + prtBad, + prGrammar, prModule, + prContext, prParam, + prQIdent, prQIdent_, + prRefinement, prTermOpt, + prt_Tree, prMarkedTree, prTree, + tree2string, prprTree, + prConstrs, prConstraints, + prMetaSubst, prEnv, prMSubst, + prExp, prOperSignature, + lookupIdent, lookupIdentInfo, lookupIdentInfoIn, + prTermTabular + ) where + +import GF.Data.Operations +import GF.Data.Zipper +import GF.Grammar.Grammar +import GF.Infra.Modules +import qualified GF.Source.PrintGF as P +import GF.Grammar.Values +import GF.Source.GrammarToSource +--- import GFC (CanonGrammar) --- cycle of modules + +import GF.Infra.Option +import GF.Infra.Ident +import GF.Data.Str + +import GF.Infra.CompactPrint + +import Data.List (intersperse) + +class Print a where + prt :: a -> String + -- | printing with parentheses, if needed + prt2 :: a -> String + -- | pretty printing + prpr :: a -> [String] + -- | printing without ident qualifications + prt_ :: a -> String + prt2 = prt + prt_ = prt + prpr = return . prt + +-- 8/1/2004 +--- Usually followed principle: prt_ for displaying in the editor, prt +--- in writing grammars to a file. For some constructs, e.g. prMarkedTree, +--- only the former is ever needed. + +-- | to show terms etc in error messages +prtBad :: Print a => String -> a -> Err b +prtBad s a = Bad (s +++ prt a) + +pprintTree :: P.Print a => a -> String +pprintTree = compactPrint . P.printTree + +prGrammar :: SourceGrammar -> String +prGrammar = pprintTree . trGrammar + +prModule :: (Ident, SourceModInfo) -> String +prModule = pprintTree . trModule + +instance Print Term where + prt = pprintTree . trt + prt_ = prExp + +instance Print Ident where + prt = pprintTree . tri + +instance Print Patt where + prt = pprintTree . trp + prt_ = prt . unqual where + unqual p = case p of + PP _ c [] -> PV c --- to remove curlies + PP _ c ps -> PC c (map unqual ps) + PC c ps -> PC c (map unqual ps) + _ -> p ---- records + +instance Print Label where + prt = pprintTree . trLabel + +instance Print MetaSymb where + prt (MetaSymb i) = "?" ++ show i + +prParam :: Param -> String +prParam (c,co) = prt c +++ prContext co + +prContext :: Context -> String +prContext co = unwords $ map prParenth [prt x +++ ":" +++ prt t | (x,t) <- co] + +-- some GFC notions + +instance Print a => Print (Tr a) where + prt (Tr (n, trees)) = prt n +++ unwords (map prt2 trees) + prt2 t@(Tr (_,args)) = if null args then prt t else prParenth (prt t) + +-- | we cannot define the method prt_ in this way +prt_Tree :: Tree -> String +prt_Tree = prt_ . tree2exp + +instance Print TrNode where + prt (N (bi,at,vt,(cs,ms),_)) = + prBinds bi ++ + prt at +++ ":" +++ prt vt + +++ prConstraints cs +++ prMetaSubst ms + prt_ (N (bi,at,vt,(cs,ms),_)) = + prBinds bi ++ + prt_ at +++ ":" +++ prt_ vt + +++ prConstraints cs +++ prMetaSubst ms + +prMarkedTree :: Tr (TrNode,Bool) -> [String] +prMarkedTree = prf 1 where + prf ind t@(Tr (node, trees)) = + prNode ind node : concatMap (prf (ind + 2)) trees + prNode ind node = case node of + (n, False) -> indent ind (prt_ n) + (n, _) -> '*' : indent (ind - 1) (prt_ n) + +prTree :: Tree -> [String] +prTree = prMarkedTree . mapTr (\n -> (n,False)) + +-- | a pretty-printer for parsable output +tree2string :: Tree -> String +tree2string = unlines . prprTree + +prprTree :: Tree -> [String] +prprTree = prf False where + prf par t@(Tr (node, trees)) = + parIf par (prn node : concat [prf (ifPar t) t | t <- trees]) + prn (N (bi,at,_,_,_)) = prb bi ++ prt_ at + prb [] = "" + prb bi = "\\" ++ concat (intersperse "," (map (prt_ . fst) bi)) ++ " -> " + parIf par (s:ss) = map (indent 2) $ + if par + then ('(':s) : ss ++ [")"] + else s:ss + ifPar (Tr (N ([],_,_,_,_), [])) = False + ifPar _ = True + + +-- auxiliaries + +prConstraints :: Constraints -> String +prConstraints = concat . prConstrs + +prMetaSubst :: MetaSubst -> String +prMetaSubst = concat . prMSubst + +prEnv :: Env -> String +---- prEnv [] = prCurly "" ---- for debugging +prEnv e = concatMap (\ (x,t) -> prCurly (prt x ++ ":=" ++ prt t)) e + +prConstrs :: Constraints -> [String] +prConstrs = map (\ (v,w) -> prCurly (prt v ++ "<>" ++ prt w)) + +prMSubst :: MetaSubst -> [String] +prMSubst = map (\ (m,e) -> prCurly ("?" ++ show m ++ "=" ++ prt e)) + +prBinds bi = if null bi + then [] + else "\\" ++ concat (intersperse "," (map prValDecl bi)) +++ "-> " + where + prValDecl (x,t) = prParenth (prt_ x +++ ":" +++ prt_ t) + +instance Print Val where + prt (VGen i x) = prt x ++ "{-" ++ show i ++ "-}" ---- latter part for debugging + prt (VApp u v) = prt u +++ prv1 v + prt (VCn mc) = prQIdent_ mc + prt (VClos env e) = case e of + Meta _ -> prt_ e ++ prEnv env + _ -> prt_ e ---- ++ prEnv env ---- for debugging + prt VType = "Type" + +prv1 v = case v of + VApp _ _ -> prParenth $ prt v + VClos _ _ -> prParenth $ prt v + _ -> prt v + +instance Print Atom where + prt (AtC f) = prQIdent f + prt (AtM i) = prt i + prt (AtV i) = prt i + prt (AtL s) = prQuotedString s + prt (AtI i) = show i + prt (AtF i) = show i + prt_ (AtC (_,f)) = prt f + prt_ a = prt a + +prQIdent :: QIdent -> String +prQIdent (m,f) = prt m ++ "." ++ prt f + +prQIdent_ :: QIdent -> String +prQIdent_ (_,f) = prt f + +-- | print terms without qualifications +prExp :: Term -> String +prExp e = case e of + App f a -> pr1 f +++ pr2 a + Abs x b -> "\\" ++ prt x +++ "->" +++ prExp b + Prod x a b -> "(\\" ++ prt x +++ ":" +++ prExp a ++ ")" +++ "->" +++ prExp b + Q _ c -> prt c + QC _ c -> prt c + _ -> prt e + where + pr1 e = case e of + Abs _ _ -> prParenth $ prExp e + Prod _ _ _ -> prParenth $ prExp e + _ -> prExp e + pr2 e = case e of + App _ _ -> prParenth $ prExp e + _ -> pr1 e + +-- | option @-strip@ strips qualifications +prTermOpt :: Options -> Term -> String +prTermOpt opts = if PrinterStrip `elem` flag optPrinter opts then prt else prExp + +-- | to get rid of brackets in the editor +prRefinement :: Term -> String +prRefinement t = case t of + Q m c -> prQIdent (m,c) + QC m c -> prQIdent (m,c) + _ -> prt t + +prOperSignature :: (QIdent,Type) -> String +prOperSignature (f, t) = prQIdent f +++ ":" +++ prt t + +-- to look up a constant etc in a search tree --- why here? AR 29/5/2008 + +lookupIdent :: Ident -> BinTree Ident b -> Err b +lookupIdent c t = case lookupTree prt c t of + Ok v -> return v + _ -> prtBad "unknown identifier" c + +lookupIdentInfo :: Module Ident a -> Ident -> Err a +lookupIdentInfo mo i = lookupIdent i (jments mo) + +lookupIdentInfoIn :: Module Ident a -> Ident -> Ident -> Err a +lookupIdentInfoIn mo m i = + err (\s -> Bad (s +++ "in module" +++ prt m)) return $ lookupIdentInfo mo i + + +--- printing cc command output AR 26/5/2008 + +prTermTabular :: Term -> [(String,String)] +prTermTabular = pr where + pr t = case t of + R rs -> + [(prt_ lab +++ "." +++ path, str) | (lab,(_,val)) <- rs, (path,str) <- pr val] + T _ cs -> + [(prt_ lab +++"=>" +++ path, str) | (lab, val) <- cs, (path,str) <- pr val] + V _ cs -> + [("#" ++ show i +++"=>" +++ path, str) | (i,val) <- zip [0..] cs, (path,str) <- pr val] + _ -> [([],ps t)] + ps t = case t of + K s -> s + C s u -> ps s +++ ps u + FV ts -> unwords (intersperse "/" (map ps ts)) + _ -> prt_ t diff --git a/src/GF/Grammar/Predef.hs b/src/GF/Grammar/Predef.hs new file mode 100644 index 000000000..71f152f92 --- /dev/null +++ b/src/GF/Grammar/Predef.hs @@ -0,0 +1,177 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Grammar.Predef +-- Maintainer : kr.angelov +-- Stability : (stable) +-- Portability : (portable) +-- +-- Predefined identifiers and labels which the compiler knows +---------------------------------------------------------------------- + + +module GF.Grammar.Predef + ( cType + , cPType + , cTok + , cStr + , cStrs + , cPredefAbs, cPredef + , cInt + , cFloat + , cString + , cInts + , cPBool + , cErrorType + , cOverload + , cUndefinedType + , isPredefCat + + , cPTrue, cPFalse + + , cLength, cDrop, cTake, cTk, cDp, cEqStr, cOccur + , cOccurs, cEqInt, cLessInt, cPlus, cShow, cRead + , cToStr, cMapStr, cError + + -- hacks + , cMeta, cAs, cChar, cChars, cSeq, cAlt, cRep + , cNeg, cCNC, cConflict + ) where + +import GF.Infra.Ident +import qualified Data.ByteString.Char8 as BS + +cType :: Ident +cType = identC (BS.pack "Type") + +cPType :: Ident +cPType = identC (BS.pack "PType") + +cTok :: Ident +cTok = identC (BS.pack "Tok") + +cStr :: Ident +cStr = identC (BS.pack "Str") + +cStrs :: Ident +cStrs = identC (BS.pack "Strs") + +cPredefAbs :: Ident +cPredefAbs = identC (BS.pack "PredefAbs") + +cPredef :: Ident +cPredef = identC (BS.pack "Predef") + +cInt :: Ident +cInt = identC (BS.pack "Int") + +cFloat :: Ident +cFloat = identC (BS.pack "Float") + +cString :: Ident +cString = identC (BS.pack "String") + +cInts :: Ident +cInts = identC (BS.pack "Ints") + +cPBool :: Ident +cPBool = identC (BS.pack "PBool") + +cErrorType :: Ident +cErrorType = identC (BS.pack "Error") + +cOverload :: Ident +cOverload = identC (BS.pack "overload") + +cUndefinedType :: Ident +cUndefinedType = identC (BS.pack "UndefinedType") + +isPredefCat :: Ident -> Bool +isPredefCat c = elem c [cInt,cString,cFloat] + +cPTrue :: Ident +cPTrue = identC (BS.pack "PTrue") + +cPFalse :: Ident +cPFalse = identC (BS.pack "PFalse") + +cLength :: Ident +cLength = identC (BS.pack "length") + +cDrop :: Ident +cDrop = identC (BS.pack "drop") + +cTake :: Ident +cTake = identC (BS.pack "take") + +cTk :: Ident +cTk = identC (BS.pack "tk") + +cDp :: Ident +cDp = identC (BS.pack "dp") + +cEqStr :: Ident +cEqStr = identC (BS.pack "eqStr") + +cOccur :: Ident +cOccur = identC (BS.pack "occur") + +cOccurs :: Ident +cOccurs = identC (BS.pack "occurs") + +cEqInt :: Ident +cEqInt = identC (BS.pack "eqInt") + +cLessInt :: Ident +cLessInt = identC (BS.pack "lessInt") + +cPlus :: Ident +cPlus = identC (BS.pack "plus") + +cShow :: Ident +cShow = identC (BS.pack "show") + +cRead :: Ident +cRead = identC (BS.pack "read") + +cToStr :: Ident +cToStr = identC (BS.pack "toStr") + +cMapStr :: Ident +cMapStr = identC (BS.pack "mapStr") + +cError :: Ident +cError = identC (BS.pack "error") + + +--- hacks: dummy identifiers used in various places +--- Not very nice! + +cMeta :: Ident +cMeta = identC (BS.singleton '?') + +cAs :: Ident +cAs = identC (BS.singleton '@') + +cChar :: Ident +cChar = identC (BS.singleton '?') + +cChars :: Ident +cChars = identC (BS.pack "[]") + +cSeq :: Ident +cSeq = identC (BS.pack "+") + +cAlt :: Ident +cAlt = identC (BS.pack "|") + +cRep :: Ident +cRep = identC (BS.pack "*") + +cNeg :: Ident +cNeg = identC (BS.pack "-") + +cCNC :: Ident +cCNC = identC (BS.pack "CNC") + +cConflict :: Ident +cConflict = IC (BS.pack "#conflict") diff --git a/src/GF/Grammar/ReservedWords.hs b/src/GF/Grammar/ReservedWords.hs new file mode 100644 index 000000000..b440141d6 --- /dev/null +++ b/src/GF/Grammar/ReservedWords.hs @@ -0,0 +1,44 @@ +---------------------------------------------------------------------- +-- | +-- Module : ReservedWords +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:28 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.5 $ +-- +-- reserved words of GF. (c) Aarne Ranta 19\/3\/2002 under Gnu GPL. +-- modified by Markus Forsberg 9\/4. +-- modified by AR 12\/6\/2003 for GF2 and GFC +----------------------------------------------------------------------------- + +module GF.Grammar.ReservedWords (isResWord, isResWordGFC) where + +import Data.List + + +isResWord :: String -> Bool +isResWord s = isInTree s resWordTree + +resWordTree :: BTree +resWordTree = +-- mapTree fst $ sorted2tree $ flip zip (repeat ()) $ sort allReservedWords +-- nowadays obtained from LexGF.hs + B "let" (B "data" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "concrete" N N))) (B "in" (B "fn" (B "flags" (B "def" N N) N) (B "grammar" (B "fun" N N) N)) (B "instance" (B "incomplete" (B "include" N N) N) (B "interface" N N)))) (B "pre" (B "open" (B "lindef" (B "lincat" (B "lin" N N) N) (B "of" (B "lintype" N N) N)) (B "param" (B "out" (B "oper" N N) N) (B "pattern" N N))) (B "transfer" (B "reuse" (B "resource" (B "printname" N N) N) (B "table" (B "strs" N N) N)) (B "where" (B "variants" (B "union" N N) N) (B "with" N N)))) + +isResWordGFC :: String -> Bool +isResWordGFC s = isInTree s $ + B "of" (B "fun" (B "concrete" (B "cat" (B "abstract" N N) N) (B "flags" N N)) (B "lin" (B "in" N N) (B "lincat" N N))) (B "resource" (B "param" (B "oper" (B "open" N N) N) (B "pre" N N)) (B "table" (B "strs" N N) (B "variants" N N))) + +data BTree = N | B String BTree BTree deriving (Show) + +isInTree :: String -> BTree -> Bool +isInTree x tree = case tree of + N -> False + B a left right + | x < a -> isInTree x left + | x > a -> isInTree x right + | x == a -> True + diff --git a/src/GF/Grammar/Unify.hs b/src/GF/Grammar/Unify.hs new file mode 100644 index 000000000..588c1b306 --- /dev/null +++ b/src/GF/Grammar/Unify.hs @@ -0,0 +1,96 @@ +---------------------------------------------------------------------- +-- | +-- Module : Unify +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:31 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.4 $ +-- +-- (c) Petri Mäenpää & Aarne Ranta, 1998--2001 +-- +-- brute-force adaptation of the old-GF program AR 21\/12\/2001 --- +-- the only use is in 'TypeCheck.splitConstraints' +----------------------------------------------------------------------------- + +module GF.Grammar.Unify (unifyVal) where + +import GF.Grammar.Abstract + +import GF.Data.Operations + +import Data.List (partition) + +unifyVal :: Constraints -> Err (Constraints,MetaSubst) +unifyVal cs0 = do + let (cs1,cs2) = partition notSolvable cs0 + let (us,vs) = unzip cs1 + us' <- mapM val2exp us + vs' <- mapM val2exp vs + let (ms,cs) = unifyAll (zip us' vs') [] + return (cs1 ++ [(VClos [] t, VClos [] u) | (t,u) <- cs], + [(m, VClos [] t) | (m,t) <- ms]) + where + notSolvable (v,w) = case (v,w) of -- don't consider nonempty closures + (VClos (_:_) _,_) -> True + (_,VClos (_:_) _) -> True + _ -> False + +type Unifier = [(MetaSymb, Trm)] +type Constrs = [(Trm, Trm)] + +unifyAll :: Constrs -> Unifier -> (Unifier,Constrs) +unifyAll [] g = (g, []) +unifyAll ((a@(s, t)) : l) g = + let (g1, c) = unifyAll l g + in case unify s t g1 of + Ok g2 -> (g2, c) + _ -> (g1, a : c) + +unify :: Trm -> Trm -> Unifier -> Err Unifier +unify e1 e2 g = + case (e1, e2) of + (Meta s, t) -> do + tg <- subst_all g t + let sg = maybe e1 id (lookup s g) + if (sg == Meta s) then extend g s tg else unify sg tg g + (t, Meta s) -> unify e2 e1 g + (Q _ a, Q _ b) | (a == b) -> return g ---- qualif? + (QC _ a, QC _ b) | (a == b) -> return g ---- + (Vr x, Vr y) | (x == y) -> return g + (Abs x b, Abs y c) -> do let c' = substTerm [x] [(y,Vr x)] c + unify b c' g + (App c a, App d b) -> case unify c d g of + Ok g1 -> unify a b g1 + _ -> prtBad "fail unify" e1 + _ -> prtBad "fail unify" e1 + +extend :: Unifier -> MetaSymb -> Trm -> Err Unifier +extend g s t | (t == Meta s) = return g + | occCheck s t = prtBad "occurs check" t + | True = return ((s, t) : g) + +subst_all :: Unifier -> Trm -> Err Trm +subst_all s u = + case (s,u) of + ([], t) -> return t + (a : l, t) -> do + t' <- (subst_all l t) --- successive substs - why ? + return $ substMetas [a] t' + +substMetas :: [(MetaSymb,Trm)] -> Trm -> Trm +substMetas subst trm = case trm of + Meta x -> case lookup x subst of + Just t -> t + _ -> trm + _ -> composSafeOp (substMetas subst) trm + +occCheck :: MetaSymb -> Trm -> Bool +occCheck s u = case u of + Meta v -> s == v + App c a -> occCheck s c || occCheck s a + Abs x b -> occCheck s b + _ -> False + diff --git a/src/GF/Grammar/Values.hs b/src/GF/Grammar/Values.hs new file mode 100644 index 000000000..ab7d874da --- /dev/null +++ b/src/GF/Grammar/Values.hs @@ -0,0 +1,91 @@ +---------------------------------------------------------------------- +-- | +-- Module : Values +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:32 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.7 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Grammar.Values (-- * values used in TC type checking + Exp, Val(..), Env, + -- * annotated tree used in editing + Tree, TrNode(..), Atom(..), Binds, Constraints, MetaSubst, + -- * for TC + valAbsInt, valAbsFloat, valAbsString, vType, + isPredefCat, + eType, tree2exp, loc2treeFocus + ) where + +import GF.Data.Operations +import GF.Data.Zipper + +import GF.Infra.Ident +import GF.Grammar.Grammar +import GF.Grammar.Predef + +-- values used in TC type checking + +type Exp = Term + +data Val = VGen Int Ident | VApp Val Val | VCn QIdent | VType | VClos Env Exp + deriving (Eq,Show) + +type Env = [(Ident,Val)] + +-- annotated tree used in editing + +type Tree = Tr TrNode + +newtype TrNode = N (Binds,Atom,Val,(Constraints,MetaSubst),Bool) + deriving (Eq,Show) + +data Atom = + AtC Fun | AtM MetaSymb | AtV Ident | AtL String | AtI Integer | AtF Double + deriving (Eq,Show) + +type Binds = [(Ident,Val)] +type Constraints = [(Val,Val)] +type MetaSubst = [(MetaSymb,Val)] + +-- for TC + +valAbsInt :: Val +valAbsInt = VCn (cPredefAbs, cInt) + +valAbsFloat :: Val +valAbsFloat = VCn (cPredefAbs, cFloat) + +valAbsString :: Val +valAbsString = VCn (cPredefAbs, cString) + +vType :: Val +vType = VType + +eType :: Exp +eType = Sort cType + +tree2exp :: Tree -> Exp +tree2exp (Tr (N (bi,at,_,_,_),ts)) = foldr Abs (foldl App at' ts') bi' where + at' = case at of + AtC (m,c) -> Q m c + AtV i -> Vr i + AtM m -> Meta m + AtL s -> K s + AtI s -> EInt s + AtF s -> EFloat s + bi' = map fst bi + ts' = map tree2exp ts + +loc2treeFocus :: Loc TrNode -> Tree +loc2treeFocus (Loc (Tr (a,ts),p)) = + loc2tree (Loc (Tr (mark a, map (mapTr nomark) ts), mapPath nomark p)) + where + (mark, nomark) = (\(N (a,b,c,d,_)) -> N(a,b,c,d,True), + \(N (a,b,c,d,_)) -> N(a,b,c,d,False)) + diff --git a/src/GF/Infra/CheckM.hs b/src/GF/Infra/CheckM.hs new file mode 100644 index 000000000..251ed2b8b --- /dev/null +++ b/src/GF/Infra/CheckM.hs @@ -0,0 +1,89 @@ +---------------------------------------------------------------------- +-- | +-- Module : CheckM +-- Maintainer : (Maintainer) +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:22:33 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.5 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Infra.CheckM (Check, + checkError, checkCond, checkWarn, checkUpdate, checkInContext, + checkUpdates, checkReset, checkResets, checkGetContext, + checkLookup, checkStart, checkErr, checkVal, checkIn, + prtFail + ) where + +import GF.Data.Operations +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Grammar.PrGrammar + +-- | the strings are non-fatal warnings +type Check a = STM (Context,[String]) a + +checkError :: String -> Check a +checkError = raise + +checkCond :: String -> Bool -> Check () +checkCond s b = if b then return () else checkError s + +-- | warnings should be reversed in the end +checkWarn :: String -> Check () +checkWarn s = updateSTM (\ (cont,msg) -> (cont, s:msg)) + +checkUpdate :: Decl -> Check () +checkUpdate d = updateSTM (\ (cont,msg) -> (d:cont, msg)) + +checkInContext :: [Decl] -> Check r -> Check r +checkInContext g ch = do + i <- checkUpdates g + r <- ch + checkResets i + return r + +checkUpdates :: [Decl] -> Check Int +checkUpdates ds = mapM checkUpdate ds >> return (length ds) + +checkReset :: Check () +checkReset = checkResets 1 + +checkResets :: Int -> Check () +checkResets i = updateSTM (\ (cont,msg) -> (drop i cont, msg)) + +checkGetContext :: Check Context +checkGetContext = do + (co,_) <- readSTM + return co + +checkLookup :: Ident -> Check Type +checkLookup x = do + co <- checkGetContext + checkErr $ maybe (prtBad "unknown variable" x) return $ lookup x co + +checkStart :: Check a -> Err (a,(Context,[String])) +checkStart c = appSTM c ([],[]) + +checkErr :: Err a -> Check a +checkErr e = stm (\s -> do + v <- e + return (v,s) + ) + +checkVal :: a -> Check a +checkVal v = return v + +prtFail :: Print a => String -> a -> Check b +prtFail s t = checkErr $ prtBad s t + +checkIn :: String -> Check a -> Check a +checkIn msg c = stm $ \s@(g,ws) -> case appSTM c s of + Bad e -> Bad $ msg ++++ e + Ok (v,(g',ws')) -> Ok (v,(g',ws2)) where + new = take (length ws' - length ws) ws' + ws2 = [msg ++++ w | w <- new] ++ ws diff --git a/src/GF/Infra/CompactPrint.hs b/src/GF/Infra/CompactPrint.hs new file mode 100644 index 000000000..486c9e183 --- /dev/null +++ b/src/GF/Infra/CompactPrint.hs @@ -0,0 +1,22 @@ +module GF.Infra.CompactPrint where +import Data.Char + +compactPrint = compactPrintCustom keywordGF (const False) + +compactPrintGFCC = compactPrintCustom (const False) keywordGFCC + +compactPrintCustom pre post = dps . concat . map (spaceIf pre post) . words + +dps = dropWhile isSpace + +spaceIf pre post w = case w of + _ | pre w -> "\n" ++ w + _ | post w -> w ++ "\n" + c:_ | isAlpha c || isDigit c -> " " ++ w + '_':_ -> " " ++ w + _ -> w + +keywordGF w = elem w ["cat","fun","lin","lincat","lindef","oper","param"] +keywordGFCC w = + last w == ';' || + elem w ["flags","fun","cat","lin","oper","lincat","lindef","printname","param"] diff --git a/src/GF/Infra/GetOpt.hs b/src/GF/Infra/GetOpt.hs new file mode 100644 index 000000000..ede561c90 --- /dev/null +++ b/src/GF/Infra/GetOpt.hs @@ -0,0 +1,381 @@ +-- This is a version of System.Console.GetOpt which has been hacked to +-- support long options with a single dash. Since we don't want the annoying +-- clash with short options that start with the same character as a long +-- one, we don't allow short options to be given together (e.g. -zxf), +-- nor do we allow options to be given as any unique prefix. + +----------------------------------------------------------------------------- +-- | +-- Module : System.Console.GetOpt +-- Copyright : (c) Sven Panne 2002-2005 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- This library provides facilities for parsing the command-line options +-- in a standalone program. It is essentially a Haskell port of the GNU +-- @getopt@ library. +-- +----------------------------------------------------------------------------- + +{- +Sven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (small +changes Dec. 1997) + +Two rather obscure features are missing: The Bash 2.0 non-option hack +(if you don't already know it, you probably don't want to hear about +it...) and the recognition of long options with a single dash +(e.g. '-help' is recognised as '--help', as long as there is no short +option 'h'). + +Other differences between GNU's getopt and this implementation: + +* To enforce a coherent description of options and arguments, there + are explanation fields in the option/argument descriptor. + +* Error messages are now more informative, but no longer POSIX + compliant... :-( + +And a final Haskell advertisement: The GNU C implementation uses well +over 1100 lines, we need only 195 here, including a 46 line example! +:-) +-} + +--module System.Console.GetOpt ( +module GF.Infra.GetOpt ( + -- * GetOpt + getOpt, getOpt', + usageInfo, + ArgOrder(..), + OptDescr(..), + ArgDescr(..), + + -- * Examples + + -- |To hopefully illuminate the role of the different data structures, + -- here are the command-line options for a (very simple) compiler, + -- done in two different ways. + -- The difference arises because the type of 'getOpt' is + -- parameterized by the type of values derived from flags. + + -- ** Interpreting flags as concrete values + -- $example1 + + -- ** Interpreting flags as transformations of an options record + -- $example2 +) where + +import Prelude -- necessary to get dependencies right + +import Data.List ( isPrefixOf, find ) + +-- |What to do with options following non-options +data ArgOrder a + = RequireOrder -- ^ no option processing after first non-option + | Permute -- ^ freely intersperse options and non-options + | ReturnInOrder (String -> a) -- ^ wrap non-options into options + +{-| +Each 'OptDescr' describes a single option. + +The arguments to 'Option' are: + +* list of short option characters + +* list of long option strings (without \"--\") + +* argument descriptor + +* explanation of option for user +-} +data OptDescr a = -- description of a single options: + Option [Char] -- list of short option characters + [String] -- list of long option strings (without "--") + (ArgDescr a) -- argument descriptor + String -- explanation of option for user + +-- |Describes whether an option takes an argument or not, and if so +-- how the argument is injected into a value of type @a@. +data ArgDescr a + = NoArg a -- ^ no argument expected + | ReqArg (String -> a) String -- ^ option requires argument + | OptArg (Maybe String -> a) String -- ^ optional argument + +data OptKind a -- kind of cmd line arg (internal use only): + = Opt a -- an option + | UnreqOpt String -- an un-recognized option + | NonOpt String -- a non-option + | EndOfOpts -- end-of-options marker (i.e. "--") + | OptErr String -- something went wrong... + +-- | Return a string describing the usage of a command, derived from +-- the header (first argument) and the options described by the +-- second argument. +usageInfo :: String -- header + -> [OptDescr a] -- option descriptors + -> String -- nicely formatted decription of options +usageInfo header optDescr = unlines (header:table) + where (ss,ls,ds) = (unzip3 . concatMap fmtOpt) optDescr + table = zipWith3 paste (sameLen ss) (sameLen ls) ds + paste x y z = " " ++ x ++ " " ++ y ++ " " ++ z + sameLen xs = flushLeft ((maximum . map length) xs) xs + flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ] + +fmtOpt :: OptDescr a -> [(String,String,String)] +fmtOpt (Option sos los ad descr) = + case lines descr of + [] -> [(sosFmt,losFmt,"")] + (d:ds) -> (sosFmt,losFmt,d) : [ ("","",d') | d' <- ds ] + where sepBy _ [] = "" + sepBy _ [x] = x + sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs + sosFmt = sepBy ',' (map (fmtShort ad) sos) + losFmt = sepBy ',' (map (fmtLong ad) los) + +fmtShort :: ArgDescr a -> Char -> String +fmtShort (NoArg _ ) so = "-" ++ [so] +fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad +fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]" + +fmtLong :: ArgDescr a -> String -> String +fmtLong (NoArg _ ) lo = "--" ++ lo +fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad +fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]" + +{-| +Process the command-line, and return the list of values that matched +(and those that didn\'t). The arguments are: + +* The order requirements (see 'ArgOrder') + +* The option descriptions (see 'OptDescr') + +* The actual command line arguments (presumably got from + 'System.Environment.getArgs'). + +'getOpt' returns a triple consisting of the option arguments, a list +of non-options, and a list of error messages. +-} +getOpt :: ArgOrder a -- non-option handling + -> [OptDescr a] -- option descriptors + -> [String] -- the command-line arguments + -> ([a],[String],[String]) -- (options,non-options,error messages) +getOpt ordering optDescr args = (os,xs,es ++ map errUnrec us) + where (os,xs,us,es) = getOpt' ordering optDescr args + +{-| +This is almost the same as 'getOpt', but returns a quadruple +consisting of the option arguments, a list of non-options, a list of +unrecognized options, and a list of error messages. +-} +getOpt' :: ArgOrder a -- non-option handling + -> [OptDescr a] -- option descriptors + -> [String] -- the command-line arguments + -> ([a],[String], [String] ,[String]) -- (options,non-options,unrecognized,error messages) +getOpt' _ _ [] = ([],[],[],[]) +getOpt' ordering optDescr (arg:args) = procNextOpt opt ordering + where procNextOpt (Opt o) _ = (o:os,xs,us,es) + procNextOpt (UnreqOpt u) _ = (os,xs,u:us,es) + procNextOpt (NonOpt x) RequireOrder = ([],x:rest,[],[]) + procNextOpt (NonOpt x) Permute = (os,x:xs,us,es) + procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,us,es) + procNextOpt EndOfOpts RequireOrder = ([],rest,[],[]) + procNextOpt EndOfOpts Permute = ([],rest,[],[]) + procNextOpt EndOfOpts (ReturnInOrder f) = (map f rest,[],[],[]) + procNextOpt (OptErr e) _ = (os,xs,us,e:es) + + (opt,rest) = getNext arg args optDescr + (os,xs,us,es) = getOpt' ordering optDescr rest + +-- take a look at the next cmd line arg and decide what to do with it +getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) +getNext ('-':'-':[]) rest _ = (EndOfOpts,rest) +getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr +getNext ('-' :xs) rest optDescr = longOpt xs rest optDescr +getNext a rest _ = (NonOpt a,rest) + +-- handle long option +longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) +longOpt ls rs optDescr = long ads arg rs + where (opt,arg) = break (=='=') ls + options = [ o | o@(Option ss xs _ _) <- optDescr + , opt `elem` map (:[]) ss || opt `elem` xs ] + ads = [ ad | Option _ _ ad _ <- options ] + optStr = ("--"++opt) + + long (_:_:_) _ rest = (errAmbig options optStr,rest) + long [NoArg a ] [] rest = (Opt a,rest) + long [NoArg _ ] ('=':_) rest = (errNoArg optStr,rest) + long [ReqArg _ d] [] [] = (errReq d optStr,[]) + long [ReqArg f _] [] (r:rest) = (Opt (f r),rest) + long [ReqArg f _] ('=':xs) rest = (Opt (f xs),rest) + long [OptArg f _] [] rest = (Opt (f Nothing),rest) + long [OptArg f _] ('=':xs) rest = (Opt (f (Just xs)),rest) + long _ _ rest = (UnreqOpt ("--"++ls),rest) + + +-- miscellaneous error formatting + +errAmbig :: [OptDescr a] -> String -> OptKind a +errAmbig ods optStr = OptErr (usageInfo header ods) + where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:" + +errReq :: String -> String -> OptKind a +errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n") + +errUnrec :: String -> String +errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n" + +errNoArg :: String -> OptKind a +errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n") + +{- +----------------------------------------------------------------------------------------- +-- and here a small and hopefully enlightening example: + +data Flag = Verbose | Version | Name String | Output String | Arg String deriving Show + +options :: [OptDescr Flag] +options = + [Option ['v'] ["verbose"] (NoArg Verbose) "verbosely list files", + Option ['V','?'] ["version","release"] (NoArg Version) "show version info", + Option ['o'] ["output"] (OptArg out "FILE") "use FILE for dump", + Option ['n'] ["name"] (ReqArg Name "USER") "only dump USER's files"] + +out :: Maybe String -> Flag +out Nothing = Output "stdout" +out (Just o) = Output o + +test :: ArgOrder Flag -> [String] -> String +test order cmdline = case getOpt order options cmdline of + (o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n ++ "\n" + (_,_,errs) -> concat errs ++ usageInfo header options + where header = "Usage: foobar [OPTION...] files..." + +-- example runs: +-- putStr (test RequireOrder ["foo","-v"]) +-- ==> options=[] args=["foo", "-v"] +-- putStr (test Permute ["foo","-v"]) +-- ==> options=[Verbose] args=["foo"] +-- putStr (test (ReturnInOrder Arg) ["foo","-v"]) +-- ==> options=[Arg "foo", Verbose] args=[] +-- putStr (test Permute ["foo","--","-v"]) +-- ==> options=[] args=["foo", "-v"] +-- putStr (test Permute ["-?o","--name","bar","--na=baz"]) +-- ==> options=[Version, Output "stdout", Name "bar", Name "baz"] args=[] +-- putStr (test Permute ["--ver","foo"]) +-- ==> option `--ver' is ambiguous; could be one of: +-- -v --verbose verbosely list files +-- -V, -? --version, --release show version info +-- Usage: foobar [OPTION...] files... +-- -v --verbose verbosely list files +-- -V, -? --version, --release show version info +-- -o[FILE] --output[=FILE] use FILE for dump +-- -n USER --name=USER only dump USER's files +----------------------------------------------------------------------------------------- +-} + +{- $example1 + +A simple choice for the type associated with flags is to define a type +@Flag@ as an algebraic type representing the possible flags and their +arguments: + +> module Opts1 where +> +> import System.Console.GetOpt +> import Data.Maybe ( fromMaybe ) +> +> data Flag +> = Verbose | Version +> | Input String | Output String | LibDir String +> deriving Show +> +> options :: [OptDescr Flag] +> options = +> [ Option ['v'] ["verbose"] (NoArg Verbose) "chatty output on stderr" +> , Option ['V','?'] ["version"] (NoArg Version) "show version number" +> , Option ['o'] ["output"] (OptArg outp "FILE") "output FILE" +> , Option ['c'] [] (OptArg inp "FILE") "input FILE" +> , Option ['L'] ["libdir"] (ReqArg LibDir "DIR") "library directory" +> ] +> +> inp,outp :: Maybe String -> Flag +> outp = Output . fromMaybe "stdout" +> inp = Input . fromMaybe "stdin" +> +> compilerOpts :: [String] -> IO ([Flag], [String]) +> compilerOpts argv = +> case getOpt Permute options argv of +> (o,n,[] ) -> return (o,n) +> (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) +> where header = "Usage: ic [OPTION...] files..." + +Then the rest of the program will use the constructed list of flags +to determine it\'s behaviour. + +-} + +{- $example2 + +A different approach is to group the option values in a record of type +@Options@, and have each flag yield a function of type +@Options -> Options@ transforming this record. + +> module Opts2 where +> +> import System.Console.GetOpt +> import Data.Maybe ( fromMaybe ) +> +> data Options = Options +> { optVerbose :: Bool +> , optShowVersion :: Bool +> , optOutput :: Maybe FilePath +> , optInput :: Maybe FilePath +> , optLibDirs :: [FilePath] +> } deriving Show +> +> defaultOptions = Options +> { optVerbose = False +> , optShowVersion = False +> , optOutput = Nothing +> , optInput = Nothing +> , optLibDirs = [] +> } +> +> options :: [OptDescr (Options -> Options)] +> options = +> [ Option ['v'] ["verbose"] +> (NoArg (\ opts -> opts { optVerbose = True })) +> "chatty output on stderr" +> , Option ['V','?'] ["version"] +> (NoArg (\ opts -> opts { optShowVersion = True })) +> "show version number" +> , Option ['o'] ["output"] +> (OptArg ((\ f opts -> opts { optOutput = Just f }) . fromMaybe "output") +> "FILE") +> "output FILE" +> , Option ['c'] [] +> (OptArg ((\ f opts -> opts { optInput = Just f }) . fromMaybe "input") +> "FILE") +> "input FILE" +> , Option ['L'] ["libdir"] +> (ReqArg (\ d opts -> opts { optLibDirs = optLibDirs opts ++ [d] }) "DIR") +> "library directory" +> ] +> +> compilerOpts :: [String] -> IO (Options, [String]) +> compilerOpts argv = +> case getOpt Permute options argv of +> (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n) +> (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) +> where header = "Usage: ic [OPTION...] files..." + +Similarly, each flag could yield a monadic function transforming a record, +of type @Options -> IO Options@ (or any other monad), allowing option +processing to perform actions of the chosen monad, e.g. printing help or +version messages, checking that file arguments exist, etc. + +-} diff --git a/src/GF/Infra/Ident.hs b/src/GF/Infra/Ident.hs new file mode 100644 index 000000000..45ebf3a5b --- /dev/null +++ b/src/GF/Infra/Ident.hs @@ -0,0 +1,152 @@ +---------------------------------------------------------------------- +-- | +-- Module : Ident +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/15 11:43:33 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.8 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Infra.Ident (-- * Identifiers + Ident(..), ident2bs, prIdent, + identC, identV, identA, identAV, identW, + argIdent, varStr, varX, isWildIdent, varIndex, + -- * refreshing identifiers + IdState, initIdStateN, initIdState, + lookVar, refVar, refVarPlus + ) where + +import GF.Data.Operations +import qualified Data.ByteString.Char8 as BS +-- import Monad + + +-- | the constructors labelled /INTERNAL/ are +-- internal representation never returned by the parser +data Ident = + IC {-# UNPACK #-} !BS.ByteString -- ^ raw identifier after parsing, resolved in Rename + | IW -- ^ wildcard +-- +-- below this constructor: internal representation never returned by the parser + | IV {-# UNPACK #-} !BS.ByteString {-# UNPACK #-} !Int -- ^ /INTERNAL/ variable + | IA {-# UNPACK #-} !BS.ByteString {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat at position + | IAV {-# UNPACK #-} !BS.ByteString {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat with bindings at position +-- + + deriving (Eq, Ord, Show, Read) + +ident2bs :: Ident -> BS.ByteString +ident2bs i = case i of + IC s -> s + IV s n -> BS.append s (BS.pack ('_':show n)) + IA s j -> BS.append s (BS.pack ('_':show j)) + IAV s b j -> BS.append s (BS.pack ('_':show b ++ '_':show j)) + IW -> BS.pack "_" + +prIdent :: Ident -> String +prIdent i = BS.unpack $! ident2bs i + +identC :: BS.ByteString -> Ident +identV :: BS.ByteString -> Int -> Ident +identA :: BS.ByteString -> Int -> Ident +identAV:: BS.ByteString -> Int -> Int -> Ident +identW :: Ident +(identC, identV, identA, identAV, identW) = + (IC, IV, IA, IAV, IW) + +-- normal identifier +-- ident s = IC s + +-- | to mark argument variables +argIdent :: Int -> Ident -> Int -> Ident +argIdent 0 (IC c) i = identA c i +argIdent b (IC c) i = identAV c b i + +-- | used in lin defaults +varStr :: Ident +varStr = identA (BS.pack "str") 0 + +-- | refreshing variables +varX :: Int -> Ident +varX = identV (BS.pack "x") + +isWildIdent :: Ident -> Bool +isWildIdent x = case x of + IW -> True + IC s | s == BS.pack "_" -> True + _ -> False + +varIndex :: Ident -> Int +varIndex (IV _ n) = n +varIndex _ = -1 --- other than IV should not count + +-- refreshing identifiers + +type IdState = ([(Ident,Ident)],Int) + +initIdStateN :: Int -> IdState +initIdStateN i = ([],i) + +initIdState :: IdState +initIdState = initIdStateN 0 + +lookVar :: Ident -> STM IdState Ident +lookVar a@(IA _ _) = return a +lookVar x = do + (sys,_) <- readSTM + stm (\s -> maybe (Bad ("cannot find" +++ show x +++ prParenth (show sys))) + return $ + lookup x sys >>= (\y -> return (y,s))) + +refVar :: Ident -> STM IdState Ident +----refVar IW = return IW --- no update of wildcard +refVar x = do + (_,m) <- readSTM + let x' = IV (ident2bs x) m + updateSTM (\(sys,mx) -> ((x, x'):sys, mx + 1)) + return x' + +refVarPlus :: Ident -> STM IdState Ident +----refVarPlus IW = refVar (identC "h") +refVarPlus x = refVar x + + +{- +------------------------------ +-- to test + +refreshExp :: Exp -> Err Exp +refreshExp e = err Bad (return . fst) (appSTM (refresh e) initState) + +refresh :: Exp -> STM State Exp +refresh e = case e of + Atom x -> lookVar x >>= return . Atom + App f a -> liftM2 App (refresh f) (refresh a) + Abs x b -> liftM2 Abs (refVar x) (refresh b) + Fun xs a b -> do + a' <- refresh a + xs' <- mapM refVar xs + b' <- refresh b + return $ Fun xs' a' b' + +data Exp = + Atom Ident + | App Exp Exp + | Abs Ident Exp + | Fun [Ident] Exp Exp + deriving Show + +exp1 = Abs (IC "y") (Atom (IC "y")) +exp2 = Abs (IC "y") (App (Atom (IC "y")) (Atom (IC "y"))) +exp3 = Abs (IC "y") (Abs (IC "z") (App (Atom (IC "y")) (Atom (IC "z")))) +exp4 = Abs (IC "y") (Abs (IC "y") (App (Atom (IC "y")) (Atom (IC "z")))) +exp5 = Abs (IC "y") (Abs (IC "y") (App (Atom (IC "y")) (Atom (IC "y")))) +exp6 = Abs (IC "y") (Fun [IC "x", IC "y"] (Atom (IC "y")) (Atom (IC "y"))) +exp7 = Abs (IL "8") (Atom (IC "y")) + +-} diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs new file mode 100644 index 000000000..797f729c8 --- /dev/null +++ b/src/GF/Infra/Modules.hs @@ -0,0 +1,429 @@ +---------------------------------------------------------------------- +-- | +-- Module : Modules +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/09 15:14:30 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.26 $ +-- +-- Datastructures and functions for modules, common to GF and GFC. +-- +-- AR 29\/4\/2003 +-- +-- The same structure will be used in both source code and canonical. +-- The parameters tell what kind of data is involved. +-- Invariant: modules are stored in dependency order +----------------------------------------------------------------------------- + +module GF.Infra.Modules ( + MGrammar(..), ModInfo(..), Module(..), ModuleType(..), + MReuseType(..), MInclude (..), + extends, isInherited,inheritAll, + updateMGrammar, updateModule, replaceJudgements, addFlag, + addOpenQualif, flagsModule, allFlags, mapModules, + MainGrammar(..), MainConcreteSpec(..), OpenSpec(..), OpenQualif(..), + oSimple, oQualif, + ModuleStatus(..), + openedModule, allOpens, depPathModule, allDepsModule, partOfGrammar, + allExtends, allExtendSpecs, allExtendsPlus, allExtensions, + searchPathModule, addModule, + emptyMGrammar, emptyModInfo, emptyModule, + IdentM(..), + typeOfModule, abstractOfConcrete, abstractModOfConcrete, + lookupModule, lookupModuleType, lookupModMod, lookupInfo, + lookupPosition, showPosition, + allModMod, isModAbs, isModRes, isModCnc, isModTrans, + sameMType, isCompilableModule, isCompleteModule, + allAbstracts, greatestAbstract, allResources, + greatestResource, allConcretes, allConcreteModules + ) where + +import GF.Infra.Ident +import GF.Infra.Option +import GF.Data.Operations + +import Data.List + + +-- AR 29/4/2003 + +-- The same structure will be used in both source code and canonical. +-- The parameters tell what kind of data is involved. +-- Invariant: modules are stored in dependency order + +data MGrammar i a = MGrammar {modules :: [(i,ModInfo i a)]} + deriving Show + +data ModInfo i a = + ModMainGrammar (MainGrammar i) + | ModMod (Module i a) + | ModWith (Module i a) (i,MInclude i) [OpenSpec i] + deriving Show + +data Module i a = Module { + mtype :: ModuleType i , + mstatus :: ModuleStatus , + flags :: ModuleOptions, + extend :: [(i,MInclude i)], + opens :: [OpenSpec i] , + jments :: BinTree i a , + positions :: BinTree i (String,(Int,Int)) -- file, first line, last line + } +--- deriving Show +instance Show (Module i a) where + show _ = "cannot show Module with FiniteMap" + +-- | encoding the type of the module +data ModuleType i = + MTAbstract + | MTTransfer (OpenSpec i) (OpenSpec i) + | MTResource + | MTConcrete i + -- ^ up to this, also used in GFC. Below, source only. + | MTInterface + | MTInstance i + | MTReuse (MReuseType i) + | MTUnion (ModuleType i) [(i,[i])] -- ^ not meant to be recursive + deriving (Eq,Show) + +data MReuseType i = MRInterface i | MRInstance i i | MRResource i + deriving (Show,Eq) + +data MInclude i = MIAll | MIOnly [i] | MIExcept [i] + deriving (Show,Eq) + +extends :: Module i a -> [i] +extends = map fst . extend + +isInherited :: Eq i => MInclude i -> i -> Bool +isInherited c i = case c of + MIAll -> True + MIOnly is -> elem i is + MIExcept is -> notElem i is + +inheritAll :: i -> (i,MInclude i) +inheritAll i = (i,MIAll) + +-- destructive update + +-- | dep order preserved since old cannot depend on new +updateMGrammar :: Ord i => MGrammar i a -> MGrammar i a -> MGrammar i a +updateMGrammar old new = MGrammar $ + [(i,m) | (i,m) <- os, notElem i (map fst ns)] ++ ns + where + os = modules old + ns = modules new + +updateModule :: Ord i => Module i t -> i -> t -> Module i t +updateModule (Module mt ms fs me ops js ps) i t = + Module mt ms fs me ops (updateTree (i,t) js) ps + +replaceJudgements :: Module i t -> BinTree i t -> Module i t +replaceJudgements (Module mt ms fs me ops _ ps) js = Module mt ms fs me ops js ps + +addOpenQualif :: i -> i -> Module i t -> Module i t +addOpenQualif i j (Module mt ms fs me ops js ps) = + Module mt ms fs me (oQualif i j : ops) js ps + +addFlag :: ModuleOptions -> Module i t -> Module i t +addFlag f mo = mo {flags = addModuleOptions (flags mo) f} + +flagsModule :: (i,ModInfo i a) -> ModuleOptions +flagsModule (_,mi) = case mi of + ModMod m -> flags m + _ -> noModuleOptions + +allFlags :: MGrammar i a -> ModuleOptions +allFlags gr = concatModuleOptions $ map flags $ [m | (_, ModMod m) <- modules gr] + +mapModules :: (Module i a -> Module i a) + -> MGrammar i a -> MGrammar i a +mapModules f = MGrammar . map (onSnd mapModules') . modules + where mapModules' (ModMod m) = ModMod (f m) + mapModules' m = m + +data MainGrammar i = MainGrammar { + mainAbstract :: i , + mainConcretes :: [MainConcreteSpec i] + } + deriving Show + +data MainConcreteSpec i = MainConcreteSpec { + concretePrintname :: i , + concreteName :: i , + transferIn :: Maybe (OpenSpec i) , -- ^ if there is an in-transfer + transferOut :: Maybe (OpenSpec i) -- ^ if there is an out-transfer + } + deriving Show + +data OpenSpec i = + OSimple OpenQualif i + | OQualif OpenQualif i i + deriving (Eq,Show) + +data OpenQualif = + OQNormal + | OQInterface + | OQIncomplete + deriving (Eq,Show) + +oSimple :: i -> OpenSpec i +oSimple = OSimple OQNormal + +oQualif :: i -> i -> OpenSpec i +oQualif = OQualif OQNormal + +data ModuleStatus = + MSComplete + | MSIncomplete + deriving (Eq,Show) + +openedModule :: OpenSpec i -> i +openedModule o = case o of + OSimple _ m -> m + OQualif _ _ m -> m + +allOpens :: Module i a -> [OpenSpec i] +allOpens m = case mtype m of + MTTransfer a b -> a : b : opens m + _ -> opens m + +-- | initial dependency list +depPathModule :: Ord i => Module i a -> [OpenSpec i] +depPathModule m = fors m ++ exts m ++ opens m where + fors m = case mtype m of + MTTransfer i j -> [i,j] + MTConcrete i -> [oSimple i] + MTInstance i -> [oSimple i] + _ -> [] + exts m = map oSimple $ extends m + +-- | all dependencies +allDepsModule :: Ord i => MGrammar i a -> Module i a -> [OpenSpec i] +allDepsModule gr m = iterFix add os0 where + os0 = depPathModule m + add os = [m | o <- os, Just (ModMod n) <- [lookup (openedModule o) mods], + m <- depPathModule n] + mods = modules gr + +-- | select just those modules that a given one depends on, including itself +partOfGrammar :: Ord i => MGrammar i a -> (i,ModInfo i a) -> MGrammar i a +partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor] + where + mods = modules gr + modsFor = case m of + ModMod n -> (i:) $ map openedModule $ allDepsModule gr n + ---- ModWith n i os -> i : map openedModule os ++ partOfGrammar (ModMod n) ---- + _ -> [i] + +-- | all modules that a module extends, directly or indirectly, without restricts +allExtends :: (Show i,Ord i) => MGrammar i a -> i -> [i] +allExtends gr i = case lookupModule gr i of + Ok (ModMod m) -> case extends m of + [] -> [i] + is -> i : concatMap (allExtends gr) is + _ -> [] + +-- | all modules that a module extends, directly or indirectly, with restricts +allExtendSpecs :: (Show i,Ord i) => MGrammar i a -> i -> [(i,MInclude i)] +allExtendSpecs gr i = case lookupModule gr i of + Ok (ModMod m) -> case extend m of + [] -> [(i,MIAll)] + is -> (i,MIAll) : concatMap (allExtendSpecs gr . fst) is + _ -> [] + +-- | this plus that an instance extends its interface +allExtendsPlus :: (Show i,Ord i) => MGrammar i a -> i -> [i] +allExtendsPlus gr i = case lookupModule gr i of + Ok (ModMod m) -> i : concatMap (allExtendsPlus gr) (exts m) + _ -> [] + where + exts m = extends m ++ [j | MTInstance j <- [mtype m]] + +-- | conversely: all modules that extend a given module, incl. instances of interface +allExtensions :: (Show i,Ord i) => MGrammar i a -> i -> [i] +allExtensions gr i = case lookupModule gr i of + Ok (ModMod m) -> let es = exts i in es ++ concatMap (allExtensions gr) es + _ -> [] + where + exts i = [j | (j,m) <- mods, elem i (extends m) + || elem (MTInstance i) [mtype m]] + mods = [(j,m) | (j,ModMod m) <- modules gr] + +-- | initial search path: the nonqualified dependencies +searchPathModule :: Ord i => Module i a -> [i] +searchPathModule m = [i | OSimple _ i <- depPathModule m] + +-- | a new module can safely be added to the end, since nothing old can depend on it +addModule :: Ord i => + MGrammar i a -> i -> ModInfo i a -> MGrammar i a +addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)]) + +emptyMGrammar :: MGrammar i a +emptyMGrammar = MGrammar [] + +emptyModInfo :: ModInfo i a +emptyModInfo = ModMod emptyModule + +emptyModule :: Module i a +emptyModule = Module + MTResource MSComplete noModuleOptions [] [] emptyBinTree emptyBinTree + +-- | we store the module type with the identifier +data IdentM i = IdentM { + identM :: i , + typeM :: ModuleType i + } + deriving (Eq,Show) + +typeOfModule :: ModInfo i a -> ModuleType i +typeOfModule mi = case mi of + ModMod m -> mtype m + +abstractOfConcrete :: (Show i, Eq i) => MGrammar i a -> i -> Err i +abstractOfConcrete gr c = do + m <- lookupModule gr c + case m of + ModMod n -> case mtype n of + MTConcrete a -> return a + _ -> Bad $ "expected concrete" +++ show c + _ -> Bad $ "expected concrete" +++ show c + +abstractModOfConcrete :: (Show i, Eq i) => + MGrammar i a -> i -> Err (Module i a) +abstractModOfConcrete gr c = do + a <- abstractOfConcrete gr c + m <- lookupModule gr a + case m of + ModMod n -> return n + _ -> Bad $ "expected abstract" +++ show c + + +-- the canonical file name + +--- canonFileName s = prt s ++ ".gfc" + +lookupModule :: (Show i,Eq i) => MGrammar i a -> i -> Err (ModInfo i a) +lookupModule gr m = case lookup m (modules gr) of + Just i -> return i + _ -> Bad $ "unknown module" +++ show m + +++ "among" +++ unwords (map (show . fst) (modules gr)) ---- debug + +lookupModuleType :: (Show i,Eq i) => MGrammar i a -> i -> Err (ModuleType i) +lookupModuleType gr m = do + mi <- lookupModule gr m + return $ typeOfModule mi + +lookupModMod :: (Show i,Eq i) => MGrammar i a -> i -> Err (Module i a) +lookupModMod gr i = do + mo <- lookupModule gr i + case mo of + ModMod m -> return m + _ -> Bad $ "expected proper module, not" +++ show i + +lookupInfo :: (Show i, Ord i) => Module i a -> i -> Err a +lookupInfo mo i = lookupTree show i (jments mo) + +lookupPosition :: (Show i, Ord i) => Module i a -> i -> Err (String,(Int,Int)) +lookupPosition mo i = lookupTree show i (positions mo) + +showPosition :: (Show i, Ord i) => Module i a -> i -> String +showPosition mo i = case lookupPosition mo i of + Ok (f,(b,e)) | b == e -> "in" +++ f ++ ", line" +++ show b + Ok (f,(b,e)) -> "in" +++ f ++ ", lines" +++ show b ++ "-" ++ show e + _ -> "" + + +allModMod :: (Show i,Eq i) => MGrammar i a -> [(i,Module i a)] +allModMod gr = [(i,m) | (i, ModMod m) <- modules gr] + +isModAbs :: Module i a -> Bool +isModAbs m = case mtype m of + MTAbstract -> True +---- MTUnion t -> isModAbs t + _ -> False + +isModRes :: Module i a -> Bool +isModRes m = case mtype m of + MTResource -> True + MTReuse _ -> True +---- MTUnion t -> isModRes t --- maybe not needed, since eliminated early + MTInterface -> True --- + MTInstance _ -> True + _ -> False + +isModCnc :: Module i a -> Bool +isModCnc m = case mtype m of + MTConcrete _ -> True +---- MTUnion t -> isModCnc t + _ -> False + +isModTrans :: Module i a -> Bool +isModTrans m = case mtype m of + MTTransfer _ _ -> True +---- MTUnion t -> isModTrans t + _ -> False + +sameMType :: Eq i => ModuleType i -> ModuleType i -> Bool +sameMType m n = case (n,m) of + (MTConcrete _, MTConcrete _) -> True + + (MTInstance _, MTInstance _) -> True + (MTInstance _, MTResource) -> True + (MTInstance _, MTConcrete _) -> True + + (MTInterface, MTInstance _) -> True + (MTInterface, MTResource) -> True -- for reuse + (MTInterface, MTAbstract) -> True -- for reuse + + (MTResource, MTInstance _) -> True + (MTResource, MTConcrete _) -> True -- for reuse + + _ -> m == n + +-- | don't generate code for interfaces and for incomplete modules +isCompilableModule :: ModInfo i a -> Bool +isCompilableModule m = case m of + ModMod m -> case mtype m of + MTInterface -> False + _ -> mstatus m == MSComplete + _ -> False --- + +-- | interface and "incomplete M" are not complete +isCompleteModule :: (Eq i) => Module i a -> Bool +isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface + + +-- | all abstract modules sorted from least to most dependent +allAbstracts :: Eq i => MGrammar i a -> [i] +allAbstracts gr = topoSort + [(i,extends m) | (i,ModMod m) <- modules gr, mtype m == MTAbstract] + +-- | the last abstract in dependency order (head of list) +greatestAbstract :: Eq i => MGrammar i a -> Maybe i +greatestAbstract gr = case allAbstracts gr of + [] -> Nothing + as -> return $ last as + +-- | all resource modules +allResources :: MGrammar i a -> [i] +allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m || isModCnc m] + +-- | the greatest resource in dependency order +greatestResource :: MGrammar i a -> Maybe i +greatestResource gr = case allResources gr of + [] -> Nothing + a -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008 + +-- | all concretes for a given abstract +allConcretes :: Eq i => MGrammar i a -> i -> [i] +allConcretes gr a = + [i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m] + +-- | all concrete modules for any abstract +allConcreteModules :: Eq i => MGrammar i a -> [i] +allConcreteModules gr = + [i | (i, ModMod m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m] diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs new file mode 100644 index 000000000..380cb3af7 --- /dev/null +++ b/src/GF/Infra/Option.hs @@ -0,0 +1,549 @@ +module GF.Infra.Option + ( + -- * Option types + Options, ModuleOptions, + Flags(..), ModuleFlags(..), + Mode(..), Phase(..), Verbosity(..), Encoding(..), OutputFormat(..), + SISRFormat(..), Optimization(..), + Dump(..), Printer(..), Recomp(..), + -- * Option parsing + parseOptions, parseModuleOptions, + -- * Option pretty-printing + moduleOptionsGFO, + -- * Option manipulation + addOptions, concatOptions, noOptions, + moduleOptions, + addModuleOptions, concatModuleOptions, noModuleOptions, + helpMessage, + -- * Checking specific options + flag, moduleFlag, + -- * Setting specific options + setOptimization, + -- * Convenience methods for checking options + verbAtLeast, dump + ) where + +import Control.Monad +import Data.Char (toLower) +import Data.List +import Data.Maybe +import GF.Infra.GetOpt +--import System.Console.GetOpt +import System.FilePath + +import GF.Data.ErrM + +import Data.Set (Set) +import qualified Data.Set as Set + + + + +usageHeader :: String +usageHeader = unlines + ["Usage: gfc [OPTIONS] [FILE [...]]", + "", + "How each FILE is handled depends on the file name suffix:", + "", + ".gf Normal or old GF source, will be compiled.", + ".gfo Compiled GF source, will be loaded as is.", + ".gfe Example-based GF source, will be converted to .gf and compiled.", + ".ebnf Extended BNF format, will be converted to .gf and compiled.", + ".cf Context-free (BNF) format, will be converted to .gf and compiled.", + "", + "If multiple FILES are given, they must be normal GF source, .gfo or .gfe files.", + "For the other input formats, only one file can be given.", + "", + "Command-line options:"] + + +helpMessage :: String +helpMessage = usageInfo usageHeader optDescr + + +-- FIXME: do we really want multi-line errors? +errors :: [String] -> Err a +errors = fail . unlines + +-- Types + +data Mode = ModeVersion | ModeHelp | ModeInteractive | ModeCompiler + deriving (Show,Eq,Ord) + +data Verbosity = Quiet | Normal | Verbose | Debug + deriving (Show,Eq,Ord,Enum,Bounded) + +data Phase = Preproc | Convert | Compile | Link + deriving (Show,Eq,Ord) + +data Encoding = UTF_8 | ISO_8859_1 | CP_1251 + deriving (Show,Eq,Ord) + +data OutputFormat = FmtPGF + | FmtJavaScript + | FmtHaskell + | FmtHaskell_GADT + | FmtBNF + | FmtSRGS_XML + | FmtSRGS_ABNF + | FmtJSGF + | FmtGSL + | FmtVoiceXML + | FmtSLF + | FmtRegExp + | FmtFA + deriving (Eq,Ord) + +data SISRFormat = + -- | SISR Working draft 1 April 2003 + -- <http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/> + SISR_WD20030401 + | SISR_1_0 + deriving (Show,Eq,Ord) + +data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues + deriving (Show,Eq,Ord) + +data Warning = WarnMissingLincat + deriving (Show,Eq,Ord) + +data Dump = DumpRebuild | DumpExtend | DumpRename | DumpTypeCheck | DumpRefresh | DumpOptimize | DumpCanon + deriving (Show,Eq,Ord) + +-- | Pretty-printing options +data Printer = PrinterStrip -- ^ Remove name qualifiers. + deriving (Show,Eq,Ord) + +data Recomp = AlwaysRecomp | RecompIfNewer | NeverRecomp + deriving (Show,Eq,Ord) + +data ModuleFlags = ModuleFlags { + optName :: Maybe String, + optAbsName :: Maybe String, + optCncName :: Maybe String, + optResName :: Maybe String, + optPreprocessors :: [String], + optEncoding :: Encoding, + optOptimizations :: Set Optimization, + optLibraryPath :: [FilePath], + optStartCat :: Maybe String, + optSpeechLanguage :: Maybe String, + optLexer :: Maybe String, + optUnlexer :: Maybe String, + optErasing :: Bool, + optBuildParser :: Bool, + optWarnings :: [Warning], + optDump :: [Dump] + } + deriving (Show) + +data Flags = Flags { + optMode :: Mode, + optStopAfterPhase :: Phase, + optVerbosity :: Verbosity, + optShowCPUTime :: Bool, + optEmitGFO :: Bool, + optGFODir :: FilePath, + optOutputFormats :: [OutputFormat], + optSISR :: Maybe SISRFormat, + optOutputFile :: Maybe FilePath, + optOutputDir :: Maybe FilePath, + optRecomp :: Recomp, + optPrinter :: [Printer], + optProb :: Bool, + optRetainResource :: Bool, + optModuleFlags :: ModuleFlags + } + deriving (Show) + +newtype Options = Options (Flags -> Flags) + +instance Show Options where + show (Options o) = show (o defaultFlags) + +newtype ModuleOptions = ModuleOptions (ModuleFlags -> ModuleFlags) + +-- Option parsing + +parseOptions :: [String] -> Err (Options, [FilePath]) +parseOptions args + | not (null errs) = errors errs + | otherwise = do opts <- liftM concatOptions $ sequence optss + return (opts, files) + where (optss, files, errs) = getOpt RequireOrder optDescr args + +parseModuleOptions :: [String] -> Err ModuleOptions +parseModuleOptions args + | not (null errs) = errors errs + | not (null files) = errors $ map ("Non-option among module options: " ++) files + | otherwise = liftM concatModuleOptions $ sequence flags + where (flags, files, errs) = getOpt RequireOrder moduleOptDescr args + +-- Showing options + +-- | Pretty-print the module options that are preserved in .gfo files. +moduleOptionsGFO :: ModuleOptions -> [(String,String)] +moduleOptionsGFO (ModuleOptions o) = + maybe [] (\x -> [("language",x)]) (optSpeechLanguage mfs) + ++ maybe [] (\x -> [("startcat",x)]) (optStartCat mfs) +-- ++ maybe [] (\x -> [("coding", e2s x)]) (Just (optEncoding mfs)) + ++ (if optErasing mfs then [("erasing","on")] else []) + where + mfs = o defaultModuleFlags + e2s e = maybe [] id $ lookup e [(s,e) | (e,s) <- encodings] + +-- Option manipulation + +noOptions :: Options +noOptions = Options id + +addOptions :: Options -- ^ Existing options. + -> Options -- ^ Options to add (these take preference). + -> Options +addOptions (Options o1) (Options o2) = Options (o2 . o1) + +concatOptions :: [Options] -> Options +concatOptions = foldr addOptions noOptions + +moduleOptions :: ModuleOptions -> Options +moduleOptions (ModuleOptions f) = Options (\o -> o { optModuleFlags = f (optModuleFlags o) }) + +addModuleOptions :: ModuleOptions -- ^ Existing options. + -> ModuleOptions -- ^ Options to add (these take preference). + -> ModuleOptions +addModuleOptions (ModuleOptions o1) (ModuleOptions o2) = ModuleOptions (o2 . o1) + +concatModuleOptions :: [ModuleOptions] -> ModuleOptions +concatModuleOptions = foldr addModuleOptions noModuleOptions + +noModuleOptions :: ModuleOptions +noModuleOptions = ModuleOptions id + +flag :: (Flags -> a) -> Options -> a +flag f (Options o) = f (o defaultFlags) + +moduleFlag :: (ModuleFlags -> a) -> Options -> a +moduleFlag f = flag (f . optModuleFlags) + +modifyFlags :: (Flags -> Flags) -> Options +modifyFlags = Options + +modifyModuleFlags :: (ModuleFlags -> ModuleFlags) -> Options +modifyModuleFlags = moduleOptions . ModuleOptions + + +{- + +parseModuleFlags :: Options -> [(String,Maybe String)] -> Err ModuleOptions +parseModuleFlags opts flags = + mapM (uncurry (findFlag moduleOptDescr)) flags >>= foldM (flip ($)) (optModuleOptions opts) + +findFlag :: Monad m => [OptDescr a] -> String -> Maybe String -> m a +findFlag opts n mv = + case filter (`flagMatches` n) opts of + [] -> fail $ "Unknown option: " ++ n + [opt] -> flagValue opt n mv + _ -> fail $ n ++ " matches multiple options." + +flagMatches :: OptDescr a -> String -> Bool +flagMatches (Option cs ss _ _) n = n `elem` (map (:[]) cs ++ ss) + +flagValue :: Monad m => OptDescr a -> String -> Maybe String -> m a +flagValue (Option _ _ arg _) n mv = + case (arg, mv) of + (NoArg x, Nothing) -> return x + (NoArg _, Just _ ) -> fail $ "Option " ++ n ++ " does not take a value." + (ReqArg _ _, Nothing) -> fail $ "Option " ++ n ++ " requires a value." + (ReqArg f _, Just x ) -> return (f x) + (OptArg f _, mx ) -> return (f mx) + +-} + +-- Default options + +defaultModuleFlags :: ModuleFlags +defaultModuleFlags = ModuleFlags { + optName = Nothing, + optAbsName = Nothing, + optCncName = Nothing, + optResName = Nothing, + optPreprocessors = [], + optEncoding = ISO_8859_1, + optOptimizations = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues], + optLibraryPath = [], + optStartCat = Nothing, + optSpeechLanguage = Nothing, + optLexer = Nothing, + optUnlexer = Nothing, + optErasing = False, + optBuildParser = True, + optWarnings = [], + optDump = [] + } + +defaultFlags :: Flags +defaultFlags = Flags { + optMode = ModeInteractive, + optStopAfterPhase = Compile, + optVerbosity = Normal, + optShowCPUTime = False, + optEmitGFO = True, + optGFODir = ".", + optOutputFormats = [FmtPGF], + optSISR = Nothing, + optOutputFile = Nothing, + optOutputDir = Nothing, + optRecomp = RecompIfNewer, + optPrinter = [], + optProb = False, + optRetainResource = False, + optModuleFlags = defaultModuleFlags + } + +-- Option descriptions + +moduleOptDescr :: [OptDescr (Err ModuleOptions)] +moduleOptDescr = + [ + Option ['n'] ["name"] (ReqArg name "NAME") + (unlines ["Use NAME as the name of the output. This is used in the output file names, ", + "with suffixes depending on the formats, and, when relevant, ", + "internally in the output."]), + Option [] ["abs"] (ReqArg absName "NAME") + ("Use NAME as the name of the abstract syntax module generated from " + ++ "a grammar in GF 1 format."), + Option [] ["cnc"] (ReqArg cncName "NAME") + ("Use NAME as the name of the concrete syntax module generated from " + ++ "a grammar in GF 1 format."), + Option [] ["res"] (ReqArg resName "NAME") + ("Use NAME as the name of the resource module generated from " + ++ "a grammar in GF 1 format."), + Option ['i'] [] (ReqArg addLibDir "DIR") "Add DIR to the library search path.", + Option [] ["path"] (ReqArg setLibPath "DIR:DIR:...") "Set the library search path.", + Option [] ["preproc"] (ReqArg preproc "CMD") + (unlines ["Use CMD to preprocess input files.", + "Multiple preprocessors can be used by giving this option multiple times."]), + Option [] ["coding"] (ReqArg coding "ENCODING") + ("Character encoding of the source grammar, ENCODING = " + ++ concat (intersperse " | " (map fst encodings)) ++ "."), + Option [] ["erasing"] (onOff erasing False) "Generate erasing grammar (default off).", + Option [] ["parser"] (onOff parser True) "Build parser (default on).", + Option [] ["startcat"] (ReqArg startcat "CAT") "Grammar start category.", + Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar.", + Option [] ["lexer"] (ReqArg lexer "LEXER") "Use lexer LEXER.", + Option [] ["unlexer"] (ReqArg unlexer "UNLEXER") "Use unlexer UNLEXER.", + Option [] ["optimize"] (ReqArg optimize "OPT") + "Select an optimization package. OPT = all | values | parametrize | none", + Option [] ["stem"] (onOff (toggleOptimize OptStem) True) "Perform stem-suffix analysis (default on).", + Option [] ["cse"] (onOff (toggleOptimize OptCSE) True) "Perform common sub-expression elimination (default on).", + dumpOption "rebuild" DumpRebuild, + dumpOption "extend" DumpExtend, + dumpOption "rename" DumpRename, + dumpOption "tc" DumpTypeCheck, + dumpOption "refresh" DumpRefresh, + dumpOption "opt" DumpOptimize, + dumpOption "canon" DumpCanon + ] + where + name x = set $ \o -> o { optName = Just x } + absName x = set $ \o -> o { optAbsName = Just x } + cncName x = set $ \o -> o { optCncName = Just x } + resName x = set $ \o -> o { optResName = Just x } + addLibDir x = set $ \o -> o { optLibraryPath = x:optLibraryPath o } + setLibPath x = set $ \o -> o { optLibraryPath = splitInModuleSearchPath x } + preproc x = set $ \o -> o { optPreprocessors = optPreprocessors o ++ [x] } + coding x = case lookup x encodings of + Just c -> set $ \o -> o { optEncoding = c } + Nothing -> fail $ "Unknown character encoding: " ++ x + erasing x = set $ \o -> o { optErasing = x } + parser x = set $ \o -> o { optBuildParser = x } + startcat x = set $ \o -> o { optStartCat = Just x } + language x = set $ \o -> o { optSpeechLanguage = Just x } + lexer x = set $ \o -> o { optLexer = Just x } + unlexer x = set $ \o -> o { optUnlexer = Just x } + + optimize x = case lookup x optimizationPackages of + Just p -> set $ \o -> o { optOptimizations = p } + Nothing -> fail $ "Unknown optimization package: " ++ x + + toggleOptimize x b = set $ setOptimization' x b + + dumpOption s d = Option [] ["dump-"++s] (NoArg (set $ \o -> o { optDump = d:optDump o})) ("Dump output of the " ++ s ++ " phase.") + + set = return . ModuleOptions + +optDescr :: [OptDescr (Err Options)] +optDescr = + [ + Option ['?','h'] ["help"] (NoArg (mode ModeHelp)) "Show help message.", + Option ['V'] ["version"] (NoArg (mode ModeVersion)) "Display GF version number.", + Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 2.", + Option ['q','s'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.", + Option [] ["batch"] (NoArg (mode ModeCompiler)) "Run in batch compiler mode.", + Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).", + Option ['E'] [] (NoArg (phase Preproc)) "Stop after preprocessing (with --preproc).", + Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.", + Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfo (default) .", + Option [] ["make"] (NoArg (phase Link)) "Build .pgf file and other output files.", + Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.", + Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).", + Option [] ["emit-gfo"] (NoArg (emitGFO True)) "Create .gfo files (default).", + Option [] ["no-emit-gfo"] (NoArg (emitGFO False)) "Do not create .gfo files.", + Option [] ["gfo-dir"] (ReqArg gfoDir "DIR") "Directory to put .gfo files in (default = '.').", + Option ['f'] ["output-format"] (ReqArg outFmt "FMT") + (unlines ["Output format. FMT can be one of:", + "Multiple concrete: pgf (default), gar, js, ...", + "Single concrete only: cf, bnf, lbnf, gsl, srgs_xml, srgs_abnf, ...", + "Abstract only: haskell, ..."]), + Option [] ["sisr"] (ReqArg sisrFmt "FMT") + (unlines ["Include SISR tags in generated speech recognition grammars.", + "FMT can be one of: old, 1.0"]), + Option ['o'] ["output-file"] (ReqArg outFile "FILE") + "Save output in FILE (default is out.X, where X depends on output format.", + Option ['D'] ["output-dir"] (ReqArg outDir "DIR") + "Save output files (other than .gfc files) in DIR.", + Option [] ["src","force-recomp"] (NoArg (recomp AlwaysRecomp)) + "Always recompile from source.", + Option [] ["gfo","recomp-if-newer"] (NoArg (recomp RecompIfNewer)) + "(default) Recompile from source if the source is newer than the .gfo file.", + Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp)) + "Never recompile from source, if there is already .gfo file.", + Option [] ["strip"] (NoArg (printer PrinterStrip)) + "Remove name qualifiers when pretty-printing.", + Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = True })) "Retain opers.", + Option [] ["prob"] (NoArg (prob True)) "Read probabilities from '--# prob' pragmas." + ] ++ map (fmap (liftM moduleOptions)) moduleOptDescr + where phase x = set $ \o -> o { optStopAfterPhase = x } + mode x = set $ \o -> o { optMode = x } + verbosity mv = case mv of + Nothing -> set $ \o -> o { optVerbosity = Verbose } + Just v -> case readMaybe v >>= toEnumBounded of + Just i -> set $ \o -> o { optVerbosity = i } + Nothing -> fail $ "Bad verbosity: " ++ show v + cpu x = set $ \o -> o { optShowCPUTime = x } + emitGFO x = set $ \o -> o { optEmitGFO = x } + gfoDir x = set $ \o -> o { optGFODir = x } + outFmt x = readOutputFormat x >>= \f -> + set $ \o -> o { optOutputFormats = optOutputFormats o ++ [f] } + sisrFmt x = case x of + "old" -> set $ \o -> o { optSISR = Just SISR_WD20030401 } + "1.0" -> set $ \o -> o { optSISR = Just SISR_1_0 } + _ -> fail $ "Unknown SISR format: " ++ show x + outFile x = set $ \o -> o { optOutputFile = Just x } + outDir x = set $ \o -> o { optOutputDir = Just x } + recomp x = set $ \o -> o { optRecomp = x } + printer x = set $ \o -> o { optPrinter = x : optPrinter o } + prob x = set $ \o -> o { optProb = x } + + set = return . Options + +outputFormats :: [(String,OutputFormat)] +outputFormats = + [("pgf", FmtPGF), + ("js", FmtJavaScript), + ("haskell", FmtHaskell), + ("haskell_gadt", FmtHaskell_GADT), + ("bnf", FmtBNF), + ("srgs_xml", FmtSRGS_XML), + ("srgs_abnf", FmtSRGS_ABNF), + ("jsgf", FmtJSGF), + ("gsl", FmtGSL), + ("vxml", FmtVoiceXML), + ("slf", FmtSLF), + ("regexp", FmtRegExp), + ("fa", FmtFA)] + +instance Show OutputFormat where + show = lookupShow outputFormats + +instance Read OutputFormat where + readsPrec = lookupReadsPrec outputFormats + +optimizationPackages :: [(String, Set Optimization)] +optimizationPackages = + [("all_subs", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]), -- deprecated + ("all", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]), + ("values", Set.fromList [OptStem,OptCSE,OptExpand,OptValues]), + ("parametrize", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]), + ("none", Set.fromList [OptStem,OptCSE,OptExpand]), + ("noexpand", Set.fromList [OptStem,OptCSE])] + +encodings :: [(String,Encoding)] +encodings = + [("utf8", UTF_8), + ("cp1251", CP_1251), + ("latin1", ISO_8859_1) + ] + +lookupShow :: Eq a => [(String,a)] -> a -> String +lookupShow xs z = fromMaybe "lookupShow" $ lookup z [(y,x) | (x,y) <- xs] + +lookupReadsPrec :: [(String,a)] -> Int -> ReadS a +lookupReadsPrec xs _ s = [(z,rest) | (x,rest) <- lex s, (y,z) <- xs, y == x] + +onOff :: Monad m => (Bool -> m a) -> Bool -> ArgDescr (m a) +onOff f def = OptArg g "[on,off]" + where g ma = maybe (return def) readOnOff ma >>= f + readOnOff x = case map toLower x of + "on" -> return True + "off" -> return False + _ -> fail $ "Expected [on,off], got: " ++ show x + +readOutputFormat :: Monad m => String -> m OutputFormat +readOutputFormat s = + maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats + +-- FIXME: this is a copy of the function in GF.Devel.UseIO. +splitInModuleSearchPath :: String -> [FilePath] +splitInModuleSearchPath s = case break isPathSep s of + (f,_:cs) -> f : splitInModuleSearchPath cs + (f,_) -> [f] + where + isPathSep :: Char -> Bool + isPathSep c = c == ':' || c == ';' + +-- +-- * Convenience functions for checking options +-- + +verbAtLeast :: Options -> Verbosity -> Bool +verbAtLeast opts v = flag optVerbosity opts >= v + +dump :: Options -> Dump -> Bool +dump opts d = moduleFlag ((d `elem`) . optDump) opts + +-- +-- * Convenience functions for setting options +-- + +setOptimization :: Optimization -> Bool -> Options +setOptimization o b = modifyModuleFlags (setOptimization' o b) + +setOptimization' :: Optimization -> Bool -> ModuleFlags -> ModuleFlags +setOptimization' o b f = f { optOptimizations = g (optOptimizations f)} + where g = if b then Set.insert o else Set.delete o + +-- +-- * General utilities +-- + +readMaybe :: Read a => String -> Maybe a +readMaybe s = case reads s of + [(x,"")] -> Just x + _ -> Nothing + +toEnumBounded :: (Bounded a, Enum a, Ord a) => Int -> Maybe a +toEnumBounded i = let mi = minBound + ma = maxBound `asTypeOf` mi + in if i >= fromEnum mi && i <= fromEnum ma + then Just (toEnum i `asTypeOf` mi) + else Nothing + + +instance Functor OptDescr where + fmap f (Option cs ss d s) = Option cs ss (fmap f d) s + +instance Functor ArgDescr where + fmap f (NoArg x) = NoArg (f x) + fmap f (ReqArg g s) = ReqArg (f . g) s + fmap f (OptArg g s) = OptArg (f . g) s diff --git a/src/GF/Infra/PrintClass.hs b/src/GF/Infra/PrintClass.hs new file mode 100644 index 000000000..5e94984a6 --- /dev/null +++ b/src/GF/Infra/PrintClass.hs @@ -0,0 +1,51 @@ +module GF.Infra.PrintClass where + +import Data.List (intersperse) + +class Print a where + prt :: a -> String + prtList :: [a] -> String + prtList as = "[" ++ prtSep "," as ++ "]" + +prtSep :: Print a => String -> [a] -> String +prtSep sep = concat . intersperse sep . map prt + +prtBefore :: Print a => String -> [a] -> String +prtBefore before = prtBeforeAfter before "" + +prtAfter :: Print a => String -> [a] -> String +prtAfter after = prtBeforeAfter "" after + +prtBeforeAfter :: Print a => String -> String -> [a] -> String +prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ] + +prtPairList :: (Print a, Print b) => String -> String -> [(a,b)] -> String +prtPairList comma sep xys = prtSep sep [ prt x ++ comma ++ prt y | (x,y) <- xys ] +prIO :: Print a => a -> IO () +prIO = putStr . prt + +instance Print a => Print [a] where + prt = prtList + +instance (Print a, Print b) => Print (a, b) where + prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")" + +instance (Print a, Print b, Print c) => Print (a, b, c) where + prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")" + +instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where + prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")" + +instance Print Char where + prt = return + prtList = id + +instance Print Int where + prt = show + +instance Print Integer where + prt = show + +instance Print a => Print (Maybe a) where + prt (Just a) = prt a + prt Nothing = "Nothing" diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs new file mode 100644 index 000000000..00b956708 --- /dev/null +++ b/src/GF/Infra/UseIO.hs @@ -0,0 +1,277 @@ +{-# OPTIONS -cpp #-} +---------------------------------------------------------------------- +-- | +-- Module : UseIO +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/08/08 09:01:25 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.17 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module GF.Infra.UseIO where + +import GF.Data.Operations +import GF.Infra.Option +import Paths_gf(getDataDir) + +import System.Directory +import System.FilePath +import System.IO +import System.IO.Error +import System.Environment +import System.Exit +import System.CPUTime +import Control.Monad +import Control.Exception(evaluate) +import qualified Data.ByteString.Char8 as BS + +putShow' :: Show a => (c -> a) -> c -> IO () +putShow' f = putStrLn . show . length . show . f + +putIfVerb :: Options -> String -> IO () +putIfVerb opts msg = + when (verbAtLeast opts Verbose) $ putStrLn msg + +putIfVerbW :: Options -> String -> IO () +putIfVerbW opts msg = + when (verbAtLeast opts Verbose) $ putStr (' ' : msg) + +errOptIO :: Options -> a -> Err a -> IO a +errOptIO os e m = case m of + Ok x -> return x + Bad k -> do + putIfVerb os k + return e + +readFileIf f = catch (readFile f) (\_ -> reportOn f) where + reportOn f = do + putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string") + return "" + +readFileIfStrict f = catch (BS.readFile f) (\_ -> reportOn f) where + reportOn f = do + putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string") + return BS.empty + +type FileName = String +type InitPath = String +type FullPath = String + +getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) +getFilePath ps file = getFilePathMsg ("file" +++ file +++ "not found\n") ps file + +getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath) +getFilePathMsg msg paths file = get paths where + get [] = putStrFlush msg >> return Nothing + get (p:ps) = do + let pfile = p </> file + exist <- doesFileExist pfile + if not exist + then get ps + else do pfile <- canonicalizePath pfile + return (Just pfile) + +readFileIfPath :: [FilePath] -> String -> IOE (FilePath,BS.ByteString) +readFileIfPath paths file = do + mpfile <- ioeIO $ getFilePath paths file + case mpfile of + Just pfile -> do + s <- ioeIO $ BS.readFile pfile + return (dropFileName pfile,s) + _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.") + +doesFileExistPath :: [FilePath] -> String -> IOE Bool +doesFileExistPath paths file = do + mpfile <- ioeIO $ getFilePathMsg "" paths file + return $ maybe False (const True) mpfile + +gfLibraryPath = "GF_LIB_PATH" +gfGrammarPathVar = "GF_GRAMMAR_PATH" + +getLibraryPath :: IO FilePath +getLibraryPath = + catch + (getEnv gfLibraryPath) + (\ex -> getDataDir >>= \path -> return (path </> "lib")) + +-- | extends the search path with the +-- 'gfLibraryPath' and 'gfGrammarPathVar' +-- environment variables. Returns only existing paths. +extendPathEnv :: [FilePath] -> IO [FilePath] +extendPathEnv ps = do + b <- getLibraryPath -- e.g. GF_LIB_PATH + s <- catch (getEnv gfGrammarPathVar) (const (return "")) -- e.g. GF_GRAMMAR_PATH + let ss = ps ++ splitSearchPath s + liftM concat $ mapM allSubdirs $ ss ++ [b </> s | s <- ss ++ ["prelude"]] + where + allSubdirs :: FilePath -> IO [FilePath] + allSubdirs [] = return [[]] + allSubdirs p = case last p of + '*' -> do let path = init p + fs <- getSubdirs path + return [path </> f | f <- fs] + _ -> do exists <- doesDirectoryExist p + if exists + then return [p] + else return [] + +getSubdirs :: FilePath -> IO [FilePath] +getSubdirs dir = do + fs <- catch (getDirectoryContents dir) (const $ return []) + foldM (\fs f -> do let fpath = dir </> f + p <- getPermissions fpath + if searchable p && not (take 1 f==".") + then return (fpath:fs) + else return fs ) [] fs + +justModuleName :: FilePath -> String +justModuleName = dropExtension . takeFileName + +splitInModuleSearchPath :: String -> [FilePath] +splitInModuleSearchPath s = case break isPathSep s of + (f,_:cs) -> f : splitInModuleSearchPath cs + (f,_) -> [f] + where + isPathSep :: Char -> Bool + isPathSep c = c == ':' || c == ';' + +-- + +getLineWell :: IO String -> IO String +getLineWell ios = + catch getLine (\e -> if (isEOFError e) then ios else ioError e) + +putStrFlush :: String -> IO () +putStrFlush s = putStr s >> hFlush stdout + +putStrLnFlush :: String -> IO () +putStrLnFlush s = putStrLn s >> hFlush stdout + +-- * a generic quiz session + +type QuestionsAndAnswers = [(String, String -> (Integer,String))] + +teachDialogue :: QuestionsAndAnswers -> String -> IO () +teachDialogue qas welc = do + putStrLn $ welc ++++ genericTeachWelcome + teach (0,0) qas + where + teach _ [] = do putStrLn "Sorry, ran out of problems" + teach (score,total) ((question,grade):quas) = do + putStr ("\n" ++ question ++ "\n> ") + answer <- getLine + if (answer == ".") then return () else do + let (result, feedback) = grade answer + score' = score + result + total' = total + 1 + putStr (feedback ++++ "Score" +++ show score' ++ "/" ++ show total') + if (total' > 9 && fromInteger score' / fromInteger total' >= 0.75) + then do putStrLn "\nCongratulations - you passed!" + else teach (score',total') quas + + genericTeachWelcome = + "The quiz is over when you have done at least 10 examples" ++++ + "with at least 75 % success." +++++ + "You can interrupt the quiz by entering a line consisting of a dot ('.').\n" + + +-- * IO monad with error; adapted from state monad + +newtype IOE a = IOE (IO (Err a)) + +appIOE :: IOE a -> IO (Err a) +appIOE (IOE iea) = iea + +ioe :: IO (Err a) -> IOE a +ioe = IOE + +ioeIO :: IO a -> IOE a +ioeIO io = ioe (io >>= return . return) + +ioeErr :: Err a -> IOE a +ioeErr = ioe . return + +instance Monad IOE where + return a = ioe (return (return a)) + IOE c >>= f = IOE $ do + x <- c -- Err a + appIOE $ err ioeBad f x -- f :: a -> IOE a + +ioeBad :: String -> IOE a +ioeBad = ioe . return . Bad + +useIOE :: a -> IOE a -> IO a +useIOE a ioe = appIOE ioe >>= err (\s -> putStrLn s >> return a) return + +foldIOE :: (a -> b -> IOE a) -> a -> [b] -> IOE (a, Maybe String) +foldIOE f s xs = case xs of + [] -> return (s,Nothing) + x:xx -> do + ev <- ioeIO $ appIOE (f s x) + case ev of + Ok v -> foldIOE f v xx + Bad m -> return $ (s, Just m) + +dieIOE :: IOE a -> IO a +dieIOE x = appIOE x >>= err die return + +die :: String -> IO a +die s = do hPutStrLn stderr s + exitFailure + +putStrLnE :: String -> IOE () +putStrLnE = ioeIO . putStrLnFlush + +putStrE :: String -> IOE () +putStrE = ioeIO . putStrFlush + +putPointE :: Verbosity -> Options -> String -> IOE a -> IOE a +putPointE v opts msg act = do + when (verbAtLeast opts v) $ ioeIO $ putStrFlush msg + + t1 <- ioeIO $ getCPUTime + a <- act >>= ioeIO . evaluate + t2 <- ioeIO $ getCPUTime + + if flag optShowCPUTime opts + then putStrLnE (" " ++ show ((t2 - t1) `div` 1000000000) ++ " msec") + else when (verbAtLeast opts v) $ putStrLnE "" + + return a + + +-- ((do {s <- readFile f; return (return s)}) ) +readFileIOE :: FilePath -> IOE BS.ByteString +readFileIOE f = ioe $ catch (BS.readFile f >>= return . return) + (\e -> return (Bad (show e))) + +-- | like readFileIOE but look also in the GF library if file not found +-- +-- intended semantics: if file is not found, try @\$GF_LIB_PATH\/file@ +-- (even if file is an absolute path, but this should always fail) +-- it returns not only contents of the file, but also the path used +readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, BS.ByteString) +readFileLibraryIOE ini f = ioe $ do + lp <- getLibraryPath + tryRead ini $ \_ -> + tryRead lp $ \e -> + return (Bad (show e)) + where + tryRead path onError = + catch (BS.readFile fpath >>= \s -> return (return (fpath,s))) + onError + where + fpath = path </> f + +-- | example +koeIOE :: IO () +koeIOE = useIOE () $ do + s <- ioeIO $ getLine + s2 <- ioeErr $ mapM (!? 2) $ words s + ioeIO $ putStrLn s2 + diff --git a/src/GF/JavaScript/AbsJS.hs b/src/GF/JavaScript/AbsJS.hs new file mode 100644 index 000000000..2632ade48 --- /dev/null +++ b/src/GF/JavaScript/AbsJS.hs @@ -0,0 +1,60 @@ +module GF.JavaScript.AbsJS where + +-- Haskell module generated by the BNF converter + +newtype Ident = Ident String deriving (Eq,Ord,Show) +data Program = + Program [Element] + deriving (Eq,Ord,Show) + +data Element = + FunDef Ident [Ident] [Stmt] + | ElStmt Stmt + deriving (Eq,Ord,Show) + +data Stmt = + SCompound [Stmt] + | SReturnVoid + | SReturn Expr + | SDeclOrExpr DeclOrExpr + deriving (Eq,Ord,Show) + +data DeclOrExpr = + Decl [DeclVar] + | DExpr Expr + deriving (Eq,Ord,Show) + +data DeclVar = + DVar Ident + | DInit Ident Expr + deriving (Eq,Ord,Show) + +data Expr = + EAssign Expr Expr + | ENew Ident [Expr] + | EMember Expr Ident + | EIndex Expr Expr + | ECall Expr [Expr] + | EVar Ident + | EInt Int + | EDbl Double + | EStr String + | ETrue + | EFalse + | ENull + | EThis + | EFun [Ident] [Stmt] + | EArray [Expr] + | EObj [Property] + | ESeq [Expr] + deriving (Eq,Ord,Show) + +data Property = + Prop PropertyName Expr + deriving (Eq,Ord,Show) + +data PropertyName = + IdentPropName Ident + | StringPropName String + deriving (Eq,Ord,Show) + diff --git a/src/GF/JavaScript/JS.cf b/src/GF/JavaScript/JS.cf new file mode 100644 index 000000000..fe31a2074 --- /dev/null +++ b/src/GF/JavaScript/JS.cf @@ -0,0 +1,55 @@ +entrypoints Program; + +Program. Program ::= [Element]; + +FunDef. Element ::= "function" Ident "(" [Ident] ")" "{" [Stmt] "}" ; +ElStmt. Element ::= Stmt; +separator Element "" ; + +separator Ident "," ; + +SCompound. Stmt ::= "{" [Stmt] "}" ; +SReturnVoid. Stmt ::= "return" ";" ; +SReturn. Stmt ::= "return" Expr ";" ; +SDeclOrExpr. Stmt ::= DeclOrExpr ";" ; +separator Stmt "" ; + +Decl. DeclOrExpr ::= "var" [DeclVar]; +DExpr. DeclOrExpr ::= Expr1 ; + +DVar. DeclVar ::= Ident ; +DInit. DeclVar ::= Ident "=" Expr ; +separator DeclVar "," ; + +EAssign. Expr13 ::= Expr14 "=" Expr13 ; + +ENew. Expr14 ::= "new" Ident "(" [Expr] ")" ; + +EMember. Expr15 ::= Expr15 "." Ident ; +EIndex. Expr15 ::= Expr15 "[" Expr "]" ; +ECall. Expr15 ::= Expr15 "(" [Expr] ")" ; + +EVar. Expr16 ::= Ident ; +EInt. Expr16 ::= Integer ; +EDbl. Expr16 ::= Double ; +EStr. Expr16 ::= String ; +ETrue. Expr16 ::= "true" ; +EFalse. Expr16 ::= "false" ; +ENull. Expr16 ::= "null" ; +EThis. Expr16 ::= "this" ; +EFun. Expr16 ::= "function" "(" [Ident] ")" "{" [Stmt] "}" ; +EArray. Expr16 ::= "[" [Expr] "]" ; +EObj. Expr16 ::= "{" [Property] "}" ; + +eseq1. Expr16 ::= "(" Expr "," [Expr] ")"; +internal ESeq. Expr16 ::= "(" [Expr] ")" ; +define eseq1 x xs = ESeq (x:xs); + +separator Expr "," ; +coercions Expr 16 ; + +Prop. Property ::= PropertyName ":" Expr ; +separator Property "," ; + +IdentPropName. PropertyName ::= Ident ; +StringPropName. PropertyName ::= String ; diff --git a/src/GF/JavaScript/LexJS.x b/src/GF/JavaScript/LexJS.x new file mode 100644 index 000000000..10ba66d69 --- /dev/null +++ b/src/GF/JavaScript/LexJS.x @@ -0,0 +1,132 @@ +-- -*- haskell -*- +-- This Alex file was machine-generated by the BNF converter +{ +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module GF.JavaScript.LexJS where + + +} + + +$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME +$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME +$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME +$d = [0-9] -- digit +$i = [$l $d _ '] -- identifier character +$u = [\0-\255] -- universal: any character + +@rsyms = -- symbols and non-identifier-like reserved words + \( | \) | \{ | \} | \, | \; | \= | \. | \[ | \] | \: + +:- + +$white+ ; +@rsyms { tok (\p s -> PT p (TS $ share s)) } + +$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) } +\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) } + +$d+ { tok (\p s -> PT p (TI $ share s)) } +$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) } + +{ + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" + +posLineCol (Pn _ l c) = (l,c) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken t = case t of + PT _ (TS s) -> s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + + _ -> show t + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords = b "return" (b "new" (b "function" (b "false" N N) N) (b "null" N N)) (b "true" (b "this" N N) (b "var" N N)) + where b s = B s (TS s) + +unescapeInitTail :: String -> String +unescapeInitTail = unesc . tail where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type AlexInput = (Posn, -- current position, + Char, -- previous char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', str) + where + go :: (Posn, Char, String) -> [Token] + go inp@(pos, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _) -> [Err pos] + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p, c, []) = Nothing +alexGetChar (p, _, (c:s)) = + let p' = alexMove p c + in p' `seq` Just (c, (p', c, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, s) = c +} diff --git a/src/GF/JavaScript/Makefile b/src/GF/JavaScript/Makefile new file mode 100644 index 000000000..10f867b06 --- /dev/null +++ b/src/GF/JavaScript/Makefile @@ -0,0 +1,14 @@ +all: + happy -gca ParJS.y + alex -g LexJS.x + +bnfc: + (cd ../.. && bnfc -p GF.JavaScript GF/JavaScript/JS.cf) + -rm -f *.bak + +clean: + -rm -f *.log *.aux *.hi *.o *.dvi + -rm -f DocJS.ps +distclean: clean + -rm -f DocJS.* LexJS.* ParJS.* LayoutJS.* SkelJS.* PrintJS.* TestJS.* AbsJS.* TestJS ErrM.* SharedString.* JS.dtd XMLJS.* Makefile* + diff --git a/src/GF/JavaScript/ParJS.y b/src/GF/JavaScript/ParJS.y new file mode 100644 index 000000000..bf0614757 --- /dev/null +++ b/src/GF/JavaScript/ParJS.y @@ -0,0 +1,225 @@ +-- This Happy file was machine-generated by the BNF converter +{ +{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module GF.JavaScript.ParJS where +import GF.JavaScript.AbsJS +import GF.JavaScript.LexJS +import GF.Data.ErrM +} + +%name pProgram Program + +-- no lexer declaration +%monad { Err } { thenM } { returnM } +%tokentype { Token } + +%token + '(' { PT _ (TS "(") } + ')' { PT _ (TS ")") } + '{' { PT _ (TS "{") } + '}' { PT _ (TS "}") } + ',' { PT _ (TS ",") } + ';' { PT _ (TS ";") } + '=' { PT _ (TS "=") } + '.' { PT _ (TS ".") } + '[' { PT _ (TS "[") } + ']' { PT _ (TS "]") } + ':' { PT _ (TS ":") } + 'false' { PT _ (TS "false") } + 'function' { PT _ (TS "function") } + 'new' { PT _ (TS "new") } + 'null' { PT _ (TS "null") } + 'return' { PT _ (TS "return") } + 'this' { PT _ (TS "this") } + 'true' { PT _ (TS "true") } + 'var' { PT _ (TS "var") } + +L_ident { PT _ (TV $$) } +L_integ { PT _ (TI $$) } +L_doubl { PT _ (TD $$) } +L_quoted { PT _ (TL $$) } +L_err { _ } + + +%% + +Ident :: { Ident } : L_ident { Ident $1 } +Integer :: { Integer } : L_integ { (read $1) :: Integer } +Double :: { Double } : L_doubl { (read $1) :: Double } +String :: { String } : L_quoted { $1 } + +Program :: { Program } +Program : ListElement { Program (reverse $1) } + + +Element :: { Element } +Element : 'function' Ident '(' ListIdent ')' '{' ListStmt '}' { FunDef $2 $4 (reverse $7) } + | Stmt { ElStmt $1 } + + +ListElement :: { [Element] } +ListElement : {- empty -} { [] } + | ListElement Element { flip (:) $1 $2 } + + +ListIdent :: { [Ident] } +ListIdent : {- empty -} { [] } + | Ident { (:[]) $1 } + | Ident ',' ListIdent { (:) $1 $3 } + + +Stmt :: { Stmt } +Stmt : '{' ListStmt '}' { SCompound (reverse $2) } + | 'return' ';' { SReturnVoid } + | 'return' Expr ';' { SReturn $2 } + | DeclOrExpr ';' { SDeclOrExpr $1 } + + +ListStmt :: { [Stmt] } +ListStmt : {- empty -} { [] } + | ListStmt Stmt { flip (:) $1 $2 } + + +DeclOrExpr :: { DeclOrExpr } +DeclOrExpr : 'var' ListDeclVar { Decl $2 } + | Expr1 { DExpr $1 } + + +DeclVar :: { DeclVar } +DeclVar : Ident { DVar $1 } + | Ident '=' Expr { DInit $1 $3 } + + +ListDeclVar :: { [DeclVar] } +ListDeclVar : {- empty -} { [] } + | DeclVar { (:[]) $1 } + | DeclVar ',' ListDeclVar { (:) $1 $3 } + + +Expr13 :: { Expr } +Expr13 : Expr14 '=' Expr13 { EAssign $1 $3 } + | Expr14 { $1 } + + +Expr14 :: { Expr } +Expr14 : 'new' Ident '(' ListExpr ')' { ENew $2 $4 } + | Expr15 { $1 } + + +Expr15 :: { Expr } +Expr15 : Expr15 '.' Ident { EMember $1 $3 } + | Expr15 '[' Expr ']' { EIndex $1 $3 } + | Expr15 '(' ListExpr ')' { ECall $1 $3 } + | Expr16 { $1 } + + +Expr16 :: { Expr } +Expr16 : Ident { EVar $1 } + | Integer { EInt $1 } + | Double { EDbl $1 } + | String { EStr $1 } + | 'true' { ETrue } + | 'false' { EFalse } + | 'null' { ENull } + | 'this' { EThis } + | 'function' '(' ListIdent ')' '{' ListStmt '}' { EFun $3 (reverse $6) } + | '[' ListExpr ']' { EArray $2 } + | '{' ListProperty '}' { EObj $2 } + | '(' Expr ',' ListExpr ')' { eseq1_ $2 $4 } + | '(' Expr ')' { $2 } + + +ListExpr :: { [Expr] } +ListExpr : {- empty -} { [] } + | Expr { (:[]) $1 } + | Expr ',' ListExpr { (:) $1 $3 } + + +Expr :: { Expr } +Expr : Expr1 { $1 } + + +Expr1 :: { Expr } +Expr1 : Expr2 { $1 } + + +Expr2 :: { Expr } +Expr2 : Expr3 { $1 } + + +Expr3 :: { Expr } +Expr3 : Expr4 { $1 } + + +Expr4 :: { Expr } +Expr4 : Expr5 { $1 } + + +Expr5 :: { Expr } +Expr5 : Expr6 { $1 } + + +Expr6 :: { Expr } +Expr6 : Expr7 { $1 } + + +Expr7 :: { Expr } +Expr7 : Expr8 { $1 } + + +Expr8 :: { Expr } +Expr8 : Expr9 { $1 } + + +Expr9 :: { Expr } +Expr9 : Expr10 { $1 } + + +Expr10 :: { Expr } +Expr10 : Expr11 { $1 } + + +Expr11 :: { Expr } +Expr11 : Expr12 { $1 } + + +Expr12 :: { Expr } +Expr12 : Expr13 { $1 } + + +Property :: { Property } +Property : PropertyName ':' Expr { Prop $1 $3 } + + +ListProperty :: { [Property] } +ListProperty : {- empty -} { [] } + | Property { (:[]) $1 } + | Property ',' ListProperty { (:) $1 $3 } + + +PropertyName :: { PropertyName } +PropertyName : Ident { IdentPropName $1 } + | String { StringPropName $1 } + + + +{ + +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 +eseq1_ x_ xs_ = ESeq (x_ : xs_) +} + diff --git a/src/GF/JavaScript/PrintJS.hs b/src/GF/JavaScript/PrintJS.hs new file mode 100644 index 000000000..4e04e3cbf --- /dev/null +++ b/src/GF/JavaScript/PrintJS.hs @@ -0,0 +1,169 @@ +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module GF.JavaScript.PrintJS (printTree, Doc, Print(..)) where + +-- pretty-printer generated by the BNF converter + +import GF.JavaScript.AbsJS +import Data.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 + t:ts | not (spaceAfter t) -> showString t . rend i ts + t:ts@(t':_) | not (spaceBefore t') -> showString t . 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)) + +spaceAfter :: String -> Bool +spaceAfter = (`notElem` [".","(","[","{","\n"]) + +spaceBefore :: String -> Bool +spaceBefore = (`notElem` [",",".",":",";","(",")","[","]","{","}","\n"]) + +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 Int where + prt _ x = doc (shows x) + + +instance Print Double where + prt _ x = doc (shows x) + + +instance Print Ident where + prt _ (Ident 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 Program where + prt i e = case e of + Program elements -> prPrec i 0 (concatD [prt 0 elements]) + + +instance Print Element where + prt i e = case e of + FunDef id ids stmts -> prPrec i 0 (concatD [doc (showString "function") , prt 0 id , doc (showString "(") , prt 0 ids , doc (showString ")") , doc (showString "{") , prt 0 stmts , doc (showString "}")]) + ElStmt stmt -> prPrec i 0 (concatD [prt 0 stmt]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString "\n"), prt 0 xs]) -- HACKED! + +instance Print Stmt where + prt i e = case e of + SCompound stmts -> prPrec i 0 (concatD [doc (showString "{") , prt 0 stmts , doc (showString "}")]) + SReturnVoid -> prPrec i 0 (concatD [doc (showString "return") , doc (showString ";")]) + SReturn expr -> prPrec i 0 (concatD [doc (showString "return") , prt 0 expr , doc (showString ";")]) + SDeclOrExpr declorexpr -> prPrec i 0 (concatD [prt 0 declorexpr , doc (showString ";")]) + + prtList es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) + +instance Print DeclOrExpr where + prt i e = case e of + Decl declvars -> prPrec i 0 (concatD [doc (showString "var") , prt 0 declvars]) + DExpr expr -> prPrec i 0 (concatD [prt 1 expr]) + + +instance Print DeclVar where + prt i e = case e of + DVar id -> prPrec i 0 (concatD [prt 0 id]) + DInit id expr -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 expr]) + + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) + +instance Print Expr where + prt i e = case e of + EAssign expr0 expr -> prPrec i 13 (concatD [prt 14 expr0 , doc (showString "=") , prt 13 expr]) + ENew id exprs -> prPrec i 14 (concatD [doc (showString "new") , prt 0 id , doc (showString "(") , prt 0 exprs , doc (showString ")")]) + EMember expr id -> prPrec i 15 (concatD [prt 15 expr , doc (showString ".") , prt 0 id]) + EIndex expr0 expr -> prPrec i 15 (concatD [prt 15 expr0 , doc (showString "[") , prt 0 expr , doc (showString "]")]) + ECall expr exprs -> prPrec i 15 (concatD [prt 15 expr , doc (showString "(") , prt 0 exprs , doc (showString ")")]) + EVar id -> prPrec i 16 (concatD [prt 0 id]) + EInt n -> prPrec i 16 (concatD [prt 0 n]) + EDbl d -> prPrec i 16 (concatD [prt 0 d]) + EStr str -> prPrec i 16 (concatD [prt 0 str]) + ETrue -> prPrec i 16 (concatD [doc (showString "true")]) + EFalse -> prPrec i 16 (concatD [doc (showString "false")]) + ENull -> prPrec i 16 (concatD [doc (showString "null")]) + EThis -> prPrec i 16 (concatD [doc (showString "this")]) + EFun ids stmts -> prPrec i 16 (concatD [doc (showString "function") , doc (showString "(") , prt 0 ids , doc (showString ")") , doc (showString "{") , prt 0 stmts , doc (showString "}")]) + EArray exprs -> prPrec i 16 (concatD [doc (showString "[") , prt 0 exprs , doc (showString "]")]) + EObj propertys -> prPrec i 16 (concatD [doc (showString "{") , prt 0 propertys , doc (showString "}")]) + ESeq exprs -> prPrec i 16 (concatD [doc (showString "(") , prt 0 exprs , 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 Property where + prt i e = case e of + Prop propertyname expr -> prPrec i 0 (concatD [prt 0 propertyname , doc (showString ":") , prt 0 expr]) + + prtList es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) + +instance Print PropertyName where + prt i e = case e of + IdentPropName id -> prPrec i 0 (concatD [prt 0 id]) + StringPropName str -> prPrec i 0 (concatD [prt 0 str]) + + + diff --git a/src/GF/Source/AbsGF.hs b/src/GF/Source/AbsGF.hs new file mode 100644 index 000000000..86e521318 --- /dev/null +++ b/src/GF/Source/AbsGF.hs @@ -0,0 +1,307 @@ +module GF.Source.AbsGF where
+
+-- Haskell module generated by the BNF converter
+
+import qualified Data.ByteString.Char8 as BS
+newtype LString = LString BS.ByteString deriving (Eq,Ord,Show)
+newtype PIdent = PIdent ((Int,Int),BS.ByteString) deriving (Eq,Ord,Show)
+data Grammar =
+ Gr [ModDef]
+ deriving (Eq,Ord,Show)
+
+data ModDef =
+ MMain PIdent PIdent [ConcSpec]
+ | MModule ComplMod ModType ModBody
+ deriving (Eq,Ord,Show)
+
+data ConcSpec =
+ ConcSpec PIdent ConcExp
+ deriving (Eq,Ord,Show)
+
+data ConcExp =
+ ConcExp PIdent [Transfer]
+ deriving (Eq,Ord,Show)
+
+data Transfer =
+ TransferIn Open
+ | TransferOut Open
+ deriving (Eq,Ord,Show)
+
+data ModType =
+ MTAbstract PIdent
+ | MTResource PIdent
+ | MTInterface PIdent
+ | MTConcrete PIdent PIdent
+ | MTInstance PIdent PIdent
+ | MTTransfer PIdent Open Open
+ deriving (Eq,Ord,Show)
+
+data ModBody =
+ MBody Extend Opens [TopDef]
+ | MNoBody [Included]
+ | MWith Included [Open]
+ | MWithBody Included [Open] Opens [TopDef]
+ | MWithE [Included] Included [Open]
+ | MWithEBody [Included] Included [Open] Opens [TopDef]
+ | MReuse PIdent
+ | MUnion [Included]
+ deriving (Eq,Ord,Show)
+
+data Extend =
+ Ext [Included]
+ | NoExt
+ deriving (Eq,Ord,Show)
+
+data Opens =
+ NoOpens
+ | OpenIn [Open]
+ deriving (Eq,Ord,Show)
+
+data Open =
+ OName PIdent
+ | OQualQO QualOpen PIdent
+ | OQual QualOpen PIdent PIdent
+ deriving (Eq,Ord,Show)
+
+data ComplMod =
+ CMCompl
+ | CMIncompl
+ deriving (Eq,Ord,Show)
+
+data QualOpen =
+ QOCompl
+ | QOIncompl
+ | QOInterface
+ deriving (Eq,Ord,Show)
+
+data Included =
+ IAll PIdent
+ | ISome PIdent [PIdent]
+ | IMinus PIdent [PIdent]
+ deriving (Eq,Ord,Show)
+
+data Def =
+ DDecl [Name] Exp
+ | DDef [Name] Exp
+ | DPatt Name [Patt] Exp
+ | DFull [Name] Exp Exp
+ deriving (Eq,Ord,Show)
+
+data TopDef =
+ DefCat [CatDef]
+ | DefFun [FunDef]
+ | DefFunData [FunDef]
+ | DefDef [Def]
+ | DefData [DataDef]
+ | DefTrans [Def]
+ | DefPar [ParDef]
+ | DefOper [Def]
+ | DefLincat [PrintDef]
+ | DefLindef [Def]
+ | DefLin [Def]
+ | DefPrintCat [PrintDef]
+ | DefPrintFun [PrintDef]
+ | DefFlag [FlagDef]
+ | DefPrintOld [PrintDef]
+ | DefLintype [Def]
+ | DefPattern [Def]
+ | DefPackage PIdent [TopDef]
+ | DefVars [Def]
+ | DefTokenizer PIdent
+ deriving (Eq,Ord,Show)
+
+data CatDef =
+ SimpleCatDef PIdent [DDecl]
+ | ListCatDef PIdent [DDecl]
+ | ListSizeCatDef PIdent [DDecl] Integer
+ deriving (Eq,Ord,Show)
+
+data FunDef =
+ FunDef [PIdent] Exp
+ deriving (Eq,Ord,Show)
+
+data DataDef =
+ DataDef PIdent [DataConstr]
+ deriving (Eq,Ord,Show)
+
+data DataConstr =
+ DataId PIdent
+ | DataQId PIdent PIdent
+ deriving (Eq,Ord,Show)
+
+data ParDef =
+ ParDefDir PIdent [ParConstr]
+ | ParDefIndir PIdent PIdent
+ | ParDefAbs PIdent
+ deriving (Eq,Ord,Show)
+
+data ParConstr =
+ ParConstr PIdent [DDecl]
+ deriving (Eq,Ord,Show)
+
+data PrintDef =
+ PrintDef [Name] Exp
+ deriving (Eq,Ord,Show)
+
+data FlagDef =
+ FlagDef PIdent PIdent
+ deriving (Eq,Ord,Show)
+
+data Name =
+ IdentName PIdent
+ | ListName PIdent
+ deriving (Eq,Ord,Show)
+
+data LocDef =
+ LDDecl [PIdent] Exp
+ | LDDef [PIdent] Exp
+ | LDFull [PIdent] Exp Exp
+ deriving (Eq,Ord,Show)
+
+data Exp =
+ EIdent PIdent
+ | EConstr PIdent
+ | ECons PIdent
+ | ESort Sort
+ | EString String
+ | EInt Integer
+ | EFloat Double
+ | EMeta
+ | EEmpty
+ | EData
+ | EList PIdent Exps
+ | EStrings String
+ | ERecord [LocDef]
+ | ETuple [TupleComp]
+ | EIndir PIdent
+ | ETyped Exp Exp
+ | EProj Exp Label
+ | EQConstr PIdent PIdent
+ | EQCons PIdent PIdent
+ | EApp Exp Exp
+ | ETable [Case]
+ | ETTable Exp [Case]
+ | EVTable Exp [Exp]
+ | ECase Exp [Case]
+ | EVariants [Exp]
+ | EPre Exp [Altern]
+ | EStrs [Exp]
+ | EConAt PIdent Exp
+ | EPatt Patt
+ | EPattType Exp
+ | ESelect Exp Exp
+ | ETupTyp Exp Exp
+ | EExtend Exp Exp
+ | EGlue Exp Exp
+ | EConcat Exp Exp
+ | EAbstr [Bind] Exp
+ | ECTable [Bind] Exp
+ | EProd Decl Exp
+ | ETType Exp Exp
+ | ELet [LocDef] Exp
+ | ELetb [LocDef] Exp
+ | EWhere Exp [LocDef]
+ | EEqs [Equation]
+ | EExample Exp String
+ | ELString LString
+ | ELin PIdent
+ deriving (Eq,Ord,Show)
+
+data Exps =
+ NilExp
+ | ConsExp Exp Exps
+ deriving (Eq,Ord,Show)
+
+data Patt =
+ PChar
+ | PChars String
+ | PMacro PIdent
+ | PM PIdent PIdent
+ | PW
+ | PV PIdent
+ | PCon PIdent
+ | PQ PIdent PIdent
+ | PInt Integer
+ | PFloat Double
+ | PStr String
+ | PR [PattAss]
+ | PTup [PattTupleComp]
+ | PC PIdent [Patt]
+ | PQC PIdent PIdent [Patt]
+ | PDisj Patt Patt
+ | PSeq Patt Patt
+ | PRep Patt
+ | PAs PIdent Patt
+ | PNeg Patt
+ deriving (Eq,Ord,Show)
+
+data PattAss =
+ PA [PIdent] Patt
+ deriving (Eq,Ord,Show)
+
+data Label =
+ LIdent PIdent
+ | LVar Integer
+ deriving (Eq,Ord,Show)
+
+data Sort =
+ Sort_Type
+ | Sort_PType
+ | Sort_Tok
+ | Sort_Str
+ | Sort_Strs
+ deriving (Eq,Ord,Show)
+
+data Bind =
+ BIdent PIdent
+ | BWild
+ deriving (Eq,Ord,Show)
+
+data Decl =
+ DDec [Bind] Exp
+ | DExp Exp
+ deriving (Eq,Ord,Show)
+
+data TupleComp =
+ TComp Exp
+ deriving (Eq,Ord,Show)
+
+data PattTupleComp =
+ PTComp Patt
+ deriving (Eq,Ord,Show)
+
+data Case =
+ Case Patt Exp
+ deriving (Eq,Ord,Show)
+
+data Equation =
+ Equ [Patt] Exp
+ deriving (Eq,Ord,Show)
+
+data Altern =
+ Alt Exp Exp
+ deriving (Eq,Ord,Show)
+
+data DDecl =
+ DDDec [Bind] Exp
+ | DDExp Exp
+ deriving (Eq,Ord,Show)
+
+data OldGrammar =
+ OldGr Include [TopDef]
+ deriving (Eq,Ord,Show)
+
+data Include =
+ NoIncl
+ | Incl [FileName]
+ deriving (Eq,Ord,Show)
+
+data FileName =
+ FString String
+ | FIdent PIdent
+ | FSlash FileName
+ | FDot FileName
+ | FMinus FileName
+ | FAddId PIdent FileName
+ deriving (Eq,Ord,Show)
+
diff --git a/src/GF/Source/ErrM.hs b/src/GF/Source/ErrM.hs new file mode 100644 index 000000000..addd22f69 --- /dev/null +++ b/src/GF/Source/ErrM.hs @@ -0,0 +1,26 @@ +-- BNF Converter: Error Monad
+-- Copyright (C) 2004 Author: Aarne Ranta
+
+-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
+module GF.Source.ErrM where
+
+-- the Error monad: like Maybe type with error msgs
+
+import Control.Monad (MonadPlus(..), liftM)
+
+data Err a = Ok a | Bad String
+ deriving (Read, Show, Eq, Ord)
+
+instance Monad Err where
+ return = Ok
+ fail = Bad
+ Ok a >>= f = f a
+ Bad s >>= f = Bad s
+
+instance Functor Err where
+ fmap = liftM
+
+instance MonadPlus Err where
+ mzero = Bad "Err.mzero"
+ mplus (Bad _) y = y
+ mplus x _ = x
diff --git a/src/GF/Source/GF.cf b/src/GF/Source/GF.cf new file mode 100644 index 000000000..ef458c91a --- /dev/null +++ b/src/GF/Source/GF.cf @@ -0,0 +1,371 @@ +-- AR 2/5/2003, 14-16 o'clock, Torino + +-- 17/6/2007: marked with suffix --% those lines that are obsolete and +-- should not be included in documentation + +entrypoints Grammar, ModDef, + OldGrammar, --% + ModHeader, + Exp ; -- let's see if more are needed + +comment "--" ; +comment "{-" "-}" ; + +-- the top-level grammar + +Gr. Grammar ::= [ModDef] ; + +-- semicolon after module is permitted but not obligatory + +terminator ModDef "" ; +_. ModDef ::= ModDef ";" ; + +-- The $main$ multilingual grammar structure --% + +MMain. ModDef ::= "grammar" PIdent "=" "{" "abstract" "=" PIdent ";" [ConcSpec] "}" ;--% + +ConcSpec. ConcSpec ::= PIdent "=" ConcExp ;--% +separator ConcSpec ";" ;--% + +ConcExp. ConcExp ::= PIdent [Transfer] ;--% + +separator Transfer "" ;--% +TransferIn. Transfer ::= "(" "transfer" "in" Open ")" ; --% +TransferOut. Transfer ::= "(" "transfer" "out" Open ")" ; --% + +-- the module header + +MModule2. ModHeader ::= ComplMod ModType "=" ModHeaderBody ; + +MBody2. ModHeaderBody ::= Extend Opens ; +MNoBody2. ModHeaderBody ::= [Included] ; +MWith2. ModHeaderBody ::= Included "with" [Open] ; +MWithBody2. ModHeaderBody ::= Included "with" [Open] "**" Opens ; +MWithE2. ModHeaderBody ::= [Included] "**" Included "with" [Open] ; +MWithEBody2. ModHeaderBody ::= [Included] "**" Included "with" [Open] "**" Opens ; + +MReuse2. ModHeaderBody ::= "reuse" PIdent ; --% +MUnion2. ModHeaderBody ::= "union" [Included] ;--% + +-- the individual modules + +MModule. ModDef ::= ComplMod ModType "=" ModBody ; + +MTAbstract. ModType ::= "abstract" PIdent ; +MTResource. ModType ::= "resource" PIdent ; +MTInterface. ModType ::= "interface" PIdent ; +MTConcrete. ModType ::= "concrete" PIdent "of" PIdent ; +MTInstance. ModType ::= "instance" PIdent "of" PIdent ; +MTTransfer. ModType ::= "transfer" PIdent ":" Open "->" Open ; + + +MBody. ModBody ::= Extend Opens "{" [TopDef] "}" ; +MNoBody. ModBody ::= [Included] ; +MWith. ModBody ::= Included "with" [Open] ; +MWithBody. ModBody ::= Included "with" [Open] "**" Opens "{" [TopDef] "}" ; +MWithE. ModBody ::= [Included] "**" Included "with" [Open] ; +MWithEBody. ModBody ::= [Included] "**" Included "with" [Open] "**" Opens "{" [TopDef] "}" ; + +MReuse. ModBody ::= "reuse" PIdent ; --% +MUnion. ModBody ::= "union" [Included] ;--% + +separator TopDef "" ; + +Ext. Extend ::= [Included] "**" ; +NoExt. Extend ::= ; + +separator Open "," ; +NoOpens. Opens ::= ; +OpenIn. Opens ::= "open" [Open] "in" ; + +OName. Open ::= PIdent ; +OQualQO. Open ::= "(" QualOpen PIdent ")" ; +OQual. Open ::= "(" QualOpen PIdent "=" PIdent ")" ; + +CMCompl. ComplMod ::= ; +CMIncompl. ComplMod ::= "incomplete" ; + +QOCompl. QualOpen ::= ; +QOIncompl. QualOpen ::= "incomplete" ;--% +QOInterface. QualOpen ::= "interface" ;--% + +separator Included "," ; + +IAll. Included ::= PIdent ; +ISome. Included ::= PIdent "[" [PIdent] "]" ; +IMinus. Included ::= PIdent "-" "[" [PIdent] "]" ; + +-- definitions after the $oper$ keywords + +DDecl. Def ::= [Name] ":" Exp ; +DDef. Def ::= [Name] "=" Exp ; +DPatt. Def ::= Name [Patt] "=" Exp ; -- non-empty pattern list +DFull. Def ::= [Name] ":" Exp "=" Exp ; + +-- top-level definitions + +DefCat. TopDef ::= "cat" [CatDef] ; +DefFun. TopDef ::= "fun" [FunDef] ; +DefFunData.TopDef ::= "data" [FunDef] ; +DefDef. TopDef ::= "def" [Def] ; +DefData. TopDef ::= "data" [DataDef] ; + +DefTrans. TopDef ::= "transfer" [Def] ;--% + +DefPar. TopDef ::= "param" [ParDef] ; +DefOper. TopDef ::= "oper" [Def] ; + +DefLincat. TopDef ::= "lincat" [PrintDef] ; +DefLindef. TopDef ::= "lindef" [Def] ; +DefLin. TopDef ::= "lin" [Def] ; + +DefPrintCat. TopDef ::= "printname" "cat" [PrintDef] ; +DefPrintFun. TopDef ::= "printname" "fun" [PrintDef] ; +DefFlag. TopDef ::= "flags" [FlagDef] ; + +SimpleCatDef. CatDef ::= PIdent [DDecl] ; +ListCatDef. CatDef ::= "[" PIdent [DDecl] "]" ; +ListSizeCatDef. CatDef ::= "[" PIdent [DDecl] "]" "{" Integer "}" ; + +FunDef. FunDef ::= [PIdent] ":" Exp ; + +DataDef. DataDef ::= PIdent "=" [DataConstr] ; +DataId. DataConstr ::= PIdent ; +DataQId. DataConstr ::= PIdent "." PIdent ; +separator DataConstr "|" ; + + +ParDefDir. ParDef ::= PIdent "=" [ParConstr] ; +ParDefIndir. ParDef ::= PIdent "=" "(" "in" PIdent ")" ; +ParDefAbs. ParDef ::= PIdent ; + +ParConstr. ParConstr ::= PIdent [DDecl] ; + +PrintDef. PrintDef ::= [Name] "=" Exp ; + +FlagDef. FlagDef ::= PIdent "=" PIdent ; + +terminator nonempty Def ";" ; +terminator nonempty CatDef ";" ; +terminator nonempty FunDef ";" ; +terminator nonempty DataDef ";" ; +terminator nonempty ParDef ";" ; + +terminator nonempty PrintDef ";" ; +terminator nonempty FlagDef ";" ; + +separator ParConstr "|" ; + +separator nonempty PIdent "," ; + +-- names of categories and functions in definition LHS + +IdentName. Name ::= PIdent ; +ListName. Name ::= "[" PIdent "]" ; + +separator nonempty Name "," ; + +-- definitions in records and $let$ expressions + +LDDecl. LocDef ::= [PIdent] ":" Exp ; +LDDef. LocDef ::= [PIdent] "=" Exp ; +LDFull. LocDef ::= [PIdent] ":" Exp "=" Exp ; + +separator LocDef ";" ; + +-- terms and types + +EIdent. Exp6 ::= PIdent ; +EConstr. Exp6 ::= "{" PIdent "}" ;--% +ECons. Exp6 ::= "%" PIdent "%" ;--% +ESort. Exp6 ::= Sort ; +EString. Exp6 ::= String ; +EInt. Exp6 ::= Integer ; +EFloat. Exp6 ::= Double ; +EMeta. Exp6 ::= "?" ; +EEmpty. Exp6 ::= "[" "]" ; +EData. Exp6 ::= "data" ; +EList. Exp6 ::= "[" PIdent Exps "]" ; +EStrings. Exp6 ::= "[" String "]" ; +ERecord. Exp6 ::= "{" [LocDef] "}" ; -- ! +ETuple. Exp6 ::= "<" [TupleComp] ">" ; --- needed for separator "," +EIndir. Exp6 ::= "(" "in" PIdent ")" ; -- indirection, used in judgements --% +ETyped. Exp6 ::= "<" Exp ":" Exp ">" ; -- typing, used for annotations + +EProj. Exp5 ::= Exp5 "." Label ; +EQConstr. Exp5 ::= "{" PIdent "." PIdent "}" ; -- qualified constructor --% +EQCons. Exp5 ::= "%" PIdent "." PIdent ; -- qualified constant --% + +EApp. Exp4 ::= Exp4 Exp5 ; +ETable. Exp4 ::= "table" "{" [Case] "}" ; +ETTable. Exp4 ::= "table" Exp6 "{" [Case] "}" ; +EVTable. Exp4 ::= "table" Exp6 "[" [Exp] "]" ; +ECase. Exp4 ::= "case" Exp "of" "{" [Case] "}" ; +EVariants. Exp4 ::= "variants" "{" [Exp] "}" ; +--- EPreCase. Exp4 ::= "pre" "{" [Case] "}" ; +EPre. Exp4 ::= "pre" "{" Exp ";" [Altern] "}" ; +EStrs. Exp4 ::= "strs" "{" [Exp] "}" ; +EConAt. Exp4 ::= PIdent "@" Exp6 ; --% + +EPatt. Exp4 ::= "#" Patt2 ; +EPattType. Exp4 ::= "pattern" Exp5 ; + +ESelect. Exp3 ::= Exp3 "!" Exp4 ; +ETupTyp. Exp3 ::= Exp3 "*" Exp4 ; +EExtend. Exp3 ::= Exp3 "**" Exp4 ; + +EGlue. Exp1 ::= Exp2 "+" Exp1 ; + +EConcat. Exp ::= Exp1 "++" Exp ; + +EAbstr. Exp ::= "\\" [Bind] "->" Exp ; +ECTable. Exp ::= "\\""\\" [Bind] "=>" Exp ; +EProd. Exp ::= Decl "->" Exp ; +ETType. Exp ::= Exp3 "=>" Exp ; -- these are thus right associative +ELet. Exp ::= "let" "{" [LocDef] "}" "in" Exp ; +ELetb. Exp ::= "let" [LocDef] "in" Exp ; +EWhere. Exp ::= Exp3 "where" "{" [LocDef] "}" ; +EEqs. Exp ::= "fn" "{" [Equation] "}" ; --% + +EExample. Exp ::= "in" Exp5 String ; + +coercions Exp 6 ; + +separator Exp ";" ; -- in variants + +-- list of arguments to category +NilExp. Exps ::= ; +ConsExp. Exps ::= Exp6 Exps ; -- Exp6 to force parantheses + +-- patterns + +PChar. Patt2 ::= "?" ; +PChars. Patt2 ::= "[" String "]" ; +PMacro. Patt2 ::= "#" PIdent ; +PM. Patt2 ::= "#" PIdent "." PIdent ; +PW. Patt2 ::= "_" ; +PV. Patt2 ::= PIdent ; +PCon. Patt2 ::= "{" PIdent "}" ; --% +PQ. Patt2 ::= PIdent "." PIdent ; +PInt. Patt2 ::= Integer ; +PFloat. Patt2 ::= Double ; +PStr. Patt2 ::= String ; +PR. Patt2 ::= "{" [PattAss] "}" ; +PTup. Patt2 ::= "<" [PattTupleComp] ">" ; +PC. Patt1 ::= PIdent [Patt] ; +PQC. Patt1 ::= PIdent "." PIdent [Patt] ; +PDisj. Patt ::= Patt "|" Patt1 ; +PSeq. Patt ::= Patt "+" Patt1 ; +PRep. Patt1 ::= Patt2 "*" ; +PAs. Patt1 ::= PIdent "@" Patt2 ; +PNeg. Patt1 ::= "-" Patt2 ; + +coercions Patt 2 ; + +PA. PattAss ::= [PIdent] "=" Patt ; + +-- labels + +LIdent. Label ::= PIdent ; +LVar. Label ::= "$" Integer ; + +-- basic types + +rules Sort ::= + "Type" + | "PType" + | "Tok" --% + | "Str" + | "Strs" ; + +separator PattAss ";" ; + +-- this is explicit to force higher precedence level on rhs +(:[]). [Patt] ::= Patt2 ; +(:). [Patt] ::= Patt2 [Patt] ; + + +-- binds in lambdas and lin rules + +BIdent. Bind ::= PIdent ; +BWild. Bind ::= "_" ; + +separator Bind "," ; + + +-- declarations in function types + +DDec. Decl ::= "(" [Bind] ":" Exp ")" ; +DExp. Decl ::= Exp4 ; -- can thus be an application + +-- tuple component (term or pattern) + +TComp. TupleComp ::= Exp ; +PTComp. PattTupleComp ::= Patt ; + +separator TupleComp "," ; +separator PattTupleComp "," ; + +-- case branches + +Case. Case ::= Patt "=>" Exp ; + +separator nonempty Case ";" ; + +-- cases in abstract syntax --% + +Equ. Equation ::= [Patt] "->" Exp ; --% + +separator Equation ";" ; --% + +-- prefix alternatives + +Alt. Altern ::= Exp "/" Exp ; + +separator Altern ";" ; + +-- in a context, higher precedence is required than in function types + +DDDec. DDecl ::= "(" [Bind] ":" Exp ")" ; +DDExp. DDecl ::= Exp6 ; -- can thus *not* be an application + +separator DDecl "" ; + + +-------------------------------------- --% + +-- for backward compatibility --% + +OldGr. OldGrammar ::= Include [TopDef] ; --% + +NoIncl. Include ::= ; --% +Incl. Include ::= "include" [FileName] ; --% + +FString. FileName ::= String ; --% + +terminator nonempty FileName ";" ; --% + +FIdent. FileName ::= PIdent ; --% +FSlash. FileName ::= "/" FileName ; --% +FDot. FileName ::= "." FileName ; --% +FMinus. FileName ::= "-" FileName ; --% +FAddId. FileName ::= PIdent FileName ; --% + +token LString '\'' (char - '\'')* '\'' ; --% +ELString. Exp6 ::= LString ; --% +ELin. Exp4 ::= "Lin" PIdent ; --% + +DefPrintOld. TopDef ::= "printname" [PrintDef] ; --% +DefLintype. TopDef ::= "lintype" [Def] ; --% +DefPattern. TopDef ::= "pattern" [Def] ; --% + +-- deprecated packages are attempted to be interpreted --% +DefPackage. TopDef ::= "package" PIdent "=" "{" [TopDef] "}" ";" ; --% + +-- these two are just ignored after parsing --% +DefVars. TopDef ::= "var" [Def] ; --% +DefTokenizer. TopDef ::= "tokenizer" PIdent ";" ; --% + +-- identifiers + +position token PIdent ('_' | letter) (letter | digit | '_' | '\'')* ; diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs new file mode 100644 index 000000000..f76fe6cee --- /dev/null +++ b/src/GF/Source/GrammarToSource.hs @@ -0,0 +1,257 @@ +---------------------------------------------------------------------- +-- | +-- Module : GrammarToSource +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/10/04 11:05:07 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.23 $ +-- +-- From internal source syntax to BNFC-generated (used for printing). +----------------------------------------------------------------------------- + +module GF.Source.GrammarToSource ( trGrammar, + trModule, + trAnyDef, + trLabel, + trt, tri, trp + ) where + +import GF.Data.Operations +import GF.Grammar.Grammar +import GF.Grammar.Predef +import GF.Infra.Modules +import GF.Infra.Option +import qualified GF.Source.AbsGF as P +import GF.Infra.Ident +import qualified Data.ByteString.Char8 as BS + +-- | AR 13\/5\/2003 +-- +-- translate internal to parsable and printable source +trGrammar :: SourceGrammar -> P.Grammar +trGrammar (MGrammar ms) = P.Gr (map trModule ms) -- no includes + +trModule :: (Ident,SourceModInfo) -> P.ModDef +trModule (i,mo) = case mo of + ModMod m -> P.MModule compl typ body where + compl = case mstatus m of + MSIncomplete -> P.CMIncompl + _ -> P.CMCompl + i' = tri i + typ = case typeOfModule mo of + MTResource -> P.MTResource i' + MTAbstract -> P.MTAbstract i' + MTConcrete a -> P.MTConcrete i' (tri a) + MTTransfer a b -> P.MTTransfer i' (trOpen a) (trOpen b) + MTInstance a -> P.MTInstance i' (tri a) + MTInterface -> P.MTInterface i' + body = P.MBody + (trExtends (extend m)) + (mkOpens (map trOpen (opens m))) + (mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++ trFlags (flags m))) + +trExtends :: [(Ident,MInclude Ident)] -> P.Extend +trExtends [] = P.NoExt +trExtends es = (P.Ext $ map tre es) where + tre (i,c) = case c of + MIAll -> P.IAll (tri i) + MIOnly is -> P.ISome (tri i) (map tri is) + MIExcept is -> P.IMinus (tri i) (map tri is) + +---- this has to be completed with other mtys +forName (MTConcrete a) = tri a + +trOpen :: OpenSpec Ident -> P.Open +trOpen o = case o of + OSimple OQNormal i -> P.OName (tri i) + OSimple q i -> P.OQualQO (trQualOpen q) (tri i) + OQualif q i j -> P.OQual (trQualOpen q) (tri i) (tri j) + +trQualOpen q = case q of + OQNormal -> P.QOCompl + OQIncomplete -> P.QOIncompl + OQInterface -> P.QOInterface + + +mkOpens ds = if null ds then P.NoOpens else P.OpenIn ds +mkTopDefs ds = ds + +trAnyDef :: (Ident,Info) -> [P.TopDef] +trAnyDef (i,info) = let i' = tri i in case info of + AbsCat (Yes co) pd -> [P.DefCat [P.SimpleCatDef i' (map trDecl co)]] + AbsFun (Yes ty) (Yes EData) -> [P.DefFunData [P.FunDef [i'] (trt ty)]] + AbsFun (Yes ty) pt -> [P.DefFun [P.FunDef [i'] (trt ty)]] ++ case pt of + Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]] + _ -> [] + AbsFun (May b) _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]] + ---- don't destroy definitions! + AbsTrans f -> [P.DefTrans [P.DDef [mkName i'] (trt f)]] + + ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]] + ResParam pp -> [P.DefPar [case pp of + Yes (ps,_) -> P.ParDefDir i' [P.ParConstr (tri c) (map trDecl co) | (c,co) <- ps] + May b -> P.ParDefIndir i' $ tri b + _ -> P.ParDefAbs i']] + + ResOverload os tysts -> + [P.DefOper [P.DDef [mkName i'] ( + foldl P.EApp + (P.EIdent $ tri $ cOverload) + (map (P.EIdent . tri) os ++ + [P.ERecord [P.LDFull [i'] (trt ty) (trt fu) | (ty,fu) <- tysts]]))]] + + CncCat (Yes ty) Nope _ -> + [P.DefLincat [P.PrintDef [mkName i'] (trt ty)]] + CncCat pty ptr ppr -> + [P.DefLindef [trDef i' pty ptr]] ++ + [P.DefPrintCat [P.PrintDef [mkName i'] (trt pr)] | Yes pr <- [ppr]] + CncFun _ ptr ppr -> + [P.DefLin [trDef i' nope ptr]] ++ + [P.DefPrintFun [P.PrintDef [mkName i'] (trt pr)] | Yes pr <- [ppr]] +{- + ---- encoding of AnyInd without changing syntax. AR 20/9/2007 + AnyInd s b -> + [P.DefOper [P.DDef [mkName i] + (P.EApp (P.EInt (if s then 1 else 0)) (P.EIdent (tri b)))]] +-} + _ -> [] + + +trDef :: P.PIdent -> Perh Type -> Perh Term -> P.Def +trDef i pty ptr = case (pty,ptr) of + (Nope, Nope) -> P.DDef [mkName i] (P.EMeta) --- + (_, Nope) -> P.DDecl [mkName i] (trPerh pty) + (Nope, _ ) -> P.DDef [mkName i] (trPerh ptr) + (_, _ ) -> P.DFull [mkName i] (trPerh pty) (trPerh ptr) + +trPerh p = case p of + Yes t -> trt t + May b -> P.EIndir $ tri b + _ -> P.EMeta --- + +trFlags :: ModuleOptions -> [P.TopDef] +trFlags = map trFlag . moduleOptionsGFO + +trFlag :: (String,String) -> P.TopDef +trFlag (f,x) = P.DefFlag [P.FlagDef (tri $ identC (BS.pack f)) (tri $ identC (BS.pack x))] + +trt :: Term -> P.Exp +trt trm = case trm of + Vr s -> P.EIdent $ tri s + Cn s -> P.ECons $ tri s + Con s -> P.EConstr $ tri s + Sort s -> P.ESort $! if s == cType then P.Sort_Type else + if s == cPType then P.Sort_PType else + if s == cTok then P.Sort_Tok else + if s == cStr then P.Sort_Str else + if s == cStrs then P.Sort_Strs else + error $ "not yet sort " +++ show trm + App c a -> P.EApp (trt c) (trt a) + Abs x b -> P.EAbstr [trb x] (trt b) + Eqs pts -> P.EEqs [P.Equ (map trp ps) (trt t) | (ps,t) <- pts] + Meta m -> P.EMeta + Prod x a b | isWildIdent x -> P.EProd (P.DExp (trt a)) (trt b) + Prod x a b -> P.EProd (P.DDec [trb x] (trt a)) (trt b) + + Example t s -> P.EExample (trt t) s + R [] -> P.ETuple [] --- to get correct parsing when read back + R r -> P.ERecord $ map trAssign r + RecType r -> P.ERecord $ map trLabelling r + ExtR x y -> P.EExtend (trt x) (trt y) + P t l -> P.EProj (trt t) (trLabel l) + PI t l _ -> P.EProj (trt t) (trLabel l) + Q t l -> P.EQCons (tri t) (tri l) + QC t l -> P.EQConstr (tri t) (tri l) + TSh (TComp ty) cc -> P.ETTable (trt ty) (map trCases cc) + TSh (TTyped ty) cc -> P.ETTable (trt ty) (map trCases cc) + TSh (TWild ty) cc -> P.ETTable (trt ty) (map trCases cc) + T (TTyped ty) cc -> P.ETTable (trt ty) (map trCase cc) + T (TComp ty) cc -> P.ETTable (trt ty) (map trCase cc) + T (TWild ty) cc -> P.ETTable (trt ty) (map trCase cc) + T _ cc -> P.ETable (map trCase cc) + V ty cc -> P.EVTable (trt ty) (map trt cc) + + Table x v -> P.ETType (trt x) (trt v) + S f x -> P.ESelect (trt f) (trt x) +---- Alias c a t -> "{-" +++ prt c +++ "=" +++ "-}" +++ prt t +-- Alias c a t -> prt (Let (c,(Just a,t)) (Vr c)) -- thus Alias is only internal + + Let (x,(ma,b)) t -> + P.ELet [maybe (P.LDDef x' b') (\ty -> P.LDFull x' (trt ty) b') ma] (trt t) + where + b' = trt b + x' = [tri x] + + Empty -> P.EEmpty + K [] -> P.EEmpty + K a -> P.EString a + C a b -> P.EConcat (trt a) (trt b) + + EInt i -> P.EInt i + EFloat i -> P.EFloat i + + EPatt p -> P.EPatt (trp p) + EPattType t -> P.EPattType (trt t) + + Glue a b -> P.EGlue (trt a) (trt b) + Alts (t, tt) -> P.EPre (trt t) [P.Alt (trt v) (trt c) | (v,c) <- tt] + FV ts -> P.EVariants $ map trt ts + Strs tt -> P.EStrs $ map trt tt + EData -> P.EData + _ -> error $ "not yet" +++ show trm ---- + +trp :: Patt -> P.Patt +trp p = case p of + PW -> P.PW + PV s | isWildIdent s -> P.PW + PV s -> P.PV $ tri s + PC c [] -> P.PCon $ tri c + PC c a -> P.PC (tri c) (map trp a) + PP p c [] -> P.PQ (tri p) (tri c) + PP p c a -> P.PQC (tri p) (tri c) (map trp a) + PR r -> P.PR [P.PA [tri $ label2ident l] (trp p) | (l,p) <- r] + PString s -> P.PStr s + PInt i -> P.PInt i + PFloat i -> P.PFloat i + PT t p -> trp p ---- prParenth (prt p +++ ":" +++ prt t) + + PAs x p -> P.PAs (tri x) (trp p) + + PAlt p q -> P.PDisj (trp p) (trp q) + PSeq p q -> P.PSeq (trp p) (trp q) + PRep p -> P.PRep (trp p) + PNeg p -> P.PNeg (trp p) + PChar -> P.PChar + PChars s -> P.PChars s + PM m c -> P.PM (tri m) (tri c) + + +trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty + where + t' = trt t + x = [tri $ label2ident lab] + +trLabelling (lab,ty) = P.LDDecl [tri $ label2ident lab] (trt ty) + +trCase (patt, trm) = P.Case (trp patt) (trt trm) +trCases (patts,trm) = P.Case (foldl1 P.PDisj (map trp patts)) (trt trm) + +trDecl (x,ty) = P.DDDec [trb x] (trt ty) + +tri :: Ident -> P.PIdent +tri = ppIdent . ident2bs + +ppIdent i = P.PIdent ((0,0),i) + +trb i = if isWildIdent i then P.BWild else P.BIdent (tri i) + +trLabel :: Label -> P.Label +trLabel i = case i of + LIdent s -> P.LIdent $ ppIdent s + LVar i -> P.LVar $ toInteger i + +mkName :: P.PIdent -> P.Name +mkName = P.IdentName diff --git a/src/GF/Source/LexGF.hs b/src/GF/Source/LexGF.hs new file mode 100644 index 000000000..1a2e507be --- /dev/null +++ b/src/GF/Source/LexGF.hs @@ -0,0 +1,350 @@ +{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LINE 3 "LexGF.x" #-}
+
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Source.LexGF where
+
+import GF.Source.SharedString
+import qualified Data.ByteString.Char8 as BS
+
+#if __GLASGOW_HASKELL__ >= 603
+#include "ghcconfig.h"
+#elif defined(__GLASGOW_HASKELL__)
+#include "config.h"
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import Data.Array
+import Data.Char (ord)
+import Data.Array.Base (unsafeAt)
+#else
+import Array
+import Char (ord)
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts
+#else
+import GlaExts
+#endif
+alex_base :: AlexAddr
+alex_base = AlexA# "\x01\x00\x00\x00\x15\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x18\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x45\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x27\x00\x00\x00\x13\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x00\x00\x6c\x01\x00\x00\x3c\x02\x00\x00\x0c\x03\x00\x00\x00\x00\x00\x00\x17\x01\x00\x00\xe7\x01\x00\x00\xd5\x00\x00\x00\x35\x00\x00\x00\xe7\x00\x00\x00\xf2\x00\x00\x00\x1d\x01\x00\x00\xc2\x01\x00\x00\xcc\x01\x00\x00"#
+
+alex_table :: AlexAddr
+alex_table = AlexA# "\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\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\x0d\x00\x0e\x00\x1a\x00\x0e\x00\x0e\x00\x0e\x00\xff\xff\x14\x00\x0e\x00\x0e\x00\x0f\x00\x10\x00\x0e\x00\x05\x00\x0e\x00\x0e\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x0e\x00\x0e\x00\x0e\x00\x11\x00\x0e\x00\x0e\x00\x0e\x00\x04\x00\xff\xff\xff\xff\x02\x00\x02\x00\x09\x00\x09\x00\x09\x00\x0a\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0e\x00\x0e\x00\x0e\x00\x13\x00\x13\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0e\x00\x0e\x00\xff\xff\x12\x00\xff\xff\x0d\x00\x20\x00\x00\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x00\x00\x00\x00\x09\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0e\x00\x0e\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\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\x06\x00\x07\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x1b\x00\xff\xff\x00\x00\x00\x00\x17\x00\x1b\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\xff\xff\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x21\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x1c\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x18\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\xff\xff\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x1c\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x17\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x18\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x00\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00"#
+
+alex_check :: AlexAddr
+alex_check = AlexA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\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\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x2d\x00\x0a\x00\x0a\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2a\x00\x3e\x00\x2b\x00\x27\x00\x27\x00\xff\xff\xff\xff\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x20\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x2d\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x7d\x00\x7d\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xd7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\x22\x00\xf7\x00\xff\xff\xff\xff\x5f\x00\x27\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\x65\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x5c\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\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\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x5c\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\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\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\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\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\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\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00"#
+
+alex_deflt :: AlexAddr
+alex_deflt = AlexA# "\x16\x00\xff\xff\x03\x00\x03\x00\xff\xff\xff\xff\x0b\x00\xff\xff\x0b\x00\x0b\x00\x0b\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_accept = listArray (0::Int,34) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[],[],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_7))],[],[],[],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_9))],[],[],[]]
+{-# LINE 37 "LexGF.x" #-}
+
+
+tok f p s = f p s
+
+share :: BS.ByteString -> BS.ByteString
+share = shareString
+
+data Tok =
+ TS !BS.ByteString !Int -- reserved words and symbols
+ | TL !BS.ByteString -- string literals
+ | TI !BS.ByteString -- integer literals
+ | TV !BS.ByteString -- identifiers
+ | TD !BS.ByteString -- double precision float literals
+ | TC !BS.ByteString -- character literals
+ | T_LString !BS.ByteString
+ | T_PIdent !BS.ByteString
+
+ deriving (Eq,Show,Ord)
+
+data Token =
+ PT Posn Tok
+ | Err Posn
+ deriving (Eq,Show,Ord)
+
+tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
+tokenPos _ = "end of file"
+
+posLineCol (Pn _ l c) = (l,c)
+mkPosToken t@(PT p _) = (posLineCol p, prToken t)
+
+prToken t = case t of
+ PT _ (TS s _) -> s
+ PT _ (TL s) -> s
+ PT _ (TI s) -> s
+ PT _ (TV s) -> s
+ PT _ (TD s) -> s
+ PT _ (TC s) -> s
+ PT _ (T_LString s) -> s
+ PT _ (T_PIdent s) -> s
+
+
+data BTree = N | B BS.ByteString Tok BTree BTree deriving (Show)
+
+eitherResIdent :: (BS.ByteString -> Tok) -> BS.ByteString -> Tok
+eitherResIdent tv s = treeFind resWords
+ where
+ treeFind N = tv s
+ treeFind (B a t left right) | s < a = treeFind left
+ | s > a = treeFind right
+ | s == a = t
+
+resWords = b "def" 39 (b "=>" 20 (b "++" 10 (b "(" 5 (b "$" 3 (b "#" 2 (b "!" 1 N N) N) (b "%" 4 N N)) (b "**" 8 (b "*" 7 (b ")" 6 N N) N) (b "+" 9 N N))) (b "/" 15 (b "->" 13 (b "-" 12 (b "," 11 N N) N) (b "." 14 N N)) (b "<" 18 (b ";" 17 (b ":" 16 N N) N) (b "=" 19 N N)))) (b "[" 30 (b "PType" 25 (b "@" 23 (b "?" 22 (b ">" 21 N N) N) (b "Lin" 24 N N)) (b "Tok" 28 (b "Strs" 27 (b "Str" 26 N N) N) (b "Type" 29 N N))) (b "case" 35 (b "_" 33 (b "]" 32 (b "\\" 31 N N) N) (b "abstract" 34 N N)) (b "concrete" 37 (b "cat" 36 N N) (b "data" 38 N N))))) (b "package" 58 (b "let" 49 (b "in" 44 (b "fun" 42 (b "fn" 41 (b "flags" 40 N N) N) (b "grammar" 43 N N)) (b "instance" 47 (b "incomplete" 46 (b "include" 45 N N) N) (b "interface" 48 N N))) (b "of" 54 (b "lindef" 52 (b "lincat" 51 (b "lin" 50 N N) N) (b "lintype" 53 N N)) (b "oper" 56 (b "open" 55 N N) (b "out" 57 N N)))) (b "transfer" 68 (b "resource" 63 (b "pre" 61 (b "pattern" 60 (b "param" 59 N N) N) (b "printname" 62 N N)) (b "table" 66 (b "strs" 65 (b "reuse" 64 N N) N) (b "tokenizer" 67 N N))) (b "with" 73 (b "variants" 71 (b "var" 70 (b "union" 69 N N) N) (b "where" 72 N N)) (b "|" 75 (b "{" 74 N N) (b "}" 76 N N)))))
+ where b s n = let bs = BS.pack s
+ in B bs (TS bs n)
+
+unescapeInitTail :: BS.ByteString -> BS.ByteString
+unescapeInitTail = BS.pack . unesc . tail . BS.unpack where
+ unesc s = case s of
+ '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
+ '\\':'n':cs -> '\n' : unesc cs
+ '\\':'t':cs -> '\t' : unesc cs
+ '"':[] -> []
+ c:cs -> c : unesc cs
+ _ -> []
+
+-------------------------------------------------------------------
+-- Alex wrapper code.
+-- A modified "posn" wrapper.
+-------------------------------------------------------------------
+
+data Posn = Pn !Int !Int !Int
+ deriving (Eq, Show,Ord)
+
+alexStartPos :: Posn
+alexStartPos = Pn 0 1 1
+
+alexMove :: Posn -> Char -> Posn
+alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)
+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1
+alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
+
+type AlexInput = (Posn, -- current position,
+ Char, -- previous char
+ BS.ByteString) -- current input string
+
+tokens :: BS.ByteString -> [Token]
+tokens str = go (alexStartPos, '\n', str)
+ where
+ go :: AlexInput -> [Token]
+ go inp@(pos, _, str) =
+ case alexScan inp 0 of
+ AlexEOF -> []
+ AlexError (pos, _, _) -> [Err pos]
+ AlexSkip inp' len -> go inp'
+ AlexToken inp' len act -> act pos (BS.take len str) : (go inp')
+
+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
+alexGetChar (p, _, s) =
+ case BS.uncons s of
+ Nothing -> Nothing
+ Just (c,s) ->
+ let p' = alexMove p c
+ in p' `seq` Just (c, (p', c, s))
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (p, c, s) = c
+
+alex_action_3 = tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s))
+alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_LString . share) s))
+alex_action_5 = tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s))
+alex_action_6 = tok (\p s -> PT p (eitherResIdent (TV . share) s))
+alex_action_7 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s))
+alex_action_8 = tok (\p s -> PT p (TI $ share s))
+alex_action_9 = tok (\p s -> PT p (TD $ share s))
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
+{-# LINE 1 "<command line>" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+-- -----------------------------------------------------------------------------
+-- ALEX TEMPLATE
+--
+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
+-- it for any purpose whatsoever.
+
+-- -----------------------------------------------------------------------------
+-- INTERNALS and main scanner engine
+
+{-# LINE 35 "templates/GenericTemplate.hs" #-}
+
+{-# LINE 45 "templates/GenericTemplate.hs" #-}
+
+
+data AlexAddr = AlexA# Addr#
+
+#if __GLASGOW_HASKELL__ < 503
+uncheckedShiftL# = shiftL#
+#endif
+
+{-# INLINE alexIndexInt16OffAddr #-}
+alexIndexInt16OffAddr (AlexA# arr) off =
+#ifdef WORDS_BIGENDIAN
+ narrow16Int# i
+ where
+ i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
+ high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+ low = int2Word# (ord# (indexCharOffAddr# arr off'))
+ off' = off *# 2#
+#else
+ indexInt16OffAddr# arr off
+#endif
+
+
+
+
+
+{-# INLINE alexIndexInt32OffAddr #-}
+alexIndexInt32OffAddr (AlexA# arr) off =
+#ifdef WORDS_BIGENDIAN
+ narrow32Int# i
+ where
+ i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`
+ (b2 `uncheckedShiftL#` 16#) `or#`
+ (b1 `uncheckedShiftL#` 8#) `or#` b0)
+ b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))
+ b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))
+ b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+ b0 = int2Word# (ord# (indexCharOffAddr# arr off'))
+ off' = off *# 4#
+#else
+ indexInt32OffAddr# arr off
+#endif
+
+
+
+
+
+#if __GLASGOW_HASKELL__ < 503
+quickIndex arr i = arr ! i
+#else
+-- GHC >= 503, unsafeAt is available from Data.Array.Base.
+quickIndex = unsafeAt
+#endif
+
+
+
+
+-- -----------------------------------------------------------------------------
+-- Main lexing routines
+
+data AlexReturn a
+ = AlexEOF
+ | AlexError !AlexInput
+ | AlexSkip !AlexInput !Int
+ | AlexToken !AlexInput !Int a
+
+-- alexScan :: AlexInput -> StartCode -> AlexReturn a
+alexScan input (I# (sc))
+ = alexScanUser undefined input (I# (sc))
+
+alexScanUser user input (I# (sc))
+ = case alex_scan_tkn user input 0# input sc AlexNone of
+ (AlexNone, input') ->
+ case alexGetChar input of
+ Nothing ->
+
+
+
+ AlexEOF
+ Just _ ->
+
+
+
+ AlexError input'
+
+ (AlexLastSkip input len, _) ->
+
+
+
+ AlexSkip input len
+
+ (AlexLastAcc k input len, _) ->
+
+
+
+ AlexToken input len k
+
+
+-- Push the input through the DFA, remembering the most recent accepting
+-- state it encountered.
+
+alex_scan_tkn user orig_input len input s last_acc =
+ input `seq` -- strict in the input
+ let
+ new_acc = check_accs (alex_accept `quickIndex` (I# (s)))
+ in
+ new_acc `seq`
+ case alexGetChar input of
+ Nothing -> (new_acc, input)
+ Just (c, new_input) ->
+
+
+
+ let
+ base = alexIndexInt32OffAddr alex_base s
+ (I# (ord_c)) = ord c
+ offset = (base +# ord_c)
+ check = alexIndexInt16OffAddr alex_check offset
+
+ new_s = if (offset >=# 0#) && (check ==# ord_c)
+ then alexIndexInt16OffAddr alex_table offset
+ else alexIndexInt16OffAddr alex_deflt s
+ in
+ case new_s of
+ -1# -> (new_acc, input)
+ -- on an error, we want to keep the input *before* the
+ -- character that failed, not after.
+ _ -> alex_scan_tkn user orig_input (len +# 1#)
+ new_input new_s new_acc
+
+ where
+ check_accs [] = last_acc
+ check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))
+ check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len))
+ check_accs (AlexAccPred a pred : rest)
+ | pred user orig_input (I# (len)) input
+ = AlexLastAcc a input (I# (len))
+ check_accs (AlexAccSkipPred pred : rest)
+ | pred user orig_input (I# (len)) input
+ = AlexLastSkip input (I# (len))
+ check_accs (_ : rest) = check_accs rest
+
+data AlexLastAcc a
+ = AlexNone
+ | AlexLastAcc a !AlexInput !Int
+ | AlexLastSkip !AlexInput !Int
+
+data AlexAcc a user
+ = AlexAcc a
+ | AlexAccSkip
+ | AlexAccPred a (AlexAccPred user)
+ | AlexAccSkipPred (AlexAccPred user)
+
+type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool
+
+-- -----------------------------------------------------------------------------
+-- Predicates on a rule
+
+alexAndPred p1 p2 user in1 len in2
+ = p1 user in1 len in2 && p2 user in1 len in2
+
+--alexPrevCharIsPred :: Char -> AlexAccPred _
+alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input
+
+--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _
+alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input
+
+--alexRightContext :: Int -> AlexAccPred _
+alexRightContext (I# (sc)) user _ _ input =
+ case alex_scan_tkn user input 0# input sc AlexNone of
+ (AlexNone, _) -> False
+ _ -> True
+ -- TODO: there's no need to find the longest
+ -- match when checking the right context, just
+ -- the first match will do.
+
+-- used by wrappers
+iUnbox (I# (i)) = i
diff --git a/src/GF/Source/LexGF.x b/src/GF/Source/LexGF.x new file mode 100644 index 000000000..15671c9de --- /dev/null +++ b/src/GF/Source/LexGF.x @@ -0,0 +1,144 @@ +-- -*- haskell -*-
+-- This Alex file was machine-generated by the BNF converter
+{
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Source.LexGF where
+
+import GF.Source.SharedString
+import qualified Data.ByteString.Char8 as BS
+}
+
+
+$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME
+$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME
+$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME
+$d = [0-9] -- digit
+$i = [$l $d _ '] -- identifier character
+$u = [\0-\255] -- universal: any character
+
+@rsyms = -- symbols and non-identifier-like reserved words
+ \; | \= | \{ | \} | \( | \) | \* \* | \: | \- \> | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \# | \! | \* | \+ | \+ \+ | \\ | \= \> | \_ | \$ | \/
+
+:-
+"--" [.]* ; -- Toss single line comments
+"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
+
+$white+ ;
+@rsyms { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
+\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . share) s)) }
+(\_ | $l)($l | $d | \_ | \')* { tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) }
+
+$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
+\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
+
+$d+ { tok (\p s -> PT p (TI $ share s)) }
+$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
+
+{
+
+tok f p s = f p s
+
+share :: BS.ByteString -> BS.ByteString
+share = shareString
+
+data Tok =
+ TS !BS.ByteString !Int -- reserved words and symbols
+ | TL !BS.ByteString -- string literals
+ | TI !BS.ByteString -- integer literals
+ | TV !BS.ByteString -- identifiers
+ | TD !BS.ByteString -- double precision float literals
+ | TC !BS.ByteString -- character literals
+ | T_LString !BS.ByteString
+ | T_PIdent !BS.ByteString
+
+ deriving (Eq,Show,Ord)
+
+data Token =
+ PT Posn Tok
+ | Err Posn
+ deriving (Eq,Show,Ord)
+
+tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
+tokenPos _ = "end of file"
+
+posLineCol (Pn _ l c) = (l,c)
+mkPosToken t@(PT p _) = (posLineCol p, prToken t)
+
+prToken t = case t of
+ PT _ (TS s _) -> s
+ PT _ (TL s) -> s
+ PT _ (TI s) -> s
+ PT _ (TV s) -> s
+ PT _ (TD s) -> s
+ PT _ (TC s) -> s
+ PT _ (T_LString s) -> s
+ PT _ (T_PIdent s) -> s
+
+
+data BTree = N | B BS.ByteString Tok BTree BTree deriving (Show)
+
+eitherResIdent :: (BS.ByteString -> Tok) -> BS.ByteString -> Tok
+eitherResIdent tv s = treeFind resWords
+ where
+ treeFind N = tv s
+ treeFind (B a t left right) | s < a = treeFind left
+ | s > a = treeFind right
+ | s == a = t
+
+resWords = b "def" 39 (b "=>" 20 (b "++" 10 (b "(" 5 (b "$" 3 (b "#" 2 (b "!" 1 N N) N) (b "%" 4 N N)) (b "**" 8 (b "*" 7 (b ")" 6 N N) N) (b "+" 9 N N))) (b "/" 15 (b "->" 13 (b "-" 12 (b "," 11 N N) N) (b "." 14 N N)) (b "<" 18 (b ";" 17 (b ":" 16 N N) N) (b "=" 19 N N)))) (b "[" 30 (b "PType" 25 (b "@" 23 (b "?" 22 (b ">" 21 N N) N) (b "Lin" 24 N N)) (b "Tok" 28 (b "Strs" 27 (b "Str" 26 N N) N) (b "Type" 29 N N))) (b "case" 35 (b "_" 33 (b "]" 32 (b "\\" 31 N N) N) (b "abstract" 34 N N)) (b "concrete" 37 (b "cat" 36 N N) (b "data" 38 N N))))) (b "package" 58 (b "let" 49 (b "in" 44 (b "fun" 42 (b "fn" 41 (b "flags" 40 N N) N) (b "grammar" 43 N N)) (b "instance" 47 (b "incomplete" 46 (b "include" 45 N N) N) (b "interface" 48 N N))) (b "of" 54 (b "lindef" 52 (b "lincat" 51 (b "lin" 50 N N) N) (b "lintype" 53 N N)) (b "oper" 56 (b "open" 55 N N) (b "out" 57 N N)))) (b "transfer" 68 (b "resource" 63 (b "pre" 61 (b "pattern" 60 (b "param" 59 N N) N) (b "printname" 62 N N)) (b "table" 66 (b "strs" 65 (b "reuse" 64 N N) N) (b "tokenizer" 67 N N))) (b "with" 73 (b "variants" 71 (b "var" 70 (b "union" 69 N N) N) (b "where" 72 N N)) (b "|" 75 (b "{" 74 N N) (b "}" 76 N N)))))
+ where b s n = let bs = BS.pack s
+ in B bs (TS bs n)
+
+unescapeInitTail :: BS.ByteString -> BS.ByteString
+unescapeInitTail = BS.pack . unesc . tail . BS.unpack where
+ unesc s = case s of
+ '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
+ '\\':'n':cs -> '\n' : unesc cs
+ '\\':'t':cs -> '\t' : unesc cs
+ '"':[] -> []
+ c:cs -> c : unesc cs
+ _ -> []
+
+-------------------------------------------------------------------
+-- Alex wrapper code.
+-- A modified "posn" wrapper.
+-------------------------------------------------------------------
+
+data Posn = Pn !Int !Int !Int
+ deriving (Eq, Show,Ord)
+
+alexStartPos :: Posn
+alexStartPos = Pn 0 1 1
+
+alexMove :: Posn -> Char -> Posn
+alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)
+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1
+alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
+
+type AlexInput = (Posn, -- current position,
+ Char, -- previous char
+ BS.ByteString) -- current input string
+
+tokens :: BS.ByteString -> [Token]
+tokens str = go (alexStartPos, '\n', str)
+ where
+ go :: AlexInput -> [Token]
+ go inp@(pos, _, str) =
+ case alexScan inp 0 of
+ AlexEOF -> []
+ AlexError (pos, _, _) -> [Err pos]
+ AlexSkip inp' len -> go inp'
+ AlexToken inp' len act -> act pos (BS.take len str) : (go inp')
+
+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
+alexGetChar (p, _, s) =
+ case BS.uncons s of
+ Nothing -> Nothing
+ Just (c,s) ->
+ let p' = alexMove p c
+ in p' `seq` Just (c, (p', c, s))
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (p, c, s) = c
+}
diff --git a/src/GF/Source/ParGF.hs b/src/GF/Source/ParGF.hs new file mode 100644 index 000000000..863e6c7e9 --- /dev/null +++ b/src/GF/Source/ParGF.hs @@ -0,0 +1,7843 @@ +{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
+module GF.Source.ParGF where
+import GF.Source.AbsGF
+import GF.Source.LexGF
+import GF.Data.ErrM
+import qualified Data.ByteString.Char8 as BS
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts
+#else
+import GlaExts
+#endif
+
+-- parser produced by Happy Version 1.17
+
+data HappyAbsSyn
+ = HappyTerminal Token
+ | HappyErrorToken Int
+ | HappyAbsSyn8 (Integer)
+ | HappyAbsSyn9 (String)
+ | HappyAbsSyn10 (Double)
+ | HappyAbsSyn11 (LString)
+ | HappyAbsSyn12 (PIdent)
+ | HappyAbsSyn13 (Grammar)
+ | HappyAbsSyn14 ([ModDef])
+ | HappyAbsSyn15 (ModDef)
+ | HappyAbsSyn16 (ConcSpec)
+ | HappyAbsSyn17 ([ConcSpec])
+ | HappyAbsSyn18 (ConcExp)
+ | HappyAbsSyn19 ([Transfer])
+ | HappyAbsSyn20 (Transfer)
+ | HappyAbsSyn22 (ModBody)
+ | HappyAbsSyn23 (ModType)
+ | HappyAbsSyn25 ([TopDef])
+ | HappyAbsSyn26 (Extend)
+ | HappyAbsSyn27 ([Open])
+ | HappyAbsSyn28 (Opens)
+ | HappyAbsSyn29 (Open)
+ | HappyAbsSyn30 (ComplMod)
+ | HappyAbsSyn31 (QualOpen)
+ | HappyAbsSyn32 ([Included])
+ | HappyAbsSyn33 (Included)
+ | HappyAbsSyn34 (Def)
+ | HappyAbsSyn35 (TopDef)
+ | HappyAbsSyn36 (CatDef)
+ | HappyAbsSyn37 (FunDef)
+ | HappyAbsSyn38 (DataDef)
+ | HappyAbsSyn39 (DataConstr)
+ | HappyAbsSyn40 ([DataConstr])
+ | HappyAbsSyn41 (ParDef)
+ | HappyAbsSyn42 (ParConstr)
+ | HappyAbsSyn43 (PrintDef)
+ | HappyAbsSyn44 (FlagDef)
+ | HappyAbsSyn45 ([Def])
+ | HappyAbsSyn46 ([CatDef])
+ | HappyAbsSyn47 ([FunDef])
+ | HappyAbsSyn48 ([DataDef])
+ | HappyAbsSyn49 ([ParDef])
+ | HappyAbsSyn50 ([PrintDef])
+ | HappyAbsSyn51 ([FlagDef])
+ | HappyAbsSyn52 ([ParConstr])
+ | HappyAbsSyn53 ([PIdent])
+ | HappyAbsSyn54 (Name)
+ | HappyAbsSyn55 ([Name])
+ | HappyAbsSyn56 (LocDef)
+ | HappyAbsSyn57 ([LocDef])
+ | HappyAbsSyn58 (Exp)
+ | HappyAbsSyn65 ([Exp])
+ | HappyAbsSyn66 (Exps)
+ | HappyAbsSyn67 (Patt)
+ | HappyAbsSyn70 (PattAss)
+ | HappyAbsSyn71 (Label)
+ | HappyAbsSyn72 (Sort)
+ | HappyAbsSyn73 ([PattAss])
+ | HappyAbsSyn74 ([Patt])
+ | HappyAbsSyn75 (Bind)
+ | HappyAbsSyn76 ([Bind])
+ | HappyAbsSyn77 (Decl)
+ | HappyAbsSyn78 (TupleComp)
+ | HappyAbsSyn79 (PattTupleComp)
+ | HappyAbsSyn80 ([TupleComp])
+ | HappyAbsSyn81 ([PattTupleComp])
+ | HappyAbsSyn82 (Case)
+ | HappyAbsSyn83 ([Case])
+ | HappyAbsSyn84 (Equation)
+ | HappyAbsSyn85 ([Equation])
+ | HappyAbsSyn86 (Altern)
+ | HappyAbsSyn87 ([Altern])
+ | HappyAbsSyn88 (DDecl)
+ | HappyAbsSyn89 ([DDecl])
+ | HappyAbsSyn90 (OldGrammar)
+ | HappyAbsSyn91 (Include)
+ | HappyAbsSyn92 (FileName)
+ | HappyAbsSyn93 ([FileName])
+
+type HappyReduction m =
+ Int#
+ -> (Token)
+ -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)
+ -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)]
+ -> HappyStk HappyAbsSyn
+ -> [(Token)] -> m HappyAbsSyn
+
+action_0,
+ action_1,
+ action_2,
+ action_3,
+ action_4,
+ action_5,
+ action_6,
+ action_7,
+ action_8,
+ action_9,
+ action_10,
+ action_11,
+ action_12,
+ action_13,
+ action_14,
+ action_15,
+ action_16,
+ action_17,
+ action_18,
+ action_19,
+ action_20,
+ action_21,
+ action_22,
+ action_23,
+ action_24,
+ action_25,
+ action_26,
+ action_27,
+ action_28,
+ action_29,
+ action_30,
+ action_31,
+ action_32,
+ action_33,
+ action_34,
+ action_35,
+ action_36,
+ action_37,
+ action_38,
+ action_39,
+ action_40,
+ action_41,
+ action_42,
+ action_43,
+ action_44,
+ action_45,
+ action_46,
+ action_47,
+ action_48,
+ action_49,
+ action_50,
+ action_51,
+ action_52,
+ action_53,
+ action_54,
+ action_55,
+ action_56,
+ action_57,
+ action_58,
+ action_59,
+ action_60,
+ action_61,
+ action_62,
+ action_63,
+ action_64,
+ action_65,
+ action_66,
+ action_67,
+ action_68,
+ action_69,
+ action_70,
+ action_71,
+ action_72,
+ action_73,
+ action_74,
+ action_75,
+ action_76,
+ action_77,
+ action_78,
+ action_79,
+ action_80,
+ action_81,
+ action_82,
+ action_83,
+ action_84,
+ action_85,
+ action_86,
+ action_87,
+ action_88,
+ action_89,
+ action_90,
+ action_91,
+ action_92,
+ action_93,
+ action_94,
+ action_95,
+ action_96,
+ action_97,
+ action_98,
+ action_99,
+ action_100,
+ action_101,
+ action_102,
+ action_103,
+ action_104,
+ action_105,
+ action_106,
+ action_107,
+ action_108,
+ action_109,
+ action_110,
+ action_111,
+ action_112,
+ action_113,
+ action_114,
+ action_115,
+ action_116,
+ action_117,
+ action_118,
+ action_119,
+ action_120,
+ action_121,
+ action_122,
+ action_123,
+ action_124,
+ action_125,
+ action_126,
+ action_127,
+ action_128,
+ action_129,
+ action_130,
+ action_131,
+ action_132,
+ action_133,
+ action_134,
+ action_135,
+ action_136,
+ action_137,
+ action_138,
+ action_139,
+ action_140,
+ action_141,
+ action_142,
+ action_143,
+ action_144,
+ action_145,
+ action_146,
+ action_147,
+ action_148,
+ action_149,
+ action_150,
+ action_151,
+ action_152,
+ action_153,
+ action_154,
+ action_155,
+ action_156,
+ action_157,
+ action_158,
+ action_159,
+ action_160,
+ action_161,
+ action_162,
+ action_163,
+ action_164,
+ action_165,
+ action_166,
+ action_167,
+ action_168,
+ action_169,
+ action_170,
+ action_171,
+ action_172,
+ action_173,
+ action_174,
+ action_175,
+ action_176,
+ action_177,
+ action_178,
+ action_179,
+ action_180,
+ action_181,
+ action_182,
+ action_183,
+ action_184,
+ action_185,
+ action_186,
+ action_187,
+ action_188,
+ action_189,
+ action_190,
+ action_191,
+ action_192,
+ action_193,
+ action_194,
+ action_195,
+ action_196,
+ action_197,
+ action_198,
+ action_199,
+ action_200,
+ action_201,
+ action_202,
+ action_203,
+ action_204,
+ action_205,
+ action_206,
+ action_207,
+ action_208,
+ action_209,
+ action_210,
+ action_211,
+ action_212,
+ action_213,
+ action_214,
+ action_215,
+ action_216,
+ action_217,
+ action_218,
+ action_219,
+ action_220,
+ action_221,
+ action_222,
+ action_223,
+ action_224,
+ action_225,
+ action_226,
+ action_227,
+ action_228,
+ action_229,
+ action_230,
+ action_231,
+ action_232,
+ action_233,
+ action_234,
+ action_235,
+ action_236,
+ action_237,
+ action_238,
+ action_239,
+ action_240,
+ action_241,
+ action_242,
+ action_243,
+ action_244,
+ action_245,
+ action_246,
+ action_247,
+ action_248,
+ action_249,
+ action_250,
+ action_251,
+ action_252,
+ action_253,
+ action_254,
+ action_255,
+ action_256,
+ action_257,
+ action_258,
+ action_259,
+ action_260,
+ action_261,
+ action_262,
+ action_263,
+ action_264,
+ action_265,
+ action_266,
+ action_267,
+ action_268,
+ action_269,
+ action_270,
+ action_271,
+ action_272,
+ action_273,
+ action_274,
+ action_275,
+ action_276,
+ action_277,
+ action_278,
+ action_279,
+ action_280,
+ action_281,
+ action_282,
+ action_283,
+ action_284,
+ action_285,
+ action_286,
+ action_287,
+ action_288,
+ action_289,
+ action_290,
+ action_291,
+ action_292,
+ action_293,
+ action_294,
+ action_295,
+ action_296,
+ action_297,
+ action_298,
+ action_299,
+ action_300,
+ action_301,
+ action_302,
+ action_303,
+ action_304,
+ action_305,
+ action_306,
+ action_307,
+ action_308,
+ action_309,
+ action_310,
+ action_311,
+ action_312,
+ action_313,
+ action_314,
+ action_315,
+ action_316,
+ action_317,
+ action_318,
+ action_319,
+ action_320,
+ action_321,
+ action_322,
+ action_323,
+ action_324,
+ action_325,
+ action_326,
+ action_327,
+ action_328,
+ action_329,
+ action_330,
+ action_331,
+ action_332,
+ action_333,
+ action_334,
+ action_335,
+ action_336,
+ action_337,
+ action_338,
+ action_339,
+ action_340,
+ action_341,
+ action_342,
+ action_343,
+ action_344,
+ action_345,
+ action_346,
+ action_347,
+ action_348,
+ action_349,
+ action_350,
+ action_351,
+ action_352,
+ action_353,
+ action_354,
+ action_355,
+ action_356,
+ action_357,
+ action_358,
+ action_359,
+ action_360,
+ action_361,
+ action_362,
+ action_363,
+ action_364,
+ action_365,
+ action_366,
+ action_367,
+ action_368,
+ action_369,
+ action_370,
+ action_371,
+ action_372,
+ action_373,
+ action_374,
+ action_375,
+ action_376,
+ action_377,
+ action_378,
+ action_379,
+ action_380,
+ action_381,
+ action_382,
+ action_383,
+ action_384,
+ action_385,
+ action_386,
+ action_387,
+ action_388,
+ action_389,
+ action_390,
+ action_391,
+ action_392,
+ action_393,
+ action_394,
+ action_395,
+ action_396,
+ action_397,
+ action_398,
+ action_399,
+ action_400,
+ action_401,
+ action_402,
+ action_403,
+ action_404,
+ action_405,
+ action_406,
+ action_407,
+ action_408,
+ action_409,
+ action_410,
+ action_411,
+ action_412,
+ action_413,
+ action_414,
+ action_415,
+ action_416,
+ action_417,
+ action_418,
+ action_419,
+ action_420,
+ action_421,
+ action_422,
+ action_423,
+ action_424,
+ action_425,
+ action_426,
+ action_427,
+ action_428,
+ action_429,
+ action_430,
+ action_431,
+ action_432,
+ action_433,
+ action_434,
+ action_435,
+ action_436,
+ action_437,
+ action_438,
+ action_439,
+ action_440,
+ action_441,
+ action_442,
+ action_443,
+ action_444,
+ action_445,
+ action_446,
+ action_447,
+ action_448,
+ action_449,
+ action_450,
+ action_451,
+ action_452,
+ action_453,
+ action_454,
+ action_455,
+ action_456,
+ action_457,
+ action_458,
+ action_459,
+ action_460,
+ action_461,
+ action_462,
+ action_463,
+ action_464,
+ action_465,
+ action_466,
+ action_467,
+ action_468,
+ action_469,
+ action_470,
+ action_471,
+ action_472,
+ action_473,
+ action_474,
+ action_475,
+ action_476,
+ action_477,
+ action_478,
+ action_479,
+ action_480,
+ action_481,
+ action_482,
+ action_483,
+ action_484,
+ action_485,
+ action_486,
+ action_487,
+ action_488,
+ action_489,
+ action_490,
+ action_491,
+ action_492,
+ action_493,
+ action_494,
+ action_495,
+ action_496,
+ action_497,
+ action_498,
+ action_499,
+ action_500,
+ action_501,
+ action_502,
+ action_503,
+ action_504,
+ action_505,
+ action_506,
+ action_507,
+ action_508,
+ action_509,
+ action_510,
+ action_511,
+ action_512,
+ action_513,
+ action_514,
+ action_515,
+ action_516,
+ action_517,
+ action_518,
+ action_519,
+ action_520,
+ action_521,
+ action_522,
+ action_523,
+ action_524,
+ action_525,
+ action_526,
+ action_527,
+ action_528,
+ action_529,
+ action_530,
+ action_531,
+ action_532,
+ action_533,
+ action_534,
+ action_535,
+ action_536,
+ action_537,
+ action_538,
+ action_539,
+ action_540,
+ action_541,
+ action_542,
+ action_543,
+ action_544,
+ action_545,
+ action_546,
+ action_547 :: () => Int# -> HappyReduction (Err)
+
+happyReduce_5,
+ happyReduce_6,
+ happyReduce_7,
+ happyReduce_8,
+ happyReduce_9,
+ happyReduce_10,
+ happyReduce_11,
+ happyReduce_12,
+ happyReduce_13,
+ happyReduce_14,
+ happyReduce_15,
+ happyReduce_16,
+ happyReduce_17,
+ happyReduce_18,
+ happyReduce_19,
+ happyReduce_20,
+ happyReduce_21,
+ happyReduce_22,
+ happyReduce_23,
+ happyReduce_24,
+ happyReduce_25,
+ happyReduce_26,
+ happyReduce_27,
+ happyReduce_28,
+ happyReduce_29,
+ happyReduce_30,
+ happyReduce_31,
+ happyReduce_32,
+ happyReduce_33,
+ happyReduce_34,
+ happyReduce_35,
+ happyReduce_36,
+ happyReduce_37,
+ happyReduce_38,
+ happyReduce_39,
+ happyReduce_40,
+ happyReduce_41,
+ happyReduce_42,
+ happyReduce_43,
+ happyReduce_44,
+ happyReduce_45,
+ happyReduce_46,
+ happyReduce_47,
+ happyReduce_48,
+ happyReduce_49,
+ happyReduce_50,
+ happyReduce_51,
+ happyReduce_52,
+ happyReduce_53,
+ happyReduce_54,
+ happyReduce_55,
+ happyReduce_56,
+ happyReduce_57,
+ happyReduce_58,
+ happyReduce_59,
+ happyReduce_60,
+ happyReduce_61,
+ happyReduce_62,
+ happyReduce_63,
+ happyReduce_64,
+ happyReduce_65,
+ happyReduce_66,
+ happyReduce_67,
+ happyReduce_68,
+ happyReduce_69,
+ happyReduce_70,
+ happyReduce_71,
+ happyReduce_72,
+ happyReduce_73,
+ happyReduce_74,
+ happyReduce_75,
+ happyReduce_76,
+ happyReduce_77,
+ happyReduce_78,
+ happyReduce_79,
+ happyReduce_80,
+ happyReduce_81,
+ happyReduce_82,
+ happyReduce_83,
+ happyReduce_84,
+ happyReduce_85,
+ happyReduce_86,
+ happyReduce_87,
+ happyReduce_88,
+ happyReduce_89,
+ happyReduce_90,
+ happyReduce_91,
+ happyReduce_92,
+ happyReduce_93,
+ happyReduce_94,
+ happyReduce_95,
+ happyReduce_96,
+ happyReduce_97,
+ happyReduce_98,
+ happyReduce_99,
+ happyReduce_100,
+ happyReduce_101,
+ happyReduce_102,
+ happyReduce_103,
+ happyReduce_104,
+ happyReduce_105,
+ happyReduce_106,
+ happyReduce_107,
+ happyReduce_108,
+ happyReduce_109,
+ happyReduce_110,
+ happyReduce_111,
+ happyReduce_112,
+ happyReduce_113,
+ happyReduce_114,
+ happyReduce_115,
+ happyReduce_116,
+ happyReduce_117,
+ happyReduce_118,
+ happyReduce_119,
+ happyReduce_120,
+ happyReduce_121,
+ happyReduce_122,
+ happyReduce_123,
+ happyReduce_124,
+ happyReduce_125,
+ happyReduce_126,
+ happyReduce_127,
+ happyReduce_128,
+ happyReduce_129,
+ happyReduce_130,
+ happyReduce_131,
+ happyReduce_132,
+ happyReduce_133,
+ happyReduce_134,
+ happyReduce_135,
+ happyReduce_136,
+ happyReduce_137,
+ happyReduce_138,
+ happyReduce_139,
+ happyReduce_140,
+ happyReduce_141,
+ happyReduce_142,
+ happyReduce_143,
+ happyReduce_144,
+ happyReduce_145,
+ happyReduce_146,
+ happyReduce_147,
+ happyReduce_148,
+ happyReduce_149,
+ happyReduce_150,
+ happyReduce_151,
+ happyReduce_152,
+ happyReduce_153,
+ happyReduce_154,
+ happyReduce_155,
+ happyReduce_156,
+ happyReduce_157,
+ happyReduce_158,
+ happyReduce_159,
+ happyReduce_160,
+ happyReduce_161,
+ happyReduce_162,
+ happyReduce_163,
+ happyReduce_164,
+ happyReduce_165,
+ happyReduce_166,
+ happyReduce_167,
+ happyReduce_168,
+ happyReduce_169,
+ happyReduce_170,
+ happyReduce_171,
+ happyReduce_172,
+ happyReduce_173,
+ happyReduce_174,
+ happyReduce_175,
+ happyReduce_176,
+ happyReduce_177,
+ happyReduce_178,
+ happyReduce_179,
+ happyReduce_180,
+ happyReduce_181,
+ happyReduce_182,
+ happyReduce_183,
+ happyReduce_184,
+ happyReduce_185,
+ happyReduce_186,
+ happyReduce_187,
+ happyReduce_188,
+ happyReduce_189,
+ happyReduce_190,
+ happyReduce_191,
+ happyReduce_192,
+ happyReduce_193,
+ happyReduce_194,
+ happyReduce_195,
+ happyReduce_196,
+ happyReduce_197,
+ happyReduce_198,
+ happyReduce_199,
+ happyReduce_200,
+ happyReduce_201,
+ happyReduce_202,
+ happyReduce_203,
+ happyReduce_204,
+ happyReduce_205,
+ happyReduce_206,
+ happyReduce_207,
+ happyReduce_208,
+ happyReduce_209,
+ happyReduce_210,
+ happyReduce_211,
+ happyReduce_212,
+ happyReduce_213,
+ happyReduce_214,
+ happyReduce_215,
+ happyReduce_216,
+ happyReduce_217,
+ happyReduce_218,
+ happyReduce_219,
+ happyReduce_220,
+ happyReduce_221,
+ happyReduce_222,
+ happyReduce_223,
+ happyReduce_224,
+ happyReduce_225,
+ happyReduce_226,
+ happyReduce_227,
+ happyReduce_228,
+ happyReduce_229,
+ happyReduce_230,
+ happyReduce_231,
+ happyReduce_232,
+ happyReduce_233,
+ happyReduce_234,
+ happyReduce_235,
+ happyReduce_236,
+ happyReduce_237,
+ happyReduce_238,
+ happyReduce_239,
+ happyReduce_240,
+ happyReduce_241,
+ happyReduce_242,
+ happyReduce_243,
+ happyReduce_244,
+ happyReduce_245,
+ happyReduce_246,
+ happyReduce_247,
+ happyReduce_248,
+ happyReduce_249,
+ happyReduce_250,
+ happyReduce_251,
+ happyReduce_252,
+ happyReduce_253,
+ happyReduce_254,
+ happyReduce_255,
+ happyReduce_256,
+ happyReduce_257,
+ happyReduce_258,
+ happyReduce_259,
+ happyReduce_260,
+ happyReduce_261,
+ happyReduce_262,
+ happyReduce_263,
+ happyReduce_264,
+ happyReduce_265,
+ happyReduce_266,
+ happyReduce_267,
+ happyReduce_268,
+ happyReduce_269,
+ happyReduce_270,
+ happyReduce_271,
+ happyReduce_272,
+ happyReduce_273,
+ happyReduce_274 :: () => HappyReduction (Err)
+
+action_0 (13#) = happyGoto action_58
+action_0 (14#) = happyGoto action_59
+action_0 x = happyTcHack x happyReduce_11
+
+action_1 (136#) = happyShift action_57
+action_1 (139#) = happyShift action_51
+action_1 (15#) = happyGoto action_55
+action_1 (30#) = happyGoto action_56
+action_1 x = happyTcHack x happyReduce_60
+
+action_2 (138#) = happyShift action_54
+action_2 (90#) = happyGoto action_52
+action_2 (91#) = happyGoto action_53
+action_2 x = happyTcHack x happyReduce_265
+
+action_3 (139#) = happyShift action_51
+action_3 (21#) = happyGoto action_49
+action_3 (30#) = happyGoto action_50
+action_3 x = happyTcHack x happyReduce_60
+
+action_4 (95#) = happyShift action_21
+action_4 (97#) = happyShift action_22
+action_4 (98#) = happyShift action_23
+action_4 (111#) = happyShift action_24
+action_4 (115#) = happyShift action_25
+action_4 (117#) = happyShift action_26
+action_4 (118#) = happyShift action_27
+action_4 (119#) = happyShift action_28
+action_4 (120#) = happyShift action_29
+action_4 (121#) = happyShift action_30
+action_4 (122#) = happyShift action_31
+action_4 (123#) = happyShift action_32
+action_4 (124#) = happyShift action_33
+action_4 (128#) = happyShift action_34
+action_4 (131#) = happyShift action_35
+action_4 (134#) = happyShift action_36
+action_4 (137#) = happyShift action_37
+action_4 (142#) = happyShift action_38
+action_4 (153#) = happyShift action_39
+action_4 (154#) = happyShift action_40
+action_4 (158#) = happyShift action_41
+action_4 (159#) = happyShift action_42
+action_4 (164#) = happyShift action_43
+action_4 (167#) = happyShift action_44
+action_4 (170#) = happyShift action_6
+action_4 (171#) = happyShift action_45
+action_4 (172#) = happyShift action_46
+action_4 (173#) = happyShift action_47
+action_4 (174#) = happyShift action_48
+action_4 (8#) = happyGoto action_7
+action_4 (9#) = happyGoto action_8
+action_4 (10#) = happyGoto action_9
+action_4 (11#) = happyGoto action_10
+action_4 (12#) = happyGoto action_11
+action_4 (58#) = happyGoto action_12
+action_4 (59#) = happyGoto action_13
+action_4 (60#) = happyGoto action_14
+action_4 (61#) = happyGoto action_15
+action_4 (62#) = happyGoto action_16
+action_4 (63#) = happyGoto action_17
+action_4 (64#) = happyGoto action_18
+action_4 (72#) = happyGoto action_19
+action_4 (77#) = happyGoto action_20
+action_4 x = happyTcHack x happyFail
+
+action_5 (170#) = happyShift action_6
+action_5 x = happyTcHack x happyFail
+
+action_6 x = happyTcHack x happyReduce_5
+
+action_7 x = happyTcHack x happyReduce_145
+
+action_8 x = happyTcHack x happyReduce_144
+
+action_9 x = happyTcHack x happyReduce_146
+
+action_10 x = happyTcHack x happyReduce_157
+
+action_11 (116#) = happyShift action_137
+action_11 x = happyTcHack x happyReduce_140
+
+action_12 x = happyTcHack x happyReduce_161
+
+action_13 (107#) = happyShift action_136
+action_13 x = happyTcHack x happyReduce_173
+
+action_14 (97#) = happyShift action_22
+action_14 (98#) = happyShift action_87
+action_14 (106#) = happyReduce_240
+action_14 (111#) = happyShift action_24
+action_14 (115#) = happyShift action_25
+action_14 (118#) = happyShift action_27
+action_14 (119#) = happyShift action_28
+action_14 (120#) = happyShift action_29
+action_14 (121#) = happyShift action_30
+action_14 (122#) = happyShift action_31
+action_14 (123#) = happyShift action_32
+action_14 (131#) = happyShift action_35
+action_14 (167#) = happyShift action_44
+action_14 (170#) = happyShift action_6
+action_14 (171#) = happyShift action_45
+action_14 (172#) = happyShift action_46
+action_14 (173#) = happyShift action_47
+action_14 (174#) = happyShift action_48
+action_14 (8#) = happyGoto action_7
+action_14 (9#) = happyGoto action_8
+action_14 (10#) = happyGoto action_9
+action_14 (11#) = happyGoto action_10
+action_14 (12#) = happyGoto action_84
+action_14 (58#) = happyGoto action_12
+action_14 (59#) = happyGoto action_135
+action_14 (72#) = happyGoto action_19
+action_14 x = happyTcHack x happyReduce_178
+
+action_15 (94#) = happyShift action_130
+action_15 (100#) = happyShift action_131
+action_15 (101#) = happyShift action_132
+action_15 (113#) = happyShift action_133
+action_15 (165#) = happyShift action_134
+action_15 x = happyTcHack x happyReduce_192
+
+action_16 (103#) = happyShift action_129
+action_16 x = happyTcHack x happyReduce_191
+
+action_17 (176#) = happyAccept
+action_17 x = happyTcHack x happyFail
+
+action_18 (102#) = happyShift action_128
+action_18 x = happyTcHack x happyReduce_180
+
+action_19 x = happyTcHack x happyReduce_143
+
+action_20 (106#) = happyShift action_127
+action_20 x = happyTcHack x happyFail
+
+action_21 (95#) = happyShift action_120
+action_21 (98#) = happyShift action_121
+action_21 (111#) = happyShift action_122
+action_21 (115#) = happyShift action_123
+action_21 (123#) = happyShift action_124
+action_21 (126#) = happyShift action_125
+action_21 (167#) = happyShift action_126
+action_21 (170#) = happyShift action_6
+action_21 (171#) = happyShift action_45
+action_21 (172#) = happyShift action_46
+action_21 (174#) = happyShift action_48
+action_21 (8#) = happyGoto action_115
+action_21 (9#) = happyGoto action_116
+action_21 (10#) = happyGoto action_117
+action_21 (12#) = happyGoto action_118
+action_21 (67#) = happyGoto action_119
+action_21 x = happyTcHack x happyFail
+
+action_22 (174#) = happyShift action_48
+action_22 (12#) = happyGoto action_114
+action_22 x = happyTcHack x happyFail
+
+action_23 (95#) = happyShift action_21
+action_23 (97#) = happyShift action_22
+action_23 (98#) = happyShift action_23
+action_23 (111#) = happyShift action_24
+action_23 (115#) = happyShift action_25
+action_23 (117#) = happyShift action_26
+action_23 (118#) = happyShift action_27
+action_23 (119#) = happyShift action_28
+action_23 (120#) = happyShift action_29
+action_23 (121#) = happyShift action_30
+action_23 (122#) = happyShift action_31
+action_23 (123#) = happyShift action_32
+action_23 (124#) = happyShift action_33
+action_23 (126#) = happyShift action_102
+action_23 (128#) = happyShift action_34
+action_23 (131#) = happyShift action_35
+action_23 (134#) = happyShift action_36
+action_23 (137#) = happyShift action_113
+action_23 (142#) = happyShift action_38
+action_23 (153#) = happyShift action_39
+action_23 (154#) = happyShift action_40
+action_23 (158#) = happyShift action_41
+action_23 (159#) = happyShift action_42
+action_23 (164#) = happyShift action_43
+action_23 (167#) = happyShift action_44
+action_23 (170#) = happyShift action_6
+action_23 (171#) = happyShift action_45
+action_23 (172#) = happyShift action_46
+action_23 (173#) = happyShift action_47
+action_23 (174#) = happyShift action_48
+action_23 (8#) = happyGoto action_7
+action_23 (9#) = happyGoto action_8
+action_23 (10#) = happyGoto action_9
+action_23 (11#) = happyGoto action_10
+action_23 (12#) = happyGoto action_110
+action_23 (58#) = happyGoto action_12
+action_23 (59#) = happyGoto action_13
+action_23 (60#) = happyGoto action_14
+action_23 (61#) = happyGoto action_15
+action_23 (62#) = happyGoto action_16
+action_23 (63#) = happyGoto action_111
+action_23 (64#) = happyGoto action_18
+action_23 (72#) = happyGoto action_19
+action_23 (75#) = happyGoto action_99
+action_23 (76#) = happyGoto action_112
+action_23 (77#) = happyGoto action_20
+action_23 x = happyTcHack x happyReduce_236
+
+action_24 (95#) = happyShift action_21
+action_24 (97#) = happyShift action_22
+action_24 (98#) = happyShift action_23
+action_24 (111#) = happyShift action_24
+action_24 (115#) = happyShift action_25
+action_24 (117#) = happyShift action_26
+action_24 (118#) = happyShift action_27
+action_24 (119#) = happyShift action_28
+action_24 (120#) = happyShift action_29
+action_24 (121#) = happyShift action_30
+action_24 (122#) = happyShift action_31
+action_24 (123#) = happyShift action_32
+action_24 (124#) = happyShift action_33
+action_24 (128#) = happyShift action_34
+action_24 (131#) = happyShift action_35
+action_24 (134#) = happyShift action_36
+action_24 (137#) = happyShift action_37
+action_24 (142#) = happyShift action_38
+action_24 (153#) = happyShift action_39
+action_24 (154#) = happyShift action_40
+action_24 (158#) = happyShift action_41
+action_24 (159#) = happyShift action_42
+action_24 (164#) = happyShift action_43
+action_24 (167#) = happyShift action_44
+action_24 (170#) = happyShift action_6
+action_24 (171#) = happyShift action_45
+action_24 (172#) = happyShift action_46
+action_24 (173#) = happyShift action_47
+action_24 (174#) = happyShift action_48
+action_24 (8#) = happyGoto action_7
+action_24 (9#) = happyGoto action_8
+action_24 (10#) = happyGoto action_9
+action_24 (11#) = happyGoto action_10
+action_24 (12#) = happyGoto action_11
+action_24 (58#) = happyGoto action_12
+action_24 (59#) = happyGoto action_13
+action_24 (60#) = happyGoto action_14
+action_24 (61#) = happyGoto action_15
+action_24 (62#) = happyGoto action_16
+action_24 (63#) = happyGoto action_107
+action_24 (64#) = happyGoto action_18
+action_24 (72#) = happyGoto action_19
+action_24 (77#) = happyGoto action_20
+action_24 (78#) = happyGoto action_108
+action_24 (80#) = happyGoto action_109
+action_24 x = happyTcHack x happyReduce_243
+
+action_25 x = happyTcHack x happyReduce_147
+
+action_26 (174#) = happyShift action_48
+action_26 (12#) = happyGoto action_106
+action_26 x = happyTcHack x happyFail
+
+action_27 x = happyTcHack x happyReduce_225
+
+action_28 x = happyTcHack x happyReduce_227
+
+action_29 x = happyTcHack x happyReduce_228
+
+action_30 x = happyTcHack x happyReduce_226
+
+action_31 x = happyTcHack x happyReduce_224
+
+action_32 (125#) = happyShift action_105
+action_32 (171#) = happyShift action_45
+action_32 (174#) = happyShift action_48
+action_32 (9#) = happyGoto action_103
+action_32 (12#) = happyGoto action_104
+action_32 x = happyTcHack x happyFail
+
+action_33 (124#) = happyShift action_101
+action_33 (126#) = happyShift action_102
+action_33 (174#) = happyShift action_48
+action_33 (12#) = happyGoto action_98
+action_33 (75#) = happyGoto action_99
+action_33 (76#) = happyGoto action_100
+action_33 x = happyTcHack x happyReduce_236
+
+action_34 (95#) = happyShift action_21
+action_34 (97#) = happyShift action_22
+action_34 (98#) = happyShift action_23
+action_34 (111#) = happyShift action_24
+action_34 (115#) = happyShift action_25
+action_34 (117#) = happyShift action_26
+action_34 (118#) = happyShift action_27
+action_34 (119#) = happyShift action_28
+action_34 (120#) = happyShift action_29
+action_34 (121#) = happyShift action_30
+action_34 (122#) = happyShift action_31
+action_34 (123#) = happyShift action_32
+action_34 (124#) = happyShift action_33
+action_34 (128#) = happyShift action_34
+action_34 (131#) = happyShift action_35
+action_34 (134#) = happyShift action_36
+action_34 (137#) = happyShift action_37
+action_34 (142#) = happyShift action_38
+action_34 (153#) = happyShift action_39
+action_34 (154#) = happyShift action_40
+action_34 (158#) = happyShift action_41
+action_34 (159#) = happyShift action_42
+action_34 (164#) = happyShift action_43
+action_34 (167#) = happyShift action_44
+action_34 (170#) = happyShift action_6
+action_34 (171#) = happyShift action_45
+action_34 (172#) = happyShift action_46
+action_34 (173#) = happyShift action_47
+action_34 (174#) = happyShift action_48
+action_34 (8#) = happyGoto action_7
+action_34 (9#) = happyGoto action_8
+action_34 (10#) = happyGoto action_9
+action_34 (11#) = happyGoto action_10
+action_34 (12#) = happyGoto action_11
+action_34 (58#) = happyGoto action_12
+action_34 (59#) = happyGoto action_13
+action_34 (60#) = happyGoto action_14
+action_34 (61#) = happyGoto action_15
+action_34 (62#) = happyGoto action_16
+action_34 (63#) = happyGoto action_97
+action_34 (64#) = happyGoto action_18
+action_34 (72#) = happyGoto action_19
+action_34 (77#) = happyGoto action_20
+action_34 x = happyTcHack x happyFail
+
+action_35 x = happyTcHack x happyReduce_149
+
+action_36 (167#) = happyShift action_96
+action_36 x = happyTcHack x happyFail
+
+action_37 (97#) = happyShift action_22
+action_37 (98#) = happyShift action_87
+action_37 (111#) = happyShift action_24
+action_37 (115#) = happyShift action_25
+action_37 (118#) = happyShift action_27
+action_37 (119#) = happyShift action_28
+action_37 (120#) = happyShift action_29
+action_37 (121#) = happyShift action_30
+action_37 (122#) = happyShift action_31
+action_37 (123#) = happyShift action_32
+action_37 (131#) = happyShift action_35
+action_37 (167#) = happyShift action_44
+action_37 (170#) = happyShift action_6
+action_37 (171#) = happyShift action_45
+action_37 (172#) = happyShift action_46
+action_37 (173#) = happyShift action_47
+action_37 (174#) = happyShift action_48
+action_37 (8#) = happyGoto action_7
+action_37 (9#) = happyGoto action_8
+action_37 (10#) = happyGoto action_9
+action_37 (11#) = happyGoto action_10
+action_37 (12#) = happyGoto action_84
+action_37 (58#) = happyGoto action_12
+action_37 (59#) = happyGoto action_95
+action_37 (72#) = happyGoto action_19
+action_37 x = happyTcHack x happyFail
+
+action_38 (167#) = happyShift action_94
+action_38 (174#) = happyShift action_48
+action_38 (12#) = happyGoto action_92
+action_38 (53#) = happyGoto action_80
+action_38 (56#) = happyGoto action_81
+action_38 (57#) = happyGoto action_93
+action_38 x = happyTcHack x happyReduce_137
+
+action_39 (97#) = happyShift action_22
+action_39 (98#) = happyShift action_87
+action_39 (111#) = happyShift action_24
+action_39 (115#) = happyShift action_25
+action_39 (118#) = happyShift action_27
+action_39 (119#) = happyShift action_28
+action_39 (120#) = happyShift action_29
+action_39 (121#) = happyShift action_30
+action_39 (122#) = happyShift action_31
+action_39 (123#) = happyShift action_32
+action_39 (131#) = happyShift action_35
+action_39 (167#) = happyShift action_44
+action_39 (170#) = happyShift action_6
+action_39 (171#) = happyShift action_45
+action_39 (172#) = happyShift action_46
+action_39 (173#) = happyShift action_47
+action_39 (174#) = happyShift action_48
+action_39 (8#) = happyGoto action_7
+action_39 (9#) = happyGoto action_8
+action_39 (10#) = happyGoto action_9
+action_39 (11#) = happyGoto action_10
+action_39 (12#) = happyGoto action_84
+action_39 (58#) = happyGoto action_12
+action_39 (59#) = happyGoto action_91
+action_39 (72#) = happyGoto action_19
+action_39 x = happyTcHack x happyFail
+
+action_40 (167#) = happyShift action_90
+action_40 x = happyTcHack x happyFail
+
+action_41 (167#) = happyShift action_89
+action_41 x = happyTcHack x happyFail
+
+action_42 (97#) = happyShift action_86
+action_42 (98#) = happyShift action_87
+action_42 (111#) = happyShift action_24
+action_42 (115#) = happyShift action_25
+action_42 (118#) = happyShift action_27
+action_42 (119#) = happyShift action_28
+action_42 (120#) = happyShift action_29
+action_42 (121#) = happyShift action_30
+action_42 (122#) = happyShift action_31
+action_42 (123#) = happyShift action_32
+action_42 (131#) = happyShift action_35
+action_42 (167#) = happyShift action_88
+action_42 (170#) = happyShift action_6
+action_42 (171#) = happyShift action_45
+action_42 (172#) = happyShift action_46
+action_42 (173#) = happyShift action_47
+action_42 (174#) = happyShift action_48
+action_42 (8#) = happyGoto action_7
+action_42 (9#) = happyGoto action_8
+action_42 (10#) = happyGoto action_9
+action_42 (11#) = happyGoto action_10
+action_42 (12#) = happyGoto action_84
+action_42 (58#) = happyGoto action_85
+action_42 (72#) = happyGoto action_19
+action_42 x = happyTcHack x happyFail
+
+action_43 (167#) = happyShift action_83
+action_43 x = happyTcHack x happyFail
+
+action_44 (174#) = happyShift action_48
+action_44 (12#) = happyGoto action_79
+action_44 (53#) = happyGoto action_80
+action_44 (56#) = happyGoto action_81
+action_44 (57#) = happyGoto action_82
+action_44 x = happyTcHack x happyReduce_137
+
+action_45 x = happyTcHack x happyReduce_6
+
+action_46 x = happyTcHack x happyReduce_7
+
+action_47 x = happyTcHack x happyReduce_8
+
+action_48 x = happyTcHack x happyReduce_9
+
+action_49 (1#) = happyAccept
+action_49 x = happyTcHack x happyFail
+
+action_50 (127#) = happyShift action_63
+action_50 (130#) = happyShift action_64
+action_50 (140#) = happyShift action_65
+action_50 (141#) = happyShift action_66
+action_50 (156#) = happyShift action_67
+action_50 (161#) = happyShift action_68
+action_50 (23#) = happyGoto action_78
+action_50 x = happyTcHack x happyFail
+
+action_51 x = happyTcHack x happyReduce_61
+
+action_52 (176#) = happyAccept
+action_52 x = happyTcHack x happyFail
+
+action_53 (25#) = happyGoto action_77
+action_53 x = happyTcHack x happyReduce_48
+
+action_54 (105#) = happyShift action_74
+action_54 (107#) = happyShift action_75
+action_54 (108#) = happyShift action_76
+action_54 (171#) = happyShift action_45
+action_54 (174#) = happyShift action_48
+action_54 (9#) = happyGoto action_70
+action_54 (12#) = happyGoto action_71
+action_54 (92#) = happyGoto action_72
+action_54 (93#) = happyGoto action_73
+action_54 x = happyTcHack x happyFail
+
+action_55 (110#) = happyShift action_69
+action_55 (176#) = happyAccept
+action_55 x = happyTcHack x happyFail
+
+action_56 (127#) = happyShift action_63
+action_56 (130#) = happyShift action_64
+action_56 (140#) = happyShift action_65
+action_56 (141#) = happyShift action_66
+action_56 (156#) = happyShift action_67
+action_56 (161#) = happyShift action_68
+action_56 (23#) = happyGoto action_62
+action_56 x = happyTcHack x happyFail
+
+action_57 (174#) = happyShift action_48
+action_57 (12#) = happyGoto action_61
+action_57 x = happyTcHack x happyFail
+
+action_58 (176#) = happyAccept
+action_58 x = happyTcHack x happyFail
+
+action_59 (136#) = happyShift action_57
+action_59 (139#) = happyShift action_51
+action_59 (176#) = happyReduce_10
+action_59 (15#) = happyGoto action_60
+action_59 (30#) = happyGoto action_56
+action_59 x = happyTcHack x happyReduce_60
+
+action_60 (110#) = happyShift action_69
+action_60 x = happyTcHack x happyReduce_12
+
+action_61 (112#) = happyShift action_239
+action_61 x = happyTcHack x happyFail
+
+action_62 (112#) = happyShift action_238
+action_62 x = happyTcHack x happyFail
+
+action_63 (174#) = happyShift action_48
+action_63 (12#) = happyGoto action_237
+action_63 x = happyTcHack x happyFail
+
+action_64 (174#) = happyShift action_48
+action_64 (12#) = happyGoto action_236
+action_64 x = happyTcHack x happyFail
+
+action_65 (174#) = happyShift action_48
+action_65 (12#) = happyGoto action_235
+action_65 x = happyTcHack x happyFail
+
+action_66 (174#) = happyShift action_48
+action_66 (12#) = happyGoto action_234
+action_66 x = happyTcHack x happyFail
+
+action_67 (174#) = happyShift action_48
+action_67 (12#) = happyGoto action_233
+action_67 x = happyTcHack x happyFail
+
+action_68 (174#) = happyShift action_48
+action_68 (12#) = happyGoto action_232
+action_68 x = happyTcHack x happyFail
+
+action_69 x = happyTcHack x happyReduce_13
+
+action_70 x = happyTcHack x happyReduce_267
+
+action_71 (105#) = happyShift action_74
+action_71 (107#) = happyShift action_75
+action_71 (108#) = happyShift action_76
+action_71 (171#) = happyShift action_45
+action_71 (174#) = happyShift action_48
+action_71 (9#) = happyGoto action_70
+action_71 (12#) = happyGoto action_71
+action_71 (92#) = happyGoto action_231
+action_71 x = happyTcHack x happyReduce_268
+
+action_72 (110#) = happyShift action_230
+action_72 x = happyTcHack x happyFail
+
+action_73 x = happyTcHack x happyReduce_266
+
+action_74 (105#) = happyShift action_74
+action_74 (107#) = happyShift action_75
+action_74 (108#) = happyShift action_76
+action_74 (171#) = happyShift action_45
+action_74 (174#) = happyShift action_48
+action_74 (9#) = happyGoto action_70
+action_74 (12#) = happyGoto action_71
+action_74 (92#) = happyGoto action_229
+action_74 x = happyTcHack x happyFail
+
+action_75 (105#) = happyShift action_74
+action_75 (107#) = happyShift action_75
+action_75 (108#) = happyShift action_76
+action_75 (171#) = happyShift action_45
+action_75 (174#) = happyShift action_48
+action_75 (9#) = happyGoto action_70
+action_75 (12#) = happyGoto action_71
+action_75 (92#) = happyGoto action_228
+action_75 x = happyTcHack x happyFail
+
+action_76 (105#) = happyShift action_74
+action_76 (107#) = happyShift action_75
+action_76 (108#) = happyShift action_76
+action_76 (171#) = happyShift action_45
+action_76 (174#) = happyShift action_48
+action_76 (9#) = happyGoto action_70
+action_76 (12#) = happyGoto action_71
+action_76 (92#) = happyGoto action_227
+action_76 x = happyTcHack x happyFail
+
+action_77 (129#) = happyShift action_210
+action_77 (131#) = happyShift action_211
+action_77 (132#) = happyShift action_212
+action_77 (133#) = happyShift action_213
+action_77 (135#) = happyShift action_214
+action_77 (143#) = happyShift action_215
+action_77 (144#) = happyShift action_216
+action_77 (145#) = happyShift action_217
+action_77 (146#) = happyShift action_218
+action_77 (149#) = happyShift action_219
+action_77 (151#) = happyShift action_220
+action_77 (152#) = happyShift action_221
+action_77 (153#) = happyShift action_222
+action_77 (155#) = happyShift action_223
+action_77 (160#) = happyShift action_224
+action_77 (161#) = happyShift action_225
+action_77 (163#) = happyShift action_226
+action_77 (35#) = happyGoto action_209
+action_77 x = happyTcHack x happyReduce_264
+
+action_78 (112#) = happyShift action_208
+action_78 x = happyTcHack x happyFail
+
+action_79 (104#) = happyShift action_190
+action_79 (107#) = happyShift action_206
+action_79 (169#) = happyShift action_207
+action_79 x = happyTcHack x happyReduce_128
+
+action_80 (109#) = happyShift action_204
+action_80 (112#) = happyShift action_205
+action_80 x = happyTcHack x happyFail
+
+action_81 (110#) = happyShift action_203
+action_81 x = happyTcHack x happyReduce_138
+
+action_82 (169#) = happyShift action_202
+action_82 x = happyTcHack x happyFail
+
+action_83 (95#) = happyShift action_21
+action_83 (97#) = happyShift action_22
+action_83 (98#) = happyShift action_23
+action_83 (111#) = happyShift action_24
+action_83 (115#) = happyShift action_25
+action_83 (117#) = happyShift action_26
+action_83 (118#) = happyShift action_27
+action_83 (119#) = happyShift action_28
+action_83 (120#) = happyShift action_29
+action_83 (121#) = happyShift action_30
+action_83 (122#) = happyShift action_31
+action_83 (123#) = happyShift action_32
+action_83 (124#) = happyShift action_33
+action_83 (128#) = happyShift action_34
+action_83 (131#) = happyShift action_35
+action_83 (134#) = happyShift action_36
+action_83 (137#) = happyShift action_37
+action_83 (142#) = happyShift action_38
+action_83 (153#) = happyShift action_39
+action_83 (154#) = happyShift action_40
+action_83 (158#) = happyShift action_41
+action_83 (159#) = happyShift action_42
+action_83 (164#) = happyShift action_43
+action_83 (167#) = happyShift action_44
+action_83 (170#) = happyShift action_6
+action_83 (171#) = happyShift action_45
+action_83 (172#) = happyShift action_46
+action_83 (173#) = happyShift action_47
+action_83 (174#) = happyShift action_48
+action_83 (8#) = happyGoto action_7
+action_83 (9#) = happyGoto action_8
+action_83 (10#) = happyGoto action_9
+action_83 (11#) = happyGoto action_10
+action_83 (12#) = happyGoto action_11
+action_83 (58#) = happyGoto action_12
+action_83 (59#) = happyGoto action_13
+action_83 (60#) = happyGoto action_14
+action_83 (61#) = happyGoto action_15
+action_83 (62#) = happyGoto action_16
+action_83 (63#) = happyGoto action_192
+action_83 (64#) = happyGoto action_18
+action_83 (65#) = happyGoto action_201
+action_83 (72#) = happyGoto action_19
+action_83 (77#) = happyGoto action_20
+action_83 x = happyTcHack x happyReduce_193
+
+action_84 x = happyTcHack x happyReduce_140
+
+action_85 (123#) = happyShift action_199
+action_85 (167#) = happyShift action_200
+action_85 x = happyTcHack x happyFail
+
+action_86 (174#) = happyShift action_48
+action_86 (12#) = happyGoto action_198
+action_86 x = happyTcHack x happyFail
+
+action_87 (95#) = happyShift action_21
+action_87 (97#) = happyShift action_22
+action_87 (98#) = happyShift action_23
+action_87 (111#) = happyShift action_24
+action_87 (115#) = happyShift action_25
+action_87 (117#) = happyShift action_26
+action_87 (118#) = happyShift action_27
+action_87 (119#) = happyShift action_28
+action_87 (120#) = happyShift action_29
+action_87 (121#) = happyShift action_30
+action_87 (122#) = happyShift action_31
+action_87 (123#) = happyShift action_32
+action_87 (124#) = happyShift action_33
+action_87 (128#) = happyShift action_34
+action_87 (131#) = happyShift action_35
+action_87 (134#) = happyShift action_36
+action_87 (137#) = happyShift action_113
+action_87 (142#) = happyShift action_38
+action_87 (153#) = happyShift action_39
+action_87 (154#) = happyShift action_40
+action_87 (158#) = happyShift action_41
+action_87 (159#) = happyShift action_42
+action_87 (164#) = happyShift action_43
+action_87 (167#) = happyShift action_44
+action_87 (170#) = happyShift action_6
+action_87 (171#) = happyShift action_45
+action_87 (172#) = happyShift action_46
+action_87 (173#) = happyShift action_47
+action_87 (174#) = happyShift action_48
+action_87 (8#) = happyGoto action_7
+action_87 (9#) = happyGoto action_8
+action_87 (10#) = happyGoto action_9
+action_87 (11#) = happyGoto action_10
+action_87 (12#) = happyGoto action_11
+action_87 (58#) = happyGoto action_12
+action_87 (59#) = happyGoto action_13
+action_87 (60#) = happyGoto action_14
+action_87 (61#) = happyGoto action_15
+action_87 (62#) = happyGoto action_16
+action_87 (63#) = happyGoto action_111
+action_87 (64#) = happyGoto action_18
+action_87 (72#) = happyGoto action_19
+action_87 (77#) = happyGoto action_20
+action_87 x = happyTcHack x happyFail
+
+action_88 (95#) = happyShift action_120
+action_88 (98#) = happyShift action_121
+action_88 (105#) = happyShift action_164
+action_88 (111#) = happyShift action_122
+action_88 (115#) = happyShift action_123
+action_88 (123#) = happyShift action_124
+action_88 (126#) = happyShift action_125
+action_88 (167#) = happyShift action_126
+action_88 (170#) = happyShift action_6
+action_88 (171#) = happyShift action_45
+action_88 (172#) = happyShift action_46
+action_88 (174#) = happyShift action_48
+action_88 (8#) = happyGoto action_115
+action_88 (9#) = happyGoto action_116
+action_88 (10#) = happyGoto action_117
+action_88 (12#) = happyGoto action_194
+action_88 (53#) = happyGoto action_80
+action_88 (56#) = happyGoto action_81
+action_88 (57#) = happyGoto action_82
+action_88 (67#) = happyGoto action_159
+action_88 (68#) = happyGoto action_160
+action_88 (69#) = happyGoto action_195
+action_88 (82#) = happyGoto action_196
+action_88 (83#) = happyGoto action_197
+action_88 x = happyTcHack x happyReduce_137
+
+action_89 (95#) = happyShift action_21
+action_89 (97#) = happyShift action_22
+action_89 (98#) = happyShift action_23
+action_89 (111#) = happyShift action_24
+action_89 (115#) = happyShift action_25
+action_89 (117#) = happyShift action_26
+action_89 (118#) = happyShift action_27
+action_89 (119#) = happyShift action_28
+action_89 (120#) = happyShift action_29
+action_89 (121#) = happyShift action_30
+action_89 (122#) = happyShift action_31
+action_89 (123#) = happyShift action_32
+action_89 (124#) = happyShift action_33
+action_89 (128#) = happyShift action_34
+action_89 (131#) = happyShift action_35
+action_89 (134#) = happyShift action_36
+action_89 (137#) = happyShift action_37
+action_89 (142#) = happyShift action_38
+action_89 (153#) = happyShift action_39
+action_89 (154#) = happyShift action_40
+action_89 (158#) = happyShift action_41
+action_89 (159#) = happyShift action_42
+action_89 (164#) = happyShift action_43
+action_89 (167#) = happyShift action_44
+action_89 (170#) = happyShift action_6
+action_89 (171#) = happyShift action_45
+action_89 (172#) = happyShift action_46
+action_89 (173#) = happyShift action_47
+action_89 (174#) = happyShift action_48
+action_89 (8#) = happyGoto action_7
+action_89 (9#) = happyGoto action_8
+action_89 (10#) = happyGoto action_9
+action_89 (11#) = happyGoto action_10
+action_89 (12#) = happyGoto action_11
+action_89 (58#) = happyGoto action_12
+action_89 (59#) = happyGoto action_13
+action_89 (60#) = happyGoto action_14
+action_89 (61#) = happyGoto action_15
+action_89 (62#) = happyGoto action_16
+action_89 (63#) = happyGoto action_192
+action_89 (64#) = happyGoto action_18
+action_89 (65#) = happyGoto action_193
+action_89 (72#) = happyGoto action_19
+action_89 (77#) = happyGoto action_20
+action_89 x = happyTcHack x happyReduce_193
+
+action_90 (95#) = happyShift action_21
+action_90 (97#) = happyShift action_22
+action_90 (98#) = happyShift action_23
+action_90 (111#) = happyShift action_24
+action_90 (115#) = happyShift action_25
+action_90 (117#) = happyShift action_26
+action_90 (118#) = happyShift action_27
+action_90 (119#) = happyShift action_28
+action_90 (120#) = happyShift action_29
+action_90 (121#) = happyShift action_30
+action_90 (122#) = happyShift action_31
+action_90 (123#) = happyShift action_32
+action_90 (124#) = happyShift action_33
+action_90 (128#) = happyShift action_34
+action_90 (131#) = happyShift action_35
+action_90 (134#) = happyShift action_36
+action_90 (137#) = happyShift action_37
+action_90 (142#) = happyShift action_38
+action_90 (153#) = happyShift action_39
+action_90 (154#) = happyShift action_40
+action_90 (158#) = happyShift action_41
+action_90 (159#) = happyShift action_42
+action_90 (164#) = happyShift action_43
+action_90 (167#) = happyShift action_44
+action_90 (170#) = happyShift action_6
+action_90 (171#) = happyShift action_45
+action_90 (172#) = happyShift action_46
+action_90 (173#) = happyShift action_47
+action_90 (174#) = happyShift action_48
+action_90 (8#) = happyGoto action_7
+action_90 (9#) = happyGoto action_8
+action_90 (10#) = happyGoto action_9
+action_90 (11#) = happyGoto action_10
+action_90 (12#) = happyGoto action_11
+action_90 (58#) = happyGoto action_12
+action_90 (59#) = happyGoto action_13
+action_90 (60#) = happyGoto action_14
+action_90 (61#) = happyGoto action_15
+action_90 (62#) = happyGoto action_16
+action_90 (63#) = happyGoto action_191
+action_90 (64#) = happyGoto action_18
+action_90 (72#) = happyGoto action_19
+action_90 (77#) = happyGoto action_20
+action_90 x = happyTcHack x happyFail
+
+action_91 (107#) = happyShift action_136
+action_91 x = happyTcHack x happyReduce_172
+
+action_92 (104#) = happyShift action_190
+action_92 x = happyTcHack x happyReduce_128
+
+action_93 (137#) = happyShift action_189
+action_93 x = happyTcHack x happyFail
+
+action_94 (174#) = happyShift action_48
+action_94 (12#) = happyGoto action_92
+action_94 (53#) = happyGoto action_80
+action_94 (56#) = happyGoto action_81
+action_94 (57#) = happyGoto action_188
+action_94 x = happyTcHack x happyReduce_137
+
+action_95 (107#) = happyShift action_136
+action_95 (171#) = happyShift action_45
+action_95 (9#) = happyGoto action_187
+action_95 x = happyTcHack x happyFail
+
+action_96 (95#) = happyShift action_120
+action_96 (98#) = happyShift action_121
+action_96 (111#) = happyShift action_122
+action_96 (115#) = happyShift action_123
+action_96 (123#) = happyShift action_124
+action_96 (126#) = happyShift action_125
+action_96 (167#) = happyShift action_126
+action_96 (170#) = happyShift action_6
+action_96 (171#) = happyShift action_45
+action_96 (172#) = happyShift action_46
+action_96 (174#) = happyShift action_48
+action_96 (8#) = happyGoto action_115
+action_96 (9#) = happyGoto action_116
+action_96 (10#) = happyGoto action_117
+action_96 (12#) = happyGoto action_118
+action_96 (67#) = happyGoto action_183
+action_96 (74#) = happyGoto action_184
+action_96 (84#) = happyGoto action_185
+action_96 (85#) = happyGoto action_186
+action_96 x = happyTcHack x happyReduce_253
+
+action_97 (147#) = happyShift action_182
+action_97 x = happyTcHack x happyFail
+
+action_98 x = happyTcHack x happyReduce_234
+
+action_99 (104#) = happyShift action_181
+action_99 x = happyTcHack x happyReduce_237
+
+action_100 (106#) = happyShift action_180
+action_100 x = happyTcHack x happyFail
+
+action_101 (126#) = happyShift action_102
+action_101 (174#) = happyShift action_48
+action_101 (12#) = happyGoto action_98
+action_101 (75#) = happyGoto action_99
+action_101 (76#) = happyGoto action_179
+action_101 x = happyTcHack x happyReduce_236
+
+action_102 x = happyTcHack x happyReduce_235
+
+action_103 (125#) = happyShift action_178
+action_103 x = happyTcHack x happyFail
+
+action_104 (97#) = happyShift action_86
+action_104 (98#) = happyShift action_87
+action_104 (111#) = happyShift action_24
+action_104 (115#) = happyShift action_25
+action_104 (118#) = happyShift action_27
+action_104 (119#) = happyShift action_28
+action_104 (120#) = happyShift action_29
+action_104 (121#) = happyShift action_30
+action_104 (122#) = happyShift action_31
+action_104 (123#) = happyShift action_32
+action_104 (131#) = happyShift action_35
+action_104 (167#) = happyShift action_139
+action_104 (170#) = happyShift action_6
+action_104 (171#) = happyShift action_45
+action_104 (172#) = happyShift action_46
+action_104 (173#) = happyShift action_47
+action_104 (174#) = happyShift action_48
+action_104 (8#) = happyGoto action_7
+action_104 (9#) = happyGoto action_8
+action_104 (10#) = happyGoto action_9
+action_104 (11#) = happyGoto action_10
+action_104 (12#) = happyGoto action_84
+action_104 (58#) = happyGoto action_176
+action_104 (66#) = happyGoto action_177
+action_104 (72#) = happyGoto action_19
+action_104 x = happyTcHack x happyReduce_196
+
+action_105 x = happyTcHack x happyReduce_148
+
+action_106 x = happyTcHack x happyReduce_174
+
+action_107 (109#) = happyShift action_175
+action_107 x = happyTcHack x happyReduce_241
+
+action_108 (104#) = happyShift action_174
+action_108 x = happyTcHack x happyReduce_244
+
+action_109 (114#) = happyShift action_173
+action_109 x = happyTcHack x happyFail
+
+action_110 (104#) = happyReduce_234
+action_110 (109#) = happyReduce_234
+action_110 (116#) = happyShift action_137
+action_110 x = happyTcHack x happyReduce_140
+
+action_111 (99#) = happyShift action_172
+action_111 x = happyTcHack x happyFail
+
+action_112 (109#) = happyShift action_171
+action_112 x = happyTcHack x happyFail
+
+action_113 (97#) = happyShift action_22
+action_113 (98#) = happyShift action_87
+action_113 (111#) = happyShift action_24
+action_113 (115#) = happyShift action_25
+action_113 (118#) = happyShift action_27
+action_113 (119#) = happyShift action_28
+action_113 (120#) = happyShift action_29
+action_113 (121#) = happyShift action_30
+action_113 (122#) = happyShift action_31
+action_113 (123#) = happyShift action_32
+action_113 (131#) = happyShift action_35
+action_113 (167#) = happyShift action_44
+action_113 (170#) = happyShift action_6
+action_113 (171#) = happyShift action_45
+action_113 (172#) = happyShift action_46
+action_113 (173#) = happyShift action_47
+action_113 (174#) = happyShift action_48
+action_113 (8#) = happyGoto action_7
+action_113 (9#) = happyGoto action_8
+action_113 (10#) = happyGoto action_9
+action_113 (11#) = happyGoto action_10
+action_113 (12#) = happyGoto action_170
+action_113 (58#) = happyGoto action_12
+action_113 (59#) = happyGoto action_95
+action_113 (72#) = happyGoto action_19
+action_113 x = happyTcHack x happyFail
+
+action_114 (97#) = happyShift action_168
+action_114 (107#) = happyShift action_169
+action_114 x = happyTcHack x happyFail
+
+action_115 x = happyTcHack x happyReduce_206
+
+action_116 x = happyTcHack x happyReduce_208
+
+action_117 x = happyTcHack x happyReduce_207
+
+action_118 (107#) = happyShift action_167
+action_118 x = happyTcHack x happyReduce_203
+
+action_119 x = happyTcHack x happyReduce_171
+
+action_120 (174#) = happyShift action_48
+action_120 (12#) = happyGoto action_166
+action_120 x = happyTcHack x happyFail
+
+action_121 (95#) = happyShift action_120
+action_121 (98#) = happyShift action_121
+action_121 (105#) = happyShift action_164
+action_121 (111#) = happyShift action_122
+action_121 (115#) = happyShift action_123
+action_121 (123#) = happyShift action_124
+action_121 (126#) = happyShift action_125
+action_121 (167#) = happyShift action_126
+action_121 (170#) = happyShift action_6
+action_121 (171#) = happyShift action_45
+action_121 (172#) = happyShift action_46
+action_121 (174#) = happyShift action_48
+action_121 (8#) = happyGoto action_115
+action_121 (9#) = happyGoto action_116
+action_121 (10#) = happyGoto action_117
+action_121 (12#) = happyGoto action_158
+action_121 (67#) = happyGoto action_159
+action_121 (68#) = happyGoto action_160
+action_121 (69#) = happyGoto action_165
+action_121 x = happyTcHack x happyFail
+
+action_122 (95#) = happyShift action_120
+action_122 (98#) = happyShift action_121
+action_122 (105#) = happyShift action_164
+action_122 (111#) = happyShift action_122
+action_122 (115#) = happyShift action_123
+action_122 (123#) = happyShift action_124
+action_122 (126#) = happyShift action_125
+action_122 (167#) = happyShift action_126
+action_122 (170#) = happyShift action_6
+action_122 (171#) = happyShift action_45
+action_122 (172#) = happyShift action_46
+action_122 (174#) = happyShift action_48
+action_122 (8#) = happyGoto action_115
+action_122 (9#) = happyGoto action_116
+action_122 (10#) = happyGoto action_117
+action_122 (12#) = happyGoto action_158
+action_122 (67#) = happyGoto action_159
+action_122 (68#) = happyGoto action_160
+action_122 (69#) = happyGoto action_161
+action_122 (79#) = happyGoto action_162
+action_122 (81#) = happyGoto action_163
+action_122 x = happyTcHack x happyReduce_246
+
+action_123 x = happyTcHack x happyReduce_198
+
+action_124 (171#) = happyShift action_45
+action_124 (9#) = happyGoto action_157
+action_124 x = happyTcHack x happyFail
+
+action_125 x = happyTcHack x happyReduce_202
+
+action_126 (174#) = happyShift action_48
+action_126 (12#) = happyGoto action_153
+action_126 (53#) = happyGoto action_154
+action_126 (70#) = happyGoto action_155
+action_126 (73#) = happyGoto action_156
+action_126 x = happyTcHack x happyReduce_229
+
+action_127 (95#) = happyShift action_21
+action_127 (97#) = happyShift action_22
+action_127 (98#) = happyShift action_23
+action_127 (111#) = happyShift action_24
+action_127 (115#) = happyShift action_25
+action_127 (117#) = happyShift action_26
+action_127 (118#) = happyShift action_27
+action_127 (119#) = happyShift action_28
+action_127 (120#) = happyShift action_29
+action_127 (121#) = happyShift action_30
+action_127 (122#) = happyShift action_31
+action_127 (123#) = happyShift action_32
+action_127 (124#) = happyShift action_33
+action_127 (128#) = happyShift action_34
+action_127 (131#) = happyShift action_35
+action_127 (134#) = happyShift action_36
+action_127 (137#) = happyShift action_37
+action_127 (142#) = happyShift action_38
+action_127 (153#) = happyShift action_39
+action_127 (154#) = happyShift action_40
+action_127 (158#) = happyShift action_41
+action_127 (159#) = happyShift action_42
+action_127 (164#) = happyShift action_43
+action_127 (167#) = happyShift action_44
+action_127 (170#) = happyShift action_6
+action_127 (171#) = happyShift action_45
+action_127 (172#) = happyShift action_46
+action_127 (173#) = happyShift action_47
+action_127 (174#) = happyShift action_48
+action_127 (8#) = happyGoto action_7
+action_127 (9#) = happyGoto action_8
+action_127 (10#) = happyGoto action_9
+action_127 (11#) = happyGoto action_10
+action_127 (12#) = happyGoto action_11
+action_127 (58#) = happyGoto action_12
+action_127 (59#) = happyGoto action_13
+action_127 (60#) = happyGoto action_14
+action_127 (61#) = happyGoto action_15
+action_127 (62#) = happyGoto action_16
+action_127 (63#) = happyGoto action_152
+action_127 (64#) = happyGoto action_18
+action_127 (72#) = happyGoto action_19
+action_127 (77#) = happyGoto action_20
+action_127 x = happyTcHack x happyFail
+
+action_128 (95#) = happyShift action_21
+action_128 (97#) = happyShift action_22
+action_128 (98#) = happyShift action_87
+action_128 (111#) = happyShift action_24
+action_128 (115#) = happyShift action_25
+action_128 (117#) = happyShift action_26
+action_128 (118#) = happyShift action_27
+action_128 (119#) = happyShift action_28
+action_128 (120#) = happyShift action_29
+action_128 (121#) = happyShift action_30
+action_128 (122#) = happyShift action_31
+action_128 (123#) = happyShift action_32
+action_128 (128#) = happyShift action_34
+action_128 (131#) = happyShift action_35
+action_128 (153#) = happyShift action_39
+action_128 (154#) = happyShift action_40
+action_128 (158#) = happyShift action_41
+action_128 (159#) = happyShift action_42
+action_128 (164#) = happyShift action_43
+action_128 (167#) = happyShift action_44
+action_128 (170#) = happyShift action_6
+action_128 (171#) = happyShift action_45
+action_128 (172#) = happyShift action_46
+action_128 (173#) = happyShift action_47
+action_128 (174#) = happyShift action_48
+action_128 (8#) = happyGoto action_7
+action_128 (9#) = happyGoto action_8
+action_128 (10#) = happyGoto action_9
+action_128 (11#) = happyGoto action_10
+action_128 (12#) = happyGoto action_11
+action_128 (58#) = happyGoto action_12
+action_128 (59#) = happyGoto action_13
+action_128 (60#) = happyGoto action_149
+action_128 (61#) = happyGoto action_150
+action_128 (62#) = happyGoto action_151
+action_128 (64#) = happyGoto action_18
+action_128 (72#) = happyGoto action_19
+action_128 x = happyTcHack x happyFail
+
+action_129 (95#) = happyShift action_21
+action_129 (97#) = happyShift action_22
+action_129 (98#) = happyShift action_23
+action_129 (111#) = happyShift action_24
+action_129 (115#) = happyShift action_25
+action_129 (117#) = happyShift action_26
+action_129 (118#) = happyShift action_27
+action_129 (119#) = happyShift action_28
+action_129 (120#) = happyShift action_29
+action_129 (121#) = happyShift action_30
+action_129 (122#) = happyShift action_31
+action_129 (123#) = happyShift action_32
+action_129 (124#) = happyShift action_33
+action_129 (128#) = happyShift action_34
+action_129 (131#) = happyShift action_35
+action_129 (134#) = happyShift action_36
+action_129 (137#) = happyShift action_37
+action_129 (142#) = happyShift action_38
+action_129 (153#) = happyShift action_39
+action_129 (154#) = happyShift action_40
+action_129 (158#) = happyShift action_41
+action_129 (159#) = happyShift action_42
+action_129 (164#) = happyShift action_43
+action_129 (167#) = happyShift action_44
+action_129 (170#) = happyShift action_6
+action_129 (171#) = happyShift action_45
+action_129 (172#) = happyShift action_46
+action_129 (173#) = happyShift action_47
+action_129 (174#) = happyShift action_48
+action_129 (8#) = happyGoto action_7
+action_129 (9#) = happyGoto action_8
+action_129 (10#) = happyGoto action_9
+action_129 (11#) = happyGoto action_10
+action_129 (12#) = happyGoto action_11
+action_129 (58#) = happyGoto action_12
+action_129 (59#) = happyGoto action_13
+action_129 (60#) = happyGoto action_14
+action_129 (61#) = happyGoto action_15
+action_129 (62#) = happyGoto action_16
+action_129 (63#) = happyGoto action_148
+action_129 (64#) = happyGoto action_18
+action_129 (72#) = happyGoto action_19
+action_129 (77#) = happyGoto action_20
+action_129 x = happyTcHack x happyFail
+
+action_130 (95#) = happyShift action_21
+action_130 (97#) = happyShift action_22
+action_130 (98#) = happyShift action_87
+action_130 (111#) = happyShift action_24
+action_130 (115#) = happyShift action_25
+action_130 (117#) = happyShift action_26
+action_130 (118#) = happyShift action_27
+action_130 (119#) = happyShift action_28
+action_130 (120#) = happyShift action_29
+action_130 (121#) = happyShift action_30
+action_130 (122#) = happyShift action_31
+action_130 (123#) = happyShift action_32
+action_130 (128#) = happyShift action_34
+action_130 (131#) = happyShift action_35
+action_130 (153#) = happyShift action_39
+action_130 (154#) = happyShift action_40
+action_130 (158#) = happyShift action_41
+action_130 (159#) = happyShift action_42
+action_130 (164#) = happyShift action_43
+action_130 (167#) = happyShift action_44
+action_130 (170#) = happyShift action_6
+action_130 (171#) = happyShift action_45
+action_130 (172#) = happyShift action_46
+action_130 (173#) = happyShift action_47
+action_130 (174#) = happyShift action_48
+action_130 (8#) = happyGoto action_7
+action_130 (9#) = happyGoto action_8
+action_130 (10#) = happyGoto action_9
+action_130 (11#) = happyGoto action_10
+action_130 (12#) = happyGoto action_11
+action_130 (58#) = happyGoto action_12
+action_130 (59#) = happyGoto action_13
+action_130 (60#) = happyGoto action_147
+action_130 (72#) = happyGoto action_19
+action_130 x = happyTcHack x happyFail
+
+action_131 (95#) = happyShift action_21
+action_131 (97#) = happyShift action_22
+action_131 (98#) = happyShift action_87
+action_131 (111#) = happyShift action_24
+action_131 (115#) = happyShift action_25
+action_131 (117#) = happyShift action_26
+action_131 (118#) = happyShift action_27
+action_131 (119#) = happyShift action_28
+action_131 (120#) = happyShift action_29
+action_131 (121#) = happyShift action_30
+action_131 (122#) = happyShift action_31
+action_131 (123#) = happyShift action_32
+action_131 (128#) = happyShift action_34
+action_131 (131#) = happyShift action_35
+action_131 (153#) = happyShift action_39
+action_131 (154#) = happyShift action_40
+action_131 (158#) = happyShift action_41
+action_131 (159#) = happyShift action_42
+action_131 (164#) = happyShift action_43
+action_131 (167#) = happyShift action_44
+action_131 (170#) = happyShift action_6
+action_131 (171#) = happyShift action_45
+action_131 (172#) = happyShift action_46
+action_131 (173#) = happyShift action_47
+action_131 (174#) = happyShift action_48
+action_131 (8#) = happyGoto action_7
+action_131 (9#) = happyGoto action_8
+action_131 (10#) = happyGoto action_9
+action_131 (11#) = happyGoto action_10
+action_131 (12#) = happyGoto action_11
+action_131 (58#) = happyGoto action_12
+action_131 (59#) = happyGoto action_13
+action_131 (60#) = happyGoto action_146
+action_131 (72#) = happyGoto action_19
+action_131 x = happyTcHack x happyFail
+
+action_132 (95#) = happyShift action_21
+action_132 (97#) = happyShift action_22
+action_132 (98#) = happyShift action_87
+action_132 (111#) = happyShift action_24
+action_132 (115#) = happyShift action_25
+action_132 (117#) = happyShift action_26
+action_132 (118#) = happyShift action_27
+action_132 (119#) = happyShift action_28
+action_132 (120#) = happyShift action_29
+action_132 (121#) = happyShift action_30
+action_132 (122#) = happyShift action_31
+action_132 (123#) = happyShift action_32
+action_132 (128#) = happyShift action_34
+action_132 (131#) = happyShift action_35
+action_132 (153#) = happyShift action_39
+action_132 (154#) = happyShift action_40
+action_132 (158#) = happyShift action_41
+action_132 (159#) = happyShift action_42
+action_132 (164#) = happyShift action_43
+action_132 (167#) = happyShift action_44
+action_132 (170#) = happyShift action_6
+action_132 (171#) = happyShift action_45
+action_132 (172#) = happyShift action_46
+action_132 (173#) = happyShift action_47
+action_132 (174#) = happyShift action_48
+action_132 (8#) = happyGoto action_7
+action_132 (9#) = happyGoto action_8
+action_132 (10#) = happyGoto action_9
+action_132 (11#) = happyGoto action_10
+action_132 (12#) = happyGoto action_11
+action_132 (58#) = happyGoto action_12
+action_132 (59#) = happyGoto action_13
+action_132 (60#) = happyGoto action_145
+action_132 (72#) = happyGoto action_19
+action_132 x = happyTcHack x happyFail
+
+action_133 (95#) = happyShift action_21
+action_133 (97#) = happyShift action_22
+action_133 (98#) = happyShift action_23
+action_133 (111#) = happyShift action_24
+action_133 (115#) = happyShift action_25
+action_133 (117#) = happyShift action_26
+action_133 (118#) = happyShift action_27
+action_133 (119#) = happyShift action_28
+action_133 (120#) = happyShift action_29
+action_133 (121#) = happyShift action_30
+action_133 (122#) = happyShift action_31
+action_133 (123#) = happyShift action_32
+action_133 (124#) = happyShift action_33
+action_133 (128#) = happyShift action_34
+action_133 (131#) = happyShift action_35
+action_133 (134#) = happyShift action_36
+action_133 (137#) = happyShift action_37
+action_133 (142#) = happyShift action_38
+action_133 (153#) = happyShift action_39
+action_133 (154#) = happyShift action_40
+action_133 (158#) = happyShift action_41
+action_133 (159#) = happyShift action_42
+action_133 (164#) = happyShift action_43
+action_133 (167#) = happyShift action_44
+action_133 (170#) = happyShift action_6
+action_133 (171#) = happyShift action_45
+action_133 (172#) = happyShift action_46
+action_133 (173#) = happyShift action_47
+action_133 (174#) = happyShift action_48
+action_133 (8#) = happyGoto action_7
+action_133 (9#) = happyGoto action_8
+action_133 (10#) = happyGoto action_9
+action_133 (11#) = happyGoto action_10
+action_133 (12#) = happyGoto action_11
+action_133 (58#) = happyGoto action_12
+action_133 (59#) = happyGoto action_13
+action_133 (60#) = happyGoto action_14
+action_133 (61#) = happyGoto action_15
+action_133 (62#) = happyGoto action_16
+action_133 (63#) = happyGoto action_144
+action_133 (64#) = happyGoto action_18
+action_133 (72#) = happyGoto action_19
+action_133 (77#) = happyGoto action_20
+action_133 x = happyTcHack x happyFail
+
+action_134 (167#) = happyShift action_143
+action_134 x = happyTcHack x happyFail
+
+action_135 (107#) = happyShift action_136
+action_135 x = happyTcHack x happyReduce_162
+
+action_136 (96#) = happyShift action_142
+action_136 (174#) = happyShift action_48
+action_136 (12#) = happyGoto action_140
+action_136 (71#) = happyGoto action_141
+action_136 x = happyTcHack x happyFail
+
+action_137 (97#) = happyShift action_86
+action_137 (98#) = happyShift action_87
+action_137 (111#) = happyShift action_24
+action_137 (115#) = happyShift action_25
+action_137 (118#) = happyShift action_27
+action_137 (119#) = happyShift action_28
+action_137 (120#) = happyShift action_29
+action_137 (121#) = happyShift action_30
+action_137 (122#) = happyShift action_31
+action_137 (123#) = happyShift action_32
+action_137 (131#) = happyShift action_35
+action_137 (167#) = happyShift action_139
+action_137 (170#) = happyShift action_6
+action_137 (171#) = happyShift action_45
+action_137 (172#) = happyShift action_46
+action_137 (173#) = happyShift action_47
+action_137 (174#) = happyShift action_48
+action_137 (8#) = happyGoto action_7
+action_137 (9#) = happyGoto action_8
+action_137 (10#) = happyGoto action_9
+action_137 (11#) = happyGoto action_10
+action_137 (12#) = happyGoto action_84
+action_137 (58#) = happyGoto action_138
+action_137 (72#) = happyGoto action_19
+action_137 x = happyTcHack x happyFail
+
+action_138 x = happyTcHack x happyReduce_170
+
+action_139 (174#) = happyShift action_48
+action_139 (12#) = happyGoto action_348
+action_139 (53#) = happyGoto action_80
+action_139 (56#) = happyGoto action_81
+action_139 (57#) = happyGoto action_82
+action_139 x = happyTcHack x happyReduce_137
+
+action_140 x = happyTcHack x happyReduce_222
+
+action_141 x = happyTcHack x happyReduce_158
+
+action_142 (170#) = happyShift action_6
+action_142 (8#) = happyGoto action_347
+action_142 x = happyTcHack x happyFail
+
+action_143 (174#) = happyShift action_48
+action_143 (12#) = happyGoto action_92
+action_143 (53#) = happyGoto action_80
+action_143 (56#) = happyGoto action_81
+action_143 (57#) = happyGoto action_346
+action_143 x = happyTcHack x happyReduce_137
+
+action_144 x = happyTcHack x happyReduce_185
+
+action_145 (97#) = happyShift action_22
+action_145 (98#) = happyShift action_87
+action_145 (111#) = happyShift action_24
+action_145 (115#) = happyShift action_25
+action_145 (118#) = happyShift action_27
+action_145 (119#) = happyShift action_28
+action_145 (120#) = happyShift action_29
+action_145 (121#) = happyShift action_30
+action_145 (122#) = happyShift action_31
+action_145 (123#) = happyShift action_32
+action_145 (131#) = happyShift action_35
+action_145 (167#) = happyShift action_44
+action_145 (170#) = happyShift action_6
+action_145 (171#) = happyShift action_45
+action_145 (172#) = happyShift action_46
+action_145 (173#) = happyShift action_47
+action_145 (174#) = happyShift action_48
+action_145 (8#) = happyGoto action_7
+action_145 (9#) = happyGoto action_8
+action_145 (10#) = happyGoto action_9
+action_145 (11#) = happyGoto action_10
+action_145 (12#) = happyGoto action_84
+action_145 (58#) = happyGoto action_12
+action_145 (59#) = happyGoto action_135
+action_145 (72#) = happyGoto action_19
+action_145 x = happyTcHack x happyReduce_177
+
+action_146 (97#) = happyShift action_22
+action_146 (98#) = happyShift action_87
+action_146 (111#) = happyShift action_24
+action_146 (115#) = happyShift action_25
+action_146 (118#) = happyShift action_27
+action_146 (119#) = happyShift action_28
+action_146 (120#) = happyShift action_29
+action_146 (121#) = happyShift action_30
+action_146 (122#) = happyShift action_31
+action_146 (123#) = happyShift action_32
+action_146 (131#) = happyShift action_35
+action_146 (167#) = happyShift action_44
+action_146 (170#) = happyShift action_6
+action_146 (171#) = happyShift action_45
+action_146 (172#) = happyShift action_46
+action_146 (173#) = happyShift action_47
+action_146 (174#) = happyShift action_48
+action_146 (8#) = happyGoto action_7
+action_146 (9#) = happyGoto action_8
+action_146 (10#) = happyGoto action_9
+action_146 (11#) = happyGoto action_10
+action_146 (12#) = happyGoto action_84
+action_146 (58#) = happyGoto action_12
+action_146 (59#) = happyGoto action_135
+action_146 (72#) = happyGoto action_19
+action_146 x = happyTcHack x happyReduce_176
+
+action_147 (97#) = happyShift action_22
+action_147 (98#) = happyShift action_87
+action_147 (111#) = happyShift action_24
+action_147 (115#) = happyShift action_25
+action_147 (118#) = happyShift action_27
+action_147 (119#) = happyShift action_28
+action_147 (120#) = happyShift action_29
+action_147 (121#) = happyShift action_30
+action_147 (122#) = happyShift action_31
+action_147 (123#) = happyShift action_32
+action_147 (131#) = happyShift action_35
+action_147 (167#) = happyShift action_44
+action_147 (170#) = happyShift action_6
+action_147 (171#) = happyShift action_45
+action_147 (172#) = happyShift action_46
+action_147 (173#) = happyShift action_47
+action_147 (174#) = happyShift action_48
+action_147 (8#) = happyGoto action_7
+action_147 (9#) = happyGoto action_8
+action_147 (10#) = happyGoto action_9
+action_147 (11#) = happyGoto action_10
+action_147 (12#) = happyGoto action_84
+action_147 (58#) = happyGoto action_12
+action_147 (59#) = happyGoto action_135
+action_147 (72#) = happyGoto action_19
+action_147 x = happyTcHack x happyReduce_175
+
+action_148 x = happyTcHack x happyReduce_181
+
+action_149 (97#) = happyShift action_22
+action_149 (98#) = happyShift action_87
+action_149 (111#) = happyShift action_24
+action_149 (115#) = happyShift action_25
+action_149 (118#) = happyShift action_27
+action_149 (119#) = happyShift action_28
+action_149 (120#) = happyShift action_29
+action_149 (121#) = happyShift action_30
+action_149 (122#) = happyShift action_31
+action_149 (123#) = happyShift action_32
+action_149 (131#) = happyShift action_35
+action_149 (167#) = happyShift action_44
+action_149 (170#) = happyShift action_6
+action_149 (171#) = happyShift action_45
+action_149 (172#) = happyShift action_46
+action_149 (173#) = happyShift action_47
+action_149 (174#) = happyShift action_48
+action_149 (8#) = happyGoto action_7
+action_149 (9#) = happyGoto action_8
+action_149 (10#) = happyGoto action_9
+action_149 (11#) = happyGoto action_10
+action_149 (12#) = happyGoto action_84
+action_149 (58#) = happyGoto action_12
+action_149 (59#) = happyGoto action_135
+action_149 (72#) = happyGoto action_19
+action_149 x = happyTcHack x happyReduce_178
+
+action_150 (94#) = happyShift action_130
+action_150 (100#) = happyShift action_131
+action_150 (101#) = happyShift action_132
+action_150 x = happyTcHack x happyReduce_192
+
+action_151 x = happyTcHack x happyReduce_179
+
+action_152 x = happyTcHack x happyReduce_184
+
+action_153 (104#) = happyShift action_190
+action_153 (169#) = happyShift action_345
+action_153 x = happyTcHack x happyReduce_128
+
+action_154 (112#) = happyShift action_344
+action_154 x = happyTcHack x happyFail
+
+action_155 (110#) = happyShift action_343
+action_155 x = happyTcHack x happyReduce_230
+
+action_156 (169#) = happyShift action_342
+action_156 x = happyTcHack x happyFail
+
+action_157 (125#) = happyShift action_341
+action_157 x = happyTcHack x happyFail
+
+action_158 (95#) = happyShift action_120
+action_158 (98#) = happyShift action_121
+action_158 (107#) = happyShift action_310
+action_158 (111#) = happyShift action_122
+action_158 (115#) = happyShift action_123
+action_158 (116#) = happyShift action_311
+action_158 (123#) = happyShift action_124
+action_158 (126#) = happyShift action_125
+action_158 (167#) = happyShift action_126
+action_158 (170#) = happyShift action_6
+action_158 (171#) = happyShift action_45
+action_158 (172#) = happyShift action_46
+action_158 (174#) = happyShift action_48
+action_158 (8#) = happyGoto action_115
+action_158 (9#) = happyGoto action_116
+action_158 (10#) = happyGoto action_117
+action_158 (12#) = happyGoto action_118
+action_158 (67#) = happyGoto action_183
+action_158 (74#) = happyGoto action_309
+action_158 x = happyTcHack x happyReduce_203
+
+action_159 (100#) = happyShift action_340
+action_159 x = happyTcHack x happyReduce_217
+
+action_160 x = happyTcHack x happyReduce_220
+
+action_161 (102#) = happyShift action_306
+action_161 (168#) = happyShift action_308
+action_161 x = happyTcHack x happyReduce_242
+
+action_162 (104#) = happyShift action_339
+action_162 x = happyTcHack x happyReduce_247
+
+action_163 (114#) = happyShift action_338
+action_163 x = happyTcHack x happyFail
+
+action_164 (95#) = happyShift action_120
+action_164 (98#) = happyShift action_121
+action_164 (111#) = happyShift action_122
+action_164 (115#) = happyShift action_123
+action_164 (123#) = happyShift action_124
+action_164 (126#) = happyShift action_125
+action_164 (167#) = happyShift action_126
+action_164 (170#) = happyShift action_6
+action_164 (171#) = happyShift action_45
+action_164 (172#) = happyShift action_46
+action_164 (174#) = happyShift action_48
+action_164 (8#) = happyGoto action_115
+action_164 (9#) = happyGoto action_116
+action_164 (10#) = happyGoto action_117
+action_164 (12#) = happyGoto action_118
+action_164 (67#) = happyGoto action_337
+action_164 x = happyTcHack x happyFail
+
+action_165 (99#) = happyShift action_336
+action_165 (102#) = happyShift action_306
+action_165 (168#) = happyShift action_308
+action_165 x = happyTcHack x happyFail
+
+action_166 (107#) = happyShift action_335
+action_166 x = happyTcHack x happyReduce_200
+
+action_167 (174#) = happyShift action_48
+action_167 (12#) = happyGoto action_334
+action_167 x = happyTcHack x happyFail
+
+action_168 x = happyTcHack x happyReduce_142
+
+action_169 (174#) = happyShift action_48
+action_169 (12#) = happyGoto action_333
+action_169 x = happyTcHack x happyFail
+
+action_170 (99#) = happyShift action_332
+action_170 x = happyTcHack x happyReduce_140
+
+action_171 (95#) = happyShift action_21
+action_171 (97#) = happyShift action_22
+action_171 (98#) = happyShift action_23
+action_171 (111#) = happyShift action_24
+action_171 (115#) = happyShift action_25
+action_171 (117#) = happyShift action_26
+action_171 (118#) = happyShift action_27
+action_171 (119#) = happyShift action_28
+action_171 (120#) = happyShift action_29
+action_171 (121#) = happyShift action_30
+action_171 (122#) = happyShift action_31
+action_171 (123#) = happyShift action_32
+action_171 (124#) = happyShift action_33
+action_171 (128#) = happyShift action_34
+action_171 (131#) = happyShift action_35
+action_171 (134#) = happyShift action_36
+action_171 (137#) = happyShift action_37
+action_171 (142#) = happyShift action_38
+action_171 (153#) = happyShift action_39
+action_171 (154#) = happyShift action_40
+action_171 (158#) = happyShift action_41
+action_171 (159#) = happyShift action_42
+action_171 (164#) = happyShift action_43
+action_171 (167#) = happyShift action_44
+action_171 (170#) = happyShift action_6
+action_171 (171#) = happyShift action_45
+action_171 (172#) = happyShift action_46
+action_171 (173#) = happyShift action_47
+action_171 (174#) = happyShift action_48
+action_171 (8#) = happyGoto action_7
+action_171 (9#) = happyGoto action_8
+action_171 (10#) = happyGoto action_9
+action_171 (11#) = happyGoto action_10
+action_171 (12#) = happyGoto action_11
+action_171 (58#) = happyGoto action_12
+action_171 (59#) = happyGoto action_13
+action_171 (60#) = happyGoto action_14
+action_171 (61#) = happyGoto action_15
+action_171 (62#) = happyGoto action_16
+action_171 (63#) = happyGoto action_331
+action_171 (64#) = happyGoto action_18
+action_171 (72#) = happyGoto action_19
+action_171 (77#) = happyGoto action_20
+action_171 x = happyTcHack x happyFail
+
+action_172 x = happyTcHack x happyReduce_156
+
+action_173 x = happyTcHack x happyReduce_153
+
+action_174 (95#) = happyShift action_21
+action_174 (97#) = happyShift action_22
+action_174 (98#) = happyShift action_23
+action_174 (111#) = happyShift action_24
+action_174 (115#) = happyShift action_25
+action_174 (117#) = happyShift action_26
+action_174 (118#) = happyShift action_27
+action_174 (119#) = happyShift action_28
+action_174 (120#) = happyShift action_29
+action_174 (121#) = happyShift action_30
+action_174 (122#) = happyShift action_31
+action_174 (123#) = happyShift action_32
+action_174 (124#) = happyShift action_33
+action_174 (128#) = happyShift action_34
+action_174 (131#) = happyShift action_35
+action_174 (134#) = happyShift action_36
+action_174 (137#) = happyShift action_37
+action_174 (142#) = happyShift action_38
+action_174 (153#) = happyShift action_39
+action_174 (154#) = happyShift action_40
+action_174 (158#) = happyShift action_41
+action_174 (159#) = happyShift action_42
+action_174 (164#) = happyShift action_43
+action_174 (167#) = happyShift action_44
+action_174 (170#) = happyShift action_6
+action_174 (171#) = happyShift action_45
+action_174 (172#) = happyShift action_46
+action_174 (173#) = happyShift action_47
+action_174 (174#) = happyShift action_48
+action_174 (8#) = happyGoto action_7
+action_174 (9#) = happyGoto action_8
+action_174 (10#) = happyGoto action_9
+action_174 (11#) = happyGoto action_10
+action_174 (12#) = happyGoto action_11
+action_174 (58#) = happyGoto action_12
+action_174 (59#) = happyGoto action_13
+action_174 (60#) = happyGoto action_14
+action_174 (61#) = happyGoto action_15
+action_174 (62#) = happyGoto action_16
+action_174 (63#) = happyGoto action_329
+action_174 (64#) = happyGoto action_18
+action_174 (72#) = happyGoto action_19
+action_174 (77#) = happyGoto action_20
+action_174 (78#) = happyGoto action_108
+action_174 (80#) = happyGoto action_330
+action_174 x = happyTcHack x happyReduce_243
+
+action_175 (95#) = happyShift action_21
+action_175 (97#) = happyShift action_22
+action_175 (98#) = happyShift action_23
+action_175 (111#) = happyShift action_24
+action_175 (115#) = happyShift action_25
+action_175 (117#) = happyShift action_26
+action_175 (118#) = happyShift action_27
+action_175 (119#) = happyShift action_28
+action_175 (120#) = happyShift action_29
+action_175 (121#) = happyShift action_30
+action_175 (122#) = happyShift action_31
+action_175 (123#) = happyShift action_32
+action_175 (124#) = happyShift action_33
+action_175 (128#) = happyShift action_34
+action_175 (131#) = happyShift action_35
+action_175 (134#) = happyShift action_36
+action_175 (137#) = happyShift action_37
+action_175 (142#) = happyShift action_38
+action_175 (153#) = happyShift action_39
+action_175 (154#) = happyShift action_40
+action_175 (158#) = happyShift action_41
+action_175 (159#) = happyShift action_42
+action_175 (164#) = happyShift action_43
+action_175 (167#) = happyShift action_44
+action_175 (170#) = happyShift action_6
+action_175 (171#) = happyShift action_45
+action_175 (172#) = happyShift action_46
+action_175 (173#) = happyShift action_47
+action_175 (174#) = happyShift action_48
+action_175 (8#) = happyGoto action_7
+action_175 (9#) = happyGoto action_8
+action_175 (10#) = happyGoto action_9
+action_175 (11#) = happyGoto action_10
+action_175 (12#) = happyGoto action_11
+action_175 (58#) = happyGoto action_12
+action_175 (59#) = happyGoto action_13
+action_175 (60#) = happyGoto action_14
+action_175 (61#) = happyGoto action_15
+action_175 (62#) = happyGoto action_16
+action_175 (63#) = happyGoto action_328
+action_175 (64#) = happyGoto action_18
+action_175 (72#) = happyGoto action_19
+action_175 (77#) = happyGoto action_20
+action_175 x = happyTcHack x happyFail
+
+action_176 (97#) = happyShift action_86
+action_176 (98#) = happyShift action_87
+action_176 (111#) = happyShift action_24
+action_176 (115#) = happyShift action_25
+action_176 (118#) = happyShift action_27
+action_176 (119#) = happyShift action_28
+action_176 (120#) = happyShift action_29
+action_176 (121#) = happyShift action_30
+action_176 (122#) = happyShift action_31
+action_176 (123#) = happyShift action_32
+action_176 (131#) = happyShift action_35
+action_176 (167#) = happyShift action_139
+action_176 (170#) = happyShift action_6
+action_176 (171#) = happyShift action_45
+action_176 (172#) = happyShift action_46
+action_176 (173#) = happyShift action_47
+action_176 (174#) = happyShift action_48
+action_176 (8#) = happyGoto action_7
+action_176 (9#) = happyGoto action_8
+action_176 (10#) = happyGoto action_9
+action_176 (11#) = happyGoto action_10
+action_176 (12#) = happyGoto action_84
+action_176 (58#) = happyGoto action_176
+action_176 (66#) = happyGoto action_327
+action_176 (72#) = happyGoto action_19
+action_176 x = happyTcHack x happyReduce_196
+
+action_177 (125#) = happyShift action_326
+action_177 x = happyTcHack x happyFail
+
+action_178 x = happyTcHack x happyReduce_151
+
+action_179 (113#) = happyShift action_325
+action_179 x = happyTcHack x happyFail
+
+action_180 (95#) = happyShift action_21
+action_180 (97#) = happyShift action_22
+action_180 (98#) = happyShift action_23
+action_180 (111#) = happyShift action_24
+action_180 (115#) = happyShift action_25
+action_180 (117#) = happyShift action_26
+action_180 (118#) = happyShift action_27
+action_180 (119#) = happyShift action_28
+action_180 (120#) = happyShift action_29
+action_180 (121#) = happyShift action_30
+action_180 (122#) = happyShift action_31
+action_180 (123#) = happyShift action_32
+action_180 (124#) = happyShift action_33
+action_180 (128#) = happyShift action_34
+action_180 (131#) = happyShift action_35
+action_180 (134#) = happyShift action_36
+action_180 (137#) = happyShift action_37
+action_180 (142#) = happyShift action_38
+action_180 (153#) = happyShift action_39
+action_180 (154#) = happyShift action_40
+action_180 (158#) = happyShift action_41
+action_180 (159#) = happyShift action_42
+action_180 (164#) = happyShift action_43
+action_180 (167#) = happyShift action_44
+action_180 (170#) = happyShift action_6
+action_180 (171#) = happyShift action_45
+action_180 (172#) = happyShift action_46
+action_180 (173#) = happyShift action_47
+action_180 (174#) = happyShift action_48
+action_180 (8#) = happyGoto action_7
+action_180 (9#) = happyGoto action_8
+action_180 (10#) = happyGoto action_9
+action_180 (11#) = happyGoto action_10
+action_180 (12#) = happyGoto action_11
+action_180 (58#) = happyGoto action_12
+action_180 (59#) = happyGoto action_13
+action_180 (60#) = happyGoto action_14
+action_180 (61#) = happyGoto action_15
+action_180 (62#) = happyGoto action_16
+action_180 (63#) = happyGoto action_324
+action_180 (64#) = happyGoto action_18
+action_180 (72#) = happyGoto action_19
+action_180 (77#) = happyGoto action_20
+action_180 x = happyTcHack x happyFail
+
+action_181 (126#) = happyShift action_102
+action_181 (174#) = happyShift action_48
+action_181 (12#) = happyGoto action_98
+action_181 (75#) = happyGoto action_99
+action_181 (76#) = happyGoto action_323
+action_181 x = happyTcHack x happyReduce_236
+
+action_182 (167#) = happyShift action_322
+action_182 x = happyTcHack x happyFail
+
+action_183 (95#) = happyShift action_120
+action_183 (98#) = happyShift action_121
+action_183 (111#) = happyShift action_122
+action_183 (115#) = happyShift action_123
+action_183 (123#) = happyShift action_124
+action_183 (126#) = happyShift action_125
+action_183 (167#) = happyShift action_126
+action_183 (170#) = happyShift action_6
+action_183 (171#) = happyShift action_45
+action_183 (172#) = happyShift action_46
+action_183 (174#) = happyShift action_48
+action_183 (8#) = happyGoto action_115
+action_183 (9#) = happyGoto action_116
+action_183 (10#) = happyGoto action_117
+action_183 (12#) = happyGoto action_118
+action_183 (67#) = happyGoto action_183
+action_183 (74#) = happyGoto action_321
+action_183 x = happyTcHack x happyReduce_232
+
+action_184 (106#) = happyShift action_320
+action_184 x = happyTcHack x happyFail
+
+action_185 (110#) = happyShift action_319
+action_185 x = happyTcHack x happyReduce_254
+
+action_186 (169#) = happyShift action_318
+action_186 x = happyTcHack x happyFail
+
+action_187 x = happyTcHack x happyReduce_190
+
+action_188 (169#) = happyShift action_317
+action_188 x = happyTcHack x happyFail
+
+action_189 (95#) = happyShift action_21
+action_189 (97#) = happyShift action_22
+action_189 (98#) = happyShift action_23
+action_189 (111#) = happyShift action_24
+action_189 (115#) = happyShift action_25
+action_189 (117#) = happyShift action_26
+action_189 (118#) = happyShift action_27
+action_189 (119#) = happyShift action_28
+action_189 (120#) = happyShift action_29
+action_189 (121#) = happyShift action_30
+action_189 (122#) = happyShift action_31
+action_189 (123#) = happyShift action_32
+action_189 (124#) = happyShift action_33
+action_189 (128#) = happyShift action_34
+action_189 (131#) = happyShift action_35
+action_189 (134#) = happyShift action_36
+action_189 (137#) = happyShift action_37
+action_189 (142#) = happyShift action_38
+action_189 (153#) = happyShift action_39
+action_189 (154#) = happyShift action_40
+action_189 (158#) = happyShift action_41
+action_189 (159#) = happyShift action_42
+action_189 (164#) = happyShift action_43
+action_189 (167#) = happyShift action_44
+action_189 (170#) = happyShift action_6
+action_189 (171#) = happyShift action_45
+action_189 (172#) = happyShift action_46
+action_189 (173#) = happyShift action_47
+action_189 (174#) = happyShift action_48
+action_189 (8#) = happyGoto action_7
+action_189 (9#) = happyGoto action_8
+action_189 (10#) = happyGoto action_9
+action_189 (11#) = happyGoto action_10
+action_189 (12#) = happyGoto action_11
+action_189 (58#) = happyGoto action_12
+action_189 (59#) = happyGoto action_13
+action_189 (60#) = happyGoto action_14
+action_189 (61#) = happyGoto action_15
+action_189 (62#) = happyGoto action_16
+action_189 (63#) = happyGoto action_316
+action_189 (64#) = happyGoto action_18
+action_189 (72#) = happyGoto action_19
+action_189 (77#) = happyGoto action_20
+action_189 x = happyTcHack x happyFail
+
+action_190 (174#) = happyShift action_48
+action_190 (12#) = happyGoto action_92
+action_190 (53#) = happyGoto action_315
+action_190 x = happyTcHack x happyFail
+
+action_191 (110#) = happyShift action_314
+action_191 x = happyTcHack x happyFail
+
+action_192 (110#) = happyShift action_313
+action_192 x = happyTcHack x happyReduce_194
+
+action_193 (169#) = happyShift action_312
+action_193 x = happyTcHack x happyFail
+
+action_194 (95#) = happyShift action_120
+action_194 (98#) = happyShift action_121
+action_194 (104#) = happyShift action_190
+action_194 (107#) = happyShift action_310
+action_194 (109#) = happyReduce_128
+action_194 (111#) = happyShift action_122
+action_194 (112#) = happyReduce_128
+action_194 (115#) = happyShift action_123
+action_194 (116#) = happyShift action_311
+action_194 (123#) = happyShift action_124
+action_194 (126#) = happyShift action_125
+action_194 (167#) = happyShift action_126
+action_194 (169#) = happyShift action_207
+action_194 (170#) = happyShift action_6
+action_194 (171#) = happyShift action_45
+action_194 (172#) = happyShift action_46
+action_194 (174#) = happyShift action_48
+action_194 (8#) = happyGoto action_115
+action_194 (9#) = happyGoto action_116
+action_194 (10#) = happyGoto action_117
+action_194 (12#) = happyGoto action_118
+action_194 (67#) = happyGoto action_183
+action_194 (74#) = happyGoto action_309
+action_194 x = happyTcHack x happyReduce_203
+
+action_195 (102#) = happyShift action_306
+action_195 (113#) = happyShift action_307
+action_195 (168#) = happyShift action_308
+action_195 x = happyTcHack x happyFail
+
+action_196 (110#) = happyShift action_305
+action_196 x = happyTcHack x happyReduce_250
+
+action_197 (169#) = happyShift action_304
+action_197 x = happyTcHack x happyFail
+
+action_198 (97#) = happyShift action_168
+action_198 x = happyTcHack x happyFail
+
+action_199 (95#) = happyShift action_21
+action_199 (97#) = happyShift action_22
+action_199 (98#) = happyShift action_23
+action_199 (111#) = happyShift action_24
+action_199 (115#) = happyShift action_25
+action_199 (117#) = happyShift action_26
+action_199 (118#) = happyShift action_27
+action_199 (119#) = happyShift action_28
+action_199 (120#) = happyShift action_29
+action_199 (121#) = happyShift action_30
+action_199 (122#) = happyShift action_31
+action_199 (123#) = happyShift action_32
+action_199 (124#) = happyShift action_33
+action_199 (128#) = happyShift action_34
+action_199 (131#) = happyShift action_35
+action_199 (134#) = happyShift action_36
+action_199 (137#) = happyShift action_37
+action_199 (142#) = happyShift action_38
+action_199 (153#) = happyShift action_39
+action_199 (154#) = happyShift action_40
+action_199 (158#) = happyShift action_41
+action_199 (159#) = happyShift action_42
+action_199 (164#) = happyShift action_43
+action_199 (167#) = happyShift action_44
+action_199 (170#) = happyShift action_6
+action_199 (171#) = happyShift action_45
+action_199 (172#) = happyShift action_46
+action_199 (173#) = happyShift action_47
+action_199 (174#) = happyShift action_48
+action_199 (8#) = happyGoto action_7
+action_199 (9#) = happyGoto action_8
+action_199 (10#) = happyGoto action_9
+action_199 (11#) = happyGoto action_10
+action_199 (12#) = happyGoto action_11
+action_199 (58#) = happyGoto action_12
+action_199 (59#) = happyGoto action_13
+action_199 (60#) = happyGoto action_14
+action_199 (61#) = happyGoto action_15
+action_199 (62#) = happyGoto action_16
+action_199 (63#) = happyGoto action_192
+action_199 (64#) = happyGoto action_18
+action_199 (65#) = happyGoto action_303
+action_199 (72#) = happyGoto action_19
+action_199 (77#) = happyGoto action_20
+action_199 x = happyTcHack x happyReduce_193
+
+action_200 (95#) = happyShift action_120
+action_200 (98#) = happyShift action_121
+action_200 (105#) = happyShift action_164
+action_200 (111#) = happyShift action_122
+action_200 (115#) = happyShift action_123
+action_200 (123#) = happyShift action_124
+action_200 (126#) = happyShift action_125
+action_200 (167#) = happyShift action_126
+action_200 (170#) = happyShift action_6
+action_200 (171#) = happyShift action_45
+action_200 (172#) = happyShift action_46
+action_200 (174#) = happyShift action_48
+action_200 (8#) = happyGoto action_115
+action_200 (9#) = happyGoto action_116
+action_200 (10#) = happyGoto action_117
+action_200 (12#) = happyGoto action_158
+action_200 (67#) = happyGoto action_159
+action_200 (68#) = happyGoto action_160
+action_200 (69#) = happyGoto action_195
+action_200 (82#) = happyGoto action_196
+action_200 (83#) = happyGoto action_302
+action_200 x = happyTcHack x happyFail
+
+action_201 (169#) = happyShift action_301
+action_201 x = happyTcHack x happyFail
+
+action_202 x = happyTcHack x happyReduce_152
+
+action_203 (174#) = happyShift action_48
+action_203 (12#) = happyGoto action_92
+action_203 (53#) = happyGoto action_80
+action_203 (56#) = happyGoto action_81
+action_203 (57#) = happyGoto action_300
+action_203 x = happyTcHack x happyReduce_137
+
+action_204 (95#) = happyShift action_21
+action_204 (97#) = happyShift action_22
+action_204 (98#) = happyShift action_23
+action_204 (111#) = happyShift action_24
+action_204 (115#) = happyShift action_25
+action_204 (117#) = happyShift action_26
+action_204 (118#) = happyShift action_27
+action_204 (119#) = happyShift action_28
+action_204 (120#) = happyShift action_29
+action_204 (121#) = happyShift action_30
+action_204 (122#) = happyShift action_31
+action_204 (123#) = happyShift action_32
+action_204 (124#) = happyShift action_33
+action_204 (128#) = happyShift action_34
+action_204 (131#) = happyShift action_35
+action_204 (134#) = happyShift action_36
+action_204 (137#) = happyShift action_37
+action_204 (142#) = happyShift action_38
+action_204 (153#) = happyShift action_39
+action_204 (154#) = happyShift action_40
+action_204 (158#) = happyShift action_41
+action_204 (159#) = happyShift action_42
+action_204 (164#) = happyShift action_43
+action_204 (167#) = happyShift action_44
+action_204 (170#) = happyShift action_6
+action_204 (171#) = happyShift action_45
+action_204 (172#) = happyShift action_46
+action_204 (173#) = happyShift action_47
+action_204 (174#) = happyShift action_48
+action_204 (8#) = happyGoto action_7
+action_204 (9#) = happyGoto action_8
+action_204 (10#) = happyGoto action_9
+action_204 (11#) = happyGoto action_10
+action_204 (12#) = happyGoto action_11
+action_204 (58#) = happyGoto action_12
+action_204 (59#) = happyGoto action_13
+action_204 (60#) = happyGoto action_14
+action_204 (61#) = happyGoto action_15
+action_204 (62#) = happyGoto action_16
+action_204 (63#) = happyGoto action_299
+action_204 (64#) = happyGoto action_18
+action_204 (72#) = happyGoto action_19
+action_204 (77#) = happyGoto action_20
+action_204 x = happyTcHack x happyFail
+
+action_205 (95#) = happyShift action_21
+action_205 (97#) = happyShift action_22
+action_205 (98#) = happyShift action_23
+action_205 (111#) = happyShift action_24
+action_205 (115#) = happyShift action_25
+action_205 (117#) = happyShift action_26
+action_205 (118#) = happyShift action_27
+action_205 (119#) = happyShift action_28
+action_205 (120#) = happyShift action_29
+action_205 (121#) = happyShift action_30
+action_205 (122#) = happyShift action_31
+action_205 (123#) = happyShift action_32
+action_205 (124#) = happyShift action_33
+action_205 (128#) = happyShift action_34
+action_205 (131#) = happyShift action_35
+action_205 (134#) = happyShift action_36
+action_205 (137#) = happyShift action_37
+action_205 (142#) = happyShift action_38
+action_205 (153#) = happyShift action_39
+action_205 (154#) = happyShift action_40
+action_205 (158#) = happyShift action_41
+action_205 (159#) = happyShift action_42
+action_205 (164#) = happyShift action_43
+action_205 (167#) = happyShift action_44
+action_205 (170#) = happyShift action_6
+action_205 (171#) = happyShift action_45
+action_205 (172#) = happyShift action_46
+action_205 (173#) = happyShift action_47
+action_205 (174#) = happyShift action_48
+action_205 (8#) = happyGoto action_7
+action_205 (9#) = happyGoto action_8
+action_205 (10#) = happyGoto action_9
+action_205 (11#) = happyGoto action_10
+action_205 (12#) = happyGoto action_11
+action_205 (58#) = happyGoto action_12
+action_205 (59#) = happyGoto action_13
+action_205 (60#) = happyGoto action_14
+action_205 (61#) = happyGoto action_15
+action_205 (62#) = happyGoto action_16
+action_205 (63#) = happyGoto action_298
+action_205 (64#) = happyGoto action_18
+action_205 (72#) = happyGoto action_19
+action_205 (77#) = happyGoto action_20
+action_205 x = happyTcHack x happyFail
+
+action_206 (174#) = happyShift action_48
+action_206 (12#) = happyGoto action_297
+action_206 x = happyTcHack x happyFail
+
+action_207 x = happyTcHack x happyReduce_141
+
+action_208 (1#) = happyReduce_65
+action_208 (101#) = happyReduce_65
+action_208 (148#) = happyReduce_51
+action_208 (157#) = happyShift action_295
+action_208 (162#) = happyShift action_296
+action_208 (174#) = happyShift action_48
+action_208 (12#) = happyGoto action_241
+action_208 (22#) = happyGoto action_291
+action_208 (26#) = happyGoto action_292
+action_208 (32#) = happyGoto action_293
+action_208 (33#) = happyGoto action_294
+action_208 x = happyTcHack x happyReduce_65
+
+action_209 x = happyTcHack x happyReduce_49
+
+action_210 (123#) = happyShift action_290
+action_210 (174#) = happyShift action_48
+action_210 (12#) = happyGoto action_287
+action_210 (36#) = happyGoto action_288
+action_210 (46#) = happyGoto action_289
+action_210 x = happyTcHack x happyFail
+
+action_211 (174#) = happyShift action_48
+action_211 (12#) = happyGoto action_283
+action_211 (37#) = happyGoto action_276
+action_211 (38#) = happyGoto action_284
+action_211 (47#) = happyGoto action_285
+action_211 (48#) = happyGoto action_286
+action_211 (53#) = happyGoto action_278
+action_211 x = happyTcHack x happyFail
+
+action_212 (123#) = happyShift action_257
+action_212 (174#) = happyShift action_48
+action_212 (12#) = happyGoto action_252
+action_212 (34#) = happyGoto action_253
+action_212 (45#) = happyGoto action_282
+action_212 (54#) = happyGoto action_255
+action_212 (55#) = happyGoto action_256
+action_212 x = happyTcHack x happyFail
+
+action_213 (174#) = happyShift action_48
+action_213 (12#) = happyGoto action_279
+action_213 (44#) = happyGoto action_280
+action_213 (51#) = happyGoto action_281
+action_213 x = happyTcHack x happyFail
+
+action_214 (174#) = happyShift action_48
+action_214 (12#) = happyGoto action_92
+action_214 (37#) = happyGoto action_276
+action_214 (47#) = happyGoto action_277
+action_214 (53#) = happyGoto action_278
+action_214 x = happyTcHack x happyFail
+
+action_215 (123#) = happyShift action_257
+action_215 (174#) = happyShift action_48
+action_215 (12#) = happyGoto action_252
+action_215 (34#) = happyGoto action_253
+action_215 (45#) = happyGoto action_275
+action_215 (54#) = happyGoto action_255
+action_215 (55#) = happyGoto action_256
+action_215 x = happyTcHack x happyFail
+
+action_216 (123#) = happyShift action_257
+action_216 (174#) = happyShift action_48
+action_216 (12#) = happyGoto action_252
+action_216 (43#) = happyGoto action_260
+action_216 (50#) = happyGoto action_274
+action_216 (54#) = happyGoto action_262
+action_216 (55#) = happyGoto action_263
+action_216 x = happyTcHack x happyFail
+
+action_217 (123#) = happyShift action_257
+action_217 (174#) = happyShift action_48
+action_217 (12#) = happyGoto action_252
+action_217 (34#) = happyGoto action_253
+action_217 (45#) = happyGoto action_273
+action_217 (54#) = happyGoto action_255
+action_217 (55#) = happyGoto action_256
+action_217 x = happyTcHack x happyFail
+
+action_218 (123#) = happyShift action_257
+action_218 (174#) = happyShift action_48
+action_218 (12#) = happyGoto action_252
+action_218 (34#) = happyGoto action_253
+action_218 (45#) = happyGoto action_272
+action_218 (54#) = happyGoto action_255
+action_218 (55#) = happyGoto action_256
+action_218 x = happyTcHack x happyFail
+
+action_219 (123#) = happyShift action_257
+action_219 (174#) = happyShift action_48
+action_219 (12#) = happyGoto action_252
+action_219 (34#) = happyGoto action_253
+action_219 (45#) = happyGoto action_271
+action_219 (54#) = happyGoto action_255
+action_219 (55#) = happyGoto action_256
+action_219 x = happyTcHack x happyFail
+
+action_220 (174#) = happyShift action_48
+action_220 (12#) = happyGoto action_270
+action_220 x = happyTcHack x happyFail
+
+action_221 (174#) = happyShift action_48
+action_221 (12#) = happyGoto action_267
+action_221 (41#) = happyGoto action_268
+action_221 (49#) = happyGoto action_269
+action_221 x = happyTcHack x happyFail
+
+action_222 (123#) = happyShift action_257
+action_222 (174#) = happyShift action_48
+action_222 (12#) = happyGoto action_252
+action_222 (34#) = happyGoto action_253
+action_222 (45#) = happyGoto action_266
+action_222 (54#) = happyGoto action_255
+action_222 (55#) = happyGoto action_256
+action_222 x = happyTcHack x happyFail
+
+action_223 (123#) = happyShift action_257
+action_223 (129#) = happyShift action_264
+action_223 (135#) = happyShift action_265
+action_223 (174#) = happyShift action_48
+action_223 (12#) = happyGoto action_252
+action_223 (43#) = happyGoto action_260
+action_223 (50#) = happyGoto action_261
+action_223 (54#) = happyGoto action_262
+action_223 (55#) = happyGoto action_263
+action_223 x = happyTcHack x happyFail
+
+action_224 (174#) = happyShift action_48
+action_224 (12#) = happyGoto action_259
+action_224 x = happyTcHack x happyFail
+
+action_225 (123#) = happyShift action_257
+action_225 (174#) = happyShift action_48
+action_225 (12#) = happyGoto action_252
+action_225 (34#) = happyGoto action_253
+action_225 (45#) = happyGoto action_258
+action_225 (54#) = happyGoto action_255
+action_225 (55#) = happyGoto action_256
+action_225 x = happyTcHack x happyFail
+
+action_226 (123#) = happyShift action_257
+action_226 (174#) = happyShift action_48
+action_226 (12#) = happyGoto action_252
+action_226 (34#) = happyGoto action_253
+action_226 (45#) = happyGoto action_254
+action_226 (54#) = happyGoto action_255
+action_226 (55#) = happyGoto action_256
+action_226 x = happyTcHack x happyFail
+
+action_227 x = happyTcHack x happyReduce_269
+
+action_228 x = happyTcHack x happyReduce_270
+
+action_229 x = happyTcHack x happyReduce_271
+
+action_230 (105#) = happyShift action_74
+action_230 (107#) = happyShift action_75
+action_230 (108#) = happyShift action_76
+action_230 (171#) = happyShift action_45
+action_230 (174#) = happyShift action_48
+action_230 (9#) = happyGoto action_70
+action_230 (12#) = happyGoto action_71
+action_230 (92#) = happyGoto action_72
+action_230 (93#) = happyGoto action_251
+action_230 x = happyTcHack x happyReduce_273
+
+action_231 x = happyTcHack x happyReduce_272
+
+action_232 (109#) = happyShift action_250
+action_232 x = happyTcHack x happyFail
+
+action_233 x = happyTcHack x happyReduce_35
+
+action_234 x = happyTcHack x happyReduce_36
+
+action_235 (147#) = happyShift action_249
+action_235 x = happyTcHack x happyFail
+
+action_236 (147#) = happyShift action_248
+action_236 x = happyTcHack x happyFail
+
+action_237 x = happyTcHack x happyReduce_34
+
+action_238 (148#) = happyReduce_51
+action_238 (157#) = happyShift action_246
+action_238 (162#) = happyShift action_247
+action_238 (167#) = happyReduce_51
+action_238 (174#) = happyShift action_48
+action_238 (12#) = happyGoto action_241
+action_238 (24#) = happyGoto action_242
+action_238 (26#) = happyGoto action_243
+action_238 (32#) = happyGoto action_244
+action_238 (33#) = happyGoto action_245
+action_238 x = happyTcHack x happyReduce_65
+
+action_239 (167#) = happyShift action_240
+action_239 x = happyTcHack x happyFail
+
+action_240 (127#) = happyShift action_418
+action_240 x = happyTcHack x happyFail
+
+action_241 (105#) = happyShift action_416
+action_241 (123#) = happyShift action_417
+action_241 x = happyTcHack x happyReduce_68
+
+action_242 x = happyTcHack x happyReduce_15
+
+action_243 (148#) = happyShift action_382
+action_243 (28#) = happyGoto action_415
+action_243 x = happyTcHack x happyReduce_55
+
+action_244 (101#) = happyShift action_414
+action_244 x = happyTcHack x happyReduce_41
+
+action_245 (104#) = happyShift action_378
+action_245 (166#) = happyShift action_413
+action_245 x = happyTcHack x happyReduce_66
+
+action_246 (174#) = happyShift action_48
+action_246 (12#) = happyGoto action_412
+action_246 x = happyTcHack x happyFail
+
+action_247 (174#) = happyShift action_48
+action_247 (12#) = happyGoto action_241
+action_247 (32#) = happyGoto action_411
+action_247 (33#) = happyGoto action_376
+action_247 x = happyTcHack x happyReduce_65
+
+action_248 (174#) = happyShift action_48
+action_248 (12#) = happyGoto action_410
+action_248 x = happyTcHack x happyFail
+
+action_249 (174#) = happyShift action_48
+action_249 (12#) = happyGoto action_409
+action_249 x = happyTcHack x happyFail
+
+action_250 (98#) = happyShift action_408
+action_250 (174#) = happyShift action_48
+action_250 (12#) = happyGoto action_406
+action_250 (29#) = happyGoto action_407
+action_250 x = happyTcHack x happyFail
+
+action_251 x = happyTcHack x happyReduce_274
+
+action_252 x = happyTcHack x happyReduce_130
+
+action_253 (110#) = happyShift action_405
+action_253 x = happyTcHack x happyFail
+
+action_254 x = happyTcHack x happyReduce_93
+
+action_255 (95#) = happyShift action_120
+action_255 (98#) = happyShift action_121
+action_255 (104#) = happyShift action_398
+action_255 (111#) = happyShift action_122
+action_255 (115#) = happyShift action_123
+action_255 (123#) = happyShift action_124
+action_255 (126#) = happyShift action_125
+action_255 (167#) = happyShift action_126
+action_255 (170#) = happyShift action_6
+action_255 (171#) = happyShift action_45
+action_255 (172#) = happyShift action_46
+action_255 (174#) = happyShift action_48
+action_255 (8#) = happyGoto action_115
+action_255 (9#) = happyGoto action_116
+action_255 (10#) = happyGoto action_117
+action_255 (12#) = happyGoto action_118
+action_255 (67#) = happyGoto action_183
+action_255 (74#) = happyGoto action_404
+action_255 x = happyTcHack x happyReduce_132
+
+action_256 (109#) = happyShift action_402
+action_256 (112#) = happyShift action_403
+action_256 x = happyTcHack x happyFail
+
+action_257 (174#) = happyShift action_48
+action_257 (12#) = happyGoto action_401
+action_257 x = happyTcHack x happyFail
+
+action_258 x = happyTcHack x happyReduce_80
+
+action_259 (110#) = happyShift action_400
+action_259 x = happyTcHack x happyFail
+
+action_260 (110#) = happyShift action_399
+action_260 x = happyTcHack x happyFail
+
+action_261 x = happyTcHack x happyReduce_89
+
+action_262 (104#) = happyShift action_398
+action_262 x = happyTcHack x happyReduce_132
+
+action_263 (112#) = happyShift action_397
+action_263 x = happyTcHack x happyFail
+
+action_264 (123#) = happyShift action_257
+action_264 (174#) = happyShift action_48
+action_264 (12#) = happyGoto action_252
+action_264 (43#) = happyGoto action_260
+action_264 (50#) = happyGoto action_396
+action_264 (54#) = happyGoto action_262
+action_264 (55#) = happyGoto action_263
+action_264 x = happyTcHack x happyFail
+
+action_265 (123#) = happyShift action_257
+action_265 (174#) = happyShift action_48
+action_265 (12#) = happyGoto action_252
+action_265 (43#) = happyGoto action_260
+action_265 (50#) = happyGoto action_395
+action_265 (54#) = happyGoto action_262
+action_265 (55#) = happyGoto action_263
+action_265 x = happyTcHack x happyFail
+
+action_266 x = happyTcHack x happyReduce_91
+
+action_267 (112#) = happyShift action_394
+action_267 x = happyTcHack x happyReduce_107
+
+action_268 (110#) = happyShift action_393
+action_268 x = happyTcHack x happyFail
+
+action_269 x = happyTcHack x happyReduce_81
+
+action_270 (112#) = happyShift action_392
+action_270 x = happyTcHack x happyFail
+
+action_271 x = happyTcHack x happyReduce_82
+
+action_272 x = happyTcHack x happyReduce_90
+
+action_273 x = happyTcHack x happyReduce_84
+
+action_274 x = happyTcHack x happyReduce_83
+
+action_275 x = happyTcHack x happyReduce_85
+
+action_276 (110#) = happyShift action_391
+action_276 x = happyTcHack x happyFail
+
+action_277 x = happyTcHack x happyReduce_76
+
+action_278 (109#) = happyShift action_390
+action_278 x = happyTcHack x happyFail
+
+action_279 (112#) = happyShift action_389
+action_279 x = happyTcHack x happyFail
+
+action_280 (110#) = happyShift action_388
+action_280 x = happyTcHack x happyFail
+
+action_281 x = happyTcHack x happyReduce_88
+
+action_282 x = happyTcHack x happyReduce_78
+
+action_283 (104#) = happyShift action_190
+action_283 (112#) = happyShift action_387
+action_283 x = happyTcHack x happyReduce_128
+
+action_284 (110#) = happyShift action_386
+action_284 x = happyTcHack x happyFail
+
+action_285 x = happyTcHack x happyReduce_77
+
+action_286 x = happyTcHack x happyReduce_79
+
+action_287 (89#) = happyGoto action_385
+action_287 x = happyTcHack x happyReduce_262
+
+action_288 (110#) = happyShift action_384
+action_288 x = happyTcHack x happyFail
+
+action_289 x = happyTcHack x happyReduce_75
+
+action_290 (174#) = happyShift action_48
+action_290 (12#) = happyGoto action_383
+action_290 x = happyTcHack x happyFail
+
+action_291 x = happyTcHack x happyReduce_25
+
+action_292 (148#) = happyShift action_382
+action_292 (28#) = happyGoto action_381
+action_292 x = happyTcHack x happyReduce_55
+
+action_293 (101#) = happyShift action_380
+action_293 x = happyTcHack x happyReduce_27
+
+action_294 (104#) = happyShift action_378
+action_294 (166#) = happyShift action_379
+action_294 x = happyTcHack x happyReduce_66
+
+action_295 (174#) = happyShift action_48
+action_295 (12#) = happyGoto action_377
+action_295 x = happyTcHack x happyFail
+
+action_296 (174#) = happyShift action_48
+action_296 (12#) = happyGoto action_241
+action_296 (32#) = happyGoto action_375
+action_296 (33#) = happyGoto action_376
+action_296 x = happyTcHack x happyReduce_65
+
+action_297 (169#) = happyShift action_374
+action_297 x = happyTcHack x happyFail
+
+action_298 x = happyTcHack x happyReduce_135
+
+action_299 (112#) = happyShift action_373
+action_299 x = happyTcHack x happyReduce_134
+
+action_300 x = happyTcHack x happyReduce_139
+
+action_301 x = happyTcHack x happyReduce_167
+
+action_302 (169#) = happyShift action_372
+action_302 x = happyTcHack x happyFail
+
+action_303 (125#) = happyShift action_371
+action_303 x = happyTcHack x happyFail
+
+action_304 x = happyTcHack x happyReduce_163
+
+action_305 (95#) = happyShift action_120
+action_305 (98#) = happyShift action_121
+action_305 (105#) = happyShift action_164
+action_305 (111#) = happyShift action_122
+action_305 (115#) = happyShift action_123
+action_305 (123#) = happyShift action_124
+action_305 (126#) = happyShift action_125
+action_305 (167#) = happyShift action_126
+action_305 (170#) = happyShift action_6
+action_305 (171#) = happyShift action_45
+action_305 (172#) = happyShift action_46
+action_305 (174#) = happyShift action_48
+action_305 (8#) = happyGoto action_115
+action_305 (9#) = happyGoto action_116
+action_305 (10#) = happyGoto action_117
+action_305 (12#) = happyGoto action_158
+action_305 (67#) = happyGoto action_159
+action_305 (68#) = happyGoto action_160
+action_305 (69#) = happyGoto action_195
+action_305 (82#) = happyGoto action_196
+action_305 (83#) = happyGoto action_370
+action_305 x = happyTcHack x happyFail
+
+action_306 (95#) = happyShift action_120
+action_306 (98#) = happyShift action_121
+action_306 (105#) = happyShift action_164
+action_306 (111#) = happyShift action_122
+action_306 (115#) = happyShift action_123
+action_306 (123#) = happyShift action_124
+action_306 (126#) = happyShift action_125
+action_306 (167#) = happyShift action_126
+action_306 (170#) = happyShift action_6
+action_306 (171#) = happyShift action_45
+action_306 (172#) = happyShift action_46
+action_306 (174#) = happyShift action_48
+action_306 (8#) = happyGoto action_115
+action_306 (9#) = happyGoto action_116
+action_306 (10#) = happyGoto action_117
+action_306 (12#) = happyGoto action_158
+action_306 (67#) = happyGoto action_159
+action_306 (68#) = happyGoto action_369
+action_306 x = happyTcHack x happyFail
+
+action_307 (95#) = happyShift action_21
+action_307 (97#) = happyShift action_22
+action_307 (98#) = happyShift action_23
+action_307 (111#) = happyShift action_24
+action_307 (115#) = happyShift action_25
+action_307 (117#) = happyShift action_26
+action_307 (118#) = happyShift action_27
+action_307 (119#) = happyShift action_28
+action_307 (120#) = happyShift action_29
+action_307 (121#) = happyShift action_30
+action_307 (122#) = happyShift action_31
+action_307 (123#) = happyShift action_32
+action_307 (124#) = happyShift action_33
+action_307 (128#) = happyShift action_34
+action_307 (131#) = happyShift action_35
+action_307 (134#) = happyShift action_36
+action_307 (137#) = happyShift action_37
+action_307 (142#) = happyShift action_38
+action_307 (153#) = happyShift action_39
+action_307 (154#) = happyShift action_40
+action_307 (158#) = happyShift action_41
+action_307 (159#) = happyShift action_42
+action_307 (164#) = happyShift action_43
+action_307 (167#) = happyShift action_44
+action_307 (170#) = happyShift action_6
+action_307 (171#) = happyShift action_45
+action_307 (172#) = happyShift action_46
+action_307 (173#) = happyShift action_47
+action_307 (174#) = happyShift action_48
+action_307 (8#) = happyGoto action_7
+action_307 (9#) = happyGoto action_8
+action_307 (10#) = happyGoto action_9
+action_307 (11#) = happyGoto action_10
+action_307 (12#) = happyGoto action_11
+action_307 (58#) = happyGoto action_12
+action_307 (59#) = happyGoto action_13
+action_307 (60#) = happyGoto action_14
+action_307 (61#) = happyGoto action_15
+action_307 (62#) = happyGoto action_16
+action_307 (63#) = happyGoto action_368
+action_307 (64#) = happyGoto action_18
+action_307 (72#) = happyGoto action_19
+action_307 (77#) = happyGoto action_20
+action_307 x = happyTcHack x happyFail
+
+action_308 (95#) = happyShift action_120
+action_308 (98#) = happyShift action_121
+action_308 (105#) = happyShift action_164
+action_308 (111#) = happyShift action_122
+action_308 (115#) = happyShift action_123
+action_308 (123#) = happyShift action_124
+action_308 (126#) = happyShift action_125
+action_308 (167#) = happyShift action_126
+action_308 (170#) = happyShift action_6
+action_308 (171#) = happyShift action_45
+action_308 (172#) = happyShift action_46
+action_308 (174#) = happyShift action_48
+action_308 (8#) = happyGoto action_115
+action_308 (9#) = happyGoto action_116
+action_308 (10#) = happyGoto action_117
+action_308 (12#) = happyGoto action_158
+action_308 (67#) = happyGoto action_159
+action_308 (68#) = happyGoto action_367
+action_308 x = happyTcHack x happyFail
+
+action_309 x = happyTcHack x happyReduce_212
+
+action_310 (174#) = happyShift action_48
+action_310 (12#) = happyGoto action_366
+action_310 x = happyTcHack x happyFail
+
+action_311 (95#) = happyShift action_120
+action_311 (98#) = happyShift action_121
+action_311 (111#) = happyShift action_122
+action_311 (115#) = happyShift action_123
+action_311 (123#) = happyShift action_124
+action_311 (126#) = happyShift action_125
+action_311 (167#) = happyShift action_126
+action_311 (170#) = happyShift action_6
+action_311 (171#) = happyShift action_45
+action_311 (172#) = happyShift action_46
+action_311 (174#) = happyShift action_48
+action_311 (8#) = happyGoto action_115
+action_311 (9#) = happyGoto action_116
+action_311 (10#) = happyGoto action_117
+action_311 (12#) = happyGoto action_118
+action_311 (67#) = happyGoto action_365
+action_311 x = happyTcHack x happyFail
+
+action_312 x = happyTcHack x happyReduce_169
+
+action_313 (95#) = happyShift action_21
+action_313 (97#) = happyShift action_22
+action_313 (98#) = happyShift action_23
+action_313 (111#) = happyShift action_24
+action_313 (115#) = happyShift action_25
+action_313 (117#) = happyShift action_26
+action_313 (118#) = happyShift action_27
+action_313 (119#) = happyShift action_28
+action_313 (120#) = happyShift action_29
+action_313 (121#) = happyShift action_30
+action_313 (122#) = happyShift action_31
+action_313 (123#) = happyShift action_32
+action_313 (124#) = happyShift action_33
+action_313 (128#) = happyShift action_34
+action_313 (131#) = happyShift action_35
+action_313 (134#) = happyShift action_36
+action_313 (137#) = happyShift action_37
+action_313 (142#) = happyShift action_38
+action_313 (153#) = happyShift action_39
+action_313 (154#) = happyShift action_40
+action_313 (158#) = happyShift action_41
+action_313 (159#) = happyShift action_42
+action_313 (164#) = happyShift action_43
+action_313 (167#) = happyShift action_44
+action_313 (170#) = happyShift action_6
+action_313 (171#) = happyShift action_45
+action_313 (172#) = happyShift action_46
+action_313 (173#) = happyShift action_47
+action_313 (174#) = happyShift action_48
+action_313 (8#) = happyGoto action_7
+action_313 (9#) = happyGoto action_8
+action_313 (10#) = happyGoto action_9
+action_313 (11#) = happyGoto action_10
+action_313 (12#) = happyGoto action_11
+action_313 (58#) = happyGoto action_12
+action_313 (59#) = happyGoto action_13
+action_313 (60#) = happyGoto action_14
+action_313 (61#) = happyGoto action_15
+action_313 (62#) = happyGoto action_16
+action_313 (63#) = happyGoto action_192
+action_313 (64#) = happyGoto action_18
+action_313 (65#) = happyGoto action_364
+action_313 (72#) = happyGoto action_19
+action_313 (77#) = happyGoto action_20
+action_313 x = happyTcHack x happyReduce_193
+
+action_314 (95#) = happyShift action_21
+action_314 (97#) = happyShift action_22
+action_314 (98#) = happyShift action_23
+action_314 (111#) = happyShift action_24
+action_314 (115#) = happyShift action_25
+action_314 (117#) = happyShift action_26
+action_314 (118#) = happyShift action_27
+action_314 (119#) = happyShift action_28
+action_314 (120#) = happyShift action_29
+action_314 (121#) = happyShift action_30
+action_314 (122#) = happyShift action_31
+action_314 (123#) = happyShift action_32
+action_314 (124#) = happyShift action_33
+action_314 (128#) = happyShift action_34
+action_314 (131#) = happyShift action_35
+action_314 (134#) = happyShift action_36
+action_314 (137#) = happyShift action_37
+action_314 (142#) = happyShift action_38
+action_314 (153#) = happyShift action_39
+action_314 (154#) = happyShift action_40
+action_314 (158#) = happyShift action_41
+action_314 (159#) = happyShift action_42
+action_314 (164#) = happyShift action_43
+action_314 (167#) = happyShift action_44
+action_314 (170#) = happyShift action_6
+action_314 (171#) = happyShift action_45
+action_314 (172#) = happyShift action_46
+action_314 (173#) = happyShift action_47
+action_314 (174#) = happyShift action_48
+action_314 (8#) = happyGoto action_7
+action_314 (9#) = happyGoto action_8
+action_314 (10#) = happyGoto action_9
+action_314 (11#) = happyGoto action_10
+action_314 (12#) = happyGoto action_11
+action_314 (58#) = happyGoto action_12
+action_314 (59#) = happyGoto action_13
+action_314 (60#) = happyGoto action_14
+action_314 (61#) = happyGoto action_15
+action_314 (62#) = happyGoto action_16
+action_314 (63#) = happyGoto action_361
+action_314 (64#) = happyGoto action_18
+action_314 (72#) = happyGoto action_19
+action_314 (77#) = happyGoto action_20
+action_314 (86#) = happyGoto action_362
+action_314 (87#) = happyGoto action_363
+action_314 x = happyTcHack x happyReduce_257
+
+action_315 x = happyTcHack x happyReduce_129
+
+action_316 x = happyTcHack x happyReduce_187
+
+action_317 (137#) = happyShift action_360
+action_317 x = happyTcHack x happyFail
+
+action_318 x = happyTcHack x happyReduce_189
+
+action_319 (95#) = happyShift action_120
+action_319 (98#) = happyShift action_121
+action_319 (111#) = happyShift action_122
+action_319 (115#) = happyShift action_123
+action_319 (123#) = happyShift action_124
+action_319 (126#) = happyShift action_125
+action_319 (167#) = happyShift action_126
+action_319 (170#) = happyShift action_6
+action_319 (171#) = happyShift action_45
+action_319 (172#) = happyShift action_46
+action_319 (174#) = happyShift action_48
+action_319 (8#) = happyGoto action_115
+action_319 (9#) = happyGoto action_116
+action_319 (10#) = happyGoto action_117
+action_319 (12#) = happyGoto action_118
+action_319 (67#) = happyGoto action_183
+action_319 (74#) = happyGoto action_184
+action_319 (84#) = happyGoto action_185
+action_319 (85#) = happyGoto action_359
+action_319 x = happyTcHack x happyReduce_253
+
+action_320 (95#) = happyShift action_21
+action_320 (97#) = happyShift action_22
+action_320 (98#) = happyShift action_23
+action_320 (111#) = happyShift action_24
+action_320 (115#) = happyShift action_25
+action_320 (117#) = happyShift action_26
+action_320 (118#) = happyShift action_27
+action_320 (119#) = happyShift action_28
+action_320 (120#) = happyShift action_29
+action_320 (121#) = happyShift action_30
+action_320 (122#) = happyShift action_31
+action_320 (123#) = happyShift action_32
+action_320 (124#) = happyShift action_33
+action_320 (128#) = happyShift action_34
+action_320 (131#) = happyShift action_35
+action_320 (134#) = happyShift action_36
+action_320 (137#) = happyShift action_37
+action_320 (142#) = happyShift action_38
+action_320 (153#) = happyShift action_39
+action_320 (154#) = happyShift action_40
+action_320 (158#) = happyShift action_41
+action_320 (159#) = happyShift action_42
+action_320 (164#) = happyShift action_43
+action_320 (167#) = happyShift action_44
+action_320 (170#) = happyShift action_6
+action_320 (171#) = happyShift action_45
+action_320 (172#) = happyShift action_46
+action_320 (173#) = happyShift action_47
+action_320 (174#) = happyShift action_48
+action_320 (8#) = happyGoto action_7
+action_320 (9#) = happyGoto action_8
+action_320 (10#) = happyGoto action_9
+action_320 (11#) = happyGoto action_10
+action_320 (12#) = happyGoto action_11
+action_320 (58#) = happyGoto action_12
+action_320 (59#) = happyGoto action_13
+action_320 (60#) = happyGoto action_14
+action_320 (61#) = happyGoto action_15
+action_320 (62#) = happyGoto action_16
+action_320 (63#) = happyGoto action_358
+action_320 (64#) = happyGoto action_18
+action_320 (72#) = happyGoto action_19
+action_320 (77#) = happyGoto action_20
+action_320 x = happyTcHack x happyFail
+
+action_321 x = happyTcHack x happyReduce_233
+
+action_322 (95#) = happyShift action_120
+action_322 (98#) = happyShift action_121
+action_322 (105#) = happyShift action_164
+action_322 (111#) = happyShift action_122
+action_322 (115#) = happyShift action_123
+action_322 (123#) = happyShift action_124
+action_322 (126#) = happyShift action_125
+action_322 (167#) = happyShift action_126
+action_322 (170#) = happyShift action_6
+action_322 (171#) = happyShift action_45
+action_322 (172#) = happyShift action_46
+action_322 (174#) = happyShift action_48
+action_322 (8#) = happyGoto action_115
+action_322 (9#) = happyGoto action_116
+action_322 (10#) = happyGoto action_117
+action_322 (12#) = happyGoto action_158
+action_322 (67#) = happyGoto action_159
+action_322 (68#) = happyGoto action_160
+action_322 (69#) = happyGoto action_195
+action_322 (82#) = happyGoto action_196
+action_322 (83#) = happyGoto action_357
+action_322 x = happyTcHack x happyFail
+
+action_323 x = happyTcHack x happyReduce_238
+
+action_324 x = happyTcHack x happyReduce_182
+
+action_325 (95#) = happyShift action_21
+action_325 (97#) = happyShift action_22
+action_325 (98#) = happyShift action_23
+action_325 (111#) = happyShift action_24
+action_325 (115#) = happyShift action_25
+action_325 (117#) = happyShift action_26
+action_325 (118#) = happyShift action_27
+action_325 (119#) = happyShift action_28
+action_325 (120#) = happyShift action_29
+action_325 (121#) = happyShift action_30
+action_325 (122#) = happyShift action_31
+action_325 (123#) = happyShift action_32
+action_325 (124#) = happyShift action_33
+action_325 (128#) = happyShift action_34
+action_325 (131#) = happyShift action_35
+action_325 (134#) = happyShift action_36
+action_325 (137#) = happyShift action_37
+action_325 (142#) = happyShift action_38
+action_325 (153#) = happyShift action_39
+action_325 (154#) = happyShift action_40
+action_325 (158#) = happyShift action_41
+action_325 (159#) = happyShift action_42
+action_325 (164#) = happyShift action_43
+action_325 (167#) = happyShift action_44
+action_325 (170#) = happyShift action_6
+action_325 (171#) = happyShift action_45
+action_325 (172#) = happyShift action_46
+action_325 (173#) = happyShift action_47
+action_325 (174#) = happyShift action_48
+action_325 (8#) = happyGoto action_7
+action_325 (9#) = happyGoto action_8
+action_325 (10#) = happyGoto action_9
+action_325 (11#) = happyGoto action_10
+action_325 (12#) = happyGoto action_11
+action_325 (58#) = happyGoto action_12
+action_325 (59#) = happyGoto action_13
+action_325 (60#) = happyGoto action_14
+action_325 (61#) = happyGoto action_15
+action_325 (62#) = happyGoto action_16
+action_325 (63#) = happyGoto action_356
+action_325 (64#) = happyGoto action_18
+action_325 (72#) = happyGoto action_19
+action_325 (77#) = happyGoto action_20
+action_325 x = happyTcHack x happyFail
+
+action_326 x = happyTcHack x happyReduce_150
+
+action_327 x = happyTcHack x happyReduce_197
+
+action_328 (114#) = happyShift action_355
+action_328 x = happyTcHack x happyFail
+
+action_329 x = happyTcHack x happyReduce_241
+
+action_330 x = happyTcHack x happyReduce_245
+
+action_331 (99#) = happyShift action_354
+action_331 x = happyTcHack x happyFail
+
+action_332 x = happyTcHack x happyReduce_154
+
+action_333 x = happyTcHack x happyReduce_160
+
+action_334 x = happyTcHack x happyReduce_205
+
+action_335 (174#) = happyShift action_48
+action_335 (12#) = happyGoto action_353
+action_335 x = happyTcHack x happyFail
+
+action_336 x = happyTcHack x happyReduce_211
+
+action_337 x = happyTcHack x happyReduce_216
+
+action_338 x = happyTcHack x happyReduce_210
+
+action_339 (95#) = happyShift action_120
+action_339 (98#) = happyShift action_121
+action_339 (105#) = happyShift action_164
+action_339 (111#) = happyShift action_122
+action_339 (115#) = happyShift action_123
+action_339 (123#) = happyShift action_124
+action_339 (126#) = happyShift action_125
+action_339 (167#) = happyShift action_126
+action_339 (170#) = happyShift action_6
+action_339 (171#) = happyShift action_45
+action_339 (172#) = happyShift action_46
+action_339 (174#) = happyShift action_48
+action_339 (8#) = happyGoto action_115
+action_339 (9#) = happyGoto action_116
+action_339 (10#) = happyGoto action_117
+action_339 (12#) = happyGoto action_158
+action_339 (67#) = happyGoto action_159
+action_339 (68#) = happyGoto action_160
+action_339 (69#) = happyGoto action_161
+action_339 (79#) = happyGoto action_162
+action_339 (81#) = happyGoto action_352
+action_339 x = happyTcHack x happyReduce_246
+
+action_340 x = happyTcHack x happyReduce_214
+
+action_341 x = happyTcHack x happyReduce_199
+
+action_342 x = happyTcHack x happyReduce_209
+
+action_343 (174#) = happyShift action_48
+action_343 (12#) = happyGoto action_92
+action_343 (53#) = happyGoto action_154
+action_343 (70#) = happyGoto action_155
+action_343 (73#) = happyGoto action_351
+action_343 x = happyTcHack x happyReduce_229
+
+action_344 (95#) = happyShift action_120
+action_344 (98#) = happyShift action_121
+action_344 (105#) = happyShift action_164
+action_344 (111#) = happyShift action_122
+action_344 (115#) = happyShift action_123
+action_344 (123#) = happyShift action_124
+action_344 (126#) = happyShift action_125
+action_344 (167#) = happyShift action_126
+action_344 (170#) = happyShift action_6
+action_344 (171#) = happyShift action_45
+action_344 (172#) = happyShift action_46
+action_344 (174#) = happyShift action_48
+action_344 (8#) = happyGoto action_115
+action_344 (9#) = happyGoto action_116
+action_344 (10#) = happyGoto action_117
+action_344 (12#) = happyGoto action_158
+action_344 (67#) = happyGoto action_159
+action_344 (68#) = happyGoto action_160
+action_344 (69#) = happyGoto action_350
+action_344 x = happyTcHack x happyFail
+
+action_345 x = happyTcHack x happyReduce_204
+
+action_346 (169#) = happyShift action_349
+action_346 x = happyTcHack x happyFail
+
+action_347 x = happyTcHack x happyReduce_223
+
+action_348 (104#) = happyShift action_190
+action_348 (169#) = happyShift action_207
+action_348 x = happyTcHack x happyReduce_128
+
+action_349 x = happyTcHack x happyReduce_188
+
+action_350 (102#) = happyShift action_306
+action_350 (168#) = happyShift action_308
+action_350 x = happyTcHack x happyReduce_221
+
+action_351 x = happyTcHack x happyReduce_231
+
+action_352 x = happyTcHack x happyReduce_248
+
+action_353 x = happyTcHack x happyReduce_201
+
+action_354 x = happyTcHack x happyReduce_239
+
+action_355 x = happyTcHack x happyReduce_155
+
+action_356 x = happyTcHack x happyReduce_183
+
+action_357 (169#) = happyShift action_468
+action_357 x = happyTcHack x happyFail
+
+action_358 x = happyTcHack x happyReduce_252
+
+action_359 x = happyTcHack x happyReduce_255
+
+action_360 (95#) = happyShift action_21
+action_360 (97#) = happyShift action_22
+action_360 (98#) = happyShift action_23
+action_360 (111#) = happyShift action_24
+action_360 (115#) = happyShift action_25
+action_360 (117#) = happyShift action_26
+action_360 (118#) = happyShift action_27
+action_360 (119#) = happyShift action_28
+action_360 (120#) = happyShift action_29
+action_360 (121#) = happyShift action_30
+action_360 (122#) = happyShift action_31
+action_360 (123#) = happyShift action_32
+action_360 (124#) = happyShift action_33
+action_360 (128#) = happyShift action_34
+action_360 (131#) = happyShift action_35
+action_360 (134#) = happyShift action_36
+action_360 (137#) = happyShift action_37
+action_360 (142#) = happyShift action_38
+action_360 (153#) = happyShift action_39
+action_360 (154#) = happyShift action_40
+action_360 (158#) = happyShift action_41
+action_360 (159#) = happyShift action_42
+action_360 (164#) = happyShift action_43
+action_360 (167#) = happyShift action_44
+action_360 (170#) = happyShift action_6
+action_360 (171#) = happyShift action_45
+action_360 (172#) = happyShift action_46
+action_360 (173#) = happyShift action_47
+action_360 (174#) = happyShift action_48
+action_360 (8#) = happyGoto action_7
+action_360 (9#) = happyGoto action_8
+action_360 (10#) = happyGoto action_9
+action_360 (11#) = happyGoto action_10
+action_360 (12#) = happyGoto action_11
+action_360 (58#) = happyGoto action_12
+action_360 (59#) = happyGoto action_13
+action_360 (60#) = happyGoto action_14
+action_360 (61#) = happyGoto action_15
+action_360 (62#) = happyGoto action_16
+action_360 (63#) = happyGoto action_467
+action_360 (64#) = happyGoto action_18
+action_360 (72#) = happyGoto action_19
+action_360 (77#) = happyGoto action_20
+action_360 x = happyTcHack x happyFail
+
+action_361 (108#) = happyShift action_466
+action_361 x = happyTcHack x happyFail
+
+action_362 (110#) = happyShift action_465
+action_362 x = happyTcHack x happyReduce_258
+
+action_363 (169#) = happyShift action_464
+action_363 x = happyTcHack x happyFail
+
+action_364 x = happyTcHack x happyReduce_195
+
+action_365 x = happyTcHack x happyReduce_215
+
+action_366 (95#) = happyShift action_120
+action_366 (98#) = happyShift action_121
+action_366 (111#) = happyShift action_122
+action_366 (115#) = happyShift action_123
+action_366 (123#) = happyShift action_124
+action_366 (126#) = happyShift action_125
+action_366 (167#) = happyShift action_126
+action_366 (170#) = happyShift action_6
+action_366 (171#) = happyShift action_45
+action_366 (172#) = happyShift action_46
+action_366 (174#) = happyShift action_48
+action_366 (8#) = happyGoto action_115
+action_366 (9#) = happyGoto action_116
+action_366 (10#) = happyGoto action_117
+action_366 (12#) = happyGoto action_118
+action_366 (67#) = happyGoto action_183
+action_366 (74#) = happyGoto action_463
+action_366 x = happyTcHack x happyReduce_205
+
+action_367 x = happyTcHack x happyReduce_218
+
+action_368 x = happyTcHack x happyReduce_249
+
+action_369 x = happyTcHack x happyReduce_219
+
+action_370 x = happyTcHack x happyReduce_251
+
+action_371 x = happyTcHack x happyReduce_165
+
+action_372 x = happyTcHack x happyReduce_164
+
+action_373 (95#) = happyShift action_21
+action_373 (97#) = happyShift action_22
+action_373 (98#) = happyShift action_23
+action_373 (111#) = happyShift action_24
+action_373 (115#) = happyShift action_25
+action_373 (117#) = happyShift action_26
+action_373 (118#) = happyShift action_27
+action_373 (119#) = happyShift action_28
+action_373 (120#) = happyShift action_29
+action_373 (121#) = happyShift action_30
+action_373 (122#) = happyShift action_31
+action_373 (123#) = happyShift action_32
+action_373 (124#) = happyShift action_33
+action_373 (128#) = happyShift action_34
+action_373 (131#) = happyShift action_35
+action_373 (134#) = happyShift action_36
+action_373 (137#) = happyShift action_37
+action_373 (142#) = happyShift action_38
+action_373 (153#) = happyShift action_39
+action_373 (154#) = happyShift action_40
+action_373 (158#) = happyShift action_41
+action_373 (159#) = happyShift action_42
+action_373 (164#) = happyShift action_43
+action_373 (167#) = happyShift action_44
+action_373 (170#) = happyShift action_6
+action_373 (171#) = happyShift action_45
+action_373 (172#) = happyShift action_46
+action_373 (173#) = happyShift action_47
+action_373 (174#) = happyShift action_48
+action_373 (8#) = happyGoto action_7
+action_373 (9#) = happyGoto action_8
+action_373 (10#) = happyGoto action_9
+action_373 (11#) = happyGoto action_10
+action_373 (12#) = happyGoto action_11
+action_373 (58#) = happyGoto action_12
+action_373 (59#) = happyGoto action_13
+action_373 (60#) = happyGoto action_14
+action_373 (61#) = happyGoto action_15
+action_373 (62#) = happyGoto action_16
+action_373 (63#) = happyGoto action_462
+action_373 (64#) = happyGoto action_18
+action_373 (72#) = happyGoto action_19
+action_373 (77#) = happyGoto action_20
+action_373 x = happyTcHack x happyFail
+
+action_374 x = happyTcHack x happyReduce_159
+
+action_375 x = happyTcHack x happyReduce_33
+
+action_376 (104#) = happyShift action_378
+action_376 x = happyTcHack x happyReduce_66
+
+action_377 x = happyTcHack x happyReduce_32
+
+action_378 (174#) = happyShift action_48
+action_378 (12#) = happyGoto action_241
+action_378 (32#) = happyGoto action_461
+action_378 (33#) = happyGoto action_376
+action_378 x = happyTcHack x happyReduce_65
+
+action_379 (98#) = happyShift action_408
+action_379 (174#) = happyShift action_48
+action_379 (12#) = happyGoto action_406
+action_379 (27#) = happyGoto action_460
+action_379 (29#) = happyGoto action_425
+action_379 x = happyTcHack x happyReduce_52
+
+action_380 (174#) = happyShift action_48
+action_380 (12#) = happyGoto action_241
+action_380 (33#) = happyGoto action_459
+action_380 x = happyTcHack x happyReduce_50
+
+action_381 x = happyTcHack x happyReduce_26
+
+action_382 (98#) = happyShift action_408
+action_382 (174#) = happyShift action_48
+action_382 (12#) = happyGoto action_406
+action_382 (27#) = happyGoto action_458
+action_382 (29#) = happyGoto action_425
+action_382 x = happyTcHack x happyReduce_52
+
+action_383 (89#) = happyGoto action_457
+action_383 x = happyTcHack x happyReduce_262
+
+action_384 (123#) = happyShift action_290
+action_384 (174#) = happyShift action_48
+action_384 (12#) = happyGoto action_287
+action_384 (36#) = happyGoto action_288
+action_384 (46#) = happyGoto action_456
+action_384 x = happyTcHack x happyReduce_113
+
+action_385 (97#) = happyShift action_86
+action_385 (98#) = happyShift action_455
+action_385 (111#) = happyShift action_24
+action_385 (115#) = happyShift action_25
+action_385 (118#) = happyShift action_27
+action_385 (119#) = happyShift action_28
+action_385 (120#) = happyShift action_29
+action_385 (121#) = happyShift action_30
+action_385 (122#) = happyShift action_31
+action_385 (123#) = happyShift action_32
+action_385 (131#) = happyShift action_35
+action_385 (167#) = happyShift action_139
+action_385 (170#) = happyShift action_6
+action_385 (171#) = happyShift action_45
+action_385 (172#) = happyShift action_46
+action_385 (173#) = happyShift action_47
+action_385 (174#) = happyShift action_48
+action_385 (8#) = happyGoto action_7
+action_385 (9#) = happyGoto action_8
+action_385 (10#) = happyGoto action_9
+action_385 (11#) = happyGoto action_10
+action_385 (12#) = happyGoto action_84
+action_385 (58#) = happyGoto action_453
+action_385 (72#) = happyGoto action_19
+action_385 (88#) = happyGoto action_454
+action_385 x = happyTcHack x happyReduce_95
+
+action_386 (174#) = happyShift action_48
+action_386 (12#) = happyGoto action_451
+action_386 (38#) = happyGoto action_284
+action_386 (48#) = happyGoto action_452
+action_386 x = happyTcHack x happyReduce_117
+
+action_387 (174#) = happyShift action_48
+action_387 (12#) = happyGoto action_448
+action_387 (39#) = happyGoto action_449
+action_387 (40#) = happyGoto action_450
+action_387 x = happyTcHack x happyReduce_102
+
+action_388 (174#) = happyShift action_48
+action_388 (12#) = happyGoto action_279
+action_388 (44#) = happyGoto action_280
+action_388 (51#) = happyGoto action_447
+action_388 x = happyTcHack x happyReduce_123
+
+action_389 (174#) = happyShift action_48
+action_389 (12#) = happyGoto action_446
+action_389 x = happyTcHack x happyFail
+
+action_390 (95#) = happyShift action_21
+action_390 (97#) = happyShift action_22
+action_390 (98#) = happyShift action_23
+action_390 (111#) = happyShift action_24
+action_390 (115#) = happyShift action_25
+action_390 (117#) = happyShift action_26
+action_390 (118#) = happyShift action_27
+action_390 (119#) = happyShift action_28
+action_390 (120#) = happyShift action_29
+action_390 (121#) = happyShift action_30
+action_390 (122#) = happyShift action_31
+action_390 (123#) = happyShift action_32
+action_390 (124#) = happyShift action_33
+action_390 (128#) = happyShift action_34
+action_390 (131#) = happyShift action_35
+action_390 (134#) = happyShift action_36
+action_390 (137#) = happyShift action_37
+action_390 (142#) = happyShift action_38
+action_390 (153#) = happyShift action_39
+action_390 (154#) = happyShift action_40
+action_390 (158#) = happyShift action_41
+action_390 (159#) = happyShift action_42
+action_390 (164#) = happyShift action_43
+action_390 (167#) = happyShift action_44
+action_390 (170#) = happyShift action_6
+action_390 (171#) = happyShift action_45
+action_390 (172#) = happyShift action_46
+action_390 (173#) = happyShift action_47
+action_390 (174#) = happyShift action_48
+action_390 (8#) = happyGoto action_7
+action_390 (9#) = happyGoto action_8
+action_390 (10#) = happyGoto action_9
+action_390 (11#) = happyGoto action_10
+action_390 (12#) = happyGoto action_11
+action_390 (58#) = happyGoto action_12
+action_390 (59#) = happyGoto action_13
+action_390 (60#) = happyGoto action_14
+action_390 (61#) = happyGoto action_15
+action_390 (62#) = happyGoto action_16
+action_390 (63#) = happyGoto action_445
+action_390 (64#) = happyGoto action_18
+action_390 (72#) = happyGoto action_19
+action_390 (77#) = happyGoto action_20
+action_390 x = happyTcHack x happyFail
+
+action_391 (174#) = happyShift action_48
+action_391 (12#) = happyGoto action_92
+action_391 (37#) = happyGoto action_276
+action_391 (47#) = happyGoto action_444
+action_391 (53#) = happyGoto action_278
+action_391 x = happyTcHack x happyReduce_115
+
+action_392 (167#) = happyShift action_443
+action_392 x = happyTcHack x happyFail
+
+action_393 (174#) = happyShift action_48
+action_393 (12#) = happyGoto action_267
+action_393 (41#) = happyGoto action_268
+action_393 (49#) = happyGoto action_442
+action_393 x = happyTcHack x happyReduce_119
+
+action_394 (98#) = happyShift action_441
+action_394 (174#) = happyShift action_48
+action_394 (12#) = happyGoto action_438
+action_394 (42#) = happyGoto action_439
+action_394 (52#) = happyGoto action_440
+action_394 x = happyTcHack x happyReduce_125
+
+action_395 x = happyTcHack x happyReduce_87
+
+action_396 x = happyTcHack x happyReduce_86
+
+action_397 (95#) = happyShift action_21
+action_397 (97#) = happyShift action_22
+action_397 (98#) = happyShift action_23
+action_397 (111#) = happyShift action_24
+action_397 (115#) = happyShift action_25
+action_397 (117#) = happyShift action_26
+action_397 (118#) = happyShift action_27
+action_397 (119#) = happyShift action_28
+action_397 (120#) = happyShift action_29
+action_397 (121#) = happyShift action_30
+action_397 (122#) = happyShift action_31
+action_397 (123#) = happyShift action_32
+action_397 (124#) = happyShift action_33
+action_397 (128#) = happyShift action_34
+action_397 (131#) = happyShift action_35
+action_397 (134#) = happyShift action_36
+action_397 (137#) = happyShift action_37
+action_397 (142#) = happyShift action_38
+action_397 (153#) = happyShift action_39
+action_397 (154#) = happyShift action_40
+action_397 (158#) = happyShift action_41
+action_397 (159#) = happyShift action_42
+action_397 (164#) = happyShift action_43
+action_397 (167#) = happyShift action_44
+action_397 (170#) = happyShift action_6
+action_397 (171#) = happyShift action_45
+action_397 (172#) = happyShift action_46
+action_397 (173#) = happyShift action_47
+action_397 (174#) = happyShift action_48
+action_397 (8#) = happyGoto action_7
+action_397 (9#) = happyGoto action_8
+action_397 (10#) = happyGoto action_9
+action_397 (11#) = happyGoto action_10
+action_397 (12#) = happyGoto action_11
+action_397 (58#) = happyGoto action_12
+action_397 (59#) = happyGoto action_13
+action_397 (60#) = happyGoto action_14
+action_397 (61#) = happyGoto action_15
+action_397 (62#) = happyGoto action_16
+action_397 (63#) = happyGoto action_437
+action_397 (64#) = happyGoto action_18
+action_397 (72#) = happyGoto action_19
+action_397 (77#) = happyGoto action_20
+action_397 x = happyTcHack x happyFail
+
+action_398 (123#) = happyShift action_257
+action_398 (174#) = happyShift action_48
+action_398 (12#) = happyGoto action_252
+action_398 (54#) = happyGoto action_262
+action_398 (55#) = happyGoto action_436
+action_398 x = happyTcHack x happyFail
+
+action_399 (123#) = happyShift action_257
+action_399 (174#) = happyShift action_48
+action_399 (12#) = happyGoto action_252
+action_399 (43#) = happyGoto action_260
+action_399 (50#) = happyGoto action_435
+action_399 (54#) = happyGoto action_262
+action_399 (55#) = happyGoto action_263
+action_399 x = happyTcHack x happyReduce_121
+
+action_400 x = happyTcHack x happyReduce_94
+
+action_401 (125#) = happyShift action_434
+action_401 x = happyTcHack x happyFail
+
+action_402 (95#) = happyShift action_21
+action_402 (97#) = happyShift action_22
+action_402 (98#) = happyShift action_23
+action_402 (111#) = happyShift action_24
+action_402 (115#) = happyShift action_25
+action_402 (117#) = happyShift action_26
+action_402 (118#) = happyShift action_27
+action_402 (119#) = happyShift action_28
+action_402 (120#) = happyShift action_29
+action_402 (121#) = happyShift action_30
+action_402 (122#) = happyShift action_31
+action_402 (123#) = happyShift action_32
+action_402 (124#) = happyShift action_33
+action_402 (128#) = happyShift action_34
+action_402 (131#) = happyShift action_35
+action_402 (134#) = happyShift action_36
+action_402 (137#) = happyShift action_37
+action_402 (142#) = happyShift action_38
+action_402 (153#) = happyShift action_39
+action_402 (154#) = happyShift action_40
+action_402 (158#) = happyShift action_41
+action_402 (159#) = happyShift action_42
+action_402 (164#) = happyShift action_43
+action_402 (167#) = happyShift action_44
+action_402 (170#) = happyShift action_6
+action_402 (171#) = happyShift action_45
+action_402 (172#) = happyShift action_46
+action_402 (173#) = happyShift action_47
+action_402 (174#) = happyShift action_48
+action_402 (8#) = happyGoto action_7
+action_402 (9#) = happyGoto action_8
+action_402 (10#) = happyGoto action_9
+action_402 (11#) = happyGoto action_10
+action_402 (12#) = happyGoto action_11
+action_402 (58#) = happyGoto action_12
+action_402 (59#) = happyGoto action_13
+action_402 (60#) = happyGoto action_14
+action_402 (61#) = happyGoto action_15
+action_402 (62#) = happyGoto action_16
+action_402 (63#) = happyGoto action_433
+action_402 (64#) = happyGoto action_18
+action_402 (72#) = happyGoto action_19
+action_402 (77#) = happyGoto action_20
+action_402 x = happyTcHack x happyFail
+
+action_403 (95#) = happyShift action_21
+action_403 (97#) = happyShift action_22
+action_403 (98#) = happyShift action_23
+action_403 (111#) = happyShift action_24
+action_403 (115#) = happyShift action_25
+action_403 (117#) = happyShift action_26
+action_403 (118#) = happyShift action_27
+action_403 (119#) = happyShift action_28
+action_403 (120#) = happyShift action_29
+action_403 (121#) = happyShift action_30
+action_403 (122#) = happyShift action_31
+action_403 (123#) = happyShift action_32
+action_403 (124#) = happyShift action_33
+action_403 (128#) = happyShift action_34
+action_403 (131#) = happyShift action_35
+action_403 (134#) = happyShift action_36
+action_403 (137#) = happyShift action_37
+action_403 (142#) = happyShift action_38
+action_403 (153#) = happyShift action_39
+action_403 (154#) = happyShift action_40
+action_403 (158#) = happyShift action_41
+action_403 (159#) = happyShift action_42
+action_403 (164#) = happyShift action_43
+action_403 (167#) = happyShift action_44
+action_403 (170#) = happyShift action_6
+action_403 (171#) = happyShift action_45
+action_403 (172#) = happyShift action_46
+action_403 (173#) = happyShift action_47
+action_403 (174#) = happyShift action_48
+action_403 (8#) = happyGoto action_7
+action_403 (9#) = happyGoto action_8
+action_403 (10#) = happyGoto action_9
+action_403 (11#) = happyGoto action_10
+action_403 (12#) = happyGoto action_11
+action_403 (58#) = happyGoto action_12
+action_403 (59#) = happyGoto action_13
+action_403 (60#) = happyGoto action_14
+action_403 (61#) = happyGoto action_15
+action_403 (62#) = happyGoto action_16
+action_403 (63#) = happyGoto action_432
+action_403 (64#) = happyGoto action_18
+action_403 (72#) = happyGoto action_19
+action_403 (77#) = happyGoto action_20
+action_403 x = happyTcHack x happyFail
+
+action_404 (112#) = happyShift action_431
+action_404 x = happyTcHack x happyFail
+
+action_405 (123#) = happyShift action_257
+action_405 (174#) = happyShift action_48
+action_405 (12#) = happyGoto action_252
+action_405 (34#) = happyGoto action_253
+action_405 (45#) = happyGoto action_430
+action_405 (54#) = happyGoto action_255
+action_405 (55#) = happyGoto action_256
+action_405 x = happyTcHack x happyReduce_111
+
+action_406 x = happyTcHack x happyReduce_57
+
+action_407 (106#) = happyShift action_429
+action_407 x = happyTcHack x happyFail
+
+action_408 (139#) = happyShift action_427
+action_408 (141#) = happyShift action_428
+action_408 (31#) = happyGoto action_426
+action_408 x = happyTcHack x happyReduce_62
+
+action_409 x = happyTcHack x happyReduce_38
+
+action_410 x = happyTcHack x happyReduce_37
+
+action_411 x = happyTcHack x happyReduce_47
+
+action_412 x = happyTcHack x happyReduce_46
+
+action_413 (98#) = happyShift action_408
+action_413 (174#) = happyShift action_48
+action_413 (12#) = happyGoto action_406
+action_413 (27#) = happyGoto action_424
+action_413 (29#) = happyGoto action_425
+action_413 x = happyTcHack x happyReduce_52
+
+action_414 (174#) = happyShift action_48
+action_414 (12#) = happyGoto action_241
+action_414 (33#) = happyGoto action_423
+action_414 x = happyTcHack x happyReduce_50
+
+action_415 (167#) = happyShift action_422
+action_415 x = happyTcHack x happyFail
+
+action_416 (123#) = happyShift action_421
+action_416 x = happyTcHack x happyFail
+
+action_417 (174#) = happyShift action_48
+action_417 (12#) = happyGoto action_92
+action_417 (53#) = happyGoto action_420
+action_417 x = happyTcHack x happyFail
+
+action_418 (112#) = happyShift action_419
+action_418 x = happyTcHack x happyFail
+
+action_419 (174#) = happyShift action_48
+action_419 (12#) = happyGoto action_492
+action_419 x = happyTcHack x happyFail
+
+action_420 (125#) = happyShift action_491
+action_420 x = happyTcHack x happyFail
+
+action_421 (174#) = happyShift action_48
+action_421 (12#) = happyGoto action_92
+action_421 (53#) = happyGoto action_490
+action_421 x = happyTcHack x happyFail
+
+action_422 (25#) = happyGoto action_489
+action_422 x = happyTcHack x happyReduce_48
+
+action_423 (166#) = happyShift action_488
+action_423 x = happyTcHack x happyFail
+
+action_424 (101#) = happyShift action_487
+action_424 x = happyTcHack x happyReduce_42
+
+action_425 (104#) = happyShift action_486
+action_425 x = happyTcHack x happyReduce_53
+
+action_426 (174#) = happyShift action_48
+action_426 (12#) = happyGoto action_485
+action_426 x = happyTcHack x happyFail
+
+action_427 x = happyTcHack x happyReduce_63
+
+action_428 x = happyTcHack x happyReduce_64
+
+action_429 (98#) = happyShift action_408
+action_429 (174#) = happyShift action_48
+action_429 (12#) = happyGoto action_406
+action_429 (29#) = happyGoto action_484
+action_429 x = happyTcHack x happyFail
+
+action_430 x = happyTcHack x happyReduce_112
+
+action_431 (95#) = happyShift action_21
+action_431 (97#) = happyShift action_22
+action_431 (98#) = happyShift action_23
+action_431 (111#) = happyShift action_24
+action_431 (115#) = happyShift action_25
+action_431 (117#) = happyShift action_26
+action_431 (118#) = happyShift action_27
+action_431 (119#) = happyShift action_28
+action_431 (120#) = happyShift action_29
+action_431 (121#) = happyShift action_30
+action_431 (122#) = happyShift action_31
+action_431 (123#) = happyShift action_32
+action_431 (124#) = happyShift action_33
+action_431 (128#) = happyShift action_34
+action_431 (131#) = happyShift action_35
+action_431 (134#) = happyShift action_36
+action_431 (137#) = happyShift action_37
+action_431 (142#) = happyShift action_38
+action_431 (153#) = happyShift action_39
+action_431 (154#) = happyShift action_40
+action_431 (158#) = happyShift action_41
+action_431 (159#) = happyShift action_42
+action_431 (164#) = happyShift action_43
+action_431 (167#) = happyShift action_44
+action_431 (170#) = happyShift action_6
+action_431 (171#) = happyShift action_45
+action_431 (172#) = happyShift action_46
+action_431 (173#) = happyShift action_47
+action_431 (174#) = happyShift action_48
+action_431 (8#) = happyGoto action_7
+action_431 (9#) = happyGoto action_8
+action_431 (10#) = happyGoto action_9
+action_431 (11#) = happyGoto action_10
+action_431 (12#) = happyGoto action_11
+action_431 (58#) = happyGoto action_12
+action_431 (59#) = happyGoto action_13
+action_431 (60#) = happyGoto action_14
+action_431 (61#) = happyGoto action_15
+action_431 (62#) = happyGoto action_16
+action_431 (63#) = happyGoto action_483
+action_431 (64#) = happyGoto action_18
+action_431 (72#) = happyGoto action_19
+action_431 (77#) = happyGoto action_20
+action_431 x = happyTcHack x happyFail
+
+action_432 x = happyTcHack x happyReduce_72
+
+action_433 (112#) = happyShift action_482
+action_433 x = happyTcHack x happyReduce_71
+
+action_434 x = happyTcHack x happyReduce_131
+
+action_435 x = happyTcHack x happyReduce_122
+
+action_436 x = happyTcHack x happyReduce_133
+
+action_437 x = happyTcHack x happyReduce_109
+
+action_438 (89#) = happyGoto action_481
+action_438 x = happyTcHack x happyReduce_262
+
+action_439 (168#) = happyShift action_480
+action_439 x = happyTcHack x happyReduce_126
+
+action_440 x = happyTcHack x happyReduce_105
+
+action_441 (137#) = happyShift action_479
+action_441 x = happyTcHack x happyFail
+
+action_442 x = happyTcHack x happyReduce_120
+
+action_443 (25#) = happyGoto action_478
+action_443 x = happyTcHack x happyReduce_48
+
+action_444 x = happyTcHack x happyReduce_116
+
+action_445 x = happyTcHack x happyReduce_98
+
+action_446 x = happyTcHack x happyReduce_110
+
+action_447 x = happyTcHack x happyReduce_124
+
+action_448 (107#) = happyShift action_477
+action_448 x = happyTcHack x happyReduce_100
+
+action_449 (168#) = happyShift action_476
+action_449 x = happyTcHack x happyReduce_103
+
+action_450 x = happyTcHack x happyReduce_99
+
+action_451 (112#) = happyShift action_387
+action_451 x = happyTcHack x happyFail
+
+action_452 x = happyTcHack x happyReduce_118
+
+action_453 x = happyTcHack x happyReduce_261
+
+action_454 x = happyTcHack x happyReduce_263
+
+action_455 (95#) = happyShift action_21
+action_455 (97#) = happyShift action_22
+action_455 (98#) = happyShift action_23
+action_455 (111#) = happyShift action_24
+action_455 (115#) = happyShift action_25
+action_455 (117#) = happyShift action_26
+action_455 (118#) = happyShift action_27
+action_455 (119#) = happyShift action_28
+action_455 (120#) = happyShift action_29
+action_455 (121#) = happyShift action_30
+action_455 (122#) = happyShift action_31
+action_455 (123#) = happyShift action_32
+action_455 (124#) = happyShift action_33
+action_455 (126#) = happyShift action_102
+action_455 (128#) = happyShift action_34
+action_455 (131#) = happyShift action_35
+action_455 (134#) = happyShift action_36
+action_455 (137#) = happyShift action_113
+action_455 (142#) = happyShift action_38
+action_455 (153#) = happyShift action_39
+action_455 (154#) = happyShift action_40
+action_455 (158#) = happyShift action_41
+action_455 (159#) = happyShift action_42
+action_455 (164#) = happyShift action_43
+action_455 (167#) = happyShift action_44
+action_455 (170#) = happyShift action_6
+action_455 (171#) = happyShift action_45
+action_455 (172#) = happyShift action_46
+action_455 (173#) = happyShift action_47
+action_455 (174#) = happyShift action_48
+action_455 (8#) = happyGoto action_7
+action_455 (9#) = happyGoto action_8
+action_455 (10#) = happyGoto action_9
+action_455 (11#) = happyGoto action_10
+action_455 (12#) = happyGoto action_110
+action_455 (58#) = happyGoto action_12
+action_455 (59#) = happyGoto action_13
+action_455 (60#) = happyGoto action_14
+action_455 (61#) = happyGoto action_15
+action_455 (62#) = happyGoto action_16
+action_455 (63#) = happyGoto action_111
+action_455 (64#) = happyGoto action_18
+action_455 (72#) = happyGoto action_19
+action_455 (75#) = happyGoto action_99
+action_455 (76#) = happyGoto action_475
+action_455 (77#) = happyGoto action_20
+action_455 x = happyTcHack x happyReduce_236
+
+action_456 x = happyTcHack x happyReduce_114
+
+action_457 (97#) = happyShift action_86
+action_457 (98#) = happyShift action_455
+action_457 (111#) = happyShift action_24
+action_457 (115#) = happyShift action_25
+action_457 (118#) = happyShift action_27
+action_457 (119#) = happyShift action_28
+action_457 (120#) = happyShift action_29
+action_457 (121#) = happyShift action_30
+action_457 (122#) = happyShift action_31
+action_457 (123#) = happyShift action_32
+action_457 (125#) = happyShift action_474
+action_457 (131#) = happyShift action_35
+action_457 (167#) = happyShift action_139
+action_457 (170#) = happyShift action_6
+action_457 (171#) = happyShift action_45
+action_457 (172#) = happyShift action_46
+action_457 (173#) = happyShift action_47
+action_457 (174#) = happyShift action_48
+action_457 (8#) = happyGoto action_7
+action_457 (9#) = happyGoto action_8
+action_457 (10#) = happyGoto action_9
+action_457 (11#) = happyGoto action_10
+action_457 (12#) = happyGoto action_84
+action_457 (58#) = happyGoto action_453
+action_457 (72#) = happyGoto action_19
+action_457 (88#) = happyGoto action_454
+action_457 x = happyTcHack x happyFail
+
+action_458 (137#) = happyShift action_473
+action_458 x = happyTcHack x happyFail
+
+action_459 (166#) = happyShift action_472
+action_459 x = happyTcHack x happyFail
+
+action_460 (101#) = happyShift action_471
+action_460 x = happyTcHack x happyReduce_28
+
+action_461 x = happyTcHack x happyReduce_67
+
+action_462 x = happyTcHack x happyReduce_136
+
+action_463 x = happyTcHack x happyReduce_213
+
+action_464 x = happyTcHack x happyReduce_168
+
+action_465 (95#) = happyShift action_21
+action_465 (97#) = happyShift action_22
+action_465 (98#) = happyShift action_23
+action_465 (111#) = happyShift action_24
+action_465 (115#) = happyShift action_25
+action_465 (117#) = happyShift action_26
+action_465 (118#) = happyShift action_27
+action_465 (119#) = happyShift action_28
+action_465 (120#) = happyShift action_29
+action_465 (121#) = happyShift action_30
+action_465 (122#) = happyShift action_31
+action_465 (123#) = happyShift action_32
+action_465 (124#) = happyShift action_33
+action_465 (128#) = happyShift action_34
+action_465 (131#) = happyShift action_35
+action_465 (134#) = happyShift action_36
+action_465 (137#) = happyShift action_37
+action_465 (142#) = happyShift action_38
+action_465 (153#) = happyShift action_39
+action_465 (154#) = happyShift action_40
+action_465 (158#) = happyShift action_41
+action_465 (159#) = happyShift action_42
+action_465 (164#) = happyShift action_43
+action_465 (167#) = happyShift action_44
+action_465 (170#) = happyShift action_6
+action_465 (171#) = happyShift action_45
+action_465 (172#) = happyShift action_46
+action_465 (173#) = happyShift action_47
+action_465 (174#) = happyShift action_48
+action_465 (8#) = happyGoto action_7
+action_465 (9#) = happyGoto action_8
+action_465 (10#) = happyGoto action_9
+action_465 (11#) = happyGoto action_10
+action_465 (12#) = happyGoto action_11
+action_465 (58#) = happyGoto action_12
+action_465 (59#) = happyGoto action_13
+action_465 (60#) = happyGoto action_14
+action_465 (61#) = happyGoto action_15
+action_465 (62#) = happyGoto action_16
+action_465 (63#) = happyGoto action_361
+action_465 (64#) = happyGoto action_18
+action_465 (72#) = happyGoto action_19
+action_465 (77#) = happyGoto action_20
+action_465 (86#) = happyGoto action_362
+action_465 (87#) = happyGoto action_470
+action_465 x = happyTcHack x happyReduce_257
+
+action_466 (95#) = happyShift action_21
+action_466 (97#) = happyShift action_22
+action_466 (98#) = happyShift action_23
+action_466 (111#) = happyShift action_24
+action_466 (115#) = happyShift action_25
+action_466 (117#) = happyShift action_26
+action_466 (118#) = happyShift action_27
+action_466 (119#) = happyShift action_28
+action_466 (120#) = happyShift action_29
+action_466 (121#) = happyShift action_30
+action_466 (122#) = happyShift action_31
+action_466 (123#) = happyShift action_32
+action_466 (124#) = happyShift action_33
+action_466 (128#) = happyShift action_34
+action_466 (131#) = happyShift action_35
+action_466 (134#) = happyShift action_36
+action_466 (137#) = happyShift action_37
+action_466 (142#) = happyShift action_38
+action_466 (153#) = happyShift action_39
+action_466 (154#) = happyShift action_40
+action_466 (158#) = happyShift action_41
+action_466 (159#) = happyShift action_42
+action_466 (164#) = happyShift action_43
+action_466 (167#) = happyShift action_44
+action_466 (170#) = happyShift action_6
+action_466 (171#) = happyShift action_45
+action_466 (172#) = happyShift action_46
+action_466 (173#) = happyShift action_47
+action_466 (174#) = happyShift action_48
+action_466 (8#) = happyGoto action_7
+action_466 (9#) = happyGoto action_8
+action_466 (10#) = happyGoto action_9
+action_466 (11#) = happyGoto action_10
+action_466 (12#) = happyGoto action_11
+action_466 (58#) = happyGoto action_12
+action_466 (59#) = happyGoto action_13
+action_466 (60#) = happyGoto action_14
+action_466 (61#) = happyGoto action_15
+action_466 (62#) = happyGoto action_16
+action_466 (63#) = happyGoto action_469
+action_466 (64#) = happyGoto action_18
+action_466 (72#) = happyGoto action_19
+action_466 (77#) = happyGoto action_20
+action_466 x = happyTcHack x happyFail
+
+action_467 x = happyTcHack x happyReduce_186
+
+action_468 x = happyTcHack x happyReduce_166
+
+action_469 x = happyTcHack x happyReduce_256
+
+action_470 x = happyTcHack x happyReduce_259
+
+action_471 (148#) = happyShift action_382
+action_471 (28#) = happyGoto action_510
+action_471 x = happyTcHack x happyReduce_55
+
+action_472 (98#) = happyShift action_408
+action_472 (174#) = happyShift action_48
+action_472 (12#) = happyGoto action_406
+action_472 (27#) = happyGoto action_509
+action_472 (29#) = happyGoto action_425
+action_472 x = happyTcHack x happyReduce_52
+
+action_473 x = happyTcHack x happyReduce_56
+
+action_474 (167#) = happyShift action_508
+action_474 x = happyTcHack x happyReduce_96
+
+action_475 (109#) = happyShift action_507
+action_475 x = happyTcHack x happyFail
+
+action_476 (174#) = happyShift action_48
+action_476 (12#) = happyGoto action_448
+action_476 (39#) = happyGoto action_449
+action_476 (40#) = happyGoto action_506
+action_476 x = happyTcHack x happyReduce_102
+
+action_477 (174#) = happyShift action_48
+action_477 (12#) = happyGoto action_505
+action_477 x = happyTcHack x happyFail
+
+action_478 (129#) = happyShift action_210
+action_478 (131#) = happyShift action_211
+action_478 (132#) = happyShift action_212
+action_478 (133#) = happyShift action_213
+action_478 (135#) = happyShift action_214
+action_478 (143#) = happyShift action_215
+action_478 (144#) = happyShift action_216
+action_478 (145#) = happyShift action_217
+action_478 (146#) = happyShift action_218
+action_478 (149#) = happyShift action_219
+action_478 (151#) = happyShift action_220
+action_478 (152#) = happyShift action_221
+action_478 (153#) = happyShift action_222
+action_478 (155#) = happyShift action_223
+action_478 (160#) = happyShift action_224
+action_478 (161#) = happyShift action_225
+action_478 (163#) = happyShift action_226
+action_478 (169#) = happyShift action_504
+action_478 (35#) = happyGoto action_209
+action_478 x = happyTcHack x happyFail
+
+action_479 (174#) = happyShift action_48
+action_479 (12#) = happyGoto action_503
+action_479 x = happyTcHack x happyFail
+
+action_480 (174#) = happyShift action_48
+action_480 (12#) = happyGoto action_438
+action_480 (42#) = happyGoto action_439
+action_480 (52#) = happyGoto action_502
+action_480 x = happyTcHack x happyReduce_125
+
+action_481 (97#) = happyShift action_86
+action_481 (98#) = happyShift action_455
+action_481 (111#) = happyShift action_24
+action_481 (115#) = happyShift action_25
+action_481 (118#) = happyShift action_27
+action_481 (119#) = happyShift action_28
+action_481 (120#) = happyShift action_29
+action_481 (121#) = happyShift action_30
+action_481 (122#) = happyShift action_31
+action_481 (123#) = happyShift action_32
+action_481 (131#) = happyShift action_35
+action_481 (167#) = happyShift action_139
+action_481 (170#) = happyShift action_6
+action_481 (171#) = happyShift action_45
+action_481 (172#) = happyShift action_46
+action_481 (173#) = happyShift action_47
+action_481 (174#) = happyShift action_48
+action_481 (8#) = happyGoto action_7
+action_481 (9#) = happyGoto action_8
+action_481 (10#) = happyGoto action_9
+action_481 (11#) = happyGoto action_10
+action_481 (12#) = happyGoto action_84
+action_481 (58#) = happyGoto action_453
+action_481 (72#) = happyGoto action_19
+action_481 (88#) = happyGoto action_454
+action_481 x = happyTcHack x happyReduce_108
+
+action_482 (95#) = happyShift action_21
+action_482 (97#) = happyShift action_22
+action_482 (98#) = happyShift action_23
+action_482 (111#) = happyShift action_24
+action_482 (115#) = happyShift action_25
+action_482 (117#) = happyShift action_26
+action_482 (118#) = happyShift action_27
+action_482 (119#) = happyShift action_28
+action_482 (120#) = happyShift action_29
+action_482 (121#) = happyShift action_30
+action_482 (122#) = happyShift action_31
+action_482 (123#) = happyShift action_32
+action_482 (124#) = happyShift action_33
+action_482 (128#) = happyShift action_34
+action_482 (131#) = happyShift action_35
+action_482 (134#) = happyShift action_36
+action_482 (137#) = happyShift action_37
+action_482 (142#) = happyShift action_38
+action_482 (153#) = happyShift action_39
+action_482 (154#) = happyShift action_40
+action_482 (158#) = happyShift action_41
+action_482 (159#) = happyShift action_42
+action_482 (164#) = happyShift action_43
+action_482 (167#) = happyShift action_44
+action_482 (170#) = happyShift action_6
+action_482 (171#) = happyShift action_45
+action_482 (172#) = happyShift action_46
+action_482 (173#) = happyShift action_47
+action_482 (174#) = happyShift action_48
+action_482 (8#) = happyGoto action_7
+action_482 (9#) = happyGoto action_8
+action_482 (10#) = happyGoto action_9
+action_482 (11#) = happyGoto action_10
+action_482 (12#) = happyGoto action_11
+action_482 (58#) = happyGoto action_12
+action_482 (59#) = happyGoto action_13
+action_482 (60#) = happyGoto action_14
+action_482 (61#) = happyGoto action_15
+action_482 (62#) = happyGoto action_16
+action_482 (63#) = happyGoto action_501
+action_482 (64#) = happyGoto action_18
+action_482 (72#) = happyGoto action_19
+action_482 (77#) = happyGoto action_20
+action_482 x = happyTcHack x happyFail
+
+action_483 x = happyTcHack x happyReduce_73
+
+action_484 x = happyTcHack x happyReduce_39
+
+action_485 (99#) = happyShift action_499
+action_485 (112#) = happyShift action_500
+action_485 x = happyTcHack x happyFail
+
+action_486 (98#) = happyShift action_408
+action_486 (174#) = happyShift action_48
+action_486 (12#) = happyGoto action_406
+action_486 (27#) = happyGoto action_498
+action_486 (29#) = happyGoto action_425
+action_486 x = happyTcHack x happyReduce_52
+
+action_487 (148#) = happyShift action_382
+action_487 (28#) = happyGoto action_497
+action_487 x = happyTcHack x happyReduce_55
+
+action_488 (98#) = happyShift action_408
+action_488 (174#) = happyShift action_48
+action_488 (12#) = happyGoto action_406
+action_488 (27#) = happyGoto action_496
+action_488 (29#) = happyGoto action_425
+action_488 x = happyTcHack x happyReduce_52
+
+action_489 (129#) = happyShift action_210
+action_489 (131#) = happyShift action_211
+action_489 (132#) = happyShift action_212
+action_489 (133#) = happyShift action_213
+action_489 (135#) = happyShift action_214
+action_489 (143#) = happyShift action_215
+action_489 (144#) = happyShift action_216
+action_489 (145#) = happyShift action_217
+action_489 (146#) = happyShift action_218
+action_489 (149#) = happyShift action_219
+action_489 (151#) = happyShift action_220
+action_489 (152#) = happyShift action_221
+action_489 (153#) = happyShift action_222
+action_489 (155#) = happyShift action_223
+action_489 (160#) = happyShift action_224
+action_489 (161#) = happyShift action_225
+action_489 (163#) = happyShift action_226
+action_489 (169#) = happyShift action_495
+action_489 (35#) = happyGoto action_209
+action_489 x = happyTcHack x happyFail
+
+action_490 (125#) = happyShift action_494
+action_490 x = happyTcHack x happyFail
+
+action_491 x = happyTcHack x happyReduce_69
+
+action_492 (110#) = happyShift action_493
+action_492 x = happyTcHack x happyFail
+
+action_493 (174#) = happyShift action_48
+action_493 (12#) = happyGoto action_519
+action_493 (16#) = happyGoto action_520
+action_493 (17#) = happyGoto action_521
+action_493 x = happyTcHack x happyReduce_17
+
+action_494 x = happyTcHack x happyReduce_70
+
+action_495 x = happyTcHack x happyReduce_40
+
+action_496 (101#) = happyShift action_518
+action_496 x = happyTcHack x happyReduce_44
+
+action_497 (167#) = happyShift action_517
+action_497 x = happyTcHack x happyFail
+
+action_498 x = happyTcHack x happyReduce_54
+
+action_499 x = happyTcHack x happyReduce_58
+
+action_500 (174#) = happyShift action_48
+action_500 (12#) = happyGoto action_516
+action_500 x = happyTcHack x happyFail
+
+action_501 x = happyTcHack x happyReduce_74
+
+action_502 x = happyTcHack x happyReduce_127
+
+action_503 (99#) = happyShift action_515
+action_503 x = happyTcHack x happyFail
+
+action_504 (110#) = happyShift action_514
+action_504 x = happyTcHack x happyFail
+
+action_505 x = happyTcHack x happyReduce_101
+
+action_506 x = happyTcHack x happyReduce_104
+
+action_507 (95#) = happyShift action_21
+action_507 (97#) = happyShift action_22
+action_507 (98#) = happyShift action_23
+action_507 (111#) = happyShift action_24
+action_507 (115#) = happyShift action_25
+action_507 (117#) = happyShift action_26
+action_507 (118#) = happyShift action_27
+action_507 (119#) = happyShift action_28
+action_507 (120#) = happyShift action_29
+action_507 (121#) = happyShift action_30
+action_507 (122#) = happyShift action_31
+action_507 (123#) = happyShift action_32
+action_507 (124#) = happyShift action_33
+action_507 (128#) = happyShift action_34
+action_507 (131#) = happyShift action_35
+action_507 (134#) = happyShift action_36
+action_507 (137#) = happyShift action_37
+action_507 (142#) = happyShift action_38
+action_507 (153#) = happyShift action_39
+action_507 (154#) = happyShift action_40
+action_507 (158#) = happyShift action_41
+action_507 (159#) = happyShift action_42
+action_507 (164#) = happyShift action_43
+action_507 (167#) = happyShift action_44
+action_507 (170#) = happyShift action_6
+action_507 (171#) = happyShift action_45
+action_507 (172#) = happyShift action_46
+action_507 (173#) = happyShift action_47
+action_507 (174#) = happyShift action_48
+action_507 (8#) = happyGoto action_7
+action_507 (9#) = happyGoto action_8
+action_507 (10#) = happyGoto action_9
+action_507 (11#) = happyGoto action_10
+action_507 (12#) = happyGoto action_11
+action_507 (58#) = happyGoto action_12
+action_507 (59#) = happyGoto action_13
+action_507 (60#) = happyGoto action_14
+action_507 (61#) = happyGoto action_15
+action_507 (62#) = happyGoto action_16
+action_507 (63#) = happyGoto action_513
+action_507 (64#) = happyGoto action_18
+action_507 (72#) = happyGoto action_19
+action_507 (77#) = happyGoto action_20
+action_507 x = happyTcHack x happyFail
+
+action_508 (170#) = happyShift action_6
+action_508 (8#) = happyGoto action_512
+action_508 x = happyTcHack x happyFail
+
+action_509 (101#) = happyShift action_511
+action_509 x = happyTcHack x happyReduce_30
+
+action_510 x = happyTcHack x happyReduce_29
+
+action_511 (148#) = happyShift action_382
+action_511 (28#) = happyGoto action_530
+action_511 x = happyTcHack x happyReduce_55
+
+action_512 (169#) = happyShift action_529
+action_512 x = happyTcHack x happyFail
+
+action_513 (99#) = happyShift action_528
+action_513 x = happyTcHack x happyFail
+
+action_514 x = happyTcHack x happyReduce_92
+
+action_515 x = happyTcHack x happyReduce_106
+
+action_516 (99#) = happyShift action_527
+action_516 x = happyTcHack x happyFail
+
+action_517 (25#) = happyGoto action_526
+action_517 x = happyTcHack x happyReduce_48
+
+action_518 (148#) = happyShift action_382
+action_518 (28#) = happyGoto action_525
+action_518 x = happyTcHack x happyReduce_55
+
+action_519 (112#) = happyShift action_524
+action_519 x = happyTcHack x happyFail
+
+action_520 (110#) = happyShift action_523
+action_520 x = happyTcHack x happyReduce_18
+
+action_521 (169#) = happyShift action_522
+action_521 x = happyTcHack x happyFail
+
+action_522 x = happyTcHack x happyReduce_14
+
+action_523 (174#) = happyShift action_48
+action_523 (12#) = happyGoto action_519
+action_523 (16#) = happyGoto action_520
+action_523 (17#) = happyGoto action_535
+action_523 x = happyTcHack x happyReduce_17
+
+action_524 (174#) = happyShift action_48
+action_524 (12#) = happyGoto action_533
+action_524 (18#) = happyGoto action_534
+action_524 x = happyTcHack x happyFail
+
+action_525 (167#) = happyShift action_532
+action_525 x = happyTcHack x happyFail
+
+action_526 (129#) = happyShift action_210
+action_526 (131#) = happyShift action_211
+action_526 (132#) = happyShift action_212
+action_526 (133#) = happyShift action_213
+action_526 (135#) = happyShift action_214
+action_526 (143#) = happyShift action_215
+action_526 (144#) = happyShift action_216
+action_526 (145#) = happyShift action_217
+action_526 (146#) = happyShift action_218
+action_526 (149#) = happyShift action_219
+action_526 (151#) = happyShift action_220
+action_526 (152#) = happyShift action_221
+action_526 (153#) = happyShift action_222
+action_526 (155#) = happyShift action_223
+action_526 (160#) = happyShift action_224
+action_526 (161#) = happyShift action_225
+action_526 (163#) = happyShift action_226
+action_526 (169#) = happyShift action_531
+action_526 (35#) = happyGoto action_209
+action_526 x = happyTcHack x happyFail
+
+action_527 x = happyTcHack x happyReduce_59
+
+action_528 x = happyTcHack x happyReduce_260
+
+action_529 x = happyTcHack x happyReduce_97
+
+action_530 x = happyTcHack x happyReduce_31
+
+action_531 x = happyTcHack x happyReduce_43
+
+action_532 (25#) = happyGoto action_537
+action_532 x = happyTcHack x happyReduce_48
+
+action_533 (19#) = happyGoto action_536
+action_533 x = happyTcHack x happyReduce_21
+
+action_534 x = happyTcHack x happyReduce_16
+
+action_535 x = happyTcHack x happyReduce_19
+
+action_536 (98#) = happyShift action_540
+action_536 (20#) = happyGoto action_539
+action_536 x = happyTcHack x happyReduce_20
+
+action_537 (129#) = happyShift action_210
+action_537 (131#) = happyShift action_211
+action_537 (132#) = happyShift action_212
+action_537 (133#) = happyShift action_213
+action_537 (135#) = happyShift action_214
+action_537 (143#) = happyShift action_215
+action_537 (144#) = happyShift action_216
+action_537 (145#) = happyShift action_217
+action_537 (146#) = happyShift action_218
+action_537 (149#) = happyShift action_219
+action_537 (151#) = happyShift action_220
+action_537 (152#) = happyShift action_221
+action_537 (153#) = happyShift action_222
+action_537 (155#) = happyShift action_223
+action_537 (160#) = happyShift action_224
+action_537 (161#) = happyShift action_225
+action_537 (163#) = happyShift action_226
+action_537 (169#) = happyShift action_538
+action_537 (35#) = happyGoto action_209
+action_537 x = happyTcHack x happyFail
+
+action_538 x = happyTcHack x happyReduce_45
+
+action_539 x = happyTcHack x happyReduce_22
+
+action_540 (161#) = happyShift action_541
+action_540 x = happyTcHack x happyFail
+
+action_541 (137#) = happyShift action_542
+action_541 (150#) = happyShift action_543
+action_541 x = happyTcHack x happyFail
+
+action_542 (98#) = happyShift action_408
+action_542 (174#) = happyShift action_48
+action_542 (12#) = happyGoto action_406
+action_542 (29#) = happyGoto action_545
+action_542 x = happyTcHack x happyFail
+
+action_543 (98#) = happyShift action_408
+action_543 (174#) = happyShift action_48
+action_543 (12#) = happyGoto action_406
+action_543 (29#) = happyGoto action_544
+action_543 x = happyTcHack x happyFail
+
+action_544 (99#) = happyShift action_547
+action_544 x = happyTcHack x happyFail
+
+action_545 (99#) = happyShift action_546
+action_545 x = happyTcHack x happyFail
+
+action_546 x = happyTcHack x happyReduce_23
+
+action_547 x = happyTcHack x happyReduce_24
+
+happyReduce_5 = happySpecReduce_1 8# happyReduction_5
+happyReduction_5 (HappyTerminal (PT _ (TI happy_var_1)))
+ = HappyAbsSyn8
+ ((read (BS.unpack happy_var_1)) :: Integer
+ )
+happyReduction_5 _ = notHappyAtAll
+
+happyReduce_6 = happySpecReduce_1 9# happyReduction_6
+happyReduction_6 (HappyTerminal (PT _ (TL happy_var_1)))
+ = HappyAbsSyn9
+ (BS.unpack happy_var_1
+ )
+happyReduction_6 _ = notHappyAtAll
+
+happyReduce_7 = happySpecReduce_1 10# happyReduction_7
+happyReduction_7 (HappyTerminal (PT _ (TD happy_var_1)))
+ = HappyAbsSyn10
+ ((read (BS.unpack happy_var_1)) :: Double
+ )
+happyReduction_7 _ = notHappyAtAll
+
+happyReduce_8 = happySpecReduce_1 11# happyReduction_8
+happyReduction_8 (HappyTerminal (PT _ (T_LString happy_var_1)))
+ = HappyAbsSyn11
+ (LString (happy_var_1)
+ )
+happyReduction_8 _ = notHappyAtAll
+
+happyReduce_9 = happySpecReduce_1 12# happyReduction_9
+happyReduction_9 (HappyTerminal happy_var_1)
+ = HappyAbsSyn12
+ (PIdent (mkPosToken happy_var_1)
+ )
+happyReduction_9 _ = notHappyAtAll
+
+happyReduce_10 = happySpecReduce_1 13# happyReduction_10
+happyReduction_10 (HappyAbsSyn14 happy_var_1)
+ = HappyAbsSyn13
+ (Gr (reverse happy_var_1)
+ )
+happyReduction_10 _ = notHappyAtAll
+
+happyReduce_11 = happySpecReduce_0 14# happyReduction_11
+happyReduction_11 = HappyAbsSyn14
+ ([]
+ )
+
+happyReduce_12 = happySpecReduce_2 14# happyReduction_12
+happyReduction_12 (HappyAbsSyn15 happy_var_2)
+ (HappyAbsSyn14 happy_var_1)
+ = HappyAbsSyn14
+ (flip (:) happy_var_1 happy_var_2
+ )
+happyReduction_12 _ _ = notHappyAtAll
+
+happyReduce_13 = happySpecReduce_2 15# happyReduction_13
+happyReduction_13 _
+ (HappyAbsSyn15 happy_var_1)
+ = HappyAbsSyn15
+ (happy_var_1
+ )
+happyReduction_13 _ _ = notHappyAtAll
+
+happyReduce_14 = happyReduce 10# 15# happyReduction_14
+happyReduction_14 (_ `HappyStk`
+ (HappyAbsSyn17 happy_var_9) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_7) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn15
+ (MMain happy_var_2 happy_var_7 happy_var_9
+ ) `HappyStk` happyRest
+
+happyReduce_15 = happyReduce 4# 15# happyReduction_15
+happyReduction_15 ((HappyAbsSyn22 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn23 happy_var_2) `HappyStk`
+ (HappyAbsSyn30 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn15
+ (MModule happy_var_1 happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_16 = happySpecReduce_3 16# happyReduction_16
+happyReduction_16 (HappyAbsSyn18 happy_var_3)
+ _
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn16
+ (ConcSpec happy_var_1 happy_var_3
+ )
+happyReduction_16 _ _ _ = notHappyAtAll
+
+happyReduce_17 = happySpecReduce_0 17# happyReduction_17
+happyReduction_17 = HappyAbsSyn17
+ ([]
+ )
+
+happyReduce_18 = happySpecReduce_1 17# happyReduction_18
+happyReduction_18 (HappyAbsSyn16 happy_var_1)
+ = HappyAbsSyn17
+ ((:[]) happy_var_1
+ )
+happyReduction_18 _ = notHappyAtAll
+
+happyReduce_19 = happySpecReduce_3 17# happyReduction_19
+happyReduction_19 (HappyAbsSyn17 happy_var_3)
+ _
+ (HappyAbsSyn16 happy_var_1)
+ = HappyAbsSyn17
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_19 _ _ _ = notHappyAtAll
+
+happyReduce_20 = happySpecReduce_2 18# happyReduction_20
+happyReduction_20 (HappyAbsSyn19 happy_var_2)
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn18
+ (ConcExp happy_var_1 (reverse happy_var_2)
+ )
+happyReduction_20 _ _ = notHappyAtAll
+
+happyReduce_21 = happySpecReduce_0 19# happyReduction_21
+happyReduction_21 = HappyAbsSyn19
+ ([]
+ )
+
+happyReduce_22 = happySpecReduce_2 19# happyReduction_22
+happyReduction_22 (HappyAbsSyn20 happy_var_2)
+ (HappyAbsSyn19 happy_var_1)
+ = HappyAbsSyn19
+ (flip (:) happy_var_1 happy_var_2
+ )
+happyReduction_22 _ _ = notHappyAtAll
+
+happyReduce_23 = happyReduce 5# 20# happyReduction_23
+happyReduction_23 (_ `HappyStk`
+ (HappyAbsSyn29 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn20
+ (TransferIn happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_24 = happyReduce 5# 20# happyReduction_24
+happyReduction_24 (_ `HappyStk`
+ (HappyAbsSyn29 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn20
+ (TransferOut happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_25 = happyReduce 4# 21# happyReduction_25
+happyReduction_25 ((HappyAbsSyn22 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn23 happy_var_2) `HappyStk`
+ (HappyAbsSyn30 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn15
+ (MModule happy_var_1 happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_26 = happySpecReduce_2 22# happyReduction_26
+happyReduction_26 (HappyAbsSyn28 happy_var_2)
+ (HappyAbsSyn26 happy_var_1)
+ = HappyAbsSyn22
+ (MBody happy_var_1 happy_var_2 []
+ )
+happyReduction_26 _ _ = notHappyAtAll
+
+happyReduce_27 = happySpecReduce_1 22# happyReduction_27
+happyReduction_27 (HappyAbsSyn32 happy_var_1)
+ = HappyAbsSyn22
+ (MNoBody happy_var_1
+ )
+happyReduction_27 _ = notHappyAtAll
+
+happyReduce_28 = happySpecReduce_3 22# happyReduction_28
+happyReduction_28 (HappyAbsSyn27 happy_var_3)
+ _
+ (HappyAbsSyn33 happy_var_1)
+ = HappyAbsSyn22
+ (MWith happy_var_1 happy_var_3
+ )
+happyReduction_28 _ _ _ = notHappyAtAll
+
+happyReduce_29 = happyReduce 5# 22# happyReduction_29
+happyReduction_29 ((HappyAbsSyn28 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn27 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn33 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn22
+ (MWithBody happy_var_1 happy_var_3 happy_var_5 []
+ ) `HappyStk` happyRest
+
+happyReduce_30 = happyReduce 5# 22# happyReduction_30
+happyReduction_30 ((HappyAbsSyn27 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn33 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn32 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn22
+ (MWithE happy_var_1 happy_var_3 happy_var_5
+ ) `HappyStk` happyRest
+
+happyReduce_31 = happyReduce 7# 22# happyReduction_31
+happyReduction_31 ((HappyAbsSyn28 happy_var_7) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn27 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn33 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn32 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn22
+ (MWithEBody happy_var_1 happy_var_3 happy_var_5 happy_var_7 []
+ ) `HappyStk` happyRest
+
+happyReduce_32 = happySpecReduce_2 22# happyReduction_32
+happyReduction_32 (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn22
+ (MReuse happy_var_2
+ )
+happyReduction_32 _ _ = notHappyAtAll
+
+happyReduce_33 = happySpecReduce_2 22# happyReduction_33
+happyReduction_33 (HappyAbsSyn32 happy_var_2)
+ _
+ = HappyAbsSyn22
+ (MUnion happy_var_2
+ )
+happyReduction_33 _ _ = notHappyAtAll
+
+happyReduce_34 = happySpecReduce_2 23# happyReduction_34
+happyReduction_34 (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn23
+ (MTAbstract happy_var_2
+ )
+happyReduction_34 _ _ = notHappyAtAll
+
+happyReduce_35 = happySpecReduce_2 23# happyReduction_35
+happyReduction_35 (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn23
+ (MTResource happy_var_2
+ )
+happyReduction_35 _ _ = notHappyAtAll
+
+happyReduce_36 = happySpecReduce_2 23# happyReduction_36
+happyReduction_36 (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn23
+ (MTInterface happy_var_2
+ )
+happyReduction_36 _ _ = notHappyAtAll
+
+happyReduce_37 = happyReduce 4# 23# happyReduction_37
+happyReduction_37 ((HappyAbsSyn12 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn23
+ (MTConcrete happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_38 = happyReduce 4# 23# happyReduction_38
+happyReduction_38 ((HappyAbsSyn12 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn23
+ (MTInstance happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_39 = happyReduce 6# 23# happyReduction_39
+happyReduction_39 ((HappyAbsSyn29 happy_var_6) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn29 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn23
+ (MTTransfer happy_var_2 happy_var_4 happy_var_6
+ ) `HappyStk` happyRest
+
+happyReduce_40 = happyReduce 5# 24# happyReduction_40
+happyReduction_40 (_ `HappyStk`
+ (HappyAbsSyn25 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn28 happy_var_2) `HappyStk`
+ (HappyAbsSyn26 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn22
+ (MBody happy_var_1 happy_var_2 (reverse happy_var_4)
+ ) `HappyStk` happyRest
+
+happyReduce_41 = happySpecReduce_1 24# happyReduction_41
+happyReduction_41 (HappyAbsSyn32 happy_var_1)
+ = HappyAbsSyn22
+ (MNoBody happy_var_1
+ )
+happyReduction_41 _ = notHappyAtAll
+
+happyReduce_42 = happySpecReduce_3 24# happyReduction_42
+happyReduction_42 (HappyAbsSyn27 happy_var_3)
+ _
+ (HappyAbsSyn33 happy_var_1)
+ = HappyAbsSyn22
+ (MWith happy_var_1 happy_var_3
+ )
+happyReduction_42 _ _ _ = notHappyAtAll
+
+happyReduce_43 = happyReduce 8# 24# happyReduction_43
+happyReduction_43 (_ `HappyStk`
+ (HappyAbsSyn25 happy_var_7) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn28 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn27 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn33 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn22
+ (MWithBody happy_var_1 happy_var_3 happy_var_5 (reverse happy_var_7)
+ ) `HappyStk` happyRest
+
+happyReduce_44 = happyReduce 5# 24# happyReduction_44
+happyReduction_44 ((HappyAbsSyn27 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn33 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn32 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn22
+ (MWithE happy_var_1 happy_var_3 happy_var_5
+ ) `HappyStk` happyRest
+
+happyReduce_45 = happyReduce 10# 24# happyReduction_45
+happyReduction_45 (_ `HappyStk`
+ (HappyAbsSyn25 happy_var_9) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn28 happy_var_7) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn27 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn33 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn32 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn22
+ (MWithEBody happy_var_1 happy_var_3 happy_var_5 happy_var_7 (reverse happy_var_9)
+ ) `HappyStk` happyRest
+
+happyReduce_46 = happySpecReduce_2 24# happyReduction_46
+happyReduction_46 (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn22
+ (MReuse happy_var_2
+ )
+happyReduction_46 _ _ = notHappyAtAll
+
+happyReduce_47 = happySpecReduce_2 24# happyReduction_47
+happyReduction_47 (HappyAbsSyn32 happy_var_2)
+ _
+ = HappyAbsSyn22
+ (MUnion happy_var_2
+ )
+happyReduction_47 _ _ = notHappyAtAll
+
+happyReduce_48 = happySpecReduce_0 25# happyReduction_48
+happyReduction_48 = HappyAbsSyn25
+ ([]
+ )
+
+happyReduce_49 = happySpecReduce_2 25# happyReduction_49
+happyReduction_49 (HappyAbsSyn35 happy_var_2)
+ (HappyAbsSyn25 happy_var_1)
+ = HappyAbsSyn25
+ (flip (:) happy_var_1 happy_var_2
+ )
+happyReduction_49 _ _ = notHappyAtAll
+
+happyReduce_50 = happySpecReduce_2 26# happyReduction_50
+happyReduction_50 _
+ (HappyAbsSyn32 happy_var_1)
+ = HappyAbsSyn26
+ (Ext happy_var_1
+ )
+happyReduction_50 _ _ = notHappyAtAll
+
+happyReduce_51 = happySpecReduce_0 26# happyReduction_51
+happyReduction_51 = HappyAbsSyn26
+ (NoExt
+ )
+
+happyReduce_52 = happySpecReduce_0 27# happyReduction_52
+happyReduction_52 = HappyAbsSyn27
+ ([]
+ )
+
+happyReduce_53 = happySpecReduce_1 27# happyReduction_53
+happyReduction_53 (HappyAbsSyn29 happy_var_1)
+ = HappyAbsSyn27
+ ((:[]) happy_var_1
+ )
+happyReduction_53 _ = notHappyAtAll
+
+happyReduce_54 = happySpecReduce_3 27# happyReduction_54
+happyReduction_54 (HappyAbsSyn27 happy_var_3)
+ _
+ (HappyAbsSyn29 happy_var_1)
+ = HappyAbsSyn27
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_54 _ _ _ = notHappyAtAll
+
+happyReduce_55 = happySpecReduce_0 28# happyReduction_55
+happyReduction_55 = HappyAbsSyn28
+ (NoOpens
+ )
+
+happyReduce_56 = happySpecReduce_3 28# happyReduction_56
+happyReduction_56 _
+ (HappyAbsSyn27 happy_var_2)
+ _
+ = HappyAbsSyn28
+ (OpenIn happy_var_2
+ )
+happyReduction_56 _ _ _ = notHappyAtAll
+
+happyReduce_57 = happySpecReduce_1 29# happyReduction_57
+happyReduction_57 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn29
+ (OName happy_var_1
+ )
+happyReduction_57 _ = notHappyAtAll
+
+happyReduce_58 = happyReduce 4# 29# happyReduction_58
+happyReduction_58 (_ `HappyStk`
+ (HappyAbsSyn12 happy_var_3) `HappyStk`
+ (HappyAbsSyn31 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn29
+ (OQualQO happy_var_2 happy_var_3
+ ) `HappyStk` happyRest
+
+happyReduce_59 = happyReduce 6# 29# happyReduction_59
+happyReduction_59 (_ `HappyStk`
+ (HappyAbsSyn12 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_3) `HappyStk`
+ (HappyAbsSyn31 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn29
+ (OQual happy_var_2 happy_var_3 happy_var_5
+ ) `HappyStk` happyRest
+
+happyReduce_60 = happySpecReduce_0 30# happyReduction_60
+happyReduction_60 = HappyAbsSyn30
+ (CMCompl
+ )
+
+happyReduce_61 = happySpecReduce_1 30# happyReduction_61
+happyReduction_61 _
+ = HappyAbsSyn30
+ (CMIncompl
+ )
+
+happyReduce_62 = happySpecReduce_0 31# happyReduction_62
+happyReduction_62 = HappyAbsSyn31
+ (QOCompl
+ )
+
+happyReduce_63 = happySpecReduce_1 31# happyReduction_63
+happyReduction_63 _
+ = HappyAbsSyn31
+ (QOIncompl
+ )
+
+happyReduce_64 = happySpecReduce_1 31# happyReduction_64
+happyReduction_64 _
+ = HappyAbsSyn31
+ (QOInterface
+ )
+
+happyReduce_65 = happySpecReduce_0 32# happyReduction_65
+happyReduction_65 = HappyAbsSyn32
+ ([]
+ )
+
+happyReduce_66 = happySpecReduce_1 32# happyReduction_66
+happyReduction_66 (HappyAbsSyn33 happy_var_1)
+ = HappyAbsSyn32
+ ((:[]) happy_var_1
+ )
+happyReduction_66 _ = notHappyAtAll
+
+happyReduce_67 = happySpecReduce_3 32# happyReduction_67
+happyReduction_67 (HappyAbsSyn32 happy_var_3)
+ _
+ (HappyAbsSyn33 happy_var_1)
+ = HappyAbsSyn32
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_67 _ _ _ = notHappyAtAll
+
+happyReduce_68 = happySpecReduce_1 33# happyReduction_68
+happyReduction_68 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn33
+ (IAll happy_var_1
+ )
+happyReduction_68 _ = notHappyAtAll
+
+happyReduce_69 = happyReduce 4# 33# happyReduction_69
+happyReduction_69 (_ `HappyStk`
+ (HappyAbsSyn53 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn33
+ (ISome happy_var_1 happy_var_3
+ ) `HappyStk` happyRest
+
+happyReduce_70 = happyReduce 5# 33# happyReduction_70
+happyReduction_70 (_ `HappyStk`
+ (HappyAbsSyn53 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn33
+ (IMinus happy_var_1 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_71 = happySpecReduce_3 34# happyReduction_71
+happyReduction_71 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn55 happy_var_1)
+ = HappyAbsSyn34
+ (DDecl happy_var_1 happy_var_3
+ )
+happyReduction_71 _ _ _ = notHappyAtAll
+
+happyReduce_72 = happySpecReduce_3 34# happyReduction_72
+happyReduction_72 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn55 happy_var_1)
+ = HappyAbsSyn34
+ (DDef happy_var_1 happy_var_3
+ )
+happyReduction_72 _ _ _ = notHappyAtAll
+
+happyReduce_73 = happyReduce 4# 34# happyReduction_73
+happyReduction_73 ((HappyAbsSyn58 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn74 happy_var_2) `HappyStk`
+ (HappyAbsSyn54 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn34
+ (DPatt happy_var_1 happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_74 = happyReduce 5# 34# happyReduction_74
+happyReduction_74 ((HappyAbsSyn58 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn58 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn55 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn34
+ (DFull happy_var_1 happy_var_3 happy_var_5
+ ) `HappyStk` happyRest
+
+happyReduce_75 = happySpecReduce_2 35# happyReduction_75
+happyReduction_75 (HappyAbsSyn46 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefCat happy_var_2
+ )
+happyReduction_75 _ _ = notHappyAtAll
+
+happyReduce_76 = happySpecReduce_2 35# happyReduction_76
+happyReduction_76 (HappyAbsSyn47 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefFun happy_var_2
+ )
+happyReduction_76 _ _ = notHappyAtAll
+
+happyReduce_77 = happySpecReduce_2 35# happyReduction_77
+happyReduction_77 (HappyAbsSyn47 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefFunData happy_var_2
+ )
+happyReduction_77 _ _ = notHappyAtAll
+
+happyReduce_78 = happySpecReduce_2 35# happyReduction_78
+happyReduction_78 (HappyAbsSyn45 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefDef happy_var_2
+ )
+happyReduction_78 _ _ = notHappyAtAll
+
+happyReduce_79 = happySpecReduce_2 35# happyReduction_79
+happyReduction_79 (HappyAbsSyn48 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefData happy_var_2
+ )
+happyReduction_79 _ _ = notHappyAtAll
+
+happyReduce_80 = happySpecReduce_2 35# happyReduction_80
+happyReduction_80 (HappyAbsSyn45 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefTrans happy_var_2
+ )
+happyReduction_80 _ _ = notHappyAtAll
+
+happyReduce_81 = happySpecReduce_2 35# happyReduction_81
+happyReduction_81 (HappyAbsSyn49 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefPar happy_var_2
+ )
+happyReduction_81 _ _ = notHappyAtAll
+
+happyReduce_82 = happySpecReduce_2 35# happyReduction_82
+happyReduction_82 (HappyAbsSyn45 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefOper happy_var_2
+ )
+happyReduction_82 _ _ = notHappyAtAll
+
+happyReduce_83 = happySpecReduce_2 35# happyReduction_83
+happyReduction_83 (HappyAbsSyn50 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefLincat happy_var_2
+ )
+happyReduction_83 _ _ = notHappyAtAll
+
+happyReduce_84 = happySpecReduce_2 35# happyReduction_84
+happyReduction_84 (HappyAbsSyn45 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefLindef happy_var_2
+ )
+happyReduction_84 _ _ = notHappyAtAll
+
+happyReduce_85 = happySpecReduce_2 35# happyReduction_85
+happyReduction_85 (HappyAbsSyn45 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefLin happy_var_2
+ )
+happyReduction_85 _ _ = notHappyAtAll
+
+happyReduce_86 = happySpecReduce_3 35# happyReduction_86
+happyReduction_86 (HappyAbsSyn50 happy_var_3)
+ _
+ _
+ = HappyAbsSyn35
+ (DefPrintCat happy_var_3
+ )
+happyReduction_86 _ _ _ = notHappyAtAll
+
+happyReduce_87 = happySpecReduce_3 35# happyReduction_87
+happyReduction_87 (HappyAbsSyn50 happy_var_3)
+ _
+ _
+ = HappyAbsSyn35
+ (DefPrintFun happy_var_3
+ )
+happyReduction_87 _ _ _ = notHappyAtAll
+
+happyReduce_88 = happySpecReduce_2 35# happyReduction_88
+happyReduction_88 (HappyAbsSyn51 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefFlag happy_var_2
+ )
+happyReduction_88 _ _ = notHappyAtAll
+
+happyReduce_89 = happySpecReduce_2 35# happyReduction_89
+happyReduction_89 (HappyAbsSyn50 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefPrintOld happy_var_2
+ )
+happyReduction_89 _ _ = notHappyAtAll
+
+happyReduce_90 = happySpecReduce_2 35# happyReduction_90
+happyReduction_90 (HappyAbsSyn45 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefLintype happy_var_2
+ )
+happyReduction_90 _ _ = notHappyAtAll
+
+happyReduce_91 = happySpecReduce_2 35# happyReduction_91
+happyReduction_91 (HappyAbsSyn45 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefPattern happy_var_2
+ )
+happyReduction_91 _ _ = notHappyAtAll
+
+happyReduce_92 = happyReduce 7# 35# happyReduction_92
+happyReduction_92 (_ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn25 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn35
+ (DefPackage happy_var_2 (reverse happy_var_5)
+ ) `HappyStk` happyRest
+
+happyReduce_93 = happySpecReduce_2 35# happyReduction_93
+happyReduction_93 (HappyAbsSyn45 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefVars happy_var_2
+ )
+happyReduction_93 _ _ = notHappyAtAll
+
+happyReduce_94 = happySpecReduce_3 35# happyReduction_94
+happyReduction_94 _
+ (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn35
+ (DefTokenizer happy_var_2
+ )
+happyReduction_94 _ _ _ = notHappyAtAll
+
+happyReduce_95 = happySpecReduce_2 36# happyReduction_95
+happyReduction_95 (HappyAbsSyn89 happy_var_2)
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn36
+ (SimpleCatDef happy_var_1 (reverse happy_var_2)
+ )
+happyReduction_95 _ _ = notHappyAtAll
+
+happyReduce_96 = happyReduce 4# 36# happyReduction_96
+happyReduction_96 (_ `HappyStk`
+ (HappyAbsSyn89 happy_var_3) `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn36
+ (ListCatDef happy_var_2 (reverse happy_var_3)
+ ) `HappyStk` happyRest
+
+happyReduce_97 = happyReduce 7# 36# happyReduction_97
+happyReduction_97 (_ `HappyStk`
+ (HappyAbsSyn8 happy_var_6) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn89 happy_var_3) `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn36
+ (ListSizeCatDef happy_var_2 (reverse happy_var_3) happy_var_6
+ ) `HappyStk` happyRest
+
+happyReduce_98 = happySpecReduce_3 37# happyReduction_98
+happyReduction_98 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn53 happy_var_1)
+ = HappyAbsSyn37
+ (FunDef happy_var_1 happy_var_3
+ )
+happyReduction_98 _ _ _ = notHappyAtAll
+
+happyReduce_99 = happySpecReduce_3 38# happyReduction_99
+happyReduction_99 (HappyAbsSyn40 happy_var_3)
+ _
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn38
+ (DataDef happy_var_1 happy_var_3
+ )
+happyReduction_99 _ _ _ = notHappyAtAll
+
+happyReduce_100 = happySpecReduce_1 39# happyReduction_100
+happyReduction_100 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn39
+ (DataId happy_var_1
+ )
+happyReduction_100 _ = notHappyAtAll
+
+happyReduce_101 = happySpecReduce_3 39# happyReduction_101
+happyReduction_101 (HappyAbsSyn12 happy_var_3)
+ _
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn39
+ (DataQId happy_var_1 happy_var_3
+ )
+happyReduction_101 _ _ _ = notHappyAtAll
+
+happyReduce_102 = happySpecReduce_0 40# happyReduction_102
+happyReduction_102 = HappyAbsSyn40
+ ([]
+ )
+
+happyReduce_103 = happySpecReduce_1 40# happyReduction_103
+happyReduction_103 (HappyAbsSyn39 happy_var_1)
+ = HappyAbsSyn40
+ ((:[]) happy_var_1
+ )
+happyReduction_103 _ = notHappyAtAll
+
+happyReduce_104 = happySpecReduce_3 40# happyReduction_104
+happyReduction_104 (HappyAbsSyn40 happy_var_3)
+ _
+ (HappyAbsSyn39 happy_var_1)
+ = HappyAbsSyn40
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_104 _ _ _ = notHappyAtAll
+
+happyReduce_105 = happySpecReduce_3 41# happyReduction_105
+happyReduction_105 (HappyAbsSyn52 happy_var_3)
+ _
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn41
+ (ParDefDir happy_var_1 happy_var_3
+ )
+happyReduction_105 _ _ _ = notHappyAtAll
+
+happyReduce_106 = happyReduce 6# 41# happyReduction_106
+happyReduction_106 (_ `HappyStk`
+ (HappyAbsSyn12 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn41
+ (ParDefIndir happy_var_1 happy_var_5
+ ) `HappyStk` happyRest
+
+happyReduce_107 = happySpecReduce_1 41# happyReduction_107
+happyReduction_107 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn41
+ (ParDefAbs happy_var_1
+ )
+happyReduction_107 _ = notHappyAtAll
+
+happyReduce_108 = happySpecReduce_2 42# happyReduction_108
+happyReduction_108 (HappyAbsSyn89 happy_var_2)
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn42
+ (ParConstr happy_var_1 (reverse happy_var_2)
+ )
+happyReduction_108 _ _ = notHappyAtAll
+
+happyReduce_109 = happySpecReduce_3 43# happyReduction_109
+happyReduction_109 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn55 happy_var_1)
+ = HappyAbsSyn43
+ (PrintDef happy_var_1 happy_var_3
+ )
+happyReduction_109 _ _ _ = notHappyAtAll
+
+happyReduce_110 = happySpecReduce_3 44# happyReduction_110
+happyReduction_110 (HappyAbsSyn12 happy_var_3)
+ _
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn44
+ (FlagDef happy_var_1 happy_var_3
+ )
+happyReduction_110 _ _ _ = notHappyAtAll
+
+happyReduce_111 = happySpecReduce_2 45# happyReduction_111
+happyReduction_111 _
+ (HappyAbsSyn34 happy_var_1)
+ = HappyAbsSyn45
+ ((:[]) happy_var_1
+ )
+happyReduction_111 _ _ = notHappyAtAll
+
+happyReduce_112 = happySpecReduce_3 45# happyReduction_112
+happyReduction_112 (HappyAbsSyn45 happy_var_3)
+ _
+ (HappyAbsSyn34 happy_var_1)
+ = HappyAbsSyn45
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_112 _ _ _ = notHappyAtAll
+
+happyReduce_113 = happySpecReduce_2 46# happyReduction_113
+happyReduction_113 _
+ (HappyAbsSyn36 happy_var_1)
+ = HappyAbsSyn46
+ ((:[]) happy_var_1
+ )
+happyReduction_113 _ _ = notHappyAtAll
+
+happyReduce_114 = happySpecReduce_3 46# happyReduction_114
+happyReduction_114 (HappyAbsSyn46 happy_var_3)
+ _
+ (HappyAbsSyn36 happy_var_1)
+ = HappyAbsSyn46
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_114 _ _ _ = notHappyAtAll
+
+happyReduce_115 = happySpecReduce_2 47# happyReduction_115
+happyReduction_115 _
+ (HappyAbsSyn37 happy_var_1)
+ = HappyAbsSyn47
+ ((:[]) happy_var_1
+ )
+happyReduction_115 _ _ = notHappyAtAll
+
+happyReduce_116 = happySpecReduce_3 47# happyReduction_116
+happyReduction_116 (HappyAbsSyn47 happy_var_3)
+ _
+ (HappyAbsSyn37 happy_var_1)
+ = HappyAbsSyn47
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_116 _ _ _ = notHappyAtAll
+
+happyReduce_117 = happySpecReduce_2 48# happyReduction_117
+happyReduction_117 _
+ (HappyAbsSyn38 happy_var_1)
+ = HappyAbsSyn48
+ ((:[]) happy_var_1
+ )
+happyReduction_117 _ _ = notHappyAtAll
+
+happyReduce_118 = happySpecReduce_3 48# happyReduction_118
+happyReduction_118 (HappyAbsSyn48 happy_var_3)
+ _
+ (HappyAbsSyn38 happy_var_1)
+ = HappyAbsSyn48
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_118 _ _ _ = notHappyAtAll
+
+happyReduce_119 = happySpecReduce_2 49# happyReduction_119
+happyReduction_119 _
+ (HappyAbsSyn41 happy_var_1)
+ = HappyAbsSyn49
+ ((:[]) happy_var_1
+ )
+happyReduction_119 _ _ = notHappyAtAll
+
+happyReduce_120 = happySpecReduce_3 49# happyReduction_120
+happyReduction_120 (HappyAbsSyn49 happy_var_3)
+ _
+ (HappyAbsSyn41 happy_var_1)
+ = HappyAbsSyn49
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_120 _ _ _ = notHappyAtAll
+
+happyReduce_121 = happySpecReduce_2 50# happyReduction_121
+happyReduction_121 _
+ (HappyAbsSyn43 happy_var_1)
+ = HappyAbsSyn50
+ ((:[]) happy_var_1
+ )
+happyReduction_121 _ _ = notHappyAtAll
+
+happyReduce_122 = happySpecReduce_3 50# happyReduction_122
+happyReduction_122 (HappyAbsSyn50 happy_var_3)
+ _
+ (HappyAbsSyn43 happy_var_1)
+ = HappyAbsSyn50
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_122 _ _ _ = notHappyAtAll
+
+happyReduce_123 = happySpecReduce_2 51# happyReduction_123
+happyReduction_123 _
+ (HappyAbsSyn44 happy_var_1)
+ = HappyAbsSyn51
+ ((:[]) happy_var_1
+ )
+happyReduction_123 _ _ = notHappyAtAll
+
+happyReduce_124 = happySpecReduce_3 51# happyReduction_124
+happyReduction_124 (HappyAbsSyn51 happy_var_3)
+ _
+ (HappyAbsSyn44 happy_var_1)
+ = HappyAbsSyn51
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_124 _ _ _ = notHappyAtAll
+
+happyReduce_125 = happySpecReduce_0 52# happyReduction_125
+happyReduction_125 = HappyAbsSyn52
+ ([]
+ )
+
+happyReduce_126 = happySpecReduce_1 52# happyReduction_126
+happyReduction_126 (HappyAbsSyn42 happy_var_1)
+ = HappyAbsSyn52
+ ((:[]) happy_var_1
+ )
+happyReduction_126 _ = notHappyAtAll
+
+happyReduce_127 = happySpecReduce_3 52# happyReduction_127
+happyReduction_127 (HappyAbsSyn52 happy_var_3)
+ _
+ (HappyAbsSyn42 happy_var_1)
+ = HappyAbsSyn52
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_127 _ _ _ = notHappyAtAll
+
+happyReduce_128 = happySpecReduce_1 53# happyReduction_128
+happyReduction_128 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn53
+ ((:[]) happy_var_1
+ )
+happyReduction_128 _ = notHappyAtAll
+
+happyReduce_129 = happySpecReduce_3 53# happyReduction_129
+happyReduction_129 (HappyAbsSyn53 happy_var_3)
+ _
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn53
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_129 _ _ _ = notHappyAtAll
+
+happyReduce_130 = happySpecReduce_1 54# happyReduction_130
+happyReduction_130 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn54
+ (IdentName happy_var_1
+ )
+happyReduction_130 _ = notHappyAtAll
+
+happyReduce_131 = happySpecReduce_3 54# happyReduction_131
+happyReduction_131 _
+ (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn54
+ (ListName happy_var_2
+ )
+happyReduction_131 _ _ _ = notHappyAtAll
+
+happyReduce_132 = happySpecReduce_1 55# happyReduction_132
+happyReduction_132 (HappyAbsSyn54 happy_var_1)
+ = HappyAbsSyn55
+ ((:[]) happy_var_1
+ )
+happyReduction_132 _ = notHappyAtAll
+
+happyReduce_133 = happySpecReduce_3 55# happyReduction_133
+happyReduction_133 (HappyAbsSyn55 happy_var_3)
+ _
+ (HappyAbsSyn54 happy_var_1)
+ = HappyAbsSyn55
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_133 _ _ _ = notHappyAtAll
+
+happyReduce_134 = happySpecReduce_3 56# happyReduction_134
+happyReduction_134 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn53 happy_var_1)
+ = HappyAbsSyn56
+ (LDDecl happy_var_1 happy_var_3
+ )
+happyReduction_134 _ _ _ = notHappyAtAll
+
+happyReduce_135 = happySpecReduce_3 56# happyReduction_135
+happyReduction_135 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn53 happy_var_1)
+ = HappyAbsSyn56
+ (LDDef happy_var_1 happy_var_3
+ )
+happyReduction_135 _ _ _ = notHappyAtAll
+
+happyReduce_136 = happyReduce 5# 56# happyReduction_136
+happyReduction_136 ((HappyAbsSyn58 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn58 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn53 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn56
+ (LDFull happy_var_1 happy_var_3 happy_var_5
+ ) `HappyStk` happyRest
+
+happyReduce_137 = happySpecReduce_0 57# happyReduction_137
+happyReduction_137 = HappyAbsSyn57
+ ([]
+ )
+
+happyReduce_138 = happySpecReduce_1 57# happyReduction_138
+happyReduction_138 (HappyAbsSyn56 happy_var_1)
+ = HappyAbsSyn57
+ ((:[]) happy_var_1
+ )
+happyReduction_138 _ = notHappyAtAll
+
+happyReduce_139 = happySpecReduce_3 57# happyReduction_139
+happyReduction_139 (HappyAbsSyn57 happy_var_3)
+ _
+ (HappyAbsSyn56 happy_var_1)
+ = HappyAbsSyn57
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_139 _ _ _ = notHappyAtAll
+
+happyReduce_140 = happySpecReduce_1 58# happyReduction_140
+happyReduction_140 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn58
+ (EIdent happy_var_1
+ )
+happyReduction_140 _ = notHappyAtAll
+
+happyReduce_141 = happySpecReduce_3 58# happyReduction_141
+happyReduction_141 _
+ (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (EConstr happy_var_2
+ )
+happyReduction_141 _ _ _ = notHappyAtAll
+
+happyReduce_142 = happySpecReduce_3 58# happyReduction_142
+happyReduction_142 _
+ (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (ECons happy_var_2
+ )
+happyReduction_142 _ _ _ = notHappyAtAll
+
+happyReduce_143 = happySpecReduce_1 58# happyReduction_143
+happyReduction_143 (HappyAbsSyn72 happy_var_1)
+ = HappyAbsSyn58
+ (ESort happy_var_1
+ )
+happyReduction_143 _ = notHappyAtAll
+
+happyReduce_144 = happySpecReduce_1 58# happyReduction_144
+happyReduction_144 (HappyAbsSyn9 happy_var_1)
+ = HappyAbsSyn58
+ (EString happy_var_1
+ )
+happyReduction_144 _ = notHappyAtAll
+
+happyReduce_145 = happySpecReduce_1 58# happyReduction_145
+happyReduction_145 (HappyAbsSyn8 happy_var_1)
+ = HappyAbsSyn58
+ (EInt happy_var_1
+ )
+happyReduction_145 _ = notHappyAtAll
+
+happyReduce_146 = happySpecReduce_1 58# happyReduction_146
+happyReduction_146 (HappyAbsSyn10 happy_var_1)
+ = HappyAbsSyn58
+ (EFloat happy_var_1
+ )
+happyReduction_146 _ = notHappyAtAll
+
+happyReduce_147 = happySpecReduce_1 58# happyReduction_147
+happyReduction_147 _
+ = HappyAbsSyn58
+ (EMeta
+ )
+
+happyReduce_148 = happySpecReduce_2 58# happyReduction_148
+happyReduction_148 _
+ _
+ = HappyAbsSyn58
+ (EEmpty
+ )
+
+happyReduce_149 = happySpecReduce_1 58# happyReduction_149
+happyReduction_149 _
+ = HappyAbsSyn58
+ (EData
+ )
+
+happyReduce_150 = happyReduce 4# 58# happyReduction_150
+happyReduction_150 (_ `HappyStk`
+ (HappyAbsSyn66 happy_var_3) `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EList happy_var_2 happy_var_3
+ ) `HappyStk` happyRest
+
+happyReduce_151 = happySpecReduce_3 58# happyReduction_151
+happyReduction_151 _
+ (HappyAbsSyn9 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (EStrings happy_var_2
+ )
+happyReduction_151 _ _ _ = notHappyAtAll
+
+happyReduce_152 = happySpecReduce_3 58# happyReduction_152
+happyReduction_152 _
+ (HappyAbsSyn57 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (ERecord happy_var_2
+ )
+happyReduction_152 _ _ _ = notHappyAtAll
+
+happyReduce_153 = happySpecReduce_3 58# happyReduction_153
+happyReduction_153 _
+ (HappyAbsSyn80 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (ETuple happy_var_2
+ )
+happyReduction_153 _ _ _ = notHappyAtAll
+
+happyReduce_154 = happyReduce 4# 58# happyReduction_154
+happyReduction_154 (_ `HappyStk`
+ (HappyAbsSyn12 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EIndir happy_var_3
+ ) `HappyStk` happyRest
+
+happyReduce_155 = happyReduce 5# 58# happyReduction_155
+happyReduction_155 (_ `HappyStk`
+ (HappyAbsSyn58 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn58 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (ETyped happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_156 = happySpecReduce_3 58# happyReduction_156
+happyReduction_156 _
+ (HappyAbsSyn58 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (happy_var_2
+ )
+happyReduction_156 _ _ _ = notHappyAtAll
+
+happyReduce_157 = happySpecReduce_1 58# happyReduction_157
+happyReduction_157 (HappyAbsSyn11 happy_var_1)
+ = HappyAbsSyn58
+ (ELString happy_var_1
+ )
+happyReduction_157 _ = notHappyAtAll
+
+happyReduce_158 = happySpecReduce_3 59# happyReduction_158
+happyReduction_158 (HappyAbsSyn71 happy_var_3)
+ _
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (EProj happy_var_1 happy_var_3
+ )
+happyReduction_158 _ _ _ = notHappyAtAll
+
+happyReduce_159 = happyReduce 5# 59# happyReduction_159
+happyReduction_159 (_ `HappyStk`
+ (HappyAbsSyn12 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EQConstr happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_160 = happyReduce 4# 59# happyReduction_160
+happyReduction_160 ((HappyAbsSyn12 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EQCons happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_161 = happySpecReduce_1 59# happyReduction_161
+happyReduction_161 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (happy_var_1
+ )
+happyReduction_161 _ = notHappyAtAll
+
+happyReduce_162 = happySpecReduce_2 60# happyReduction_162
+happyReduction_162 (HappyAbsSyn58 happy_var_2)
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (EApp happy_var_1 happy_var_2
+ )
+happyReduction_162 _ _ = notHappyAtAll
+
+happyReduce_163 = happyReduce 4# 60# happyReduction_163
+happyReduction_163 (_ `HappyStk`
+ (HappyAbsSyn83 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (ETable happy_var_3
+ ) `HappyStk` happyRest
+
+happyReduce_164 = happyReduce 5# 60# happyReduction_164
+happyReduction_164 (_ `HappyStk`
+ (HappyAbsSyn83 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn58 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (ETTable happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_165 = happyReduce 5# 60# happyReduction_165
+happyReduction_165 (_ `HappyStk`
+ (HappyAbsSyn65 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn58 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EVTable happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_166 = happyReduce 6# 60# happyReduction_166
+happyReduction_166 (_ `HappyStk`
+ (HappyAbsSyn83 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn58 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (ECase happy_var_2 happy_var_5
+ ) `HappyStk` happyRest
+
+happyReduce_167 = happyReduce 4# 60# happyReduction_167
+happyReduction_167 (_ `HappyStk`
+ (HappyAbsSyn65 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EVariants happy_var_3
+ ) `HappyStk` happyRest
+
+happyReduce_168 = happyReduce 6# 60# happyReduction_168
+happyReduction_168 (_ `HappyStk`
+ (HappyAbsSyn87 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn58 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EPre happy_var_3 happy_var_5
+ ) `HappyStk` happyRest
+
+happyReduce_169 = happyReduce 4# 60# happyReduction_169
+happyReduction_169 (_ `HappyStk`
+ (HappyAbsSyn65 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EStrs happy_var_3
+ ) `HappyStk` happyRest
+
+happyReduce_170 = happySpecReduce_3 60# happyReduction_170
+happyReduction_170 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn58
+ (EConAt happy_var_1 happy_var_3
+ )
+happyReduction_170 _ _ _ = notHappyAtAll
+
+happyReduce_171 = happySpecReduce_2 60# happyReduction_171
+happyReduction_171 (HappyAbsSyn67 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (EPatt happy_var_2
+ )
+happyReduction_171 _ _ = notHappyAtAll
+
+happyReduce_172 = happySpecReduce_2 60# happyReduction_172
+happyReduction_172 (HappyAbsSyn58 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (EPattType happy_var_2
+ )
+happyReduction_172 _ _ = notHappyAtAll
+
+happyReduce_173 = happySpecReduce_1 60# happyReduction_173
+happyReduction_173 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (happy_var_1
+ )
+happyReduction_173 _ = notHappyAtAll
+
+happyReduce_174 = happySpecReduce_2 60# happyReduction_174
+happyReduction_174 (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (ELin happy_var_2
+ )
+happyReduction_174 _ _ = notHappyAtAll
+
+happyReduce_175 = happySpecReduce_3 61# happyReduction_175
+happyReduction_175 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (ESelect happy_var_1 happy_var_3
+ )
+happyReduction_175 _ _ _ = notHappyAtAll
+
+happyReduce_176 = happySpecReduce_3 61# happyReduction_176
+happyReduction_176 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (ETupTyp happy_var_1 happy_var_3
+ )
+happyReduction_176 _ _ _ = notHappyAtAll
+
+happyReduce_177 = happySpecReduce_3 61# happyReduction_177
+happyReduction_177 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (EExtend happy_var_1 happy_var_3
+ )
+happyReduction_177 _ _ _ = notHappyAtAll
+
+happyReduce_178 = happySpecReduce_1 61# happyReduction_178
+happyReduction_178 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (happy_var_1
+ )
+happyReduction_178 _ = notHappyAtAll
+
+happyReduce_179 = happySpecReduce_3 62# happyReduction_179
+happyReduction_179 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (EGlue happy_var_1 happy_var_3
+ )
+happyReduction_179 _ _ _ = notHappyAtAll
+
+happyReduce_180 = happySpecReduce_1 62# happyReduction_180
+happyReduction_180 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (happy_var_1
+ )
+happyReduction_180 _ = notHappyAtAll
+
+happyReduce_181 = happySpecReduce_3 63# happyReduction_181
+happyReduction_181 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (EConcat happy_var_1 happy_var_3
+ )
+happyReduction_181 _ _ _ = notHappyAtAll
+
+happyReduce_182 = happyReduce 4# 63# happyReduction_182
+happyReduction_182 ((HappyAbsSyn58 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn76 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EAbstr happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_183 = happyReduce 5# 63# happyReduction_183
+happyReduction_183 ((HappyAbsSyn58 happy_var_5) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn76 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (ECTable happy_var_3 happy_var_5
+ ) `HappyStk` happyRest
+
+happyReduce_184 = happySpecReduce_3 63# happyReduction_184
+happyReduction_184 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn77 happy_var_1)
+ = HappyAbsSyn58
+ (EProd happy_var_1 happy_var_3
+ )
+happyReduction_184 _ _ _ = notHappyAtAll
+
+happyReduce_185 = happySpecReduce_3 63# happyReduction_185
+happyReduction_185 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (ETType happy_var_1 happy_var_3
+ )
+happyReduction_185 _ _ _ = notHappyAtAll
+
+happyReduce_186 = happyReduce 6# 63# happyReduction_186
+happyReduction_186 ((HappyAbsSyn58 happy_var_6) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn57 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (ELet happy_var_3 happy_var_6
+ ) `HappyStk` happyRest
+
+happyReduce_187 = happyReduce 4# 63# happyReduction_187
+happyReduction_187 ((HappyAbsSyn58 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn57 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (ELetb happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_188 = happyReduce 5# 63# happyReduction_188
+happyReduction_188 (_ `HappyStk`
+ (HappyAbsSyn57 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn58 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EWhere happy_var_1 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_189 = happyReduce 4# 63# happyReduction_189
+happyReduction_189 (_ `HappyStk`
+ (HappyAbsSyn85 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn58
+ (EEqs happy_var_3
+ ) `HappyStk` happyRest
+
+happyReduce_190 = happySpecReduce_3 63# happyReduction_190
+happyReduction_190 (HappyAbsSyn9 happy_var_3)
+ (HappyAbsSyn58 happy_var_2)
+ _
+ = HappyAbsSyn58
+ (EExample happy_var_2 happy_var_3
+ )
+happyReduction_190 _ _ _ = notHappyAtAll
+
+happyReduce_191 = happySpecReduce_1 63# happyReduction_191
+happyReduction_191 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (happy_var_1
+ )
+happyReduction_191 _ = notHappyAtAll
+
+happyReduce_192 = happySpecReduce_1 64# happyReduction_192
+happyReduction_192 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn58
+ (happy_var_1
+ )
+happyReduction_192 _ = notHappyAtAll
+
+happyReduce_193 = happySpecReduce_0 65# happyReduction_193
+happyReduction_193 = HappyAbsSyn65
+ ([]
+ )
+
+happyReduce_194 = happySpecReduce_1 65# happyReduction_194
+happyReduction_194 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn65
+ ((:[]) happy_var_1
+ )
+happyReduction_194 _ = notHappyAtAll
+
+happyReduce_195 = happySpecReduce_3 65# happyReduction_195
+happyReduction_195 (HappyAbsSyn65 happy_var_3)
+ _
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn65
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_195 _ _ _ = notHappyAtAll
+
+happyReduce_196 = happySpecReduce_0 66# happyReduction_196
+happyReduction_196 = HappyAbsSyn66
+ (NilExp
+ )
+
+happyReduce_197 = happySpecReduce_2 66# happyReduction_197
+happyReduction_197 (HappyAbsSyn66 happy_var_2)
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn66
+ (ConsExp happy_var_1 happy_var_2
+ )
+happyReduction_197 _ _ = notHappyAtAll
+
+happyReduce_198 = happySpecReduce_1 67# happyReduction_198
+happyReduction_198 _
+ = HappyAbsSyn67
+ (PChar
+ )
+
+happyReduce_199 = happySpecReduce_3 67# happyReduction_199
+happyReduction_199 _
+ (HappyAbsSyn9 happy_var_2)
+ _
+ = HappyAbsSyn67
+ (PChars happy_var_2
+ )
+happyReduction_199 _ _ _ = notHappyAtAll
+
+happyReduce_200 = happySpecReduce_2 67# happyReduction_200
+happyReduction_200 (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn67
+ (PMacro happy_var_2
+ )
+happyReduction_200 _ _ = notHappyAtAll
+
+happyReduce_201 = happyReduce 4# 67# happyReduction_201
+happyReduction_201 ((HappyAbsSyn12 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn67
+ (PM happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_202 = happySpecReduce_1 67# happyReduction_202
+happyReduction_202 _
+ = HappyAbsSyn67
+ (PW
+ )
+
+happyReduce_203 = happySpecReduce_1 67# happyReduction_203
+happyReduction_203 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn67
+ (PV happy_var_1
+ )
+happyReduction_203 _ = notHappyAtAll
+
+happyReduce_204 = happySpecReduce_3 67# happyReduction_204
+happyReduction_204 _
+ (HappyAbsSyn12 happy_var_2)
+ _
+ = HappyAbsSyn67
+ (PCon happy_var_2
+ )
+happyReduction_204 _ _ _ = notHappyAtAll
+
+happyReduce_205 = happySpecReduce_3 67# happyReduction_205
+happyReduction_205 (HappyAbsSyn12 happy_var_3)
+ _
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn67
+ (PQ happy_var_1 happy_var_3
+ )
+happyReduction_205 _ _ _ = notHappyAtAll
+
+happyReduce_206 = happySpecReduce_1 67# happyReduction_206
+happyReduction_206 (HappyAbsSyn8 happy_var_1)
+ = HappyAbsSyn67
+ (PInt happy_var_1
+ )
+happyReduction_206 _ = notHappyAtAll
+
+happyReduce_207 = happySpecReduce_1 67# happyReduction_207
+happyReduction_207 (HappyAbsSyn10 happy_var_1)
+ = HappyAbsSyn67
+ (PFloat happy_var_1
+ )
+happyReduction_207 _ = notHappyAtAll
+
+happyReduce_208 = happySpecReduce_1 67# happyReduction_208
+happyReduction_208 (HappyAbsSyn9 happy_var_1)
+ = HappyAbsSyn67
+ (PStr happy_var_1
+ )
+happyReduction_208 _ = notHappyAtAll
+
+happyReduce_209 = happySpecReduce_3 67# happyReduction_209
+happyReduction_209 _
+ (HappyAbsSyn73 happy_var_2)
+ _
+ = HappyAbsSyn67
+ (PR happy_var_2
+ )
+happyReduction_209 _ _ _ = notHappyAtAll
+
+happyReduce_210 = happySpecReduce_3 67# happyReduction_210
+happyReduction_210 _
+ (HappyAbsSyn81 happy_var_2)
+ _
+ = HappyAbsSyn67
+ (PTup happy_var_2
+ )
+happyReduction_210 _ _ _ = notHappyAtAll
+
+happyReduce_211 = happySpecReduce_3 67# happyReduction_211
+happyReduction_211 _
+ (HappyAbsSyn67 happy_var_2)
+ _
+ = HappyAbsSyn67
+ (happy_var_2
+ )
+happyReduction_211 _ _ _ = notHappyAtAll
+
+happyReduce_212 = happySpecReduce_2 68# happyReduction_212
+happyReduction_212 (HappyAbsSyn74 happy_var_2)
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn67
+ (PC happy_var_1 happy_var_2
+ )
+happyReduction_212 _ _ = notHappyAtAll
+
+happyReduce_213 = happyReduce 4# 68# happyReduction_213
+happyReduction_213 ((HappyAbsSyn74 happy_var_4) `HappyStk`
+ (HappyAbsSyn12 happy_var_3) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn12 happy_var_1) `HappyStk`
+ happyRest)
+ = HappyAbsSyn67
+ (PQC happy_var_1 happy_var_3 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_214 = happySpecReduce_2 68# happyReduction_214
+happyReduction_214 _
+ (HappyAbsSyn67 happy_var_1)
+ = HappyAbsSyn67
+ (PRep happy_var_1
+ )
+happyReduction_214 _ _ = notHappyAtAll
+
+happyReduce_215 = happySpecReduce_3 68# happyReduction_215
+happyReduction_215 (HappyAbsSyn67 happy_var_3)
+ _
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn67
+ (PAs happy_var_1 happy_var_3
+ )
+happyReduction_215 _ _ _ = notHappyAtAll
+
+happyReduce_216 = happySpecReduce_2 68# happyReduction_216
+happyReduction_216 (HappyAbsSyn67 happy_var_2)
+ _
+ = HappyAbsSyn67
+ (PNeg happy_var_2
+ )
+happyReduction_216 _ _ = notHappyAtAll
+
+happyReduce_217 = happySpecReduce_1 68# happyReduction_217
+happyReduction_217 (HappyAbsSyn67 happy_var_1)
+ = HappyAbsSyn67
+ (happy_var_1
+ )
+happyReduction_217 _ = notHappyAtAll
+
+happyReduce_218 = happySpecReduce_3 69# happyReduction_218
+happyReduction_218 (HappyAbsSyn67 happy_var_3)
+ _
+ (HappyAbsSyn67 happy_var_1)
+ = HappyAbsSyn67
+ (PDisj happy_var_1 happy_var_3
+ )
+happyReduction_218 _ _ _ = notHappyAtAll
+
+happyReduce_219 = happySpecReduce_3 69# happyReduction_219
+happyReduction_219 (HappyAbsSyn67 happy_var_3)
+ _
+ (HappyAbsSyn67 happy_var_1)
+ = HappyAbsSyn67
+ (PSeq happy_var_1 happy_var_3
+ )
+happyReduction_219 _ _ _ = notHappyAtAll
+
+happyReduce_220 = happySpecReduce_1 69# happyReduction_220
+happyReduction_220 (HappyAbsSyn67 happy_var_1)
+ = HappyAbsSyn67
+ (happy_var_1
+ )
+happyReduction_220 _ = notHappyAtAll
+
+happyReduce_221 = happySpecReduce_3 70# happyReduction_221
+happyReduction_221 (HappyAbsSyn67 happy_var_3)
+ _
+ (HappyAbsSyn53 happy_var_1)
+ = HappyAbsSyn70
+ (PA happy_var_1 happy_var_3
+ )
+happyReduction_221 _ _ _ = notHappyAtAll
+
+happyReduce_222 = happySpecReduce_1 71# happyReduction_222
+happyReduction_222 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn71
+ (LIdent happy_var_1
+ )
+happyReduction_222 _ = notHappyAtAll
+
+happyReduce_223 = happySpecReduce_2 71# happyReduction_223
+happyReduction_223 (HappyAbsSyn8 happy_var_2)
+ _
+ = HappyAbsSyn71
+ (LVar happy_var_2
+ )
+happyReduction_223 _ _ = notHappyAtAll
+
+happyReduce_224 = happySpecReduce_1 72# happyReduction_224
+happyReduction_224 _
+ = HappyAbsSyn72
+ (Sort_Type
+ )
+
+happyReduce_225 = happySpecReduce_1 72# happyReduction_225
+happyReduction_225 _
+ = HappyAbsSyn72
+ (Sort_PType
+ )
+
+happyReduce_226 = happySpecReduce_1 72# happyReduction_226
+happyReduction_226 _
+ = HappyAbsSyn72
+ (Sort_Tok
+ )
+
+happyReduce_227 = happySpecReduce_1 72# happyReduction_227
+happyReduction_227 _
+ = HappyAbsSyn72
+ (Sort_Str
+ )
+
+happyReduce_228 = happySpecReduce_1 72# happyReduction_228
+happyReduction_228 _
+ = HappyAbsSyn72
+ (Sort_Strs
+ )
+
+happyReduce_229 = happySpecReduce_0 73# happyReduction_229
+happyReduction_229 = HappyAbsSyn73
+ ([]
+ )
+
+happyReduce_230 = happySpecReduce_1 73# happyReduction_230
+happyReduction_230 (HappyAbsSyn70 happy_var_1)
+ = HappyAbsSyn73
+ ((:[]) happy_var_1
+ )
+happyReduction_230 _ = notHappyAtAll
+
+happyReduce_231 = happySpecReduce_3 73# happyReduction_231
+happyReduction_231 (HappyAbsSyn73 happy_var_3)
+ _
+ (HappyAbsSyn70 happy_var_1)
+ = HappyAbsSyn73
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_231 _ _ _ = notHappyAtAll
+
+happyReduce_232 = happySpecReduce_1 74# happyReduction_232
+happyReduction_232 (HappyAbsSyn67 happy_var_1)
+ = HappyAbsSyn74
+ ((:[]) happy_var_1
+ )
+happyReduction_232 _ = notHappyAtAll
+
+happyReduce_233 = happySpecReduce_2 74# happyReduction_233
+happyReduction_233 (HappyAbsSyn74 happy_var_2)
+ (HappyAbsSyn67 happy_var_1)
+ = HappyAbsSyn74
+ ((:) happy_var_1 happy_var_2
+ )
+happyReduction_233 _ _ = notHappyAtAll
+
+happyReduce_234 = happySpecReduce_1 75# happyReduction_234
+happyReduction_234 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn75
+ (BIdent happy_var_1
+ )
+happyReduction_234 _ = notHappyAtAll
+
+happyReduce_235 = happySpecReduce_1 75# happyReduction_235
+happyReduction_235 _
+ = HappyAbsSyn75
+ (BWild
+ )
+
+happyReduce_236 = happySpecReduce_0 76# happyReduction_236
+happyReduction_236 = HappyAbsSyn76
+ ([]
+ )
+
+happyReduce_237 = happySpecReduce_1 76# happyReduction_237
+happyReduction_237 (HappyAbsSyn75 happy_var_1)
+ = HappyAbsSyn76
+ ((:[]) happy_var_1
+ )
+happyReduction_237 _ = notHappyAtAll
+
+happyReduce_238 = happySpecReduce_3 76# happyReduction_238
+happyReduction_238 (HappyAbsSyn76 happy_var_3)
+ _
+ (HappyAbsSyn75 happy_var_1)
+ = HappyAbsSyn76
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_238 _ _ _ = notHappyAtAll
+
+happyReduce_239 = happyReduce 5# 77# happyReduction_239
+happyReduction_239 (_ `HappyStk`
+ (HappyAbsSyn58 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn76 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn77
+ (DDec happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_240 = happySpecReduce_1 77# happyReduction_240
+happyReduction_240 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn77
+ (DExp happy_var_1
+ )
+happyReduction_240 _ = notHappyAtAll
+
+happyReduce_241 = happySpecReduce_1 78# happyReduction_241
+happyReduction_241 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn78
+ (TComp happy_var_1
+ )
+happyReduction_241 _ = notHappyAtAll
+
+happyReduce_242 = happySpecReduce_1 79# happyReduction_242
+happyReduction_242 (HappyAbsSyn67 happy_var_1)
+ = HappyAbsSyn79
+ (PTComp happy_var_1
+ )
+happyReduction_242 _ = notHappyAtAll
+
+happyReduce_243 = happySpecReduce_0 80# happyReduction_243
+happyReduction_243 = HappyAbsSyn80
+ ([]
+ )
+
+happyReduce_244 = happySpecReduce_1 80# happyReduction_244
+happyReduction_244 (HappyAbsSyn78 happy_var_1)
+ = HappyAbsSyn80
+ ((:[]) happy_var_1
+ )
+happyReduction_244 _ = notHappyAtAll
+
+happyReduce_245 = happySpecReduce_3 80# happyReduction_245
+happyReduction_245 (HappyAbsSyn80 happy_var_3)
+ _
+ (HappyAbsSyn78 happy_var_1)
+ = HappyAbsSyn80
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_245 _ _ _ = notHappyAtAll
+
+happyReduce_246 = happySpecReduce_0 81# happyReduction_246
+happyReduction_246 = HappyAbsSyn81
+ ([]
+ )
+
+happyReduce_247 = happySpecReduce_1 81# happyReduction_247
+happyReduction_247 (HappyAbsSyn79 happy_var_1)
+ = HappyAbsSyn81
+ ((:[]) happy_var_1
+ )
+happyReduction_247 _ = notHappyAtAll
+
+happyReduce_248 = happySpecReduce_3 81# happyReduction_248
+happyReduction_248 (HappyAbsSyn81 happy_var_3)
+ _
+ (HappyAbsSyn79 happy_var_1)
+ = HappyAbsSyn81
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_248 _ _ _ = notHappyAtAll
+
+happyReduce_249 = happySpecReduce_3 82# happyReduction_249
+happyReduction_249 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn67 happy_var_1)
+ = HappyAbsSyn82
+ (Case happy_var_1 happy_var_3
+ )
+happyReduction_249 _ _ _ = notHappyAtAll
+
+happyReduce_250 = happySpecReduce_1 83# happyReduction_250
+happyReduction_250 (HappyAbsSyn82 happy_var_1)
+ = HappyAbsSyn83
+ ((:[]) happy_var_1
+ )
+happyReduction_250 _ = notHappyAtAll
+
+happyReduce_251 = happySpecReduce_3 83# happyReduction_251
+happyReduction_251 (HappyAbsSyn83 happy_var_3)
+ _
+ (HappyAbsSyn82 happy_var_1)
+ = HappyAbsSyn83
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_251 _ _ _ = notHappyAtAll
+
+happyReduce_252 = happySpecReduce_3 84# happyReduction_252
+happyReduction_252 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn74 happy_var_1)
+ = HappyAbsSyn84
+ (Equ happy_var_1 happy_var_3
+ )
+happyReduction_252 _ _ _ = notHappyAtAll
+
+happyReduce_253 = happySpecReduce_0 85# happyReduction_253
+happyReduction_253 = HappyAbsSyn85
+ ([]
+ )
+
+happyReduce_254 = happySpecReduce_1 85# happyReduction_254
+happyReduction_254 (HappyAbsSyn84 happy_var_1)
+ = HappyAbsSyn85
+ ((:[]) happy_var_1
+ )
+happyReduction_254 _ = notHappyAtAll
+
+happyReduce_255 = happySpecReduce_3 85# happyReduction_255
+happyReduction_255 (HappyAbsSyn85 happy_var_3)
+ _
+ (HappyAbsSyn84 happy_var_1)
+ = HappyAbsSyn85
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_255 _ _ _ = notHappyAtAll
+
+happyReduce_256 = happySpecReduce_3 86# happyReduction_256
+happyReduction_256 (HappyAbsSyn58 happy_var_3)
+ _
+ (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn86
+ (Alt happy_var_1 happy_var_3
+ )
+happyReduction_256 _ _ _ = notHappyAtAll
+
+happyReduce_257 = happySpecReduce_0 87# happyReduction_257
+happyReduction_257 = HappyAbsSyn87
+ ([]
+ )
+
+happyReduce_258 = happySpecReduce_1 87# happyReduction_258
+happyReduction_258 (HappyAbsSyn86 happy_var_1)
+ = HappyAbsSyn87
+ ((:[]) happy_var_1
+ )
+happyReduction_258 _ = notHappyAtAll
+
+happyReduce_259 = happySpecReduce_3 87# happyReduction_259
+happyReduction_259 (HappyAbsSyn87 happy_var_3)
+ _
+ (HappyAbsSyn86 happy_var_1)
+ = HappyAbsSyn87
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_259 _ _ _ = notHappyAtAll
+
+happyReduce_260 = happyReduce 5# 88# happyReduction_260
+happyReduction_260 (_ `HappyStk`
+ (HappyAbsSyn58 happy_var_4) `HappyStk`
+ _ `HappyStk`
+ (HappyAbsSyn76 happy_var_2) `HappyStk`
+ _ `HappyStk`
+ happyRest)
+ = HappyAbsSyn88
+ (DDDec happy_var_2 happy_var_4
+ ) `HappyStk` happyRest
+
+happyReduce_261 = happySpecReduce_1 88# happyReduction_261
+happyReduction_261 (HappyAbsSyn58 happy_var_1)
+ = HappyAbsSyn88
+ (DDExp happy_var_1
+ )
+happyReduction_261 _ = notHappyAtAll
+
+happyReduce_262 = happySpecReduce_0 89# happyReduction_262
+happyReduction_262 = HappyAbsSyn89
+ ([]
+ )
+
+happyReduce_263 = happySpecReduce_2 89# happyReduction_263
+happyReduction_263 (HappyAbsSyn88 happy_var_2)
+ (HappyAbsSyn89 happy_var_1)
+ = HappyAbsSyn89
+ (flip (:) happy_var_1 happy_var_2
+ )
+happyReduction_263 _ _ = notHappyAtAll
+
+happyReduce_264 = happySpecReduce_2 90# happyReduction_264
+happyReduction_264 (HappyAbsSyn25 happy_var_2)
+ (HappyAbsSyn91 happy_var_1)
+ = HappyAbsSyn90
+ (OldGr happy_var_1 (reverse happy_var_2)
+ )
+happyReduction_264 _ _ = notHappyAtAll
+
+happyReduce_265 = happySpecReduce_0 91# happyReduction_265
+happyReduction_265 = HappyAbsSyn91
+ (NoIncl
+ )
+
+happyReduce_266 = happySpecReduce_2 91# happyReduction_266
+happyReduction_266 (HappyAbsSyn93 happy_var_2)
+ _
+ = HappyAbsSyn91
+ (Incl happy_var_2
+ )
+happyReduction_266 _ _ = notHappyAtAll
+
+happyReduce_267 = happySpecReduce_1 92# happyReduction_267
+happyReduction_267 (HappyAbsSyn9 happy_var_1)
+ = HappyAbsSyn92
+ (FString happy_var_1
+ )
+happyReduction_267 _ = notHappyAtAll
+
+happyReduce_268 = happySpecReduce_1 92# happyReduction_268
+happyReduction_268 (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn92
+ (FIdent happy_var_1
+ )
+happyReduction_268 _ = notHappyAtAll
+
+happyReduce_269 = happySpecReduce_2 92# happyReduction_269
+happyReduction_269 (HappyAbsSyn92 happy_var_2)
+ _
+ = HappyAbsSyn92
+ (FSlash happy_var_2
+ )
+happyReduction_269 _ _ = notHappyAtAll
+
+happyReduce_270 = happySpecReduce_2 92# happyReduction_270
+happyReduction_270 (HappyAbsSyn92 happy_var_2)
+ _
+ = HappyAbsSyn92
+ (FDot happy_var_2
+ )
+happyReduction_270 _ _ = notHappyAtAll
+
+happyReduce_271 = happySpecReduce_2 92# happyReduction_271
+happyReduction_271 (HappyAbsSyn92 happy_var_2)
+ _
+ = HappyAbsSyn92
+ (FMinus happy_var_2
+ )
+happyReduction_271 _ _ = notHappyAtAll
+
+happyReduce_272 = happySpecReduce_2 92# happyReduction_272
+happyReduction_272 (HappyAbsSyn92 happy_var_2)
+ (HappyAbsSyn12 happy_var_1)
+ = HappyAbsSyn92
+ (FAddId happy_var_1 happy_var_2
+ )
+happyReduction_272 _ _ = notHappyAtAll
+
+happyReduce_273 = happySpecReduce_2 93# happyReduction_273
+happyReduction_273 _
+ (HappyAbsSyn92 happy_var_1)
+ = HappyAbsSyn93
+ ((:[]) happy_var_1
+ )
+happyReduction_273 _ _ = notHappyAtAll
+
+happyReduce_274 = happySpecReduce_3 93# happyReduction_274
+happyReduction_274 (HappyAbsSyn93 happy_var_3)
+ _
+ (HappyAbsSyn92 happy_var_1)
+ = HappyAbsSyn93
+ ((:) happy_var_1 happy_var_3
+ )
+happyReduction_274 _ _ _ = notHappyAtAll
+
+happyNewToken action sts stk [] =
+ action 176# 176# notHappyAtAll (HappyState action) sts stk []
+
+happyNewToken action sts stk (tk:tks) =
+ let cont i = action i i tk (HappyState action) sts stk tks in
+ case tk of {
+ PT _ (TS _ 1) -> cont 94#;
+ PT _ (TS _ 2) -> cont 95#;
+ PT _ (TS _ 3) -> cont 96#;
+ PT _ (TS _ 4) -> cont 97#;
+ PT _ (TS _ 5) -> cont 98#;
+ PT _ (TS _ 6) -> cont 99#;
+ PT _ (TS _ 7) -> cont 100#;
+ PT _ (TS _ 8) -> cont 101#;
+ PT _ (TS _ 9) -> cont 102#;
+ PT _ (TS _ 10) -> cont 103#;
+ PT _ (TS _ 11) -> cont 104#;
+ PT _ (TS _ 12) -> cont 105#;
+ PT _ (TS _ 13) -> cont 106#;
+ PT _ (TS _ 14) -> cont 107#;
+ PT _ (TS _ 15) -> cont 108#;
+ PT _ (TS _ 16) -> cont 109#;
+ PT _ (TS _ 17) -> cont 110#;
+ PT _ (TS _ 18) -> cont 111#;
+ PT _ (TS _ 19) -> cont 112#;
+ PT _ (TS _ 20) -> cont 113#;
+ PT _ (TS _ 21) -> cont 114#;
+ PT _ (TS _ 22) -> cont 115#;
+ PT _ (TS _ 23) -> cont 116#;
+ PT _ (TS _ 24) -> cont 117#;
+ PT _ (TS _ 25) -> cont 118#;
+ PT _ (TS _ 26) -> cont 119#;
+ PT _ (TS _ 27) -> cont 120#;
+ PT _ (TS _ 28) -> cont 121#;
+ PT _ (TS _ 29) -> cont 122#;
+ PT _ (TS _ 30) -> cont 123#;
+ PT _ (TS _ 31) -> cont 124#;
+ PT _ (TS _ 32) -> cont 125#;
+ PT _ (TS _ 33) -> cont 126#;
+ PT _ (TS _ 34) -> cont 127#;
+ PT _ (TS _ 35) -> cont 128#;
+ PT _ (TS _ 36) -> cont 129#;
+ PT _ (TS _ 37) -> cont 130#;
+ PT _ (TS _ 38) -> cont 131#;
+ PT _ (TS _ 39) -> cont 132#;
+ PT _ (TS _ 40) -> cont 133#;
+ PT _ (TS _ 41) -> cont 134#;
+ PT _ (TS _ 42) -> cont 135#;
+ PT _ (TS _ 43) -> cont 136#;
+ PT _ (TS _ 44) -> cont 137#;
+ PT _ (TS _ 45) -> cont 138#;
+ PT _ (TS _ 46) -> cont 139#;
+ PT _ (TS _ 47) -> cont 140#;
+ PT _ (TS _ 48) -> cont 141#;
+ PT _ (TS _ 49) -> cont 142#;
+ PT _ (TS _ 50) -> cont 143#;
+ PT _ (TS _ 51) -> cont 144#;
+ PT _ (TS _ 52) -> cont 145#;
+ PT _ (TS _ 53) -> cont 146#;
+ PT _ (TS _ 54) -> cont 147#;
+ PT _ (TS _ 55) -> cont 148#;
+ PT _ (TS _ 56) -> cont 149#;
+ PT _ (TS _ 57) -> cont 150#;
+ PT _ (TS _ 58) -> cont 151#;
+ PT _ (TS _ 59) -> cont 152#;
+ PT _ (TS _ 60) -> cont 153#;
+ PT _ (TS _ 61) -> cont 154#;
+ PT _ (TS _ 62) -> cont 155#;
+ PT _ (TS _ 63) -> cont 156#;
+ PT _ (TS _ 64) -> cont 157#;
+ PT _ (TS _ 65) -> cont 158#;
+ PT _ (TS _ 66) -> cont 159#;
+ PT _ (TS _ 67) -> cont 160#;
+ PT _ (TS _ 68) -> cont 161#;
+ PT _ (TS _ 69) -> cont 162#;
+ PT _ (TS _ 70) -> cont 163#;
+ PT _ (TS _ 71) -> cont 164#;
+ PT _ (TS _ 72) -> cont 165#;
+ PT _ (TS _ 73) -> cont 166#;
+ PT _ (TS _ 74) -> cont 167#;
+ PT _ (TS _ 75) -> cont 168#;
+ PT _ (TS _ 76) -> cont 169#;
+ PT _ (TI happy_dollar_dollar) -> cont 170#;
+ PT _ (TL happy_dollar_dollar) -> cont 171#;
+ PT _ (TD happy_dollar_dollar) -> cont 172#;
+ PT _ (T_LString happy_dollar_dollar) -> cont 173#;
+ PT _ (T_PIdent _) -> cont 174#;
+ _ -> cont 175#;
+ _ -> 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 action_0 tks) (\x -> case x of {HappyAbsSyn13 z -> happyReturn z; _other -> notHappyAtAll })
+
+pModDef tks = happySomeParser where
+ happySomeParser = happyThen (happyParse action_1 tks) (\x -> case x of {HappyAbsSyn15 z -> happyReturn z; _other -> notHappyAtAll })
+
+pOldGrammar tks = happySomeParser where
+ happySomeParser = happyThen (happyParse action_2 tks) (\x -> case x of {HappyAbsSyn90 z -> happyReturn z; _other -> notHappyAtAll })
+
+pModHeader tks = happySomeParser where
+ happySomeParser = happyThen (happyParse action_3 tks) (\x -> case x of {HappyAbsSyn15 z -> happyReturn z; _other -> notHappyAtAll })
+
+pExp tks = happySomeParser where
+ happySomeParser = happyThen (happyParse action_4 tks) (\x -> case x of {HappyAbsSyn58 z -> happyReturn z; _other -> notHappyAtAll })
+
+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 (BS.unpack . prToken) (take 4 ts))
+
+myLexer = tokens
+{-# 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" #-}
+
+
+
+
+
+
+
+
+{-# 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 1#, 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 1# tk st sts (_ `HappyStk` ans `HappyStk` _) =
+ happyReturn1 ans
+happyAccept j tk st sts (HappyStk ans _) =
+ (happyTcHack j ) (happyReturn1 ans)
+
+-----------------------------------------------------------------------------
+-- Arrays only: do the next action
+
+{-# LINE 155 "templates/GenericTemplate.hs" #-}
+
+-----------------------------------------------------------------------------
+-- HappyState data type (not arrays)
+
+
+
+newtype HappyState b c = HappyState
+ (Int# -> -- token number
+ Int# -> -- token number (yes, again)
+ b -> -- token semantic value
+ HappyState b c -> -- current state
+ [HappyState b c] -> -- state stack
+ c)
+
+
+
+-----------------------------------------------------------------------------
+-- Shifting a token
+
+happyShift new_state 1# tk st sts stk@(x `HappyStk` _) =
+ let i = (case x of { HappyErrorToken (I# (i)) -> i }) in
+-- trace "shifting the error token" $
+ new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)
+
+happyShift new_state i tk st sts stk =
+ happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk)
+
+-- happyReduce is specialised for the common cases.
+
+happySpecReduce_0 i fn 1# tk st sts stk
+ = happyFail 1# tk st sts stk
+happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk
+ = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)
+
+happySpecReduce_1 i fn 1# tk st sts stk
+ = happyFail 1# tk st sts stk
+happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')
+ = let r = fn v1 in
+ happySeq r (action nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_2 i fn 1# tk st sts stk
+ = happyFail 1# tk st sts stk
+happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')
+ = let r = fn v1 v2 in
+ happySeq r (action nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_3 i fn 1# tk st sts stk
+ = happyFail 1# tk st sts stk
+happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
+ = let r = fn v1 v2 v3 in
+ happySeq r (action nt j tk st sts (r `HappyStk` stk'))
+
+happyReduce k i fn 1# tk st sts stk
+ = happyFail 1# tk st sts stk
+happyReduce k nt fn j tk st sts stk
+ = case happyDrop (k -# (1# :: Int#)) sts of
+ sts1@(((st1@(HappyState (action))):(_))) ->
+ let r = fn stk in -- it doesn't hurt to always seq here...
+ happyDoSeq r (action nt j tk st1 sts1 r)
+
+happyMonadReduce k nt fn 1# tk st sts stk
+ = happyFail 1# tk st sts stk
+happyMonadReduce k nt fn j tk st sts stk =
+ happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))
+ where sts1@(((st1@(HappyState (action))):(_))) = happyDrop k ((st):(sts))
+ drop_stk = happyDropStk k stk
+
+happyMonad2Reduce k nt fn 1# tk st sts stk
+ = happyFail 1# 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@(((st1@(HappyState (action))):(_))) = happyDrop k ((st):(sts))
+ drop_stk = happyDropStk k stk
+
+
+
+
+
+ new_state = action
+
+
+happyDrop 0# l = l
+happyDrop n ((_):(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
+
+{-# LINE 253 "templates/GenericTemplate.hs" #-}
+happyGoto action j tk st = action j j tk (HappyState action)
+
+
+-----------------------------------------------------------------------------
+-- Error recovery (1# is the error token)
+
+-- parse error if we are in recovery and we fail again
+happyFail 1# 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 1# tk old_st (((HappyState (action))):(sts))
+ (saved_tok `HappyStk` _ `HappyStk` stk) =
+-- trace ("discarding state, depth " ++ show (length stk)) $
+ action 1# 1# tk (HappyState (action)) sts ((saved_tok`HappyStk`stk))
+-}
+
+-- Enter error recovery: generate an error token,
+-- save the old token and carry on.
+happyFail i tk (HappyState (action)) sts stk =
+-- trace "entering error recovery" $
+ action 1# 1# tk (HappyState (action)) sts ( (HappyErrorToken (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.
+
+{-# LINE 317 "templates/GenericTemplate.hs" #-}
+{-# 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/Source/ParGF.y b/src/GF/Source/ParGF.y new file mode 100644 index 000000000..22a15cd93 --- /dev/null +++ b/src/GF/Source/ParGF.y @@ -0,0 +1,642 @@ +-- This Happy file was machine-generated by the BNF converter
+{
+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
+module GF.Source.ParGF where
+import GF.Source.AbsGF
+import GF.Source.LexGF
+import GF.Data.ErrM
+import qualified Data.ByteString.Char8 as BS
+}
+
+%name pGrammar Grammar
+%name pModDef ModDef
+%name pOldGrammar OldGrammar
+%partial pModHeader ModHeader
+%name pExp Exp
+
+-- no lexer declaration
+%monad { Err } { thenM } { returnM }
+%tokentype { Token }
+
+%token
+ '!' { PT _ (TS _ 1) }
+ '#' { PT _ (TS _ 2) }
+ '$' { PT _ (TS _ 3) }
+ '%' { PT _ (TS _ 4) }
+ '(' { PT _ (TS _ 5) }
+ ')' { PT _ (TS _ 6) }
+ '*' { PT _ (TS _ 7) }
+ '**' { PT _ (TS _ 8) }
+ '+' { PT _ (TS _ 9) }
+ '++' { PT _ (TS _ 10) }
+ ',' { PT _ (TS _ 11) }
+ '-' { PT _ (TS _ 12) }
+ '->' { PT _ (TS _ 13) }
+ '.' { PT _ (TS _ 14) }
+ '/' { PT _ (TS _ 15) }
+ ':' { PT _ (TS _ 16) }
+ ';' { PT _ (TS _ 17) }
+ '<' { PT _ (TS _ 18) }
+ '=' { PT _ (TS _ 19) }
+ '=>' { PT _ (TS _ 20) }
+ '>' { PT _ (TS _ 21) }
+ '?' { PT _ (TS _ 22) }
+ '@' { PT _ (TS _ 23) }
+ 'Lin' { PT _ (TS _ 24) }
+ 'PType' { PT _ (TS _ 25) }
+ 'Str' { PT _ (TS _ 26) }
+ 'Strs' { PT _ (TS _ 27) }
+ 'Tok' { PT _ (TS _ 28) }
+ 'Type' { PT _ (TS _ 29) }
+ '[' { PT _ (TS _ 30) }
+ '\\' { PT _ (TS _ 31) }
+ ']' { PT _ (TS _ 32) }
+ '_' { PT _ (TS _ 33) }
+ 'abstract' { PT _ (TS _ 34) }
+ 'case' { PT _ (TS _ 35) }
+ 'cat' { PT _ (TS _ 36) }
+ 'concrete' { PT _ (TS _ 37) }
+ 'data' { PT _ (TS _ 38) }
+ 'def' { PT _ (TS _ 39) }
+ 'flags' { PT _ (TS _ 40) }
+ 'fn' { PT _ (TS _ 41) }
+ 'fun' { PT _ (TS _ 42) }
+ 'grammar' { PT _ (TS _ 43) }
+ 'in' { PT _ (TS _ 44) }
+ 'include' { PT _ (TS _ 45) }
+ 'incomplete' { PT _ (TS _ 46) }
+ 'instance' { PT _ (TS _ 47) }
+ 'interface' { PT _ (TS _ 48) }
+ 'let' { PT _ (TS _ 49) }
+ 'lin' { PT _ (TS _ 50) }
+ 'lincat' { PT _ (TS _ 51) }
+ 'lindef' { PT _ (TS _ 52) }
+ 'lintype' { PT _ (TS _ 53) }
+ 'of' { PT _ (TS _ 54) }
+ 'open' { PT _ (TS _ 55) }
+ 'oper' { PT _ (TS _ 56) }
+ 'out' { PT _ (TS _ 57) }
+ 'package' { PT _ (TS _ 58) }
+ 'param' { PT _ (TS _ 59) }
+ 'pattern' { PT _ (TS _ 60) }
+ 'pre' { PT _ (TS _ 61) }
+ 'printname' { PT _ (TS _ 62) }
+ 'resource' { PT _ (TS _ 63) }
+ 'reuse' { PT _ (TS _ 64) }
+ 'strs' { PT _ (TS _ 65) }
+ 'table' { PT _ (TS _ 66) }
+ 'tokenizer' { PT _ (TS _ 67) }
+ 'transfer' { PT _ (TS _ 68) }
+ 'union' { PT _ (TS _ 69) }
+ 'var' { PT _ (TS _ 70) }
+ 'variants' { PT _ (TS _ 71) }
+ 'where' { PT _ (TS _ 72) }
+ 'with' { PT _ (TS _ 73) }
+ '{' { PT _ (TS _ 74) }
+ '|' { PT _ (TS _ 75) }
+ '}' { PT _ (TS _ 76) }
+
+L_integ { PT _ (TI $$) }
+L_quoted { PT _ (TL $$) }
+L_doubl { PT _ (TD $$) }
+L_LString { PT _ (T_LString $$) }
+L_PIdent { PT _ (T_PIdent _) }
+L_err { _ }
+
+
+%%
+
+Integer :: { Integer } : L_integ { (read (BS.unpack $1)) :: Integer }
+String :: { String } : L_quoted { BS.unpack $1 }
+Double :: { Double } : L_doubl { (read (BS.unpack $1)) :: Double }
+LString :: { LString} : L_LString { LString ($1)}
+PIdent :: { PIdent} : L_PIdent { PIdent (mkPosToken $1)}
+
+Grammar :: { Grammar }
+Grammar : ListModDef { Gr (reverse $1) }
+
+
+ListModDef :: { [ModDef] }
+ListModDef : {- empty -} { [] }
+ | ListModDef ModDef { flip (:) $1 $2 }
+
+
+ModDef :: { ModDef }
+ModDef : ModDef ';' { $1 }
+ | 'grammar' PIdent '=' '{' 'abstract' '=' PIdent ';' ListConcSpec '}' { MMain $2 $7 $9 }
+ | ComplMod ModType '=' ModBody { MModule $1 $2 $4 }
+
+
+ConcSpec :: { ConcSpec }
+ConcSpec : PIdent '=' ConcExp { ConcSpec $1 $3 }
+
+
+ListConcSpec :: { [ConcSpec] }
+ListConcSpec : {- empty -} { [] }
+ | ConcSpec { (:[]) $1 }
+ | ConcSpec ';' ListConcSpec { (:) $1 $3 }
+
+
+ConcExp :: { ConcExp }
+ConcExp : PIdent ListTransfer { ConcExp $1 (reverse $2) }
+
+
+ListTransfer :: { [Transfer] }
+ListTransfer : {- empty -} { [] }
+ | ListTransfer Transfer { flip (:) $1 $2 }
+
+
+Transfer :: { Transfer }
+Transfer : '(' 'transfer' 'in' Open ')' { TransferIn $4 }
+ | '(' 'transfer' 'out' Open ')' { TransferOut $4 }
+
+
+ModHeader :: { ModDef }
+ModHeader : ComplMod ModType '=' ModHeaderBody { MModule $1 $2 $4 }
+
+
+ModHeaderBody :: { ModBody }
+ModHeaderBody : Extend Opens { MBody $1 $2 [] }
+ | ListIncluded { MNoBody $1 }
+ | Included 'with' ListOpen { MWith $1 $3 }
+ | Included 'with' ListOpen '**' Opens { MWithBody $1 $3 $5 [] }
+ | ListIncluded '**' Included 'with' ListOpen { MWithE $1 $3 $5 }
+ | ListIncluded '**' Included 'with' ListOpen '**' Opens { MWithEBody $1 $3 $5 $7 [] }
+ | 'reuse' PIdent { MReuse $2 }
+ | 'union' ListIncluded { MUnion $2 }
+
+
+ModType :: { ModType }
+ModType : 'abstract' PIdent { MTAbstract $2 }
+ | 'resource' PIdent { MTResource $2 }
+ | 'interface' PIdent { MTInterface $2 }
+ | 'concrete' PIdent 'of' PIdent { MTConcrete $2 $4 }
+ | 'instance' PIdent 'of' PIdent { MTInstance $2 $4 }
+ | 'transfer' PIdent ':' Open '->' Open { MTTransfer $2 $4 $6 }
+
+
+ModBody :: { ModBody }
+ModBody : Extend Opens '{' ListTopDef '}' { MBody $1 $2 (reverse $4) }
+ | ListIncluded { MNoBody $1 }
+ | Included 'with' ListOpen { MWith $1 $3 }
+ | Included 'with' ListOpen '**' Opens '{' ListTopDef '}' { MWithBody $1 $3 $5 (reverse $7) }
+ | ListIncluded '**' Included 'with' ListOpen { MWithE $1 $3 $5 }
+ | ListIncluded '**' Included 'with' ListOpen '**' Opens '{' ListTopDef '}' { MWithEBody $1 $3 $5 $7 (reverse $9) }
+ | 'reuse' PIdent { MReuse $2 }
+ | 'union' ListIncluded { MUnion $2 }
+
+
+ListTopDef :: { [TopDef] }
+ListTopDef : {- empty -} { [] }
+ | ListTopDef TopDef { flip (:) $1 $2 }
+
+
+Extend :: { Extend }
+Extend : ListIncluded '**' { Ext $1 }
+ | {- empty -} { NoExt }
+
+
+ListOpen :: { [Open] }
+ListOpen : {- empty -} { [] }
+ | Open { (:[]) $1 }
+ | Open ',' ListOpen { (:) $1 $3 }
+
+
+Opens :: { Opens }
+Opens : {- empty -} { NoOpens }
+ | 'open' ListOpen 'in' { OpenIn $2 }
+
+
+Open :: { Open }
+Open : PIdent { OName $1 }
+ | '(' QualOpen PIdent ')' { OQualQO $2 $3 }
+ | '(' QualOpen PIdent '=' PIdent ')' { OQual $2 $3 $5 }
+
+
+ComplMod :: { ComplMod }
+ComplMod : {- empty -} { CMCompl }
+ | 'incomplete' { CMIncompl }
+
+
+QualOpen :: { QualOpen }
+QualOpen : {- empty -} { QOCompl }
+ | 'incomplete' { QOIncompl }
+ | 'interface' { QOInterface }
+
+
+ListIncluded :: { [Included] }
+ListIncluded : {- empty -} { [] }
+ | Included { (:[]) $1 }
+ | Included ',' ListIncluded { (:) $1 $3 }
+
+
+Included :: { Included }
+Included : PIdent { IAll $1 }
+ | PIdent '[' ListPIdent ']' { ISome $1 $3 }
+ | PIdent '-' '[' ListPIdent ']' { IMinus $1 $4 }
+
+
+Def :: { Def }
+Def : ListName ':' Exp { DDecl $1 $3 }
+ | ListName '=' Exp { DDef $1 $3 }
+ | Name ListPatt '=' Exp { DPatt $1 $2 $4 }
+ | ListName ':' Exp '=' Exp { DFull $1 $3 $5 }
+
+
+TopDef :: { TopDef }
+TopDef : 'cat' ListCatDef { DefCat $2 }
+ | 'fun' ListFunDef { DefFun $2 }
+ | 'data' ListFunDef { DefFunData $2 }
+ | 'def' ListDef { DefDef $2 }
+ | 'data' ListDataDef { DefData $2 }
+ | 'transfer' ListDef { DefTrans $2 }
+ | 'param' ListParDef { DefPar $2 }
+ | 'oper' ListDef { DefOper $2 }
+ | 'lincat' ListPrintDef { DefLincat $2 }
+ | 'lindef' ListDef { DefLindef $2 }
+ | 'lin' ListDef { DefLin $2 }
+ | 'printname' 'cat' ListPrintDef { DefPrintCat $3 }
+ | 'printname' 'fun' ListPrintDef { DefPrintFun $3 }
+ | 'flags' ListFlagDef { DefFlag $2 }
+ | 'printname' ListPrintDef { DefPrintOld $2 }
+ | 'lintype' ListDef { DefLintype $2 }
+ | 'pattern' ListDef { DefPattern $2 }
+ | 'package' PIdent '=' '{' ListTopDef '}' ';' { DefPackage $2 (reverse $5) }
+ | 'var' ListDef { DefVars $2 }
+ | 'tokenizer' PIdent ';' { DefTokenizer $2 }
+
+
+CatDef :: { CatDef }
+CatDef : PIdent ListDDecl { SimpleCatDef $1 (reverse $2) }
+ | '[' PIdent ListDDecl ']' { ListCatDef $2 (reverse $3) }
+ | '[' PIdent ListDDecl ']' '{' Integer '}' { ListSizeCatDef $2 (reverse $3) $6 }
+
+
+FunDef :: { FunDef }
+FunDef : ListPIdent ':' Exp { FunDef $1 $3 }
+
+
+DataDef :: { DataDef }
+DataDef : PIdent '=' ListDataConstr { DataDef $1 $3 }
+
+
+DataConstr :: { DataConstr }
+DataConstr : PIdent { DataId $1 }
+ | PIdent '.' PIdent { DataQId $1 $3 }
+
+
+ListDataConstr :: { [DataConstr] }
+ListDataConstr : {- empty -} { [] }
+ | DataConstr { (:[]) $1 }
+ | DataConstr '|' ListDataConstr { (:) $1 $3 }
+
+
+ParDef :: { ParDef }
+ParDef : PIdent '=' ListParConstr { ParDefDir $1 $3 }
+ | PIdent '=' '(' 'in' PIdent ')' { ParDefIndir $1 $5 }
+ | PIdent { ParDefAbs $1 }
+
+
+ParConstr :: { ParConstr }
+ParConstr : PIdent ListDDecl { ParConstr $1 (reverse $2) }
+
+
+PrintDef :: { PrintDef }
+PrintDef : ListName '=' Exp { PrintDef $1 $3 }
+
+
+FlagDef :: { FlagDef }
+FlagDef : PIdent '=' PIdent { FlagDef $1 $3 }
+
+
+ListDef :: { [Def] }
+ListDef : Def ';' { (:[]) $1 }
+ | Def ';' ListDef { (:) $1 $3 }
+
+
+ListCatDef :: { [CatDef] }
+ListCatDef : CatDef ';' { (:[]) $1 }
+ | CatDef ';' ListCatDef { (:) $1 $3 }
+
+
+ListFunDef :: { [FunDef] }
+ListFunDef : FunDef ';' { (:[]) $1 }
+ | FunDef ';' ListFunDef { (:) $1 $3 }
+
+
+ListDataDef :: { [DataDef] }
+ListDataDef : DataDef ';' { (:[]) $1 }
+ | DataDef ';' ListDataDef { (:) $1 $3 }
+
+
+ListParDef :: { [ParDef] }
+ListParDef : ParDef ';' { (:[]) $1 }
+ | ParDef ';' ListParDef { (:) $1 $3 }
+
+
+ListPrintDef :: { [PrintDef] }
+ListPrintDef : PrintDef ';' { (:[]) $1 }
+ | PrintDef ';' ListPrintDef { (:) $1 $3 }
+
+
+ListFlagDef :: { [FlagDef] }
+ListFlagDef : FlagDef ';' { (:[]) $1 }
+ | FlagDef ';' ListFlagDef { (:) $1 $3 }
+
+
+ListParConstr :: { [ParConstr] }
+ListParConstr : {- empty -} { [] }
+ | ParConstr { (:[]) $1 }
+ | ParConstr '|' ListParConstr { (:) $1 $3 }
+
+
+ListPIdent :: { [PIdent] }
+ListPIdent : PIdent { (:[]) $1 }
+ | PIdent ',' ListPIdent { (:) $1 $3 }
+
+
+Name :: { Name }
+Name : PIdent { IdentName $1 }
+ | '[' PIdent ']' { ListName $2 }
+
+
+ListName :: { [Name] }
+ListName : Name { (:[]) $1 }
+ | Name ',' ListName { (:) $1 $3 }
+
+
+LocDef :: { LocDef }
+LocDef : ListPIdent ':' Exp { LDDecl $1 $3 }
+ | ListPIdent '=' Exp { LDDef $1 $3 }
+ | ListPIdent ':' Exp '=' Exp { LDFull $1 $3 $5 }
+
+
+ListLocDef :: { [LocDef] }
+ListLocDef : {- empty -} { [] }
+ | LocDef { (:[]) $1 }
+ | LocDef ';' ListLocDef { (:) $1 $3 }
+
+
+Exp6 :: { Exp }
+Exp6 : PIdent { EIdent $1 }
+ | '{' PIdent '}' { EConstr $2 }
+ | '%' PIdent '%' { ECons $2 }
+ | Sort { ESort $1 }
+ | String { EString $1 }
+ | Integer { EInt $1 }
+ | Double { EFloat $1 }
+ | '?' { EMeta }
+ | '[' ']' { EEmpty }
+ | 'data' { EData }
+ | '[' PIdent Exps ']' { EList $2 $3 }
+ | '[' String ']' { EStrings $2 }
+ | '{' ListLocDef '}' { ERecord $2 }
+ | '<' ListTupleComp '>' { ETuple $2 }
+ | '(' 'in' PIdent ')' { EIndir $3 }
+ | '<' Exp ':' Exp '>' { ETyped $2 $4 }
+ | '(' Exp ')' { $2 }
+ | LString { ELString $1 }
+
+
+Exp5 :: { Exp }
+Exp5 : Exp5 '.' Label { EProj $1 $3 }
+ | '{' PIdent '.' PIdent '}' { EQConstr $2 $4 }
+ | '%' PIdent '.' PIdent { EQCons $2 $4 }
+ | Exp6 { $1 }
+
+
+Exp4 :: { Exp }
+Exp4 : Exp4 Exp5 { EApp $1 $2 }
+ | 'table' '{' ListCase '}' { ETable $3 }
+ | 'table' Exp6 '{' ListCase '}' { ETTable $2 $4 }
+ | 'table' Exp6 '[' ListExp ']' { EVTable $2 $4 }
+ | 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 }
+ | 'variants' '{' ListExp '}' { EVariants $3 }
+ | 'pre' '{' Exp ';' ListAltern '}' { EPre $3 $5 }
+ | 'strs' '{' ListExp '}' { EStrs $3 }
+ | PIdent '@' Exp6 { EConAt $1 $3 }
+ | '#' Patt2 { EPatt $2 }
+ | 'pattern' Exp5 { EPattType $2 }
+ | Exp5 { $1 }
+ | 'Lin' PIdent { ELin $2 }
+
+
+Exp3 :: { Exp }
+Exp3 : Exp3 '!' Exp4 { ESelect $1 $3 }
+ | Exp3 '*' Exp4 { ETupTyp $1 $3 }
+ | Exp3 '**' Exp4 { EExtend $1 $3 }
+ | Exp4 { $1 }
+
+
+Exp1 :: { Exp }
+Exp1 : Exp2 '+' Exp1 { EGlue $1 $3 }
+ | Exp2 { $1 }
+
+
+Exp :: { Exp }
+Exp : Exp1 '++' Exp { EConcat $1 $3 }
+ | '\\' ListBind '->' Exp { EAbstr $2 $4 }
+ | '\\' '\\' ListBind '=>' Exp { ECTable $3 $5 }
+ | Decl '->' Exp { EProd $1 $3 }
+ | Exp3 '=>' Exp { ETType $1 $3 }
+ | 'let' '{' ListLocDef '}' 'in' Exp { ELet $3 $6 }
+ | 'let' ListLocDef 'in' Exp { ELetb $2 $4 }
+ | Exp3 'where' '{' ListLocDef '}' { EWhere $1 $4 }
+ | 'fn' '{' ListEquation '}' { EEqs $3 }
+ | 'in' Exp5 String { EExample $2 $3 }
+ | Exp1 { $1 }
+
+
+Exp2 :: { Exp }
+Exp2 : Exp3 { $1 }
+
+
+ListExp :: { [Exp] }
+ListExp : {- empty -} { [] }
+ | Exp { (:[]) $1 }
+ | Exp ';' ListExp { (:) $1 $3 }
+
+
+Exps :: { Exps }
+Exps : {- empty -} { NilExp }
+ | Exp6 Exps { ConsExp $1 $2 }
+
+
+Patt2 :: { Patt }
+Patt2 : '?' { PChar }
+ | '[' String ']' { PChars $2 }
+ | '#' PIdent { PMacro $2 }
+ | '#' PIdent '.' PIdent { PM $2 $4 }
+ | '_' { PW }
+ | PIdent { PV $1 }
+ | '{' PIdent '}' { PCon $2 }
+ | PIdent '.' PIdent { PQ $1 $3 }
+ | Integer { PInt $1 }
+ | Double { PFloat $1 }
+ | String { PStr $1 }
+ | '{' ListPattAss '}' { PR $2 }
+ | '<' ListPattTupleComp '>' { PTup $2 }
+ | '(' Patt ')' { $2 }
+
+
+Patt1 :: { Patt }
+Patt1 : PIdent ListPatt { PC $1 $2 }
+ | PIdent '.' PIdent ListPatt { PQC $1 $3 $4 }
+ | Patt2 '*' { PRep $1 }
+ | PIdent '@' Patt2 { PAs $1 $3 }
+ | '-' Patt2 { PNeg $2 }
+ | Patt2 { $1 }
+
+
+Patt :: { Patt }
+Patt : Patt '|' Patt1 { PDisj $1 $3 }
+ | Patt '+' Patt1 { PSeq $1 $3 }
+ | Patt1 { $1 }
+
+
+PattAss :: { PattAss }
+PattAss : ListPIdent '=' Patt { PA $1 $3 }
+
+
+Label :: { Label }
+Label : PIdent { LIdent $1 }
+ | '$' Integer { LVar $2 }
+
+
+Sort :: { Sort }
+Sort : 'Type' { Sort_Type }
+ | 'PType' { Sort_PType }
+ | 'Tok' { Sort_Tok }
+ | 'Str' { Sort_Str }
+ | 'Strs' { Sort_Strs }
+
+
+ListPattAss :: { [PattAss] }
+ListPattAss : {- empty -} { [] }
+ | PattAss { (:[]) $1 }
+ | PattAss ';' ListPattAss { (:) $1 $3 }
+
+
+ListPatt :: { [Patt] }
+ListPatt : Patt2 { (:[]) $1 }
+ | Patt2 ListPatt { (:) $1 $2 }
+
+
+Bind :: { Bind }
+Bind : PIdent { BIdent $1 }
+ | '_' { BWild }
+
+
+ListBind :: { [Bind] }
+ListBind : {- empty -} { [] }
+ | Bind { (:[]) $1 }
+ | Bind ',' ListBind { (:) $1 $3 }
+
+
+Decl :: { Decl }
+Decl : '(' ListBind ':' Exp ')' { DDec $2 $4 }
+ | Exp4 { DExp $1 }
+
+
+TupleComp :: { TupleComp }
+TupleComp : Exp { TComp $1 }
+
+
+PattTupleComp :: { PattTupleComp }
+PattTupleComp : Patt { PTComp $1 }
+
+
+ListTupleComp :: { [TupleComp] }
+ListTupleComp : {- empty -} { [] }
+ | TupleComp { (:[]) $1 }
+ | TupleComp ',' ListTupleComp { (:) $1 $3 }
+
+
+ListPattTupleComp :: { [PattTupleComp] }
+ListPattTupleComp : {- empty -} { [] }
+ | PattTupleComp { (:[]) $1 }
+ | PattTupleComp ',' ListPattTupleComp { (:) $1 $3 }
+
+
+Case :: { Case }
+Case : Patt '=>' Exp { Case $1 $3 }
+
+
+ListCase :: { [Case] }
+ListCase : Case { (:[]) $1 }
+ | Case ';' ListCase { (:) $1 $3 }
+
+
+Equation :: { Equation }
+Equation : ListPatt '->' Exp { Equ $1 $3 }
+
+
+ListEquation :: { [Equation] }
+ListEquation : {- empty -} { [] }
+ | Equation { (:[]) $1 }
+ | Equation ';' ListEquation { (:) $1 $3 }
+
+
+Altern :: { Altern }
+Altern : Exp '/' Exp { Alt $1 $3 }
+
+
+ListAltern :: { [Altern] }
+ListAltern : {- empty -} { [] }
+ | Altern { (:[]) $1 }
+ | Altern ';' ListAltern { (:) $1 $3 }
+
+
+DDecl :: { DDecl }
+DDecl : '(' ListBind ':' Exp ')' { DDDec $2 $4 }
+ | Exp6 { DDExp $1 }
+
+
+ListDDecl :: { [DDecl] }
+ListDDecl : {- empty -} { [] }
+ | ListDDecl DDecl { flip (:) $1 $2 }
+
+
+OldGrammar :: { OldGrammar }
+OldGrammar : Include ListTopDef { OldGr $1 (reverse $2) }
+
+
+Include :: { Include }
+Include : {- empty -} { NoIncl }
+ | 'include' ListFileName { Incl $2 }
+
+
+FileName :: { FileName }
+FileName : String { FString $1 }
+ | PIdent { FIdent $1 }
+ | '/' FileName { FSlash $2 }
+ | '.' FileName { FDot $2 }
+ | '-' FileName { FMinus $2 }
+ | PIdent FileName { FAddId $1 $2 }
+
+
+ListFileName :: { [FileName] }
+ListFileName : FileName ';' { (:[]) $1 }
+ | FileName ';' ListFileName { (:) $1 $3 }
+
+
+
+{
+
+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 (BS.unpack . prToken) (take 4 ts))
+
+myLexer = tokens
+}
+
diff --git a/src/GF/Source/PrintGF.hs b/src/GF/Source/PrintGF.hs new file mode 100644 index 000000000..ea2277e67 --- /dev/null +++ b/src/GF/Source/PrintGF.hs @@ -0,0 +1,534 @@ +{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Source.PrintGF where
+
+-- pretty-printer generated by the BNF converter
+
+import GF.Source.AbsGF
+import Data.Char
+import qualified Data.ByteString.Char8 as BS
+
+-- 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 Double where
+ prt _ x = doc (shows x)
+
+
+
+instance Print LString where
+ prt _ (LString i) = doc (showString (BS.unpack i))
+
+
+instance Print PIdent where
+ prt _ (PIdent (_,i)) = doc (showString (BS.unpack i))
+ prtList es = case es of
+ [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
+ Gr moddefs -> prPrec i 0 (concatD [prt 0 moddefs])
+
+
+instance Print ModDef where
+ prt i e = case e of
+ MMain pident0 pident concspecs -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 pident0 , doc (showString "=") , doc (showString "{") , doc (showString "abstract") , doc (showString "=") , prt 0 pident , doc (showString ";") , prt 0 concspecs , doc (showString "}")])
+ MModule complmod modtype modbody -> prPrec i 0 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modbody])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print ConcSpec where
+ prt i e = case e of
+ ConcSpec pident concexp -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 concexp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print ConcExp where
+ prt i e = case e of
+ ConcExp pident transfers -> prPrec i 0 (concatD [prt 0 pident , prt 0 transfers])
+
+
+instance Print Transfer where
+ prt i e = case e of
+ TransferIn open -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "transfer") , doc (showString "in") , prt 0 open , doc (showString ")")])
+ TransferOut open -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "transfer") , doc (showString "out") , prt 0 open , doc (showString ")")])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+
+instance Print ModType where
+ prt i e = case e of
+ MTAbstract pident -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 pident])
+ MTResource pident -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 pident])
+ MTInterface pident -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 pident])
+ MTConcrete pident0 pident -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
+ MTInstance pident0 pident -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
+ MTTransfer pident open0 open -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 pident , doc (showString ":") , prt 0 open0 , doc (showString "->") , prt 0 open])
+
+
+instance Print ModBody where
+ prt i e = case e of
+ MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
+ MNoBody includeds -> prPrec i 0 (concatD [prt 0 includeds])
+ MWith included opens -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens])
+ MWithBody included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
+ MWithE includeds included opens -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens])
+ MWithEBody includeds included opens0 opens topdefs -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**") , prt 0 included , doc (showString "with") , prt 0 opens0 , doc (showString "**") , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
+ MReuse pident -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 pident])
+ MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
+
+
+instance Print Extend where
+ prt i e = case e of
+ Ext includeds -> prPrec i 0 (concatD [prt 0 includeds , doc (showString "**")])
+ NoExt -> prPrec i 0 (concatD [])
+
+
+instance Print Opens where
+ prt i e = case e of
+ NoOpens -> prPrec i 0 (concatD [])
+ OpenIn opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
+
+
+instance Print Open where
+ prt i e = case e of
+ OName pident -> prPrec i 0 (concatD [prt 0 pident])
+ OQualQO qualopen pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 pident , doc (showString ")")])
+ OQual qualopen pident0 pident -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 pident0 , doc (showString "=") , prt 0 pident , 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 ComplMod where
+ prt i e = case e of
+ CMCompl -> prPrec i 0 (concatD [])
+ CMIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
+
+
+instance Print QualOpen where
+ prt i e = case e of
+ QOCompl -> prPrec i 0 (concatD [])
+ QOIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
+ QOInterface -> prPrec i 0 (concatD [doc (showString "interface")])
+
+
+instance Print Included where
+ prt i e = case e of
+ IAll pident -> prPrec i 0 (concatD [prt 0 pident])
+ ISome pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "[") , prt 0 pidents , doc (showString "]")])
+ IMinus pident pidents -> prPrec i 0 (concatD [prt 0 pident , doc (showString "-") , doc (showString "[") , prt 0 pidents , 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 Def where
+ prt i e = case e of
+ DDecl names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp])
+ DDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
+ DPatt name patts exp -> prPrec i 0 (concatD [prt 0 name , prt 0 patts , doc (showString "=") , prt 0 exp])
+ DFull names exp0 exp -> prPrec i 0 (concatD [prt 0 names , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print TopDef where
+ prt i e = case e of
+ DefCat catdefs -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 catdefs])
+ DefFun fundefs -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 fundefs])
+ DefFunData fundefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 fundefs])
+ DefDef defs -> prPrec i 0 (concatD [doc (showString "def") , prt 0 defs])
+ DefData datadefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 datadefs])
+ DefTrans defs -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 defs])
+ DefPar pardefs -> prPrec i 0 (concatD [doc (showString "param") , prt 0 pardefs])
+ DefOper defs -> prPrec i 0 (concatD [doc (showString "oper") , prt 0 defs])
+ DefLincat printdefs -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 printdefs])
+ DefLindef defs -> prPrec i 0 (concatD [doc (showString "lindef") , prt 0 defs])
+ DefLin defs -> prPrec i 0 (concatD [doc (showString "lin") , prt 0 defs])
+ DefPrintCat printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "cat") , prt 0 printdefs])
+ DefPrintFun printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "fun") , prt 0 printdefs])
+ DefFlag flagdefs -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 flagdefs])
+ DefPrintOld printdefs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 printdefs])
+ DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs])
+ DefPattern defs -> prPrec i 0 (concatD [doc (showString "pattern") , prt 0 defs])
+ DefPackage pident topdefs -> prPrec i 0 (concatD [doc (showString "package") , prt 0 pident , doc (showString "=") , doc (showString "{") , prt 0 topdefs , doc (showString "}") , doc (showString ";")])
+ DefVars defs -> prPrec i 0 (concatD [doc (showString "var") , prt 0 defs])
+ DefTokenizer pident -> prPrec i 0 (concatD [doc (showString "tokenizer") , prt 0 pident , doc (showString ";")])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print CatDef where
+ prt i e = case e of
+ SimpleCatDef pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
+ ListCatDef pident ddecls -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]")])
+ ListSizeCatDef pident ddecls n -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , prt 0 ddecls , doc (showString "]") , doc (showString "{") , prt 0 n , doc (showString "}")])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print FunDef where
+ prt i e = case e of
+ FunDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print DataDef where
+ prt i e = case e of
+ DataDef pident dataconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 dataconstrs])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print DataConstr where
+ prt i e = case e of
+ DataId pident -> prPrec i 0 (concatD [prt 0 pident])
+ DataQId pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
+
+instance Print ParDef where
+ prt i e = case e of
+ ParDefDir pident parconstrs -> prPrec i 0 (concatD [prt 0 pident , doc (showString "=") , prt 0 parconstrs])
+ ParDefIndir pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString "=") , doc (showString "(") , doc (showString "in") , prt 0 pident , doc (showString ")")])
+ ParDefAbs pident -> prPrec i 0 (concatD [prt 0 pident])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print ParConstr where
+ prt i e = case e of
+ ParConstr pident ddecls -> prPrec i 0 (concatD [prt 0 pident , prt 0 ddecls])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
+
+instance Print PrintDef where
+ prt i e = case e of
+ PrintDef names exp -> prPrec i 0 (concatD [prt 0 names , doc (showString "=") , prt 0 exp])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print FlagDef where
+ prt i e = case e of
+ FlagDef pident0 pident -> prPrec i 0 (concatD [prt 0 pident0 , doc (showString "=") , prt 0 pident])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Name where
+ prt i e = case e of
+ IdentName pident -> prPrec i 0 (concatD [prt 0 pident])
+ ListName pident -> prPrec i 0 (concatD [doc (showString "[") , prt 0 pident , doc (showString "]")])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print LocDef where
+ prt i e = case e of
+ LDDecl pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp])
+ LDDef pidents exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 exp])
+ LDFull pidents exp0 exp -> prPrec i 0 (concatD [prt 0 pidents , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Exp where
+ prt i e = case e of
+ EIdent pident -> prPrec i 6 (concatD [prt 0 pident])
+ EConstr pident -> prPrec i 6 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
+ ECons pident -> prPrec i 6 (concatD [doc (showString "%") , prt 0 pident , doc (showString "%")])
+ ESort sort -> prPrec i 6 (concatD [prt 0 sort])
+ EString str -> prPrec i 6 (concatD [prt 0 str])
+ EInt n -> prPrec i 6 (concatD [prt 0 n])
+ EFloat d -> prPrec i 6 (concatD [prt 0 d])
+ EMeta -> prPrec i 6 (concatD [doc (showString "?")])
+ EEmpty -> prPrec i 6 (concatD [doc (showString "[") , doc (showString "]")])
+ EData -> prPrec i 6 (concatD [doc (showString "data")])
+ EList pident exps -> prPrec i 6 (concatD [doc (showString "[") , prt 0 pident , prt 0 exps , doc (showString "]")])
+ EStrings str -> prPrec i 6 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
+ ERecord locdefs -> prPrec i 6 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
+ ETuple tuplecomps -> prPrec i 6 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
+ EIndir pident -> prPrec i 6 (concatD [doc (showString "(") , doc (showString "in") , prt 0 pident , doc (showString ")")])
+ ETyped exp0 exp -> prPrec i 6 (concatD [doc (showString "<") , prt 0 exp0 , doc (showString ":") , prt 0 exp , doc (showString ">")])
+ EProj exp label -> prPrec i 5 (concatD [prt 5 exp , doc (showString ".") , prt 0 label])
+ EQConstr pident0 pident -> prPrec i 5 (concatD [doc (showString "{") , prt 0 pident0 , doc (showString ".") , prt 0 pident , doc (showString "}")])
+ EQCons pident0 pident -> prPrec i 5 (concatD [doc (showString "%") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
+ EApp exp0 exp -> prPrec i 4 (concatD [prt 4 exp0 , prt 5 exp])
+ ETable cases -> prPrec i 4 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
+ ETTable exp cases -> prPrec i 4 (concatD [doc (showString "table") , prt 6 exp , doc (showString "{") , prt 0 cases , doc (showString "}")])
+ EVTable exp exps -> prPrec i 4 (concatD [doc (showString "table") , prt 6 exp , doc (showString "[") , prt 0 exps , doc (showString "]")])
+ ECase exp cases -> prPrec i 4 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
+ EVariants exps -> prPrec i 4 (concatD [doc (showString "variants") , doc (showString "{") , prt 0 exps , doc (showString "}")])
+ EPre exp alterns -> prPrec i 4 (concatD [doc (showString "pre") , doc (showString "{") , prt 0 exp , doc (showString ";") , prt 0 alterns , doc (showString "}")])
+ EStrs exps -> prPrec i 4 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
+ EConAt pident exp -> prPrec i 4 (concatD [prt 0 pident , doc (showString "@") , prt 6 exp])
+ EPatt patt -> prPrec i 4 (concatD [doc (showString "#") , prt 2 patt])
+ EPattType exp -> prPrec i 4 (concatD [doc (showString "pattern") , prt 5 exp])
+ ESelect exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "!") , prt 4 exp])
+ ETupTyp exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "*") , prt 4 exp])
+ EExtend exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "**") , prt 4 exp])
+ EGlue exp0 exp -> prPrec i 1 (concatD [prt 2 exp0 , doc (showString "+") , prt 1 exp])
+ EConcat exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "++") , prt 0 exp])
+ EAbstr binds exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 binds , doc (showString "->") , prt 0 exp])
+ ECTable binds exp -> prPrec i 0 (concatD [doc (showString "\\") , doc (showString "\\") , prt 0 binds , doc (showString "=>") , prt 0 exp])
+ EProd decl exp -> prPrec i 0 (concatD [prt 0 decl , doc (showString "->") , prt 0 exp])
+ ETType exp0 exp -> prPrec i 0 (concatD [prt 3 exp0 , doc (showString "=>") , prt 0 exp])
+ ELet locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , doc (showString "{") , prt 0 locdefs , doc (showString "}") , doc (showString "in") , prt 0 exp])
+ ELetb locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , prt 0 locdefs , doc (showString "in") , prt 0 exp])
+ EWhere exp locdefs -> prPrec i 0 (concatD [prt 3 exp , doc (showString "where") , doc (showString "{") , prt 0 locdefs , doc (showString "}")])
+ EEqs equations -> prPrec i 0 (concatD [doc (showString "fn") , doc (showString "{") , prt 0 equations , doc (showString "}")])
+ EExample exp str -> prPrec i 0 (concatD [doc (showString "in") , prt 5 exp , prt 0 str])
+ ELString lstring -> prPrec i 6 (concatD [prt 0 lstring])
+ ELin pident -> prPrec i 4 (concatD [doc (showString "Lin") , prt 0 pident])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Exps where
+ prt i e = case e of
+ NilExp -> prPrec i 0 (concatD [])
+ ConsExp exp exps -> prPrec i 0 (concatD [prt 6 exp , prt 0 exps])
+
+
+instance Print Patt where
+ prt i e = case e of
+ PChar -> prPrec i 2 (concatD [doc (showString "?")])
+ PChars str -> prPrec i 2 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
+ PMacro pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident])
+ PM pident0 pident -> prPrec i 2 (concatD [doc (showString "#") , prt 0 pident0 , doc (showString ".") , prt 0 pident])
+ PW -> prPrec i 2 (concatD [doc (showString "_")])
+ PV pident -> prPrec i 2 (concatD [prt 0 pident])
+ PCon pident -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pident , doc (showString "}")])
+ PQ pident0 pident -> prPrec i 2 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident])
+ PInt n -> prPrec i 2 (concatD [prt 0 n])
+ PFloat d -> prPrec i 2 (concatD [prt 0 d])
+ PStr str -> prPrec i 2 (concatD [prt 0 str])
+ PR pattasss -> prPrec i 2 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")])
+ PTup patttuplecomps -> prPrec i 2 (concatD [doc (showString "<") , prt 0 patttuplecomps , doc (showString ">")])
+ PC pident patts -> prPrec i 1 (concatD [prt 0 pident , prt 0 patts])
+ PQC pident0 pident patts -> prPrec i 1 (concatD [prt 0 pident0 , doc (showString ".") , prt 0 pident , prt 0 patts])
+ PDisj patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "|") , prt 1 patt])
+ PSeq patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "+") , prt 1 patt])
+ PRep patt -> prPrec i 1 (concatD [prt 2 patt , doc (showString "*")])
+ PAs pident patt -> prPrec i 1 (concatD [prt 0 pident , doc (showString "@") , prt 2 patt])
+ PNeg patt -> prPrec i 1 (concatD [doc (showString "-") , prt 2 patt])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 2 x])
+ x:xs -> (concatD [prt 2 x , prt 0 xs])
+
+instance Print PattAss where
+ prt i e = case e of
+ PA pidents patt -> prPrec i 0 (concatD [prt 0 pidents , doc (showString "=") , prt 0 patt])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Label where
+ prt i e = case e of
+ LIdent pident -> prPrec i 0 (concatD [prt 0 pident])
+ LVar n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
+
+
+instance Print Sort where
+ prt i e = case e of
+ Sort_Type -> prPrec i 0 (concatD [doc (showString "Type")])
+ Sort_PType -> prPrec i 0 (concatD [doc (showString "PType")])
+ Sort_Tok -> prPrec i 0 (concatD [doc (showString "Tok")])
+ Sort_Str -> prPrec i 0 (concatD [doc (showString "Str")])
+ Sort_Strs -> prPrec i 0 (concatD [doc (showString "Strs")])
+
+
+instance Print Bind where
+ prt i e = case e of
+ BIdent pident -> prPrec i 0 (concatD [prt 0 pident])
+ BWild -> prPrec i 0 (concatD [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 Decl where
+ prt i e = case e of
+ DDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
+ DExp exp -> prPrec i 0 (concatD [prt 4 exp])
+
+
+instance Print TupleComp where
+ prt i e = case e of
+ TComp exp -> prPrec i 0 (concatD [prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print PattTupleComp where
+ prt i e = case e of
+ PTComp patt -> prPrec i 0 (concatD [prt 0 patt])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Case where
+ prt i e = case e of
+ Case patt exp -> prPrec i 0 (concatD [prt 0 patt , doc (showString "=>") , prt 0 exp])
+
+ prtList es = case es of
+ [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 patts exp -> prPrec i 0 (concatD [prt 0 patts , doc (showString "->") , prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Altern where
+ prt i e = case e of
+ Alt exp0 exp -> prPrec i 0 (concatD [prt 0 exp0 , doc (showString "/") , prt 0 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ [x] -> (concatD [prt 0 x])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print DDecl where
+ prt i e = case e of
+ DDDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
+ DDExp exp -> prPrec i 0 (concatD [prt 6 exp])
+
+ prtList es = case es of
+ [] -> (concatD [])
+ x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print OldGrammar where
+ prt i e = case e of
+ OldGr include topdefs -> prPrec i 0 (concatD [prt 0 include , prt 0 topdefs])
+
+
+instance Print Include where
+ prt i e = case e of
+ NoIncl -> prPrec i 0 (concatD [])
+ Incl filenames -> prPrec i 0 (concatD [doc (showString "include") , prt 0 filenames])
+
+
+instance Print FileName where
+ prt i e = case e of
+ FString str -> prPrec i 0 (concatD [prt 0 str])
+ FIdent pident -> prPrec i 0 (concatD [prt 0 pident])
+ FSlash filename -> prPrec i 0 (concatD [doc (showString "/") , prt 0 filename])
+ FDot filename -> prPrec i 0 (concatD [doc (showString ".") , prt 0 filename])
+ FMinus filename -> prPrec i 0 (concatD [doc (showString "-") , prt 0 filename])
+ FAddId pident filename -> prPrec i 0 (concatD [prt 0 pident , prt 0 filename])
+
+ prtList es = case es of
+ [x] -> (concatD [prt 0 x , doc (showString ";")])
+ x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+
diff --git a/src/GF/Source/SharedString.hs b/src/GF/Source/SharedString.hs new file mode 100644 index 000000000..732873fe6 --- /dev/null +++ b/src/GF/Source/SharedString.hs @@ -0,0 +1,20 @@ +module GF.Source.SharedString (shareString) where
+
+import Data.Map as M
+import Data.IORef
+import qualified Data.ByteString.Char8 as BS
+import System.IO.Unsafe (unsafePerformIO)
+
+{-# NOINLINE stringPoolRef #-}
+stringPoolRef :: IORef (M.Map BS.ByteString BS.ByteString)
+stringPoolRef = unsafePerformIO $ newIORef M.empty
+
+{-# NOINLINE shareString #-}
+shareString :: BS.ByteString -> BS.ByteString
+shareString s = unsafePerformIO $ do
+ stringPool <- readIORef stringPoolRef
+ case M.lookup s stringPool of
+ Just s' -> return s'
+ Nothing -> do let s' = BS.copy s
+ writeIORef stringPoolRef $! M.insert s' s' stringPool
+ return s'
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs new file mode 100644 index 000000000..e80219f30 --- /dev/null +++ b/src/GF/Source/SourceToGrammar.hs @@ -0,0 +1,765 @@ +---------------------------------------------------------------------- +-- | +-- Module : SourceToGrammar +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/10/04 11:05:07 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.28 $ +-- +-- based on the skeleton Haskell module generated by the BNF converter +----------------------------------------------------------------------------- + +module GF.Source.SourceToGrammar ( transGrammar, + transInclude, + transModDef, + transOldGrammar, + transExp, + newReservedWords + ) where + +import qualified GF.Grammar.Grammar as G +import qualified GF.Grammar.PrGrammar as GP +import qualified GF.Infra.Modules as GM +import qualified GF.Grammar.Macros as M +import qualified GF.Compile.Update as U +import qualified GF.Infra.Option as GO +import qualified GF.Compile.ModDeps as GD +import GF.Grammar.Predef +import GF.Infra.Ident +import GF.Source.AbsGF +import GF.Source.PrintGF +import GF.Compile.RemoveLiT --- for bw compat +import GF.Data.Operations +import GF.Infra.Option + +import Control.Monad +import Data.Char +import Data.List (genericReplicate) +import qualified Data.ByteString.Char8 as BS + +-- based on the skeleton Haskell module generated by the BNF converter + +type Result = Err String + +failure :: Show a => a -> Err b +failure x = Bad $ "Undefined case: " ++ show x + +getIdentPos :: PIdent -> Err (Ident,Int) +getIdentPos x = case x of + PIdent ((line,_),c) -> return (IC c,line) + +transIdent :: PIdent -> Err Ident +transIdent = liftM fst . getIdentPos + +transName :: Name -> Err Ident +transName n = case n of + IdentName i -> transIdent i + ListName i -> liftM mkListId (transIdent i) + +transNamePos :: Name -> Err (Ident,Int) +transNamePos n = case n of + IdentName i -> getIdentPos i + ListName i -> liftM (\ (c,p) -> (mkListId c,p)) (getIdentPos i) + +transGrammar :: Grammar -> Err G.SourceGrammar +transGrammar x = case x of + Gr moddefs -> do + moddefs' <- mapM transModDef moddefs + GD.mkSourceGrammar moddefs' + +transModDef :: ModDef -> Err (Ident, G.SourceModInfo) +transModDef x = case x of + + MMain id0 id concspecs -> do + id0' <- transIdent id0 + id' <- transIdent id + concspecs' <- mapM transConcSpec concspecs + return $ (id0', GM.ModMainGrammar (GM.MainGrammar id' concspecs')) + + MModule compl mtyp body -> do + + let mstat' = transComplMod compl + + (trDef, mtyp', id') <- case mtyp of + MTAbstract id -> do + id' <- transIdent id + return (transAbsDef, GM.MTAbstract, id') + MTResource id -> mkModRes id GM.MTResource body + MTConcrete id open -> do + id' <- transIdent id + open' <- transIdent open + return (transCncDef, GM.MTConcrete open', id') + MTTransfer id a b -> do + id' <- transIdent id + a' <- transOpen a + b' <- transOpen a + return (transAbsDef, GM.MTTransfer a' b', id') + MTInterface id -> mkModRes id GM.MTInterface body + MTInstance id open -> do + open' <- transIdent open + mkModRes id (GM.MTInstance open') body + + mkBody (mstat', trDef, mtyp', id') body + where + poss = emptyBinTree ---- + + mkBody xx@(mstat', trDef, mtyp', id') bod = case bod of + MNoBody incls -> do + mkBody xx $ MBody (Ext incls) NoOpens [] + MBody extends opens defs -> do + extends' <- transExtend extends + opens' <- transOpens opens + defs0 <- mapM trDef $ getTopDefs defs + poss0 <- return [(i,p) | Left ds <- defs0, (i,p,_) <- ds] + defs' <- U.buildAnyTree [(i,d) | Left ds <- defs0, (i,_,d) <- ds] + flags' <- return $ concatModuleOptions [o | Right o <- defs0] + let poss1 = buildPosTree id' poss0 + return (id', + GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs' poss1)) + MReuse _ -> do + return (id', GM.ModMod (GM.Module mtyp' mstat' noModuleOptions [] [] emptyBinTree poss)) + MUnion imps -> do + imps' <- mapM transIncluded imps + return (id', + GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' noModuleOptions [] [] emptyBinTree poss)) + + MWith m insts -> mkBody xx $ MWithEBody [] m insts NoOpens [] + MWithBody m insts opens defs -> mkBody xx $ MWithEBody [] m insts opens defs + MWithE extends m insts -> mkBody xx $ MWithEBody extends m insts NoOpens [] + MWithEBody extends m insts opens defs -> do + extends' <- mapM transIncludedExt extends + m' <- transIncludedExt m + insts' <- mapM transOpen insts + opens' <- transOpens opens + defs0 <- mapM trDef $ getTopDefs defs + poss0 <- return [(i,p) | Left ds <- defs0, (i,p,_) <- ds] + defs' <- U.buildAnyTree [(i,d) | Left ds <- defs0, (i,_,d) <- ds] + flags' <- return $ concatModuleOptions [o | Right o <- defs0] + let poss1 = buildPosTree id' poss0 + return (id', + GM.ModWith (GM.Module mtyp' mstat' flags' extends' opens' defs' poss1) m' insts') + + mkModRes id mtyp body = do + id' <- transIdent id + case body of + MReuse c -> do + c' <- transIdent c + mtyp' <- trMReuseType mtyp c' + return (transResDef, GM.MTReuse mtyp', id') + _ -> return (transResDef, mtyp, id') + trMReuseType mtyp c = case mtyp of + GM.MTInterface -> return $ GM.MRInterface c + GM.MTInstance op -> return $ GM.MRInstance c op + GM.MTResource -> return $ GM.MRResource c + + +transComplMod :: ComplMod -> GM.ModuleStatus +transComplMod x = case x of + CMCompl -> GM.MSComplete + CMIncompl -> GM.MSIncomplete + +getTopDefs :: [TopDef] -> [TopDef] +getTopDefs x = x + +transConcSpec :: ConcSpec -> Err (GM.MainConcreteSpec Ident) +transConcSpec x = case x of + ConcSpec id concexp -> do + id' <- transIdent id + (m,mi,mo) <- transConcExp concexp + return $ GM.MainConcreteSpec id' m mi mo + +transConcExp :: ConcExp -> + Err (Ident, Maybe (GM.OpenSpec Ident),Maybe (GM.OpenSpec Ident)) +transConcExp x = case x of + ConcExp id transfers -> do + id' <- transIdent id + trs <- mapM transTransfer transfers + tin <- case [o | Left o <- trs] of + [o] -> return $ Just o + [] -> return $ Nothing + _ -> Bad "ambiguous transfer in" + tout <- case [o | Right o <- trs] of + [o] -> return $ Just o + [] -> return $ Nothing + _ -> Bad "ambiguous transfer out" + return (id',tin,tout) + +transTransfer :: Transfer -> + Err (Either (GM.OpenSpec Ident)(GM.OpenSpec Ident)) +transTransfer x = case x of + TransferIn open -> liftM Left $ transOpen open + TransferOut open -> liftM Right $ transOpen open + +transExtend :: Extend -> Err [(Ident,GM.MInclude Ident)] +transExtend x = case x of + Ext ids -> mapM transIncludedExt ids + NoExt -> return [] + +transOpens :: Opens -> Err [GM.OpenSpec Ident] +transOpens x = case x of + NoOpens -> return [] + OpenIn opens -> mapM transOpen opens + +transOpen :: Open -> Err (GM.OpenSpec Ident) +transOpen x = case x of + OName id -> liftM (GM.OSimple GM.OQNormal) $ transIdent id + OQualQO q id -> liftM2 GM.OSimple (transQualOpen q) (transIdent id) + OQual q id m -> liftM3 GM.OQualif (transQualOpen q) (transIdent id) (transIdent m) + +transQualOpen :: QualOpen -> Err GM.OpenQualif +transQualOpen x = case x of + QOCompl -> return GM.OQNormal + QOInterface -> return GM.OQInterface + QOIncompl -> return GM.OQIncomplete + +transIncluded :: Included -> Err (Ident,[Ident]) +transIncluded x = case x of + IAll i -> liftM (flip (curry id) []) $ transIdent i + ISome i ids -> liftM2 (curry id) (transIdent i) (mapM transIdent ids) + IMinus i ids -> liftM2 (curry id) (transIdent i) (mapM transIdent ids) ---- + +transIncludedExt :: Included -> Err (Ident, GM.MInclude Ident) +transIncludedExt x = case x of + IAll i -> liftM2 (,) (transIdent i) (return GM.MIAll) + ISome i ids -> liftM2 (,) (transIdent i) (liftM GM.MIOnly $ mapM transIdent ids) + IMinus i ids -> liftM2 (,) (transIdent i) (liftM GM.MIExcept $ mapM transIdent ids) + +--- where no position is saved +nopos :: Int +nopos = -1 + +buildPosTree :: Ident -> [(Ident,Int)] -> BinTree Ident (String,(Int,Int)) +buildPosTree m = buildTree . mkPoss . filter ((>0) . snd) where + mkPoss cs = case cs of + (i,p):rest@((_,q):_) -> (i,(name,(p,max p (q-1)))) : mkPoss rest + (i,p):[] -> (i,(name,(p,p+100))) : [] --- don't know last line + _ -> [] + name = prIdent m ++ ".gf" ---- + +transAbsDef :: TopDef -> Err (Either [(Ident, Int, G.Info)] GO.ModuleOptions) +transAbsDef x = case x of + DefCat catdefs -> liftM (Left . concat) $ mapM transCatDef catdefs + DefFun fundefs -> do + fundefs' <- mapM transFunDef fundefs + returnl [(fun, nopos, G.AbsFun (yes typ) nope) | (funs,typ) <- fundefs', fun <- funs] + DefFunData fundefs -> do + fundefs' <- mapM transFunDef fundefs + returnl $ + [(cat, nopos, G.AbsCat nope (yes [G.Cn fun])) | (funs,typ) <- fundefs', + fun <- funs, + Ok (_,cat) <- [M.valCat typ] + ] ++ + [(fun, nopos, G.AbsFun (yes typ) (yes G.EData)) | (funs,typ) <- fundefs', fun <- funs] + DefDef defs -> do + defs' <- liftM concat $ mapM getDefsGen defs + returnl [(c, nopos, G.AbsFun nope pe) | ((c,p),(_,pe)) <- defs'] + DefData ds -> do + ds' <- mapM transDataDef ds + returnl $ + [(c, nopos, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++ + [(f, nopos, G.AbsFun nope (yes G.EData)) | (_,fs) <- ds', tf <- fs, f <- funs tf] + DefTrans defs -> do + defs' <- liftM concat $ mapM getDefsGen defs + returnl [(c, nopos, G.AbsTrans f) | ((c,p),(_,Yes f)) <- defs'] + DefFlag defs -> liftM (Right . concatModuleOptions) $ mapM transFlagDef defs + _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x + where + -- to get data constructors as terms + funs t = case t of + G.Cn f -> [f] + G.Q _ f -> [f] + G.QC _ f -> [f] + _ -> [] + +returnl :: a -> Err (Either a b) +returnl = return . Left + +transFlagDef :: FlagDef -> Err GO.ModuleOptions +transFlagDef x = case x of + FlagDef f x -> parseModuleOptions ["--" ++ prPIdent f ++ "=" ++ prPIdent x] + where + prPIdent (PIdent (_,c)) = BS.unpack c + + +-- | Cat definitions can also return some fun defs +-- if it is a list category definition +transCatDef :: CatDef -> Err [(Ident, Int, G.Info)] +transCatDef x = case x of + SimpleCatDef id ddecls -> do + (id',pos) <- getIdentPos id + liftM (:[]) $ cat id' pos ddecls + ListCatDef id ddecls -> listCat id ddecls 0 + ListSizeCatDef id ddecls size -> listCat id ddecls size + where + cat i pos ddecls = do + -- i <- transIdent id + cont <- liftM concat $ mapM transDDecl ddecls + return (i, pos, G.AbsCat (yes cont) nope) + listCat id ddecls size = do + (id',pos) <- getIdentPos id + let + li = mkListId id' + baseId = mkBaseId id' + consId = mkConsId id' + catd0@(c,p,G.AbsCat (Yes cont0) _) <- cat li pos ddecls + let + catd = (c,pos,G.AbsCat (Yes cont0) (Yes [G.Cn baseId,G.Cn consId])) + cont = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont0] + xs = map (G.Vr . fst) cont + cd = M.mkDecl (M.mkApp (G.Vr id') xs) + lc = M.mkApp (G.Vr li) xs + niltyp = M.mkProdSimple (cont ++ genericReplicate size cd) lc + nilfund = (baseId, nopos, G.AbsFun (yes niltyp) (yes G.EData)) + constyp = M.mkProdSimple (cont ++ [cd, M.mkDecl lc]) lc + consfund = (consId, nopos, G.AbsFun (yes constyp) (yes G.EData)) + return [catd,nilfund,consfund] + mkId x i = if isWildIdent x then (varX i) else x + +transFunDef :: FunDef -> Err ([Ident], G.Type) +transFunDef x = case x of + FunDef ids typ -> liftM2 (,) (mapM transIdent ids) (transExp typ) + +transDataDef :: DataDef -> Err (Ident,[G.Term]) +transDataDef x = case x of + DataDef id ds -> liftM2 (,) (transIdent id) (mapM transData ds) + where + transData d = case d of + DataId id -> liftM G.Cn $ transIdent id + DataQId id0 id -> liftM2 G.QC (transIdent id0) (transIdent id) + +transResDef :: TopDef -> Err (Either [(Ident, Int, G.Info)] GO.ModuleOptions) +transResDef x = case x of + DefPar pardefs -> do + pardefs' <- mapM transParDef pardefs + returnl $ [(p, nopos, G.ResParam (if null pars + then nope -- abstract param type + else (yes (pars,Nothing)))) + | (p,pars) <- pardefs'] + ++ [(f, nopos, G.ResValue (yes (M.mkProdSimple co (G.Cn p),Nothing))) | + (p,pars) <- pardefs', (f,co) <- pars] + + DefOper defs -> do + defs' <- liftM concat $ mapM getDefs defs + returnl $ + concatMap mkOverload [(f, p, G.ResOper pt pe) | ((f,p),(pt,pe)) <- defs'] + + DefLintype defs -> do + defs' <- liftM concat $ mapM getDefs defs + returnl [(f, p, G.ResOper pt pe) | ((f,p),(pt,pe)) <- defs'] + + DefFlag defs -> liftM (Right . concatModuleOptions) $ mapM transFlagDef defs + _ -> Bad $ "illegal definition form in resource" +++ printTree x + where + mkOverload op@(c,p,j) = case j of + G.ResOper _ (Yes df) -> case M.appForm df of + (keyw, ts@(_:_)) | isOverloading keyw -> case last ts of + G.R fs -> + [(c,p,G.ResOverload [m | G.Vr m <- ts] [(ty,fu) | (_,(Just ty,fu)) <- fs])] + _ -> [op] + _ -> [op] + + -- to enable separare type signature --- not type-checked + G.ResOper (Yes df) _ -> case M.appForm df of + (keyw, ts@(_:_)) | isOverloading keyw -> case last ts of + G.RecType _ -> [] + _ -> [op] + _ -> [op] + _ -> [(c,p,j)] + isOverloading keyw = + GP.prt keyw == "overload" -- overload is a "soft keyword" + isRec t = case t of + G.R _ -> True + _ -> False + +transParDef :: ParDef -> Err (Ident, [G.Param]) +transParDef x = case x of + ParDefDir id params -> liftM2 (,) (transIdent id) (mapM transParConstr params) + ParDefAbs id -> liftM2 (,) (transIdent id) (return []) + _ -> Bad $ "illegal definition in resource:" ++++ printTree x + +transCncDef :: TopDef -> Err (Either [(Ident, Int, G.Info)] GO.ModuleOptions) +transCncDef x = case x of + DefLincat defs -> do + defs' <- liftM concat $ mapM transPrintDef defs + returnl [(f, nopos, G.CncCat (yes t) nope nope) | (f,t) <- defs'] + DefLindef defs -> do + defs' <- liftM concat $ mapM getDefs defs + returnl [(f, p, G.CncCat pt pe nope) | ((f,p),(pt,pe)) <- defs'] + DefLin defs -> do + defs' <- liftM concat $ mapM getDefs defs + returnl [(f, p, G.CncFun Nothing pe nope) | ((f,p),(_,pe)) <- defs'] + DefPrintCat defs -> do + defs' <- liftM concat $ mapM transPrintDef defs + returnl [(f, nopos, G.CncCat nope nope (yes e)) | (f,e) <- defs'] + DefPrintFun defs -> do + defs' <- liftM concat $ mapM transPrintDef defs + returnl [(f, nopos, G.CncFun Nothing nope (yes e)) | (f,e) <- defs'] + DefPrintOld defs -> do --- a guess, for backward compatibility + defs' <- liftM concat $ mapM transPrintDef defs + returnl [(f, nopos, G.CncFun Nothing nope (yes e)) | (f,e) <- defs'] + DefFlag defs -> liftM (Right . concatModuleOptions) $ mapM transFlagDef defs + DefPattern defs -> do + defs' <- liftM concat $ mapM getDefs defs + let defs2 = [(f, termInPattern t) | (f,(_,Yes t)) <- defs'] + returnl [(f, p, G.CncFun Nothing (yes t) nope) | ((f,p),t) <- defs2] + + _ -> errIn ("illegal definition in concrete syntax:") $ transResDef x + +transPrintDef :: PrintDef -> Err [(Ident,G.Term)] +transPrintDef x = case x of + PrintDef ids exp -> do + (ids,e) <- liftM2 (,) (mapM transName ids) (transExp exp) + return $ [(i,e) | i <- ids] + +getDefsGen :: Def -> Err [((Ident, Int),(G.Perh G.Type, G.Perh G.Term))] +getDefsGen d = case d of + DDecl ids t -> do + ids' <- mapM transNamePos ids + t' <- transExp t + return [(i,(yes t', nope)) | i <- ids'] + DDef ids e -> do + ids' <- mapM transNamePos ids + e' <- transExp e + return [(i,(nope, yes e')) | i <- ids'] + DFull ids t e -> do + ids' <- mapM transNamePos ids + t' <- transExp t + e' <- transExp e + return [(i,(yes t', yes e')) | i <- ids'] + DPatt id patts e -> do + id' <- transNamePos id + ps' <- mapM transPatt patts + e' <- transExp e + return [(id',(nope, yes (G.Eqs [(ps',e')])))] + +-- | sometimes you need this special case, e.g. in linearization rules +getDefs :: Def -> Err [((Ident,Int), (G.Perh G.Type, G.Perh G.Term))] +getDefs d = case d of + DPatt id patts e -> do + id' <- transNamePos id + xs <- mapM tryMakeVar patts + e' <- transExp e + return [(id',(nope, yes (M.mkAbs xs e')))] + _ -> getDefsGen d + +-- | accepts a pattern that is either a variable or a wild card +tryMakeVar :: Patt -> Err Ident +tryMakeVar p = do + p' <- transPatt p + case p' of + G.PV i -> return i + G.PW -> return identW + _ -> Bad $ "not a legal pattern in lambda binding" +++ GP.prt p' + +transExp :: Exp -> Err G.Term +transExp x = case x of + EIdent id -> liftM G.Vr $ transIdent id + EConstr id -> liftM G.Con $ transIdent id + ECons id -> liftM G.Cn $ transIdent id + EQConstr m c -> liftM2 G.QC (transIdent m) (transIdent c) + EQCons m c -> liftM2 G.Q (transIdent m) (transIdent c) + EString str -> return $ G.K str + ESort sort -> return $ G.Sort $ transSort sort + EInt n -> return $ G.EInt n + EFloat n -> return $ G.EFloat n + EMeta -> return $ G.Meta $ M.int2meta 0 + EEmpty -> return G.Empty + -- [ C x_1 ... x_n ] becomes (ListC x_1 ... x_n) + EList i es -> do + i' <- transIdent i + es' <- mapM transExp (exps2list es) + return $ foldl G.App (G.Vr (mkListId i')) es' + EStrings [] -> return G.Empty + EStrings str -> return $ foldr1 G.C $ map G.K $ words str + ERecord defs -> erecord2term defs + ETupTyp _ _ -> do + let tups t = case t of + ETupTyp x y -> tups x ++ [y] -- right-associative parsing + _ -> [t] + es <- mapM transExp $ tups x + return $ G.RecType $ M.tuple2recordType es + ETuple tuplecomps -> do + es <- mapM transExp [e | TComp e <- tuplecomps] + return $ G.R $ M.tuple2record es + EProj exp id -> liftM2 G.P (transExp exp) (trLabel id) + EApp exp0 exp -> liftM2 G.App (transExp exp0) (transExp exp) + ETable cases -> liftM (G.T G.TRaw) (transCases cases) + ETTable exp cases -> + liftM2 (\t c -> G.T (G.TTyped t) c) (transExp exp) (transCases cases) + EVTable exp cases -> + liftM2 (\t c -> G.V t c) (transExp exp) (mapM transExp cases) + ECase exp cases -> do + exp' <- transExp exp + cases' <- transCases cases + let annot = case exp' of + G.Typed _ t -> G.TTyped t + _ -> G.TRaw + return $ G.S (G.T annot cases') exp' + ECTable binds exp -> liftM2 M.mkCTable (mapM transBind binds) (transExp exp) + + EVariants exps -> liftM G.FV $ mapM transExp exps + EPre exp alts -> liftM2 (curry G.Alts) (transExp exp) (mapM transAltern alts) + EStrs exps -> liftM G.Strs $ mapM transExp exps + ESelect exp0 exp -> liftM2 G.S (transExp exp0) (transExp exp) + EExtend exp0 exp -> liftM2 G.ExtR (transExp exp0) (transExp exp) + EAbstr binds exp -> liftM2 M.mkAbs (mapM transBind binds) (transExp exp) + ETyped exp0 exp -> liftM2 G.Typed (transExp exp0) (transExp exp) + EExample exp str -> liftM2 G.Example (transExp exp) (return str) + + EProd decl exp -> liftM2 M.mkProdSimple (transDecl decl) (transExp exp) + ETType exp0 exp -> liftM2 G.Table (transExp exp0) (transExp exp) + EConcat exp0 exp -> liftM2 G.C (transExp exp0) (transExp exp) + EGlue exp0 exp -> liftM2 G.Glue (transExp exp0) (transExp exp) + ELet defs exp -> do + exp' <- transExp exp + defs0 <- mapM locdef2fields defs + defs' <- mapM tryLoc $ concat defs0 + return $ M.mkLet defs' exp' + where + tryLoc (c,(mty,Just e)) = return (c,(mty,e)) + tryLoc (c,_) = Bad $ "local definition of" +++ GP.prt c +++ "without value" + ELetb defs exp -> transExp $ ELet defs exp + EWhere exp defs -> transExp $ ELet defs exp + + EPattType typ -> liftM G.EPattType (transExp typ) + EPatt patt -> liftM G.EPatt (transPatt patt) + + ELString (LString str) -> return $ G.K (BS.unpack str) -- use the grammar encoding here + ELin id -> liftM G.LiT $ transIdent id + + EEqs eqs -> liftM G.Eqs $ mapM transEquation eqs + + _ -> Bad $ "translation not yet defined for" +++ printTree x ---- + +exps2list :: Exps -> [Exp] +exps2list NilExp = [] +exps2list (ConsExp e es) = e : exps2list es + +--- this is complicated: should we change Exp or G.Term ? + +erecord2term :: [LocDef] -> Err G.Term +erecord2term ds = do + ds' <- mapM locdef2fields ds + mkR $ concat ds' + where + mkR fs = do + fs' <- transF fs + return $ case fs' of + Left ts -> G.RecType ts + Right ds -> G.R ds + transF [] = return $ Left [] --- empty record always interpreted as record type + transF fs@(f:_) = case f of + (lab,(Just ty,Nothing)) -> mapM tryRT fs >>= return . Left + _ -> mapM tryR fs >>= return . Right + tryRT f = case f of + (lab,(Just ty,Nothing)) -> return (G.ident2label lab,ty) + _ -> Bad $ "illegal record type field" +++ GP.prt (fst f) --- manifest fields ?! + tryR f = case f of + (lab,(mty, Just t)) -> return (G.ident2label lab,(mty,t)) + _ -> Bad $ "illegal record field" +++ GP.prt (fst f) + + +locdef2fields :: LocDef -> Err [(Ident, (Maybe G.Type, Maybe G.Type))] +locdef2fields d = case d of + LDDecl ids t -> do + labs <- mapM transIdent ids + t' <- transExp t + return [(lab,(Just t',Nothing)) | lab <- labs] + LDDef ids e -> do + labs <- mapM transIdent ids + e' <- transExp e + return [(lab,(Nothing, Just e')) | lab <- labs] + LDFull ids t e -> do + labs <- mapM transIdent ids + t' <- transExp t + e' <- transExp e + return [(lab,(Just t', Just e')) | lab <- labs] + +trLabel :: Label -> Err G.Label +trLabel x = case x of + LIdent (PIdent (_, s)) -> return $ G.LIdent s + LVar x -> return $ G.LVar $ fromInteger x + +transSort :: Sort -> Ident +transSort Sort_Type = cType +transSort Sort_PType = cPType +transSort Sort_Tok = cTok +transSort Sort_Str = cStr +transSort Sort_Strs = cStrs + + +{- +--- no more used 7/1/2006 AR +transPatts :: Patt -> Err [G.Patt] +transPatts p = case p of + PDisj p1 p2 -> liftM2 (++) (transPatts p1) (transPatts p2) + PC id patts -> liftM (map (G.PC id) . combinations) $ mapM transPatts patts + PQC q id patts -> liftM (map (G.PP q id) . combinations) (mapM transPatts patts) + + PR pattasss -> do + let (lss,ps) = unzip [(ls,p) | PA ls p <- pattasss] + ls = map LIdent $ concat lss + ps0 <- mapM transPatts ps + let ps' = combinations ps0 + lss' <- mapM trLabel ls + let rss = map (zip lss') ps' + return $ map G.PR rss + PTup pcs -> do + ps0 <- mapM transPatts [e | PTComp e <- pcs] + let ps' = combinations ps0 + return $ map (G.PR . M.tuple2recordPatt) ps' + _ -> liftM singleton $ transPatt p +-} + +transPatt :: Patt -> Err G.Patt +transPatt x = case x of + PW -> return G.wildPatt + PV id -> liftM G.PV $ transIdent id + PC id patts -> liftM2 G.PC (transIdent id) (mapM transPatt patts) + PCon id -> liftM2 G.PC (transIdent id) (return []) + PInt n -> return $ G.PInt n + PFloat n -> return $ G.PFloat n + PStr str -> return $ G.PString str + PR pattasss -> do + let (lss,ps) = unzip [(ls,p) | PA ls p <- pattasss] + ls = map LIdent $ concat lss + liftM G.PR $ liftM2 zip (mapM trLabel ls) (mapM transPatt ps) + PTup pcs -> + liftM (G.PR . M.tuple2recordPatt) (mapM transPatt [e | PTComp e <- pcs]) + PQ id0 id -> liftM3 G.PP (transIdent id0) (transIdent id) (return []) + PQC id0 id patts -> + liftM3 G.PP (transIdent id0) (transIdent id) (mapM transPatt patts) + PDisj p1 p2 -> liftM2 G.PAlt (transPatt p1) (transPatt p2) + PSeq p1 p2 -> liftM2 G.PSeq (transPatt p1) (transPatt p2) + PRep p -> liftM G.PRep (transPatt p) + PNeg p -> liftM G.PNeg (transPatt p) + PAs x p -> liftM2 G.PAs (transIdent x) (transPatt p) + PChar -> return G.PChar + PChars s -> return $ G.PChars s + PMacro c -> liftM G.PMacro $ transIdent c + PM m c -> liftM2 G.PM (transIdent m) (transIdent c) + +transBind :: Bind -> Err Ident +transBind x = case x of + BIdent id -> transIdent id + BWild -> return identW + +transDecl :: Decl -> Err [G.Decl] +transDecl x = case x of + DDec binds exp -> do + xs <- mapM transBind binds + exp' <- transExp exp + return [(x,exp') | x <- xs] + DExp exp -> liftM (return . M.mkDecl) $ transExp exp + +transCases :: [Case] -> Err [G.Case] +transCases = mapM transCase + +transCase :: Case -> Err G.Case +transCase (Case p exp) = do + patt <- transPatt p + exp' <- transExp exp + return (patt,exp') + +transEquation :: Equation -> Err G.Equation +transEquation x = case x of + Equ apatts exp -> liftM2 (,) (mapM transPatt apatts) (transExp exp) + +transAltern :: Altern -> Err (G.Term, G.Term) +transAltern x = case x of + Alt exp0 exp -> liftM2 (,) (transExp exp0) (transExp exp) + +transParConstr :: ParConstr -> Err G.Param +transParConstr x = case x of + ParConstr id ddecls -> do + id' <- transIdent id + ddecls' <- mapM transDDecl ddecls + return (id',concat ddecls') + +transDDecl :: DDecl -> Err [G.Decl] +transDDecl x = case x of + DDDec binds exp -> transDecl $ DDec binds exp + DDExp exp -> transDecl $ DExp exp + +-- | to deal with the old format, sort judgements in two modules, forming +-- their names from a given string, e.g. file name or overriding user-given string +transOldGrammar :: Options -> FilePath -> OldGrammar -> Err G.SourceGrammar +transOldGrammar opts name0 x = case x of + OldGr includes topdefs -> do --- includes must be collected separately + let moddefs = sortTopDefs topdefs + g1 <- transGrammar $ Gr moddefs + removeLiT g1 --- needed for bw compatibility with an obsolete feature + where + sortTopDefs ds = [mkAbs a, mkCnc ops (c ++ r)] + where + ops = map fst ps + (a,r,c,ps) = foldr srt ([],[],[],[]) ds + srt d (a,r,c,ps) = case d of + DefCat catdefs -> (d:a,r,c,ps) + DefFun fundefs -> (d:a,r,c,ps) + DefFunData fundefs -> (d:a,r,c,ps) + DefDef defs -> (d:a,r,c,ps) + DefData pardefs -> (d:a,r,c,ps) + DefPar pardefs -> (a,d:r,c,ps) + DefOper defs -> (a,d:r,c,ps) + DefLintype defs -> (a,d:r,c,ps) + DefLincat defs -> (a,r,d:c,ps) + DefLindef defs -> (a,r,d:c,ps) + DefLin defs -> (a,r,d:c,ps) + DefPattern defs -> (a,r,d:c,ps) + DefFlag defs -> (a,r,d:c,ps) --- a guess + DefPrintCat printdefs -> (a,r,d:c,ps) + DefPrintFun printdefs -> (a,r,d:c,ps) + DefPrintOld printdefs -> (a,r,d:c,ps) + -- DefPackage m ds -> (a,r,c,(m,ds):ps) -- OBSOLETE + _ -> (a,r,c,ps) + mkAbs a = MModule q (MTAbstract absName) (MBody ne (OpenIn []) (topDefs a)) + mkCnc ps r = MModule q (MTConcrete cncName absName) (MBody ne (OpenIn []) (topDefs r)) + topDefs t = t + ne = NoExt + q = CMCompl + + name = maybe name0 (++ ".gf") $ moduleFlag optName opts + absName = identPI $ maybe topic id $ moduleFlag optAbsName opts + resName = identPI $ maybe ("Res" ++ lang) id $ moduleFlag optResName opts + cncName = identPI $ maybe lang id $ moduleFlag optCncName opts + + identPI s = PIdent ((0,0),BS.pack s) + + (beg,rest) = span (/='.') name + (topic,lang) = case rest of -- to avoid overwriting old files + ".gf" -> ("Abs" ++ beg,"Cnc" ++ beg) + ".cf" -> ("Abs" ++ beg,"Cnc" ++ beg) + ".ebnf" -> ("Abs" ++ beg,"Cnc" ++ beg) + [] -> ("Abs" ++ beg,"Cnc" ++ beg) + _:s -> (beg, takeWhile (/='.') s) + +transInclude :: Include -> Err [FilePath] +transInclude x = Bad "Old GF with includes no more supported in GF 3.0" + +newReservedWords :: [String] +newReservedWords = + words $ "abstract concrete interface incomplete " ++ + "instance out open resource reuse transfer union with where" + +termInPattern :: G.Term -> G.Term +termInPattern t = M.mkAbs xx $ G.R [(s, (Nothing, toP body))] where + toP t = case t of + G.Vr x -> G.P t s + _ -> M.composSafeOp toP t + s = G.LIdent (BS.pack "s") + (xx,body) = abss [] t + abss xs t = case t of + G.Abs x b -> abss (x:xs) b + _ -> (reverse xs,t) + +mkListId,mkConsId,mkBaseId :: Ident -> Ident +mkListId = prefixId (BS.pack "List") +mkConsId = prefixId (BS.pack "Cons") +mkBaseId = prefixId (BS.pack "Base") + +prefixId :: BS.ByteString -> Ident -> Ident +prefixId pref id = identC (BS.append pref (ident2bs id)) diff --git a/src/GF/Speech/CFG.hs b/src/GF/Speech/CFG.hs new file mode 100644 index 000000000..5b2a0f2ca --- /dev/null +++ b/src/GF/Speech/CFG.hs @@ -0,0 +1,344 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.CFG +-- +-- Context-free grammar representation and manipulation. +---------------------------------------------------------------------- +module GF.Speech.CFG where + +import GF.Data.Utilities +import PGF.CId +import GF.Infra.Option +import GF.Infra.PrintClass +import GF.Speech.Relation + +import Control.Monad +import Control.Monad.State (State, get, put, evalState) +import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import Data.List +import Data.Maybe (fromMaybe) +import Data.Monoid (mconcat) +import Data.Set (Set) +import qualified Data.Set as Set + +-- +-- * Types +-- + +type Cat = String +type Token = String + +data Symbol c t = NonTerminal c | Terminal t + deriving (Eq, Ord, Show) + +type CFSymbol = Symbol Cat Token + +data CFRule = CFRule { + lhsCat :: Cat, + ruleRhs :: [CFSymbol], + ruleName :: CFTerm + } + deriving (Eq, Ord, Show) + +data CFTerm + = CFObj CId [CFTerm] -- ^ an abstract syntax function with arguments + | CFAbs Int CFTerm -- ^ A lambda abstraction. The Int is the variable id. + | CFApp CFTerm CFTerm -- ^ Application + | CFRes Int -- ^ The result of the n:th (0-based) non-terminal + | CFVar Int -- ^ A lambda-bound variable + | CFMeta CId -- ^ A metavariable + deriving (Eq, Ord, Show) + +data CFG = CFG { cfgStartCat :: Cat, + cfgExternalCats :: Set Cat, + cfgRules :: Map Cat (Set CFRule) } + deriving (Eq, Ord, Show) + +-- +-- * Grammar filtering +-- + +-- | Removes all directly and indirectly cyclic productions. +-- FIXME: this may be too aggressive, only one production +-- needs to be removed to break a given cycle. But which +-- one should we pick? +-- FIXME: Does not (yet) remove productions which are cyclic +-- because of empty productions. +removeCycles :: CFG -> CFG +removeCycles = onRules f + where f rs = filter (not . isCycle) rs + where alias = transitiveClosure $ mkRel [(c,c') | CFRule c [NonTerminal c'] _ <- rs] + isCycle (CFRule c [NonTerminal c'] _) = isRelatedTo alias c' c + isCycle _ = False + +-- | Better bottom-up filter that also removes categories which contain no finite +-- strings. +bottomUpFilter :: CFG -> CFG +bottomUpFilter gr = fix grow (gr { cfgRules = Map.empty }) + where grow g = g `unionCFG` filterCFG (all (okSym g) . ruleRhs) gr + okSym g = symbol (`elem` allCats g) (const True) + +-- | Removes categories which are not reachable from any external category. +topDownFilter :: CFG -> CFG +topDownFilter cfg = filterCFGCats (`Set.member` keep) cfg + where + rhsCats = [ (lhsCat r, c') | r <- allRules cfg, c' <- filterCats (ruleRhs r) ] + uses = reflexiveClosure_ (allCats cfg) $ transitiveClosure $ mkRel rhsCats + keep = Set.unions $ map (allRelated uses) $ Set.toList $ cfgExternalCats cfg + +-- | Merges categories with identical right-hand-sides. +-- FIXME: handle probabilities +mergeIdentical :: CFG -> CFG +mergeIdentical g = onRules (map subst) g + where + -- maps categories to their replacement + m = Map.fromList [(y,concat (intersperse "+" xs)) + | (_,xs) <- buildMultiMap [(rulesKey rs,c) | (c,rs) <- Map.toList (cfgRules g)], y <- xs] + -- build data to compare for each category: a set of name,rhs pairs + rulesKey = Set.map (\ (CFRule _ r n) -> (n,r)) + subst (CFRule c r n) = CFRule (substCat c) (map (mapSymbol substCat id) r) n + substCat c = Map.findWithDefault (error $ "mergeIdentical: " ++ c) c m + +-- +-- * Removing left recursion +-- + +-- The LC_LR algorithm from +-- http://research.microsoft.com/users/bobmoore/naacl2k-proc-rev.pdf +removeLeftRecursion :: CFG -> CFG +removeLeftRecursion gr + = gr { cfgRules = groupProds $ concat [scheme1, scheme2, scheme3, scheme4] } + where + scheme1 = [CFRule a [x,NonTerminal a_x] n' | + a <- retainedLeftRecursive, + x <- properLeftCornersOf a, + not (isLeftRecursive x), + let a_x = mkCat (NonTerminal a) x, + -- this is an extension of LC_LR to avoid generating + -- A-X categories for which there are no productions: + a_x `Set.member` newCats, + let n' = symbol (\_ -> CFApp (CFRes 1) (CFRes 0)) + (\_ -> CFRes 0) x] + scheme2 = [CFRule a_x (beta++[NonTerminal a_b]) n' | + a <- retainedLeftRecursive, + b@(NonTerminal b') <- properLeftCornersOf a, + isLeftRecursive b, + CFRule _ (x:beta) n <- catRules gr b', + let a_x = mkCat (NonTerminal a) x, + let a_b = mkCat (NonTerminal a) b, + let i = length $ filterCats beta, + let n' = symbol (\_ -> CFAbs 1 (CFApp (CFRes i) (shiftTerm n))) + (\_ -> CFApp (CFRes i) n) x] + scheme3 = [CFRule a_x beta n' | + a <- retainedLeftRecursive, + x <- properLeftCornersOf a, + CFRule _ (x':beta) n <- catRules gr a, + x == x', + let a_x = mkCat (NonTerminal a) x, + let n' = symbol (\_ -> CFAbs 1 (shiftTerm n)) + (\_ -> n) x] + scheme4 = catSetRules gr $ Set.fromList $ filter (not . isLeftRecursive . NonTerminal) cats + + newCats = Set.fromList (map lhsCat (scheme2 ++ scheme3)) + + shiftTerm :: CFTerm -> CFTerm + shiftTerm (CFObj f ts) = CFObj f (map shiftTerm ts) + shiftTerm (CFRes 0) = CFVar 1 + shiftTerm (CFRes n) = CFRes (n-1) + shiftTerm t = t + -- note: the rest don't occur in the original grammar + + cats = allCats gr + rules = allRules gr + + directLeftCorner = mkRel [(NonTerminal c,t) | CFRule c (t:_) _ <- allRules gr] + leftCorner = reflexiveClosure_ (map NonTerminal cats) $ transitiveClosure directLeftCorner + properLeftCorner = transitiveClosure directLeftCorner + properLeftCornersOf = Set.toList . allRelated properLeftCorner . NonTerminal + isProperLeftCornerOf = flip (isRelatedTo properLeftCorner) + + leftRecursive = reflexiveElements properLeftCorner + isLeftRecursive = (`Set.member` leftRecursive) + + retained = cfgStartCat gr `Set.insert` + Set.fromList [a | r <- allRules (filterCFGCats (not . isLeftRecursive . NonTerminal) gr), + NonTerminal a <- ruleRhs r] + isRetained = (`Set.member` retained) + + retainedLeftRecursive = filter (isLeftRecursive . NonTerminal) $ Set.toList retained + + mkCat :: CFSymbol -> CFSymbol -> Cat + mkCat x y = showSymbol x ++ "-" ++ showSymbol y + where showSymbol = symbol id show + +-- | Get the sets of mutually recursive non-terminals for a grammar. +mutRecCats :: Bool -- ^ If true, all categories will be in some set. + -- If false, only recursive categories will be included. + -> CFG -> [Set Cat] +mutRecCats incAll g = equivalenceClasses $ refl $ symmetricSubrelation $ transitiveClosure r + where r = mkRel [(c,c') | CFRule c ss _ <- allRules g, NonTerminal c' <- ss] + refl = if incAll then reflexiveClosure_ (allCats g) else reflexiveSubrelation + +-- +-- * Approximate context-free grammars with regular grammars. +-- + +makeSimpleRegular :: CFG -> CFG +makeSimpleRegular = makeRegular . topDownFilter . bottomUpFilter . removeCycles + +-- Use the transformation algorithm from \"Regular Approximation of Context-free +-- Grammars through Approximation\", Mohri and Nederhof, 2000 +-- to create an over-generating regular frammar for a context-free +-- grammar +makeRegular :: CFG -> CFG +makeRegular g = g { cfgRules = groupProds $ concatMap trSet (mutRecCats True g) } + where trSet cs | allXLinear cs rs = rs + | otherwise = concatMap handleCat csl + where csl = Set.toList cs + rs = catSetRules g cs + handleCat c = [CFRule c' [] (mkCFTerm (c++"-empty"))] -- introduce A' -> e + ++ concatMap (makeRightLinearRules c) (catRules g c) + where c' = newCat c + makeRightLinearRules b' (CFRule c ss n) = + case ys of + [] -> newRule b' (xs ++ [NonTerminal (newCat c)]) n -- no non-terminals left + (NonTerminal b:zs) -> newRule b' (xs ++ [NonTerminal b]) n + ++ makeRightLinearRules (newCat b) (CFRule c zs n) + where (xs,ys) = break (`catElem` cs) ss + -- don't add rules on the form A -> A + newRule c rhs n | rhs == [NonTerminal c] = [] + | otherwise = [CFRule c rhs n] + newCat c = c ++ "$" + +-- +-- * CFG Utilities +-- + +mkCFG :: Cat -> Set Cat -> [CFRule] -> CFG +mkCFG start ext rs = CFG { cfgStartCat = start, cfgExternalCats = ext, cfgRules = groupProds rs } + +groupProds :: [CFRule] -> Map Cat (Set CFRule) +groupProds = Map.fromListWith Set.union . map (\r -> (lhsCat r,Set.singleton r)) + +-- | Gets all rules in a CFG. +allRules :: CFG -> [CFRule] +allRules = concat . map Set.toList . Map.elems . cfgRules + +-- | Gets all rules in a CFG, grouped by their LHS categories. +allRulesGrouped :: CFG -> [(Cat,[CFRule])] +allRulesGrouped = Map.toList . Map.map Set.toList . cfgRules + +-- | Gets all categories which have rules. +allCats :: CFG -> [Cat] +allCats = Map.keys . cfgRules + +-- | Gets all rules for the given category. +catRules :: CFG -> Cat -> [CFRule] +catRules gr c = Set.toList $ Map.findWithDefault Set.empty c (cfgRules gr) + +-- | Gets all rules for categories in the given set. +catSetRules :: CFG -> Set Cat -> [CFRule] +catSetRules gr cs = allRules $ filterCFGCats (`Set.member` cs) gr + +mapCFGCats :: (Cat -> Cat) -> CFG -> CFG +mapCFGCats f cfg = mkCFG (f (cfgStartCat cfg)) + (Set.map f (cfgExternalCats cfg)) + [CFRule (f lhs) (map (mapSymbol f id) rhs) t | CFRule lhs rhs t <- allRules cfg] + +onCFG :: (Map Cat (Set CFRule) -> Map Cat (Set CFRule)) -> CFG -> CFG +onCFG f cfg = cfg { cfgRules = f (cfgRules cfg) } + +onRules :: ([CFRule] -> [CFRule]) -> CFG -> CFG +onRules f cfg = cfg { cfgRules = groupProds $ f $ allRules cfg } + +-- | Clean up CFG after rules have been removed. +cleanCFG :: CFG -> CFG +cleanCFG = onCFG (Map.filter (not . Set.null)) + +-- | Combine two CFGs. +unionCFG :: CFG -> CFG -> CFG +unionCFG x y = onCFG (\rs -> Map.unionWith Set.union rs (cfgRules y)) x + +filterCFG :: (CFRule -> Bool) -> CFG -> CFG +filterCFG p = cleanCFG . onCFG (Map.map (Set.filter p)) + +filterCFGCats :: (Cat -> Bool) -> CFG -> CFG +filterCFGCats p = onCFG (Map.filterWithKey (\c _ -> p c)) + +countCats :: CFG -> Int +countCats = Map.size . cfgRules . cleanCFG + +countRules :: CFG -> Int +countRules = length . allRules + +prCFG :: CFG -> String +prCFG = unlines . map prRule . allRules + where + prRule r = lhsCat r ++ " ::= " ++ unwords (map prSym (ruleRhs r)) + prSym = symbol id (\t -> "\""++ t ++"\"") + +-- +-- * CFRule Utilities +-- + +ruleFun :: CFRule -> CId +ruleFun (CFRule _ _ t) = f t + where f (CFObj n _) = n + f (CFApp _ x) = f x + f (CFAbs _ x) = f x + f _ = mkCId "" + +-- | Check if any of the categories used on the right-hand side +-- are in the given list of categories. +anyUsedBy :: [Cat] -> CFRule -> Bool +anyUsedBy cs (CFRule _ ss _) = any (`elem` cs) (filterCats ss) + +mkCFTerm :: String -> CFTerm +mkCFTerm n = CFObj (mkCId n) [] + +ruleIsNonRecursive :: Set Cat -> CFRule -> Bool +ruleIsNonRecursive cs = noCatsInSet cs . ruleRhs + +-- | Check if all the rules are right-linear, or all the rules are +-- left-linear, with respect to given categories. +allXLinear :: Set Cat -> [CFRule] -> Bool +allXLinear cs rs = all (isRightLinear cs) rs || all (isLeftLinear cs) rs + +-- | Checks if a context-free rule is right-linear. +isRightLinear :: Set Cat -- ^ The categories to consider + -> CFRule -- ^ The rule to check for right-linearity + -> Bool +isRightLinear cs = noCatsInSet cs . safeInit . ruleRhs + +-- | Checks if a context-free rule is left-linear. +isLeftLinear :: Set Cat -- ^ The categories to consider + -> CFRule -- ^ The rule to check for left-linearity + -> Bool +isLeftLinear cs = noCatsInSet cs . drop 1 . ruleRhs + + +-- +-- * Symbol utilities +-- + +symbol :: (c -> a) -> (t -> a) -> Symbol c t -> a +symbol fc ft (NonTerminal cat) = fc cat +symbol fc ft (Terminal tok) = ft tok + +mapSymbol :: (c -> c') -> (t -> t') -> Symbol c t -> Symbol c' t' +mapSymbol fc ft = symbol (NonTerminal . fc) (Terminal . ft) + +filterCats :: [Symbol c t] -> [c] +filterCats syms = [ cat | NonTerminal cat <- syms ] + +filterToks :: [Symbol c t] -> [t] +filterToks syms = [ tok | Terminal tok <- syms ] + +-- | Checks if a symbol is a non-terminal of one of the given categories. +catElem :: Ord c => Symbol c t -> Set c -> Bool +catElem s cs = symbol (`Set.member` cs) (const False) s + +noCatsInSet :: Ord c => Set c -> [Symbol c t] -> Bool +noCatsInSet cs = not . any (`catElem` cs) diff --git a/src/GF/Speech/CFGToFA.hs b/src/GF/Speech/CFGToFA.hs new file mode 100644 index 000000000..1ac4bd24e --- /dev/null +++ b/src/GF/Speech/CFGToFA.hs @@ -0,0 +1,244 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.CFGToFA +-- +-- Approximates CFGs with finite state networks. +---------------------------------------------------------------------- +module GF.Speech.CFGToFA (cfgToFA, makeSimpleRegular, + MFA(..), cfgToMFA, cfgToFA') where + +import Data.List +import Data.Maybe +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set + +import PGF.CId +import PGF.Data +import GF.Data.Utilities +import GF.Speech.CFG +import GF.Speech.PGFToCFG +import GF.Infra.Ident (Ident) + +import GF.Speech.FiniteState +import GF.Speech.Graph +import GF.Speech.Relation +import GF.Speech.CFG + +data Recursivity = RightR | LeftR | NotR + +data MutRecSet = MutRecSet { + mrCats :: Set Cat, + mrNonRecRules :: [CFRule], + mrRecRules :: [CFRule], + mrRec :: Recursivity + } + + +type MutRecSets = Map Cat MutRecSet + +-- +-- * Multiple DFA type +-- + +data MFA = MFA Cat [(Cat,DFA CFSymbol)] + + + +cfgToFA :: CFG -> DFA Token +cfgToFA = minimize . compileAutomaton . makeSimpleRegular + + +-- +-- * Compile strongly regular grammars to NFAs +-- + +-- Convert a strongly regular grammar to a finite automaton. +compileAutomaton :: CFG -> NFA Token +compileAutomaton g = make_fa (g,ns) s [NonTerminal (cfgStartCat g)] f fa + where + (fa,s,f) = newFA_ + ns = mutRecSets g $ mutRecCats False g + +-- | The make_fa algorithm from \"Regular approximation of CFLs: a grammatical view\", +-- Mark-Jan Nederhof, Advances in Probabilistic and other Parsing Technologies, 2000. +make_fa :: (CFG,MutRecSets) -> State -> [CFSymbol] -> State + -> NFA Token -> NFA Token +make_fa c@(g,ns) q0 alpha q1 fa = + case alpha of + [] -> newTransition q0 q1 Nothing fa + [Terminal t] -> newTransition q0 q1 (Just t) fa + [NonTerminal a] -> + case Map.lookup a ns of + -- a is recursive + Just n@(MutRecSet { mrCats = ni, mrNonRecRules = nrs, mrRecRules = rs} ) -> + case mrRec n of + -- the set Ni is right-recursive or cyclic + RightR -> + let new = [(getState c, xs, q1) | CFRule c xs _ <- nrs] + ++ [(getState c, xs, getState d) | CFRule c ss _ <- rs, + let (xs,NonTerminal d) = (init ss,last ss)] + in make_fas new $ newTransition q0 (getState a) Nothing fa' + -- the set Ni is left-recursive + LeftR -> + let new = [(q0, xs, getState c) | CFRule c xs _ <- nrs] + ++ [(getState d, xs, getState c) | CFRule c (NonTerminal d:xs) _ <- rs] + in make_fas new $ newTransition (getState a) q1 Nothing fa' + where + (fa',stateMap) = addStatesForCats ni fa + getState x = Map.findWithDefault + (error $ "CFGToFiniteState: No state for " ++ x) + x stateMap + -- a is not recursive + Nothing -> let rs = catRules g a + in foldl' (\f (CFRule _ b _) -> make_fa_ q0 b q1 f) fa rs + (x:beta) -> let (fa',q) = newState () fa + in make_fa_ q beta q1 $ make_fa_ q0 [x] q fa' + where + make_fa_ = make_fa c + make_fas xs fa = foldl' (\f' (s1,xs,s2) -> make_fa_ s1 xs s2 f') fa xs + +-- +-- * Compile a strongly regular grammar to a DFA with sub-automata +-- + +cfgToMFA :: CFG -> MFA +cfgToMFA = buildMFA . makeSimpleRegular + +-- | Build a DFA by building and expanding an MFA +cfgToFA' :: CFG -> DFA Token +cfgToFA' = mfaToDFA . cfgToMFA + +buildMFA :: CFG -> MFA +buildMFA g = sortSubLats $ removeUnusedSubLats mfa + where fas = compileAutomata g + mfa = MFA (cfgStartCat g) [(c, minimize fa) | (c,fa) <- fas] + +mfaStartDFA :: MFA -> DFA CFSymbol +mfaStartDFA (MFA start subs) = + fromMaybe (error $ "Bad start MFA: " ++ start) $ lookup start subs + +mfaToDFA :: MFA -> DFA Token +mfaToDFA mfa@(MFA _ subs) = minimize $ expand $ dfa2nfa $ mfaStartDFA mfa + where + subs' = Map.fromList [(c, dfa2nfa n) | (c,n) <- subs] + getSub l = fromJust $ Map.lookup l subs' + expand (FA (Graph c ns es) s f) + = foldl' expandEdge (FA (Graph c ns []) s f) es + expandEdge fa (f,t,x) = + case x of + Nothing -> newTransition f t Nothing fa + Just (Terminal s) -> newTransition f t (Just s) fa + Just (NonTerminal l) -> insertNFA fa (f,t) (expand $ getSub l) + +removeUnusedSubLats :: MFA -> MFA +removeUnusedSubLats mfa@(MFA start subs) = MFA start [(c,s) | (c,s) <- subs, isUsed c] + where + usedMap = subLatUseMap mfa + used = growUsedSet (Set.singleton start) + isUsed c = c `Set.member` used + growUsedSet = fix (\s -> foldl Set.union s $ mapMaybe (flip Map.lookup usedMap) $ Set.toList s) + +subLatUseMap :: MFA -> Map Cat (Set Cat) +subLatUseMap (MFA _ subs) = Map.fromList [(c,usedSubLats n) | (c,n) <- subs] + +usedSubLats :: DFA CFSymbol -> Set Cat +usedSubLats fa = Set.fromList [s | (_,_,NonTerminal s) <- transitions fa] + +-- | Sort sub-networks topologically. +sortSubLats :: MFA -> MFA +sortSubLats mfa@(MFA main subs) = MFA main (reverse $ sortLats usedByMap subs) + where + usedByMap = revMultiMap (subLatUseMap mfa) + sortLats _ [] = [] + sortLats ub ls = xs ++ sortLats ub' ys + where (xs,ys) = partition ((==0) . indeg) ls + ub' = Map.map (Set.\\ Set.fromList (map fst xs)) ub + indeg (c,_) = maybe 0 Set.size $ Map.lookup c ub + +-- | Convert a strongly regular grammar to a number of finite automata, +-- one for each non-terminal. +-- The edges in the automata accept tokens, or name another automaton to use. +compileAutomata :: CFG + -> [(Cat,NFA CFSymbol)] + -- ^ A map of non-terminals and their automata. +compileAutomata g = [(c, makeOneFA c) | c <- allCats g] + where + mrs = mutRecSets g $ mutRecCats True g + makeOneFA c = make_fa1 mr s [NonTerminal c] f fa + where (fa,s,f) = newFA_ + mr = fromJust (Map.lookup c mrs) + + +-- | The make_fa algorithm from \"Regular approximation of CFLs: a grammatical view\", +-- Mark-Jan Nederhof, Advances in Probabilistic and other Parsing Technologies, 2000, +-- adapted to build a finite automaton for a single (mutually recursive) set only. +-- Categories not in the set will result in category-labelled edges. +make_fa1 :: MutRecSet -- ^ The set of (mutually recursive) categories for which + -- we are building the automaton. + -> State -- ^ State to come from + -> [CFSymbol] -- ^ Symbols to accept + -> State -- ^ State to end up in + -> NFA CFSymbol -- ^ FA to add to. + -> NFA CFSymbol +make_fa1 mr q0 alpha q1 fa = + case alpha of + [] -> newTransition q0 q1 Nothing fa + [t@(Terminal _)] -> newTransition q0 q1 (Just t) fa + [c@(NonTerminal a)] | not (a `Set.member` mrCats mr) -> newTransition q0 q1 (Just c) fa + [NonTerminal a] -> + case mrRec mr of + NotR -> -- the set is a non-recursive (always singleton) set of categories + -- so the set of category rules is the set of rules for the whole set + make_fas [(q0, b, q1) | CFRule _ b _ <- mrNonRecRules mr] fa + RightR -> -- the set is right-recursive or cyclic + let new = [(getState c, xs, q1) | CFRule c xs _ <- mrNonRecRules mr] + ++ [(getState c, xs, getState d) | CFRule c ss _ <- mrRecRules mr, + let (xs,NonTerminal d) = (init ss,last ss)] + in make_fas new $ newTransition q0 (getState a) Nothing fa' + LeftR -> -- the set is left-recursive + let new = [(q0, xs, getState c) | CFRule c xs _ <- mrNonRecRules mr] + ++ [(getState d, xs, getState c) | CFRule c (NonTerminal d:xs) _ <- mrRecRules mr] + in make_fas new $ newTransition (getState a) q1 Nothing fa' + where + (fa',stateMap) = addStatesForCats (mrCats mr) fa + getState x = Map.findWithDefault + (error $ "CFGToFiniteState: No state for " ++ x) + x stateMap + (x:beta) -> let (fa',q) = newState () fa + in make_fas [(q0,[x],q),(q,beta,q1)] fa' + where + make_fas xs fa = foldl' (\f' (s1,xs,s2) -> make_fa1 mr s1 xs s2 f') fa xs + +mutRecSets :: CFG -> [Set Cat] -> MutRecSets +mutRecSets g = Map.fromList . concatMap mkMutRecSet + where + mkMutRecSet cs = [ (c,ms) | c <- csl ] + where csl = Set.toList cs + rs = catSetRules g cs + (nrs,rrs) = partition (ruleIsNonRecursive cs) rs + ms = MutRecSet { + mrCats = cs, + mrNonRecRules = nrs, + mrRecRules = rrs, + mrRec = rec + } + rec | null rrs = NotR + | all (isRightLinear cs) rrs = RightR + | otherwise = LeftR + +-- +-- * Utilities +-- + +-- | Add a state for the given NFA for each of the categories +-- in the given set. Returns a map of categories to their +-- corresponding states. +addStatesForCats :: Set Cat -> NFA t -> (NFA t, Map Cat State) +addStatesForCats cs fa = (fa', m) + where (fa', ns) = newStates (replicate (Set.size cs) ()) fa + m = Map.fromList (zip (Set.toList cs) (map fst ns)) + +revMultiMap :: (Ord a, Ord b) => Map a (Set b) -> Map b (Set a) +revMultiMap m = Map.fromListWith Set.union [ (y,Set.singleton x) | (x,s) <- Map.toList m, y <- Set.toList s] diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs new file mode 100644 index 000000000..c809eb544 --- /dev/null +++ b/src/GF/Speech/FiniteState.hs @@ -0,0 +1,329 @@ +---------------------------------------------------------------------- +-- | +-- Module : FiniteState +-- Maintainer : BB +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/10 16:43:44 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.16 $ +-- +-- A simple finite state network module. +----------------------------------------------------------------------------- +module GF.Speech.FiniteState (FA(..), State, NFA, DFA, + startState, finalStates, + states, transitions, + isInternal, + newFA, newFA_, + addFinalState, + newState, newStates, + newTransition, newTransitions, + insertTransitionWith, insertTransitionsWith, + mapStates, mapTransitions, + modifyTransitions, + nonLoopTransitionsTo, nonLoopTransitionsFrom, + loops, + removeState, + oneFinalState, + insertNFA, + onGraph, + moveLabelsToNodes, removeTrivialEmptyNodes, + minimize, + dfa2nfa, + unusedNames, renameStates, + prFAGraphviz, faToGraphviz) where + +import Data.List +import Data.Maybe +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set + +import GF.Data.Utilities +import GF.Speech.Graph +import qualified GF.Speech.Graphviz as Dot + +type State = Int + +-- | Type parameters: node id type, state label type, edge label type +-- Data constructor arguments: nodes and edges, start state, final states +data FA n a b = FA !(Graph n a b) !n ![n] + +type NFA a = FA State () (Maybe a) + +type DFA a = FA State () a + + +startState :: FA n a b -> n +startState (FA _ s _) = s + +finalStates :: FA n a b -> [n] +finalStates (FA _ _ ss) = ss + +states :: FA n a b -> [(n,a)] +states (FA g _ _) = nodes g + +transitions :: FA n a b -> [(n,n,b)] +transitions (FA g _ _) = edges g + +newFA :: Enum n => a -- ^ Start node label + -> FA n a b +newFA l = FA g s [] + where (g,s) = newNode l (newGraph [toEnum 0..]) + +-- | Create a new finite automaton with an initial and a final state. +newFA_ :: Enum n => (FA n () b, n, n) +newFA_ = (fa'', s, f) + where fa = newFA () + s = startState fa + (fa',f) = newState () fa + fa'' = addFinalState f fa' + +addFinalState :: n -> FA n a b -> FA n a b +addFinalState f (FA g s ss) = FA g s (f:ss) + +newState :: a -> FA n a b -> (FA n a b, n) +newState x (FA g s ss) = (FA g' s ss, n) + where (g',n) = newNode x g + +newStates :: [a] -> FA n a b -> (FA n a b, [(n,a)]) +newStates xs (FA g s ss) = (FA g' s ss, ns) + where (g',ns) = newNodes xs g + +newTransition :: n -> n -> b -> FA n a b -> FA n a b +newTransition f t l = onGraph (newEdge (f,t,l)) + +newTransitions :: [(n, n, b)] -> FA n a b -> FA n a b +newTransitions es = onGraph (newEdges es) + +insertTransitionWith :: Eq n => + (b -> b -> b) -> (n, n, b) -> FA n a b -> FA n a b +insertTransitionWith f t = onGraph (insertEdgeWith f t) + +insertTransitionsWith :: Eq n => + (b -> b -> b) -> [(n, n, b)] -> FA n a b -> FA n a b +insertTransitionsWith f ts fa = + foldl' (flip (insertTransitionWith f)) fa ts + +mapStates :: (a -> c) -> FA n a b -> FA n c b +mapStates f = onGraph (nmap f) + +mapTransitions :: (b -> c) -> FA n a b -> FA n a c +mapTransitions f = onGraph (emap f) + +modifyTransitions :: ([(n,n,b)] -> [(n,n,b)]) -> FA n a b -> FA n a b +modifyTransitions f = onGraph (\ (Graph r ns es) -> Graph r ns (f es)) + +removeState :: Ord n => n -> FA n a b -> FA n a b +removeState n = onGraph (removeNode n) + +minimize :: Ord a => NFA a -> DFA a +minimize = determinize . reverseNFA . dfa2nfa . determinize . reverseNFA + +unusedNames :: FA n a b -> [n] +unusedNames (FA (Graph names _ _) _ _) = names + +-- | Gets all incoming transitions to a given state, excluding +-- transtions from the state itself. +nonLoopTransitionsTo :: Eq n => n -> FA n a b -> [(n,b)] +nonLoopTransitionsTo s fa = + [(f,l) | (f,t,l) <- transitions fa, t == s && f /= s] + +nonLoopTransitionsFrom :: Eq n => n -> FA n a b -> [(n,b)] +nonLoopTransitionsFrom s fa = + [(t,l) | (f,t,l) <- transitions fa, f == s && t /= s] + +loops :: Eq n => n -> FA n a b -> [b] +loops s fa = [l | (f,t,l) <- transitions fa, f == s && t == s] + +-- | Give new names to all nodes. +renameStates :: Ord x => [y] -- ^ Infinite supply of new names + -> FA x a b + -> FA y a b +renameStates supply (FA g s fs) = FA (renameNodes newName rest g) s' fs' + where (ns,rest) = splitAt (length (nodes g)) supply + newNodes = Map.fromList (zip (map fst (nodes g)) ns) + newName n = Map.findWithDefault (error "FiniteState.newName") n newNodes + s' = newName s + fs' = map newName fs + +-- | Insert an NFA into another +insertNFA :: NFA a -- ^ NFA to insert into + -> (State, State) -- ^ States to insert between + -> NFA a -- ^ NFA to insert. + -> NFA a +insertNFA (FA g1 s1 fs1) (f,t) (FA g2 s2 fs2) + = FA (newEdges es g') s1 fs1 + where + es = (f,ren s2,Nothing):[(ren f2,t,Nothing) | f2 <- fs2] + (g',ren) = mergeGraphs g1 g2 + +onGraph :: (Graph n a b -> Graph n c d) -> FA n a b -> FA n c d +onGraph f (FA g s ss) = FA (f g) s ss + + +-- | Make the finite automaton have a single final state +-- by adding a new final state and adding an edge +-- from the old final states to the new state. +oneFinalState :: a -- ^ Label to give the new node + -> b -- ^ Label to give the new edges + -> FA n a b -- ^ The old network + -> FA n a b -- ^ The new network +oneFinalState nl el fa = + let (FA g s fs,nf) = newState nl fa + es = [ (f,nf,el) | f <- fs ] + in FA (newEdges es g) s [nf] + +-- | Transform a standard finite automaton with labelled edges +-- to one where the labels are on the nodes instead. This can add +-- up to one extra node per edge. +moveLabelsToNodes :: (Ord n,Eq a) => FA n () (Maybe a) -> FA n (Maybe a) () +moveLabelsToNodes = onGraph f + where f g@(Graph c _ _) = Graph c' ns (concat ess) + where is = [ ((n,l),inc) | (n, (l,inc,_)) <- Map.toList (nodeInfo g)] + (c',is') = mapAccumL fixIncoming c is + (ns,ess) = unzip (concat is') + + +-- | Remove empty nodes which are not start or final, and have +-- exactly one outgoing edge or exactly one incoming edge. +removeTrivialEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) () +removeTrivialEmptyNodes = pruneUnusable . skipSimpleEmptyNodes + +-- | Move edges to empty nodes to point to the next node(s). +-- This is not done if the pointed-to node is a final node. +skipSimpleEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) () +skipSimpleEmptyNodes fa = onGraph og fa + where + og g@(Graph c ns es) = if es' == es then g else og (Graph c ns es') + where + es' = concatMap changeEdge es + info = nodeInfo g + changeEdge e@(f,t,()) + | isNothing (getNodeLabel info t) + -- && (i * o <= i + o) + && not (isFinal fa t) + = [ (f,t',()) | (_,t',()) <- getOutgoing info t] + | otherwise = [e] +-- where i = inDegree info t +-- o = outDegree info t + +isInternal :: Eq n => FA n a b -> n -> Bool +isInternal (FA _ start final) n = n /= start && n `notElem` final + +isFinal :: Eq n => FA n a b -> n -> Bool +isFinal (FA _ _ final) n = n `elem` final + +-- | Remove all internal nodes with no incoming edges +-- or no outgoing edges. +pruneUnusable :: Ord n => FA n (Maybe a) () -> FA n (Maybe a) () +pruneUnusable fa = onGraph f fa + where + f g = if Set.null rns then g else f (removeNodes rns g) + where info = nodeInfo g + rns = Set.fromList [ n | (n,_) <- nodes g, + isInternal fa n, + inDegree info n == 0 + || outDegree info n == 0] + +fixIncoming :: (Ord n, Eq a) => [n] + -> (Node n (),[Edge n (Maybe a)]) -- ^ A node and its incoming edges + -> ([n],[(Node n (Maybe a),[Edge n ()])]) -- ^ Replacement nodes with their + -- incoming edges. +fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts) + where ls = nub $ map edgeLabel es + (cs',cs'') = splitAt (length ls) cs + newNodes = zip cs' ls + es' = [ (x,n,()) | x <- map fst newNodes ] + -- separate cyclic and non-cyclic edges + (cyc,ncyc) = partition (\ (f,_,_) -> f == n) es + -- keep all incoming non-cyclic edges with the right label + to (x,l) = [ (f,x,()) | (f,_,l') <- ncyc, l == l'] + -- for each cyclic edge with the right label, + -- add an edge from each of the new nodes (including this one) + ++ [ (y,x,()) | (f,_,l') <- cyc, l == l', (y,_) <- newNodes] + newContexts = [ (v, to v) | v <- newNodes ] + +alphabet :: Eq b => Graph n a (Maybe b) -> [b] +alphabet = nub . catMaybes . map edgeLabel . edges + +determinize :: Ord a => NFA a -> DFA a +determinize (FA g s f) = let (ns,es) = h (Set.singleton start) Set.empty Set.empty + (ns',es') = (Set.toList ns, Set.toList es) + final = filter isDFAFinal ns' + fa = FA (Graph undefined [(n,()) | n <- ns'] es') start final + in renameStates [0..] fa + where info = nodeInfo g +-- reach = nodesReachable out + start = closure info $ Set.singleton s + isDFAFinal n = not (Set.null (Set.fromList f `Set.intersection` n)) + h currentStates oldStates es + | Set.null currentStates = (oldStates,es) + | otherwise = ((h $! uniqueNewStates) $! allOldStates) $! es' + where + allOldStates = oldStates `Set.union` currentStates + (newStates,es') = new (Set.toList currentStates) Set.empty es + uniqueNewStates = newStates Set.\\ allOldStates + -- Get the sets of states reachable from the given states + -- by consuming one symbol, and the associated edges. + new [] rs es = (rs,es) + new (n:ns) rs es = new ns rs' es' + where cs = reachable info n --reachable reach n + rs' = rs `Set.union` Set.fromList (map snd cs) + es' = es `Set.union` Set.fromList [(n,s,c) | (c,s) <- cs] + + +-- | Get all the nodes reachable from a list of nodes by only empty edges. +closure :: Ord n => NodeInfo n a (Maybe b) -> Set n -> Set n +closure info x = closure_ x x + where closure_ acc check | Set.null check = acc + | otherwise = closure_ acc' check' + where + reach = Set.fromList [y | x <- Set.toList check, + (_,y,Nothing) <- getOutgoing info x] + acc' = acc `Set.union` reach + check' = reach Set.\\ acc + +-- | Get a map of labels to sets of all nodes reachable +-- from a the set of nodes by one edge with the given +-- label and then any number of empty edges. +reachable :: (Ord n,Ord b) => NodeInfo n a (Maybe b) -> Set n -> [(b,Set n)] +reachable info ns = Map.toList $ Map.map (closure info . Set.fromList) $ reachable1 info ns +reachable1 info ns = Map.fromListWith (++) [(c, [y]) | n <- Set.toList ns, (_,y,Just c) <- getOutgoing info n] + +reverseNFA :: NFA a -> NFA a +reverseNFA (FA g s fs) = FA g''' s' [s] + where g' = reverseGraph g + (g'',s') = newNode () g' + g''' = newEdges [(s',f,Nothing) | f <- fs] g'' + +dfa2nfa :: DFA a -> NFA a +dfa2nfa = mapTransitions Just + +-- +-- * Visualization +-- + +prFAGraphviz :: (Eq n,Show n) => FA n String String -> String +prFAGraphviz = Dot.prGraphviz . faToGraphviz + +prFAGraphviz_ :: (Eq n,Show n,Show a, Show b) => FA n a b -> String +prFAGraphviz_ = Dot.prGraphviz . faToGraphviz . mapStates show . mapTransitions show + +faToGraphviz :: (Eq n,Show n) => FA n String String -> Dot.Graph +faToGraphviz (FA (Graph _ ns es) s f) + = Dot.Graph Dot.Directed Nothing [] (map mkNode ns) (map mkEdge es) [] + where mkNode (n,l) = Dot.Node (show n) attrs + where attrs = [("label",l)] + ++ if n == s then [("shape","box")] else [] + ++ if n `elem` f then [("style","bold")] else [] + mkEdge (x,y,l) = Dot.Edge (show x) (show y) [("label",l)] + +-- +-- * Utilities +-- + +lookups :: Ord k => [k] -> Map k a -> [a] +lookups xs m = mapMaybe (flip Map.lookup m) xs diff --git a/src/GF/Speech/GSL.hs b/src/GF/Speech/GSL.hs new file mode 100644 index 000000000..637552bf4 --- /dev/null +++ b/src/GF/Speech/GSL.hs @@ -0,0 +1,94 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.GSL +-- +-- This module prints a CFG as a Nuance GSL 2.0 grammar. +-- +----------------------------------------------------------------------------- + +module GF.Speech.GSL (gslPrinter) where + +import GF.Data.Utilities +import GF.Speech.CFG +import GF.Speech.SRG +import GF.Speech.RegExp +import GF.Infra.Ident +import PGF.CId +import PGF.Data + +import Data.Char (toUpper,toLower) +import Data.List (partition) +import Text.PrettyPrint.HughesPJ + +width :: Int +width = 75 + +gslPrinter :: PGF -> CId -> String +gslPrinter pgf cnc = renderStyle st $ prGSL $ makeSimpleSRG pgf cnc + where st = style { lineLength = width } + +prGSL :: SRG -> Doc +prGSL srg = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg)) + where + header = text ";GSL2.0" $$ + comment ("Nuance speech recognition grammar for " ++ srgName srg) $$ + comment ("Generated by GF") + mainCat = text ".MAIN" <+> prCat (srgStartCat srg) + prRule (SRGRule cat rhs) = prCat cat <+> union (map prAlt rhs) + -- FIXME: use the probability + prAlt (SRGAlt mp _ rhs) = prItem rhs + + +prItem :: SRGItem -> Doc +prItem = f + where + f (REUnion xs) = (if null es then empty else text "?") <> union (map f nes) + where (es,nes) = partition isEpsilon xs + f (REConcat [x]) = f x + f (REConcat xs) = text "(" <> fsep (map f xs) <> text ")" + f (RERepeat x) = text "*" <> f x + f (RESymbol s) = prSymbol s + +union :: [Doc] -> Doc +union [x] = x +union xs = text "[" <> fsep xs <> text "]" + +prSymbol :: Symbol SRGNT Token -> Doc +prSymbol = symbol (prCat . fst) (doubleQuotes . showToken) + +-- GSL requires an upper case letter in category names +prCat :: Cat -> Doc +prCat = text . firstToUpper + + +firstToUpper :: String -> String +firstToUpper [] = [] +firstToUpper (x:xs) = toUpper x : xs + +{- +rmPunctCFG :: CGrammar -> CGrammar +rmPunctCFG g = [CFRule c (filter keepSymbol ss) n | CFRule c ss n <- g] + +keepSymbol :: Symbol c Token -> Bool +keepSymbol (Tok t) = not (all isPunct (prt t)) +keepSymbol _ = True +-} + +-- Nuance does not like upper case characters in tokens +showToken :: Token -> Doc +showToken = text . map toLower + +isPunct :: Char -> Bool +isPunct c = c `elem` "-_.:;.,?!()[]{}" + +comment :: String -> Doc +comment s = text ";" <+> text s + + +-- Pretty-printing utilities + +emptyLine :: Doc +emptyLine = text "" + +($++$) :: Doc -> Doc -> Doc +x $++$ y = x $$ emptyLine $$ y diff --git a/src/GF/Speech/Graph.hs b/src/GF/Speech/Graph.hs new file mode 100644 index 000000000..1a0ebe0c0 --- /dev/null +++ b/src/GF/Speech/Graph.hs @@ -0,0 +1,178 @@ +---------------------------------------------------------------------- +-- | +-- Module : Graph +-- Maintainer : BB +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/10 16:43:44 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.2 $ +-- +-- A simple graph module. +----------------------------------------------------------------------------- +module GF.Speech.Graph ( Graph(..), Node, Edge, NodeInfo + , newGraph, nodes, edges + , nmap, emap, newNode, newNodes, newEdge, newEdges + , insertEdgeWith + , removeNode, removeNodes + , nodeInfo + , getIncoming, getOutgoing, getNodeLabel + , inDegree, outDegree + , nodeLabel + , edgeFrom, edgeTo, edgeLabel + , reverseGraph, mergeGraphs, renameNodes + ) where + +import GF.Data.Utilities + +import Data.List +import Data.Maybe +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set + +data Graph n a b = Graph [n] ![Node n a] ![Edge n b] + deriving (Eq,Show) + +type Node n a = (n,a) +type Edge n b = (n,n,b) + +type NodeInfo n a b = Map n (a, [Edge n b], [Edge n b]) + +-- | Create a new empty graph. +newGraph :: [n] -> Graph n a b +newGraph ns = Graph ns [] [] + +-- | Get all the nodes in the graph. +nodes :: Graph n a b -> [Node n a] +nodes (Graph _ ns _) = ns + +-- | Get all the edges in the graph. +edges :: Graph n a b -> [Edge n b] +edges (Graph _ _ es) = es + +-- | Map a function over the node labels. +nmap :: (a -> c) -> Graph n a b -> Graph n c b +nmap f (Graph c ns es) = Graph c [(n,f l) | (n,l) <- ns] es + +-- | Map a function over the edge labels. +emap :: (b -> c) -> Graph n a b -> Graph n a c +emap f (Graph c ns es) = Graph c ns [(x,y,f l) | (x,y,l) <- es] + +-- | Add a node to the graph. +newNode :: a -- ^ Node label + -> Graph n a b + -> (Graph n a b,n) -- ^ Node graph and name of new node +newNode l (Graph (c:cs) ns es) = (Graph cs ((c,l):ns) es, c) + +newNodes :: [a] -> Graph n a b -> (Graph n a b,[Node n a]) +newNodes ls g = (g', zip ns ls) + where (g',ns) = mapAccumL (flip newNode) g ls +-- lazy version: +--newNodes ls (Graph cs ns es) = (Graph cs' (ns'++ns) es, ns') +-- where (xs,cs') = splitAt (length ls) cs +-- ns' = zip xs ls + +newEdge :: Edge n b -> Graph n a b -> Graph n a b +newEdge e (Graph c ns es) = Graph c ns (e:es) + +newEdges :: [Edge n b] -> Graph n a b -> Graph n a b +newEdges es g = foldl' (flip newEdge) g es +-- lazy version: +-- newEdges es' (Graph c ns es) = Graph c ns (es'++es) + +insertEdgeWith :: Eq n => + (b -> b -> b) -> Edge n b -> Graph n a b -> Graph n a b +insertEdgeWith f e@(x,y,l) (Graph c ns es) = Graph c ns (h es) + where h [] = [e] + h (e'@(x',y',l'):es') | x' == x && y' == y = (x',y', f l l'):es' + | otherwise = e':h es' + +-- | Remove a node and all edges to and from that node. +removeNode :: Ord n => n -> Graph n a b -> Graph n a b +removeNode n = removeNodes (Set.singleton n) + +-- | Remove a set of nodes and all edges to and from those nodes. +removeNodes :: Ord n => Set n -> Graph n a b -> Graph n a b +removeNodes xs (Graph c ns es) = Graph c ns' es' + where + keepNode n = not (Set.member n xs) + ns' = [ x | x@(n,_) <- ns, keepNode n ] + es' = [ e | e@(f,t,_) <- es, keepNode f && keepNode t ] + +-- | Get a map of node names to info about each node. +nodeInfo :: Ord n => Graph n a b -> NodeInfo n a b +nodeInfo g = Map.fromList [ (n, (x, fn inc n, fn out n)) | (n,x) <- nodes g ] + where + inc = groupEdgesBy edgeTo g + out = groupEdgesBy edgeFrom g + fn m n = fromMaybe [] (Map.lookup n m) + +groupEdgesBy :: (Ord n) => (Edge n b -> n) -- ^ Gets the node to group by + -> Graph n a b -> Map n [Edge n b] +groupEdgesBy f g = Map.fromListWith (++) [(f e, [e]) | e <- edges g] + +lookupNode :: Ord n => NodeInfo n a b -> n -> (a, [Edge n b], [Edge n b]) +lookupNode i n = fromJust $ Map.lookup n i + +getIncoming :: Ord n => NodeInfo n a b -> n -> [Edge n b] +getIncoming i n = let (_,inc,_) = lookupNode i n in inc + +getOutgoing :: Ord n => NodeInfo n a b -> n -> [Edge n b] +getOutgoing i n = let (_,_,out) = lookupNode i n in out + +inDegree :: Ord n => NodeInfo n a b -> n -> Int +inDegree i n = length $ getIncoming i n + +outDegree :: Ord n => NodeInfo n a b -> n -> Int +outDegree i n = length $ getOutgoing i n + +getNodeLabel :: Ord n => NodeInfo n a b -> n -> a +getNodeLabel i n = let (l,_,_) = lookupNode i n in l + +nodeLabel :: Node n a -> a +nodeLabel = snd + +edgeFrom :: Edge n b -> n +edgeFrom (f,_,_) = f + +edgeTo :: Edge n b -> n +edgeTo (_,t,_) = t + +edgeLabel :: Edge n b -> b +edgeLabel (_,_,l) = l + +reverseGraph :: Graph n a b -> Graph n a b +reverseGraph (Graph c ns es) = Graph c ns [ (t,f,l) | (f,t,l) <- es ] + +-- | Add the nodes from the second graph to the first graph. +-- The nodes in the second graph will be renamed using the name +-- supply in the first graph. +-- This function is more efficient when the second graph +-- is smaller than the first. +mergeGraphs :: Ord m => Graph n a b -> Graph m a b + -> (Graph n a b, m -> n) -- ^ The new graph and a function translating + -- the old names of nodes in the second graph + -- to names in the new graph. +mergeGraphs (Graph c ns1 es1) g2 = (Graph c' (ns2++ns1) (es2++es1), newName) + where + (xs,c') = splitAt (length (nodes g2)) c + newNames = Map.fromList (zip (map fst (nodes g2)) xs) + newName n = fromJust $ Map.lookup n newNames + Graph _ ns2 es2 = renameNodes newName undefined g2 + +-- | Rename the nodes in the graph. +renameNodes :: (n -> m) -- ^ renaming function + -> [m] -- ^ infinite supply of fresh node names, to + -- use when adding nodes in the future. + -> Graph n a b -> Graph m a b +renameNodes newName c (Graph _ ns es) = Graph c ns' es' + where ns' = map' (\ (n,x) -> (newName n,x)) ns + es' = map' (\ (f,t,l) -> (newName f, newName t, l)) es + +-- | A strict 'map' +map' :: (a -> b) -> [a] -> [b] +map' _ [] = [] +map' f (x:xs) = ((:) $! f x) $! map' f xs diff --git a/src/GF/Speech/Graphviz.hs b/src/GF/Speech/Graphviz.hs new file mode 100644 index 000000000..1851fcb64 --- /dev/null +++ b/src/GF/Speech/Graphviz.hs @@ -0,0 +1,116 @@ +---------------------------------------------------------------------- +-- | +-- Module : Graphviz +-- Maintainer : BB +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/09/15 18:10:44 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.2 $ +-- +-- Graphviz DOT format representation and printing. +----------------------------------------------------------------------------- + +module GF.Speech.Graphviz ( + Graph(..), GraphType(..), + Node(..), Edge(..), + Attr, + addSubGraphs, + setName, + setAttr, + prGraphviz + ) where + +import Data.Char + +import GF.Data.Utilities + +-- | Graph type, graph ID, graph attirbutes, graph nodes, graph edges, subgraphs +data Graph = Graph { + gType :: GraphType, + gId :: Maybe String, + gAttrs :: [Attr], + gNodes :: [Node], + gEdges :: [Edge], + gSubgraphs :: [Graph] + } + deriving (Show) + +data GraphType = Directed | Undirected + deriving (Show) + +data Node = Node String [Attr] + deriving Show + +data Edge = Edge String String [Attr] + deriving Show + +type Attr = (String,String) + +-- +-- * Graph construction +-- + +addSubGraphs :: [Graph] -> Graph -> Graph +addSubGraphs gs g = g { gSubgraphs = gs ++ gSubgraphs g } + +setName :: String -> Graph -> Graph +setName n g = g { gId = Just n } + +setAttr :: String -> String -> Graph -> Graph +setAttr n v g = g { gAttrs = tableSet n v (gAttrs g) } + +-- +-- * Pretty-printing +-- + +prGraphviz :: Graph -> String +prGraphviz g@(Graph t i _ _ _ _) = + graphtype t ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}\n" + +prSubGraph :: Graph -> String +prSubGraph g@(Graph _ i _ _ _ _) = + "subgraph" ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}" + +prGraph :: Graph -> String +prGraph (Graph t id at ns es ss) = + unlines $ map (++";") (map prAttr at + ++ map prNode ns + ++ map (prEdge t) es + ++ map prSubGraph ss) + +graphtype :: GraphType -> String +graphtype Directed = "digraph" +graphtype Undirected = "graph" + +prNode :: Node -> String +prNode (Node n at) = esc n ++ " " ++ prAttrList at + +prEdge :: GraphType -> Edge -> String +prEdge t (Edge x y at) = esc x ++ " " ++ edgeop t ++ " " ++ esc y ++ " " ++ prAttrList at + +edgeop :: GraphType -> String +edgeop Directed = "->" +edgeop Undirected = "--" + +prAttrList :: [Attr] -> String +prAttrList [] = "" +prAttrList at = "[" ++ join "," (map prAttr at) ++ "]" + +prAttr :: Attr -> String +prAttr (n,v) = esc n ++ " = " ++ esc v + +esc :: String -> String +esc s | needEsc s = "\"" ++ concat [ if shouldEsc c then ['\\',c] else [c] | c <- s ] ++ "\"" + | otherwise = s + where shouldEsc = (`elem` ['"', '\\']) + +needEsc :: String -> Bool +needEsc [] = True +needEsc xs | all isDigit xs = False +needEsc (x:xs) = not (isIDFirst x && all isIDChar xs) + +isIDFirst, isIDChar :: Char -> Bool +isIDFirst c = c `elem` (['_']++['a'..'z']++['A'..'Z']) +isIDChar c = isIDFirst c || isDigit c diff --git a/src/GF/Speech/JSGF.hs b/src/GF/Speech/JSGF.hs new file mode 100644 index 000000000..dc9f4170a --- /dev/null +++ b/src/GF/Speech/JSGF.hs @@ -0,0 +1,111 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.JSGF +-- +-- This module prints a CFG as a JSGF grammar. +-- +-- FIXME: remove \/ warn \/ fail if there are int \/ string literal +-- categories in the grammar +-- +-- FIXME: convert to UTF-8 +----------------------------------------------------------------------------- + +module GF.Speech.JSGF (jsgfPrinter) where + +import GF.Data.Utilities +import GF.Speech.CFG +import GF.Speech.RegExp +import GF.Speech.SISR +import GF.Speech.SRG +import PGF.CId +import PGF.Data + +import Data.Char +import Data.List +import Data.Maybe +import Text.PrettyPrint.HughesPJ +import Debug.Trace + +width :: Int +width = 75 + +jsgfPrinter :: Maybe SISRFormat + -> PGF + -> CId -> String +jsgfPrinter sisr pgf cnc = renderStyle st $ prJSGF sisr $ makeSimpleSRG pgf cnc + where st = style { lineLength = width } + +prJSGF :: Maybe SISRFormat -> SRG -> Doc +prJSGF sisr srg + = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg)) + where + header = text "#JSGF" <+> text "V1.0" <+> text "UTF-8" <+> lang <> char ';' $$ + comment ("JSGF speech recognition grammar for " ++ srgName srg) $$ + comment "Generated by GF" $$ + text ("grammar " ++ srgName srg ++ ";") + lang = maybe empty text (srgLanguage srg) + mainCat = rule True "MAIN" [prCat (srgStartCat srg)] + prRule (SRGRule cat rhs) = rule (isExternalCat srg cat) cat (map prAlt rhs) + prAlt (SRGAlt mp n rhs) = sep [initTag, p (prItem sisr n rhs), finalTag] + where initTag | isEmpty t = empty + | otherwise = text "<NULL>" <+> t + where t = tag sisr (profileInitSISR n) + finalTag = tag sisr (profileFinalSISR n) + p = if isEmpty initTag && isEmpty finalTag then id else parens + +prCat :: Cat -> Doc +prCat c = char '<' <> text c <> char '>' + +prItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> Doc +prItem sisr t = f 0 + where + f _ (REUnion []) = text "<VOID>" + f p (REUnion xs) + | not (null es) = brackets (f 0 (REUnion nes)) + | otherwise = (if p >= 1 then parens else id) (alts (map (f 1) xs)) + where (es,nes) = partition isEpsilon xs + f _ (REConcat []) = text "<NULL>" + f p (REConcat xs) = (if p >= 3 then parens else id) (fsep (map (f 2) xs)) + f p (RERepeat x) = f 3 x <> char '*' + f _ (RESymbol s) = prSymbol sisr t s + +prSymbol :: Maybe SISRFormat -> CFTerm -> SRGSymbol -> Doc +prSymbol sisr cn (NonTerminal n@(c,_)) = prCat c <+> tag sisr (catSISR cn n) +prSymbol _ cn (Terminal t) | all isPunct t = empty -- removes punctuation + | otherwise = text t -- FIXME: quote if there is whitespace or odd chars + +tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> Doc +tag Nothing _ = empty +tag (Just fmt) t = case t fmt of + [] -> empty + ts -> char '{' <+> (text (e $ prSISR ts)) <+> char '}' + where e [] = [] + e ('}':xs) = '\\':'}':e xs + e ('\n':xs) = ' ' : e (dropWhile isSpace xs) + e (x:xs) = x:e xs + +isPunct :: Char -> Bool +isPunct c = c `elem` "-_.;.,?!" + +comment :: String -> Doc +comment s = text "//" <+> text s + +alts :: [Doc] -> Doc +alts = fsep . prepunctuate (text "| ") + +rule :: Bool -> Cat -> [Doc] -> Doc +rule pub c xs = p <+> prCat c <+> char '=' <+> nest 2 (alts xs) <+> char ';' + where p = if pub then text "public" else empty + +-- Pretty-printing utilities + +emptyLine :: Doc +emptyLine = text "" + +prepunctuate :: Doc -> [Doc] -> [Doc] +prepunctuate _ [] = [] +prepunctuate p (x:xs) = x : map (p <>) xs + +($++$) :: Doc -> Doc -> Doc +x $++$ y = x $$ emptyLine $$ y + diff --git a/src/GF/Speech/PGFToCFG.hs b/src/GF/Speech/PGFToCFG.hs new file mode 100644 index 000000000..1f3ebaeb4 --- /dev/null +++ b/src/GF/Speech/PGFToCFG.hs @@ -0,0 +1,84 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.PGFToCFG +-- +-- Approximates PGF grammars with context-free grammars. +---------------------------------------------------------------------- +module GF.Speech.PGFToCFG (bnfPrinter, pgfToCFG) where + +import PGF.CId +import PGF.Data as PGF +import PGF.Macros +import GF.Infra.Ident +import GF.Speech.CFG + +import Data.Array as Array +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe +import Data.Set (Set) +import qualified Data.Set as Set + +bnfPrinter :: PGF -> CId -> String +bnfPrinter pgf cnc = prCFG $ pgfToCFG pgf cnc + +pgfToCFG :: PGF + -> CId -- ^ Concrete syntax name + -> CFG +pgfToCFG pgf lang = mkCFG (lookStartCat pgf) extCats (startRules ++ concatMap fruleToCFRule rules) + where + pinfo = fromMaybe (error "pgfToCFG: No parser.") (lookParser pgf lang) + + rules :: [FRule] + rules = Array.elems (PGF.allRules pinfo) + + fcatGFCats :: Map FCat CId + fcatGFCats = Map.fromList [(fc,c) | (c,fcs) <- Map.toList (startupCats pinfo), fc <- fcs] + + fcatGFCat :: FCat -> CId + fcatGFCat c = fromMaybe (mkCId "Unknown") (Map.lookup c fcatGFCats) + + fcatToCat :: FCat -> FIndex -> Cat + fcatToCat c l = prCId (fcatGFCat c) ++ "_" ++ show c ++ "_" ++ show l + + extCats :: Set Cat + extCats = Set.fromList $ map lhsCat startRules + + -- NOTE: this is only correct for cats that have a lincat with exactly one row. + startRules :: [CFRule] + startRules = [CFRule (prCId c) [NonTerminal (fcatToCat fc 0)] (CFRes 0) + | (c,fcs) <- Map.toList (startupCats pinfo), + fc <- fcs, not (isLiteralFCat fc)] + + fruleToCFRule :: FRule -> [CFRule] + fruleToCFRule (FRule f ps args c rhs) = + [CFRule (fcatToCat c l) (mkRhs row) (profilesToTerm (map (fixProfile row) ps)) + | (l,row) <- Array.assocs rhs, not (containsLiterals row)] + where + mkRhs :: Array FPointPos FSymbol -> [CFSymbol] + mkRhs = map fsymbolToSymbol . Array.elems + + containsLiterals :: Array FPointPos FSymbol -> Bool + containsLiterals row = any isLiteralFCat [args!!n | FSymCat _ n <- Array.elems row] + + fsymbolToSymbol :: FSymbol -> CFSymbol + fsymbolToSymbol (FSymCat l n) = NonTerminal (fcatToCat (args!!n) l) + fsymbolToSymbol (FSymTok t) = Terminal t + + fixProfile :: Array FPointPos FSymbol -> Profile -> Profile + fixProfile row = concatMap positions + where + nts = zip [0..] [nt | nt@(FSymCat _ _) <- Array.elems row ] + positions i = [k | (k,FSymCat _ j) <- nts, j == i] + + profilesToTerm :: [Profile] -> CFTerm + profilesToTerm [[n]] | f == wildCId = CFRes n + profilesToTerm ps = CFObj f (zipWith profileToTerm argTypes ps) + where (argTypes,_) = catSkeleton $ lookType pgf f + + profileToTerm :: CId -> Profile -> CFTerm + profileToTerm t [] = CFMeta t + profileToTerm _ xs = CFRes (last xs) -- FIXME: unify + +isLiteralFCat :: FCat -> Bool +isLiteralFCat = (`elem` [fcatString, fcatInt, fcatFloat, fcatVar]) diff --git a/src/GF/Speech/PrRegExp.hs b/src/GF/Speech/PrRegExp.hs new file mode 100644 index 000000000..ae450dee8 --- /dev/null +++ b/src/GF/Speech/PrRegExp.hs @@ -0,0 +1,27 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.PrRegExp +-- +-- This module prints a grammar as a regular expression. +----------------------------------------------------------------------------- + +module GF.Speech.PrRegExp (regexpPrinter,multiRegexpPrinter) where + +import GF.Speech.CFG +import GF.Speech.CFGToFA +import GF.Speech.PGFToCFG +import GF.Speech.RegExp +import PGF + +regexpPrinter :: PGF -> CId -> String +regexpPrinter pgf cnc = (++"\n") $ prRE $ dfa2re $ cfgToFA $ pgfToCFG pgf cnc + +multiRegexpPrinter :: PGF -> CId -> String +multiRegexpPrinter pgf cnc = prREs $ mfa2res $ cfgToMFA $ pgfToCFG pgf cnc + +prREs :: [(String,RE CFSymbol)] -> String +prREs res = unlines [l ++ " = " ++ prRE (mapRE showLabel re) | (l,re) <- res] + where showLabel = symbol (\l -> "<" ++ l ++ ">") id + +mfa2res :: MFA -> [(String,RE CFSymbol)] +mfa2res (MFA _ dfas) = [(l, minimizeRE (dfa2re dfa)) | (l,dfa) <- dfas] diff --git a/src/GF/Speech/RegExp.hs b/src/GF/Speech/RegExp.hs new file mode 100644 index 000000000..5ee40828e --- /dev/null +++ b/src/GF/Speech/RegExp.hs @@ -0,0 +1,143 @@ +module GF.Speech.RegExp (RE(..), + epsilonRE, nullRE, + isEpsilon, isNull, + unionRE, concatRE, seqRE, + repeatRE, minimizeRE, + mapRE, mapRE', joinRE, + symbolsRE, + dfa2re, prRE) where + +import Data.List + +import GF.Data.Utilities +import GF.Speech.FiniteState + +data RE a = + REUnion [RE a] -- ^ REUnion [] is null + | REConcat [RE a] -- ^ REConcat [] is epsilon + | RERepeat (RE a) + | RESymbol a + deriving (Eq,Ord,Show) + + +dfa2re :: (Ord a) => DFA a -> RE a +dfa2re = finalRE . elimStates . modifyTransitions merge . addLoops + . oneFinalState () epsilonRE . mapTransitions RESymbol + where addLoops fa = newTransitions [(s,s,nullRE) | (s,_) <- states fa] fa + merge es = [(f,t,unionRE ls) + | ((f,t),ls) <- buildMultiMap [((f,t),l) | (f,t,l) <- es]] + +elimStates :: (Ord a) => DFA (RE a) -> DFA (RE a) +elimStates fa = + case [s | (s,_) <- states fa, isInternal fa s] of + [] -> fa + sE:_ -> elimStates $ insertTransitionsWith (\x y -> unionRE [x,y]) ts $ removeState sE fa + where sAs = nonLoopTransitionsTo sE fa + sBs = nonLoopTransitionsFrom sE fa + r2 = unionRE $ loops sE fa + ts = [(sA, sB, r r1 r3) | (sA,r1) <- sAs, (sB,r3) <- sBs] + r r1 r3 = concatRE [r1, repeatRE r2, r3] + +epsilonRE :: RE a +epsilonRE = REConcat [] + +nullRE :: RE a +nullRE = REUnion [] + +isNull :: RE a -> Bool +isNull (REUnion []) = True +isNull _ = False + +isEpsilon :: RE a -> Bool +isEpsilon (REConcat []) = True +isEpsilon _ = False + +unionRE :: Ord a => [RE a] -> RE a +unionRE = unionOrId . sortNub . concatMap toList + where + toList (REUnion xs) = xs + toList x = [x] + unionOrId [r] = r + unionOrId rs = REUnion rs + +concatRE :: [RE a] -> RE a +concatRE xs | any isNull xs = nullRE + | otherwise = case concatMap toList xs of + [r] -> r + rs -> REConcat rs + where + toList (REConcat xs) = xs + toList x = [x] + +seqRE :: [a] -> RE a +seqRE = concatRE . map RESymbol + +repeatRE :: RE a -> RE a +repeatRE x | isNull x || isEpsilon x = epsilonRE + | otherwise = RERepeat x + +finalRE :: Ord a => DFA (RE a) -> RE a +finalRE fa = concatRE [repeatRE r1, r2, + repeatRE (unionRE [r3, concatRE [r4, repeatRE r1, r2]])] + where + s0 = startState fa + [sF] = finalStates fa + r1 = unionRE $ loops s0 fa + r2 = unionRE $ map snd $ nonLoopTransitionsTo sF fa + r3 = unionRE $ loops sF fa + r4 = unionRE $ map snd $ nonLoopTransitionsFrom sF fa + +reverseRE :: RE a -> RE a +reverseRE (REConcat xs) = REConcat $ map reverseRE $ reverse xs +reverseRE (REUnion xs) = REUnion (map reverseRE xs) +reverseRE (RERepeat x) = RERepeat (reverseRE x) +reverseRE x = x + +minimizeRE :: Ord a => RE a -> RE a +minimizeRE = reverseRE . mergeForward . reverseRE . mergeForward + +mergeForward :: Ord a => RE a -> RE a +mergeForward (REUnion xs) = + unionRE [concatRE [mergeForward y,mergeForward (unionRE rs)] | (y,rs) <- buildMultiMap (map firstRE xs)] +mergeForward (REConcat (x:xs)) = concatRE [mergeForward x,mergeForward (REConcat xs)] +mergeForward (RERepeat r) = repeatRE (mergeForward r) +mergeForward r = r + +firstRE :: RE a -> (RE a, RE a) +firstRE (REConcat (x:xs)) = (x, REConcat xs) +firstRE r = (r,epsilonRE) + +mapRE :: (a -> b) -> RE a -> RE b +mapRE f = mapRE' (RESymbol . f) + +mapRE' :: (a -> RE b) -> RE a -> RE b +mapRE' f (REConcat xs) = REConcat (map (mapRE' f) xs) +mapRE' f (REUnion xs) = REUnion (map (mapRE' f) xs) +mapRE' f (RERepeat x) = RERepeat (mapRE' f x) +mapRE' f (RESymbol s) = f s + +joinRE :: RE (RE a) -> RE a +joinRE (REConcat xs) = REConcat (map joinRE xs) +joinRE (REUnion xs) = REUnion (map joinRE xs) +joinRE (RERepeat xs) = RERepeat (joinRE xs) +joinRE (RESymbol ss) = ss + +symbolsRE :: RE a -> [a] +symbolsRE (REConcat xs) = concatMap symbolsRE xs +symbolsRE (REUnion xs) = concatMap symbolsRE xs +symbolsRE (RERepeat x) = symbolsRE x +symbolsRE (RESymbol x) = [x] + +-- Debugging + +prRE :: RE String -> String +prRE = prRE' 0 + +prRE' _ (REUnion []) = "<NULL>" +prRE' n (REUnion xs) = p n 1 (concat (intersperse " | " (map (prRE' 1) xs))) +prRE' n (REConcat xs) = p n 2 (unwords (map (prRE' 2) xs)) +prRE' n (RERepeat x) = p n 3 (prRE' 3 x) ++ "*" +prRE' _ (RESymbol s) = s + +p n m s | n >= m = "(" ++ s ++ ")" + | True = s diff --git a/src/GF/Speech/Relation.hs b/src/GF/Speech/Relation.hs new file mode 100644 index 000000000..641d671a9 --- /dev/null +++ b/src/GF/Speech/Relation.hs @@ -0,0 +1,130 @@ +---------------------------------------------------------------------- +-- | +-- Module : Relation +-- Maintainer : BB +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/10/26 17:13:13 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- A simple module for relations. +----------------------------------------------------------------------------- + +module GF.Speech.Relation (Rel, mkRel, mkRel' + , allRelated , isRelatedTo + , transitiveClosure + , reflexiveClosure, reflexiveClosure_ + , symmetricClosure + , symmetricSubrelation, reflexiveSubrelation + , reflexiveElements + , equivalenceClasses + , isTransitive, isReflexive, isSymmetric + , isEquivalence + , isSubRelationOf) where + +import Data.List +import Data.Maybe +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set + +import GF.Data.Utilities + +type Rel a = Map a (Set a) + +-- | Creates a relation from a list of related pairs. +mkRel :: Ord a => [(a,a)] -> Rel a +mkRel ps = relates ps Map.empty + +-- | Creates a relation from a list pairs of elements and the elements +-- related to them. +mkRel' :: Ord a => [(a,[a])] -> Rel a +mkRel' xs = Map.fromListWith Set.union [(x,Set.fromList ys) | (x,ys) <- xs] + +relToList :: Rel a -> [(a,a)] +relToList r = [ (x,y) | (x,ys) <- Map.toList r, y <- Set.toList ys ] + +-- | Add a pair to the relation. +relate :: Ord a => a -> a -> Rel a -> Rel a +relate x y r = Map.insertWith Set.union x (Set.singleton y) r + +-- | Add a list of pairs to the relation. +relates :: Ord a => [(a,a)] -> Rel a -> Rel a +relates ps r = foldl (\r' (x,y) -> relate x y r') r ps + +-- | Checks if an element is related to another. +isRelatedTo :: Ord a => Rel a -> a -> a -> Bool +isRelatedTo r x y = maybe False (y `Set.member`) (Map.lookup x r) + +-- | Get the set of elements to which a given element is related. +allRelated :: Ord a => Rel a -> a -> Set a +allRelated r x = fromMaybe Set.empty (Map.lookup x r) + +-- | Get all elements in the relation. +domain :: Ord a => Rel a -> Set a +domain r = foldl Set.union (Map.keysSet r) (Map.elems r) + +-- | Keep only pairs for which both elements are in the given set. +intersectSetRel :: Ord a => Set a -> Rel a -> Rel a +intersectSetRel s = filterRel (\x y -> x `Set.member` s && y `Set.member` s) + +transitiveClosure :: Ord a => Rel a -> Rel a +transitiveClosure r = fix (Map.map growSet) r + where growSet ys = foldl Set.union ys (map (allRelated r) $ Set.toList ys) + +reflexiveClosure_ :: Ord a => [a] -- ^ The set over which the relation is defined. + -> Rel a -> Rel a +reflexiveClosure_ u r = relates [(x,x) | x <- u] r + +-- | Uses 'domain' +reflexiveClosure :: Ord a => Rel a -> Rel a +reflexiveClosure r = reflexiveClosure_ (Set.toList $ domain r) r + +symmetricClosure :: Ord a => Rel a -> Rel a +symmetricClosure r = relates [ (y,x) | (x,y) <- relToList r ] r + +symmetricSubrelation :: Ord a => Rel a -> Rel a +symmetricSubrelation r = filterRel (flip $ isRelatedTo r) r + +reflexiveSubrelation :: Ord a => Rel a -> Rel a +reflexiveSubrelation r = intersectSetRel (reflexiveElements r) r + +-- | Get the set of elements which are related to themselves. +reflexiveElements :: Ord a => Rel a -> Set a +reflexiveElements r = Set.fromList [ x | (x,ys) <- Map.toList r, x `Set.member` ys ] + +-- | Keep the related pairs for which the predicate is true. +filterRel :: Ord a => (a -> a -> Bool) -> Rel a -> Rel a +filterRel p = purgeEmpty . Map.mapWithKey (Set.filter . p) + +-- | Remove keys that map to no elements. +purgeEmpty :: Ord a => Rel a -> Rel a +purgeEmpty r = Map.filter (not . Set.null) r + + +-- | Get the equivalence classes from an equivalence relation. +equivalenceClasses :: Ord a => Rel a -> [Set a] +equivalenceClasses r = equivalenceClasses_ (Map.keys r) r + where equivalenceClasses_ [] _ = [] + equivalenceClasses_ (x:xs) r = ys:equivalenceClasses_ zs r + where ys = allRelated r x + zs = [x' | x' <- xs, not (x' `Set.member` ys)] + +isTransitive :: Ord a => Rel a -> Bool +isTransitive r = and [z `Set.member` ys | (x,ys) <- Map.toList r, + y <- Set.toList ys, z <- Set.toList (allRelated r y)] + +isReflexive :: Ord a => Rel a -> Bool +isReflexive r = all (\ (x,ys) -> x `Set.member` ys) (Map.toList r) + +isSymmetric :: Ord a => Rel a -> Bool +isSymmetric r = and [isRelatedTo r y x | (x,y) <- relToList r] + +isEquivalence :: Ord a => Rel a -> Bool +isEquivalence r = isReflexive r && isSymmetric r && isTransitive r + +isSubRelationOf :: Ord a => Rel a -> Rel a -> Bool +isSubRelationOf r1 r2 = all (uncurry (isRelatedTo r2)) (relToList r1) diff --git a/src/GF/Speech/SISR.hs b/src/GF/Speech/SISR.hs new file mode 100644 index 000000000..723dc1a49 --- /dev/null +++ b/src/GF/Speech/SISR.hs @@ -0,0 +1,75 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.SISR +-- +-- Abstract syntax and pretty printer for SISR, +-- (Semantic Interpretation for Speech Recognition) +---------------------------------------------------------------------- +module GF.Speech.SISR (SISRFormat(..), SISRTag, prSISR, + topCatSISR, profileInitSISR, catSISR, profileFinalSISR) where + +import Data.List + +import GF.Data.Utilities +import GF.Infra.Ident +import GF.Infra.Option (SISRFormat(..)) +import GF.Speech.CFG +import GF.Speech.SRG (SRGNT) +import PGF.CId + +import qualified GF.JavaScript.AbsJS as JS +import qualified GF.JavaScript.PrintJS as JS + +type SISRTag = [JS.DeclOrExpr] + + +prSISR :: SISRTag -> String +prSISR = JS.printTree + +topCatSISR :: String -> SISRFormat -> SISRTag +topCatSISR c fmt = map JS.DExpr [fmtOut fmt `ass` fmtRef fmt c] + +profileInitSISR :: CFTerm -> SISRFormat -> SISRTag +profileInitSISR t fmt + | null (usedArgs t) = [] + | otherwise = [JS.Decl [JS.DInit args (JS.EArray [])]] + +usedArgs :: CFTerm -> [Int] +usedArgs (CFObj _ ts) = foldr union [] (map usedArgs ts) +usedArgs (CFAbs _ x) = usedArgs x +usedArgs (CFApp x y) = usedArgs x `union` usedArgs y +usedArgs (CFRes i) = [i] +usedArgs _ = [] + +catSISR :: CFTerm -> SRGNT -> SISRFormat -> SISRTag +catSISR t (c,i) fmt + | i `elem` usedArgs t = map JS.DExpr + [JS.EIndex (JS.EVar args) (JS.EInt (fromIntegral i)) `ass` fmtRef fmt c] + | otherwise = [] + +profileFinalSISR :: CFTerm -> SISRFormat -> SISRTag +profileFinalSISR term fmt = [JS.DExpr $ fmtOut fmt `ass` f term] + where + f (CFObj n ts) = tree (prCId n) (map f ts) + f (CFAbs v x) = JS.EFun [var v] [JS.SReturn (f x)] + f (CFApp x y) = JS.ECall (f x) [f y] + f (CFRes i) = JS.EIndex (JS.EVar args) (JS.EInt (fromIntegral i)) + f (CFVar v) = JS.EVar (var v) + f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr (prCId typ))] + +fmtOut SISR_WD20030401 = JS.EVar (JS.Ident "$") + +fmtRef SISR_WD20030401 c = JS.EVar (JS.Ident ("$" ++ c)) + +args = JS.Ident "a" + +var v = JS.Ident ("x" ++ show v) + +field x y = JS.EMember x (JS.Ident y) + +ass = JS.EAssign + +tree n xs = obj [("name", JS.EStr n), ("args", JS.EArray xs)] + +obj ps = JS.EObj [JS.Prop (JS.StringPropName x) y | (x,y) <- ps] + diff --git a/src/GF/Speech/SLF.hs b/src/GF/Speech/SLF.hs new file mode 100644 index 000000000..4bdc05212 --- /dev/null +++ b/src/GF/Speech/SLF.hs @@ -0,0 +1,178 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.SLF +-- +-- This module converts a CFG to an SLF finite-state network +-- for use with the ATK recognizer. The SLF format is described +-- in the HTK manual, and an example for use in ATK is shown +-- in the ATK manual. +-- +----------------------------------------------------------------------------- + +module GF.Speech.SLF (slfPrinter,slfGraphvizPrinter, + slfSubPrinter,slfSubGraphvizPrinter) where + +import GF.Data.Utilities +import GF.Speech.CFG +import GF.Speech.FiniteState +import GF.Speech.CFG +import GF.Speech.CFGToFA +import GF.Speech.PGFToCFG +import qualified GF.Speech.Graphviz as Dot +import PGF +import PGF.CId + +import Control.Monad +import qualified Control.Monad.State as STM +import Data.Char (toUpper) +import Data.List +import Data.Maybe + +data SLFs = SLFs [(String,SLF)] SLF + +data SLF = SLF { slfNodes :: [SLFNode], slfEdges :: [SLFEdge] } + +data SLFNode = SLFNode { nId :: Int, nWord :: SLFWord, nTag :: Maybe String } + | SLFSubLat { nId :: Int, nLat :: String } + +-- | An SLF word is a word, or the empty string. +type SLFWord = Maybe String + +data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int } + +type SLF_FA = FA State (Maybe CFSymbol) () + +mkFAs :: PGF -> CId -> (SLF_FA, [(String,SLF_FA)]) +mkFAs pgf cnc = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs]) + where MFA start subs = {- renameSubs $ -} cfgToMFA $ pgfToCFG pgf cnc + main = let (fa,s,f) = newFA_ in newTransition s f (NonTerminal start) fa + +slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) () +slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing () + . moveLabelsToNodes . dfa2nfa + +-- | Give sequential names to subnetworks. +renameSubs :: MFA -> MFA +renameSubs (MFA start subs) = MFA (newName start) subs' + where newNames = zip (map fst subs) ["sub"++show n | n <- [0..]] + newName s = lookup' s newNames + subs' = [(newName s,renameLabels n) | (s,n) <- subs] + renameLabels = mapTransitions (mapSymbol newName id) + +-- +-- * SLF graphviz printing (without sub-networks) +-- + +slfGraphvizPrinter :: PGF -> CId -> String +slfGraphvizPrinter pgf cnc + = prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc + where + gvFA = mapStates (fromMaybe "") . mapTransitions (const "") + +-- +-- * SLF graphviz printing (with sub-networks) +-- + +slfSubGraphvizPrinter :: PGF -> CId -> String +slfSubGraphvizPrinter pgf cnc = Dot.prGraphviz g + where (main, subs) = mkFAs pgf cnc + g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..] + ss = mapM (\ (c,f) -> gvSLFFA (Just c) f) subs + m = gvSLFFA Nothing main + +gvSLFFA :: Maybe String -> SLF_FA -> STM.State [State] Dot.Graph +gvSLFFA n fa = + liftM (mkCluster n . faToGraphviz . mapStates (maybe "" mfaLabelToGv) + . mapTransitions (const "")) (rename fa) + where mfaLabelToGv = symbol ("#"++) id + mkCluster Nothing = id + mkCluster (Just x) + = Dot.setName ("cluster_"++x) . Dot.setAttr "label" x + rename fa = do + names <- STM.get + let fa' = renameStates names fa + names' = unusedNames fa' + STM.put names' + return fa' + +-- +-- * SLF printing (without sub-networks) +-- + +slfPrinter :: PGF -> CId -> String +slfPrinter pgf cnc + = prSLF $ automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc + +-- +-- * SLF printing (with sub-networks) +-- + +-- | Make a network with subnetworks in SLF +slfSubPrinter :: PGF -> CId -> String +slfSubPrinter pgf cnc = prSLFs slfs + where + (main,subs) = mkFAs pgf cnc + slfs = SLFs [(c, faToSLF fa) | (c,fa) <- subs] (faToSLF main) + faToSLF = automatonToSLF mfaNodeToSLFNode + +automatonToSLF :: (Int -> a -> SLFNode) -> FA State a () -> SLF +automatonToSLF mkNode fa = SLF { slfNodes = ns, slfEdges = es } + where ns = map (uncurry mkNode) (states fa) + es = zipWith (\i (f,t,()) -> mkSLFEdge i (f,t)) [0..] (transitions fa) + +mfaNodeToSLFNode :: Int -> Maybe CFSymbol -> SLFNode +mfaNodeToSLFNode i l = case l of + Nothing -> mkSLFNode i Nothing + Just (Terminal x) -> mkSLFNode i (Just x) + Just (NonTerminal s) -> mkSLFSubLat i s + +mkSLFNode :: Int -> Maybe String -> SLFNode +mkSLFNode i Nothing = SLFNode { nId = i, nWord = Nothing, nTag = Nothing } +mkSLFNode i (Just w) + | isNonWord w = SLFNode { nId = i, + nWord = Nothing, + nTag = Just w } + | otherwise = SLFNode { nId = i, + nWord = Just (map toUpper w), + nTag = Just w } + +mkSLFSubLat :: Int -> String -> SLFNode +mkSLFSubLat i sub = SLFSubLat { nId = i, nLat = sub } + +mkSLFEdge :: Int -> (Int,Int) -> SLFEdge +mkSLFEdge i (f,t) = SLFEdge { eId = i, eStart = f, eEnd = t } + +prSLFs :: SLFs -> String +prSLFs (SLFs subs main) = unlinesS (map prSub subs ++ [prOneSLF main]) "" + where prSub (n,s) = showString "SUBLAT=" . shows n + . nl . prOneSLF s . showString "." . nl + +prSLF :: SLF -> String +prSLF slf = prOneSLF slf "" + +prOneSLF :: SLF -> ShowS +prOneSLF (SLF { slfNodes = ns, slfEdges = es}) + = header . unlinesS (map prNode ns) . nl . unlinesS (map prEdge es) . nl + where + header = prFields [("N",show (length ns)),("L", show (length es))] . nl + prNode (SLFNode { nId = i, nWord = w, nTag = t }) + = prFields $ [("I",show i),("W",showWord w)] + ++ maybe [] (\t -> [("s",t)]) t + prNode (SLFSubLat { nId = i, nLat = l }) + = prFields [("I",show i),("L",show l)] + prEdge e = prFields [("J",show (eId e)),("S",show (eStart e)),("E",show (eEnd e))] + +-- | Check if a word should not correspond to a word in the SLF file. +isNonWord :: String -> Bool +isNonWord = any isPunct + +isPunct :: Char -> Bool +isPunct c = c `elem` "-_.;.,?!()[]{}" + +showWord :: SLFWord -> String +showWord Nothing = "!NULL" +showWord (Just w) | null w = "!NULL" + | otherwise = w + +prFields :: [(String,String)] -> ShowS +prFields fs = unwordsS [ showString l . showChar '=' . showString v | (l,v) <- fs ] diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs new file mode 100644 index 000000000..a861d889d --- /dev/null +++ b/src/GF/Speech/SRG.hs @@ -0,0 +1,175 @@ +---------------------------------------------------------------------- +-- | +-- Module : SRG +-- +-- Representation of, conversion to, and utilities for +-- printing of a general Speech Recognition Grammar. +-- +-- FIXME: remove \/ warn \/ fail if there are int \/ string literal +-- categories in the grammar +---------------------------------------------------------------------- +module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol + , SRGNT, CFTerm + , makeSimpleSRG + , makeNonRecursiveSRG + , getSpeechLanguage + , isExternalCat + , lookupFM_, prtS + ) where + +import GF.Data.Operations +import GF.Data.Utilities +import GF.Infra.Ident +import GF.Infra.PrintClass +import GF.Speech.CFG +import GF.Speech.PGFToCFG +import GF.Speech.Relation +import GF.Speech.FiniteState +import GF.Speech.RegExp +import GF.Speech.CFGToFA +import GF.Infra.Option +import PGF.CId +import PGF.Data +import PGF.Macros + +import Data.List +import Data.Maybe (fromMaybe, maybeToList) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set + +import Debug.Trace + +data SRG = SRG { srgName :: String -- ^ grammar name + , srgStartCat :: Cat -- ^ start category name + , srgExternalCats :: Set Cat + , srgLanguage :: Maybe String -- ^ The language for which the grammar + -- is intended, e.g. en-UK + , srgRules :: [SRGRule] + } + deriving (Eq,Show) + +data SRGRule = SRGRule Cat [SRGAlt] -- ^ SRG category name, original category name + -- and productions + deriving (Eq,Show) + +-- | maybe a probability, a rule name and an EBNF right-hand side +data SRGAlt = SRGAlt (Maybe Double) CFTerm SRGItem + deriving (Eq,Show) + +type SRGItem = RE SRGSymbol + +type SRGSymbol = Symbol SRGNT Token + +-- | An SRG non-terminal. Category name and its number in the profile. +type SRGNT = (Cat, Int) + + +-- | Create a compact filtered non-left-recursive SRG. +makeSimpleSRG :: PGF -> CId -> SRG +makeSimpleSRG = mkSRG cfgToSRG preprocess + where + preprocess = traceStats "After mergeIdentical" + . mergeIdentical + . traceStats "After removeLeftRecursion" + . removeLeftRecursion + . traceStats "After topDownFilter" + . topDownFilter + . traceStats "After bottomUpFilter" + . bottomUpFilter + . traceStats "After removeCycles" + . removeCycles + . traceStats "Inital CFG" + cfgToSRG cfg = [cfRulesToSRGRule rs | (_,rs) <- allRulesGrouped cfg] + +traceStats s g = trace ("---- " ++ s ++ ": " ++ stats g {- ++ "\n" ++ prCFRules g ++ "----" -}) g + +stats g = "Categories: " ++ show (countCats g) + ++ ", External categories: " ++ show (Set.size (cfgExternalCats g)) + ++ ", Rules: " ++ show (countRules g) + +makeNonRecursiveSRG :: PGF + -> CId -- ^ Concrete syntax name. + -> SRG +makeNonRecursiveSRG = mkSRG cfgToSRG id + where + cfgToSRG cfg = [SRGRule l [SRGAlt Nothing dummyCFTerm (dfaToSRGItem dfa)] | (l,dfa) <- dfas] + where + MFA _ dfas = cfgToMFA cfg + dfaToSRGItem = mapRE dummySRGNT . minimizeRE . dfa2re + dummyCFTerm = CFMeta (mkCId "dummy") + dummySRGNT = mapSymbol (\c -> (c,0)) id + +mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> CId -> SRG +mkSRG mkRules preprocess pgf cnc = + SRG { srgName = prCId cnc, + srgStartCat = cfgStartCat cfg, + srgExternalCats = cfgExternalCats cfg, + srgLanguage = getSpeechLanguage pgf cnc, + srgRules = mkRules cfg } + where cfg = renameCats (prCId cnc) $ preprocess $ pgfToCFG pgf cnc + +-- | Renames all external cats C to C_cat, and all internal cats to +-- GrammarName_N where N is an integer. +renameCats :: String -> CFG -> CFG +renameCats prefix cfg = mapCFGCats renameCat cfg + where renameCat c | isExternal c = c ++ "_cat" + | otherwise = fromMaybe ("renameCats: " ++ c) (Map.lookup c names) + isExternal c = c `Set.member` cfgExternalCats cfg + names = Map.fromList $ zip (allCats cfg) [prefix ++ "_" ++ show x | x <- [0..]] + +getSpeechLanguage :: PGF -> CId -> Maybe String +getSpeechLanguage pgf cnc = fmap (replace '_' '-') $ lookConcrFlag pgf cnc (mkCId "language") + +cfRulesToSRGRule :: [CFRule] -> SRGRule +cfRulesToSRGRule rs@(r:_) = SRGRule (lhsCat r) rhs + where + alts = [((n,Nothing),mkSRGSymbols 0 ss) | CFRule c ss n <- rs] + rhs = [SRGAlt p n (srgItem sss) | ((n,p),sss) <- buildMultiMap alts ] + + mkSRGSymbols _ [] = [] + mkSRGSymbols i (NonTerminal c:ss) = NonTerminal (c,i) : mkSRGSymbols (i+1) ss + mkSRGSymbols i (Terminal t:ss) = Terminal t : mkSRGSymbols i ss + +allSRGCats :: SRG -> [String] +allSRGCats SRG { srgRules = rs } = [c | SRGRule c _ <- rs] + +isExternalCat :: SRG -> Cat -> Bool +isExternalCat srg c = c `Set.member` srgExternalCats srg + +-- +-- * Size-optimized EBNF SRGs +-- + +srgItem :: [[SRGSymbol]] -> SRGItem +srgItem = unionRE . map mergeItems . sortGroupBy (compareBy filterCats) +-- non-optimizing version: +--srgItem = unionRE . map seqRE + +-- | Merges a list of right-hand sides which all have the same +-- sequence of non-terminals. +mergeItems :: [[SRGSymbol]] -> SRGItem +mergeItems = minimizeRE . ungroupTokens . minimizeRE . unionRE . map seqRE . map groupTokens + +groupTokens :: [SRGSymbol] -> [Symbol SRGNT [Token]] +groupTokens [] = [] +groupTokens (Terminal t:ss) = case groupTokens ss of + Terminal ts:ss' -> Terminal (t:ts):ss' + ss' -> Terminal [t]:ss' +groupTokens (NonTerminal c:ss) = NonTerminal c : groupTokens ss + +ungroupTokens :: RE (Symbol SRGNT [Token]) -> RE SRGSymbol +ungroupTokens = joinRE . mapRE (symbol (RESymbol . NonTerminal) (REConcat . map (RESymbol . Terminal))) + +-- +-- * Utilities for building and printing SRGs +-- + +lookupFM_ :: (Ord key, Show key) => Map key elt -> key -> elt +lookupFM_ fm k = Map.findWithDefault err k fm + where err = error $ "Key not found: " ++ show k + ++ "\namong " ++ show (Map.keys fm) + +prtS :: Print a => a -> ShowS +prtS = showString . prt diff --git a/src/GF/Speech/SRGS_XML.hs b/src/GF/Speech/SRGS_XML.hs new file mode 100644 index 000000000..33e2d0374 --- /dev/null +++ b/src/GF/Speech/SRGS_XML.hs @@ -0,0 +1,104 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.SRGS_XML +-- +-- Prints an SRGS XML speech recognition grammars. +---------------------------------------------------------------------- +module GF.Speech.SRGS_XML (srgsXmlPrinter, srgsXmlNonRecursivePrinter) where + +import GF.Data.Utilities +import GF.Data.XML +import GF.Infra.Option +import GF.Speech.CFG +import GF.Speech.RegExp +import GF.Speech.SISR as SISR +import GF.Speech.SRG +import PGF (PGF, CId) + +import Control.Monad +import Data.Char (toUpper,toLower) +import Data.List +import Data.Maybe +import qualified Data.Map as Map + +srgsXmlPrinter :: Maybe SISRFormat + -> PGF -> CId -> String +srgsXmlPrinter sisr pgf cnc = prSrgsXml sisr $ makeSimpleSRG pgf cnc + +srgsXmlNonRecursivePrinter :: PGF -> CId -> String +srgsXmlNonRecursivePrinter pgf cnc = prSrgsXml Nothing $ makeNonRecursiveSRG pgf cnc + + +prSrgsXml :: Maybe SISRFormat -> SRG -> String +prSrgsXml sisr srg = showXMLDoc (optimizeSRGS xmlGr) + where + xmlGr = grammar sisr (srgStartCat srg) (srgLanguage srg) $ + [meta "description" + ("SRGS XML speech recognition grammar for " ++ srgName srg ++ "."), + meta "generator" "Grammatical Framework"] + ++ map ruleToXML (srgRules srg) + ruleToXML (SRGRule cat alts) = Tag "rule" ([("id",cat)]++pub) (prRhs alts) + where pub = if isExternalCat srg cat then [("scope","public")] else [] + prRhs rhss = [oneOf (map (mkProd sisr) rhss)] + +mkProd :: Maybe SISRFormat -> SRGAlt -> XML +mkProd sisr (SRGAlt mp n rhs) = Tag "item" [] (ti ++ [x] ++ tf) + where x = mkItem sisr n rhs + ti = tag sisr (profileInitSISR n) + tf = tag sisr (profileFinalSISR n) + +mkItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> XML +mkItem sisr cn = f + where + f (REUnion []) = ETag "ruleref" [("special","VOID")] + f (REUnion xs) + | not (null es) = Tag "item" [("repeat","0-1")] [f (REUnion nes)] + | otherwise = oneOf (map f xs) + where (es,nes) = partition isEpsilon xs + f (REConcat []) = ETag "ruleref" [("special","NULL")] + f (REConcat xs) = Tag "item" [] (map f xs) + f (RERepeat x) = Tag "item" [("repeat","0-")] [f x] + f (RESymbol s) = symItem sisr cn s + +symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML +symItem sisr cn (NonTerminal n@(c,_)) = + Tag "item" [] $ [ETag "ruleref" [("uri","#" ++ c)]] ++ tag sisr (catSISR cn n) +symItem _ _ (Terminal t) = Tag "item" [] [Data (showToken t)] + +tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> [XML] +tag Nothing _ = [] +tag (Just fmt) t = case t fmt of + [] -> [] + ts -> [Tag "tag" [] [Data (prSISR ts)]] + +showToken :: Token -> String +showToken t = t + +oneOf :: [XML] -> XML +oneOf = Tag "one-of" [] + +grammar :: Maybe SISRFormat + -> String -- ^ root + -> Maybe String -- ^language + -> [XML] -> XML +grammar sisr root ml = + Tag "grammar" $ [("xmlns","http://www.w3.org/2001/06/grammar"), + ("version","1.0"), + ("mode","voice"), + ("root",root)] + ++ (if isJust sisr then [("tag-format","semantics/1.0")] else []) + ++ maybe [] (\l -> [("xml:lang", l)]) ml + +meta :: String -> String -> XML +meta n c = ETag "meta" [("name",n),("content",c)] + +optimizeSRGS :: XML -> XML +optimizeSRGS = bottomUpXML f + where f (Tag "item" [] [x@(Tag "item" _ _)]) = x + f (Tag "item" [] [x@(Tag "one-of" _ _)]) = x + f (Tag "item" as [Tag "item" [] xs]) = Tag "item" as xs + f (Tag "item" as xs) = Tag "item" as (map g xs) + where g (Tag "item" [] [x@(ETag "ruleref" _)]) = x + g x = x + f (Tag "one-of" [] [x]) = x + f x = x diff --git a/src/GF/Speech/VoiceXML.hs b/src/GF/Speech/VoiceXML.hs new file mode 100644 index 000000000..14a93c796 --- /dev/null +++ b/src/GF/Speech/VoiceXML.hs @@ -0,0 +1,247 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.Speech.VoiceXML +-- +-- Creates VoiceXML dialogue systems from PGF grammars. +----------------------------------------------------------------------------- +module GF.Speech.VoiceXML (grammar2vxml) where + +import GF.Data.Operations +import GF.Data.Str (sstrV) +import GF.Data.Utilities +import GF.Data.XML +import GF.Infra.Ident +import GF.Infra.Modules +import GF.Speech.SRG (getSpeechLanguage) +import PGF.CId +import PGF.Data +import PGF.Macros +import PGF.Linearize (realize) + +import Control.Monad (liftM) +import Data.List (isPrefixOf, find, intersperse) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) + +import Debug.Trace + +-- | the main function +grammar2vxml :: PGF -> CId -> String +grammar2vxml pgf cnc = showsXMLDoc (skel2vxml name language start skel qs) "" + where skel = pgfSkeleton pgf + name = prCId cnc + qs = catQuestions pgf cnc (map fst skel) + language = getSpeechLanguage pgf cnc + start = mkCId (lookStartCat pgf) + +-- +-- * VSkeleton: a simple description of the abstract syntax. +-- + +type Skeleton = [(CId, [(CId, [CId])])] + +pgfSkeleton :: PGF -> Skeleton +pgfSkeleton pgf = [(c,[(f,fst (catSkeleton (lookType pgf f))) | f <- fs]) + | (c,fs) <- Map.toList (catfuns (abstract pgf)), + not (isLiteralCat c)] + +-- FIXME: should this go in a more general module? +isLiteralCat :: CId -> Bool +isLiteralCat = (`elem` [mkCId "String", mkCId "Float", mkCId "Int"]) + +-- +-- * Questions to ask +-- + +type CatQuestions = [(CId,String)] + +catQuestions :: PGF -> CId -> [CId] -> CatQuestions +catQuestions pgf cnc cats = [(c,catQuestion pgf cnc c) | c <- cats] + +catQuestion :: PGF -> CId -> CId -> String +catQuestion pgf cnc cat = realize (lookPrintName pgf cnc cat) + + +{- +lin :: StateGrammar -> String -> Err String +lin gr fun = do + tree <- string2treeErr gr fun + let ls = map unt $ linTree2strings noMark g c tree + case ls of + [] -> fail $ "No linearization of " ++ fun + l:_ -> return l + where c = cncId gr + g = stateGrammarST gr + unt = formatAsText +-} + +getCatQuestion :: CId -> CatQuestions -> String +getCatQuestion c qs = + fromMaybe (error "No question for category " ++ prCId c) (lookup c qs) + +-- +-- * Generate VoiceXML +-- + +skel2vxml :: String -> Maybe String -> CId -> Skeleton -> CatQuestions -> XML +skel2vxml name language start skel qs = + vxml language ([startForm] ++ concatMap (uncurry (catForms gr qs)) skel) + where + gr = grammarURI name + startForm = Tag "form" [] [subdialog "sub" [("src", "#"++catFormId start)] + [param "old" "{ name : '?' }"]] + +grammarURI :: String -> String +grammarURI name = name ++ ".grxml" + + +catForms :: String -> CatQuestions -> CId -> [(CId, [CId])] -> [XML] +catForms gr qs cat fs = + comments [prCId cat ++ " category."] + ++ [cat2form gr qs cat fs] + +cat2form :: String -> CatQuestions -> CId -> [(CId, [CId])] -> XML +cat2form gr qs cat fs = + form (catFormId cat) $ + [var "old" Nothing, + blockCond "old.name != '?'" [assign "term" "old"], + field "term" [] + [promptString (getCatQuestion cat qs), + vxmlGrammar (gr++"#"++catFormId cat) + ] + ] + ++ concatMap (uncurry (fun2sub gr cat)) fs + ++ [block [return_ ["term"]{-]-}]] + +fun2sub :: String -> CId -> CId -> [CId] -> [XML] +fun2sub gr cat fun args = + comments [prCId fun ++ " : (" + ++ concat (intersperse ", " (map prCId args)) + ++ ") " ++ prCId cat] ++ ss + where + ss = zipWith mkSub [0..] args + mkSub n t = subdialog s [("src","#"++catFormId t), + ("cond","term.name == "++string (prCId fun))] + [param "old" v, + filled [] [assign v (s++".term")]] + where s = prCId fun ++ "_" ++ show n + v = "term.args["++show n++"]" + +catFormId :: CId -> String +catFormId c = prCId c ++ "_cat" + + +-- +-- * VoiceXML stuff +-- + +vxml :: Maybe String -> [XML] -> XML +vxml ml = Tag "vxml" $ [("version","2.0"), + ("xmlns","http://www.w3.org/2001/vxml")] + ++ maybe [] (\l -> [("xml:lang", l)]) ml + +form :: String -> [XML] -> XML +form id xs = Tag "form" [("id", id)] xs + +field :: String -> [(String,String)] -> [XML] -> XML +field name attrs = Tag "field" ([("name",name)]++attrs) + +subdialog :: String -> [(String,String)] -> [XML] -> XML +subdialog name attrs = Tag "subdialog" ([("name",name)]++attrs) + +filled :: [(String,String)] -> [XML] -> XML +filled = Tag "filled" + +vxmlGrammar :: String -> XML +vxmlGrammar uri = ETag "grammar" [("src",uri)] + +prompt :: [XML] -> XML +prompt = Tag "prompt" [] + +promptString :: String -> XML +promptString p = prompt [Data p] + +reprompt :: XML +reprompt = ETag "reprompt" [] + +assign :: String -> String -> XML +assign n e = ETag "assign" [("name",n),("expr",e)] + +value :: String -> XML +value expr = ETag "value" [("expr",expr)] + +if_ :: String -> [XML] -> XML +if_ c b = if_else c b [] + +if_else :: String -> [XML] -> [XML] -> XML +if_else c t f = cond [(c,t)] f + +cond :: [(String,[XML])] -> [XML] -> XML +cond ((c,b):rest) els = Tag "if" [("cond",c)] (b ++ es) + where es = [Tag "elseif" [("cond",c')] b' | (c',b') <- rest] + ++ if null els then [] else (Tag "else" [] []:els) + +goto_item :: String -> XML +goto_item nextitem = ETag "goto" [("nextitem",nextitem)] + +return_ :: [String] -> XML +return_ names = ETag "return" [("namelist", unwords names)] + +block :: [XML] -> XML +block = Tag "block" [] + +blockCond :: String -> [XML] -> XML +blockCond cond = Tag "block" [("cond", cond)] + +throw :: String -> String -> XML +throw event msg = Tag "throw" [("event",event),("message",msg)] [] + +nomatch :: [XML] -> XML +nomatch = Tag "nomatch" [] + +help :: [XML] -> XML +help = Tag "help" [] + +param :: String -> String -> XML +param name expr = ETag "param" [("name",name),("expr",expr)] + +var :: String -> Maybe String -> XML +var name expr = ETag "var" ([("name",name)]++e) + where e = maybe [] ((:[]) . (,) "expr") expr + +script :: String -> XML +script s = Tag "script" [] [CData s] + +scriptURI :: String -> XML +scriptURI uri = Tag "script" [("uri", uri)] [] + +-- +-- * ECMAScript stuff +-- + +string :: String -> String +string s = "'" ++ concatMap esc s ++ "'" + where esc '\'' = "\\'" + esc c = [c] + +{- +-- +-- * List stuff +-- + +isListCat :: (CId, [(CId, [CId])]) -> Bool +isListCat (cat,rules) = "List" `isPrefixOf` prIdent cat && length rules == 2 + && ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs + where c = drop 4 (prIdent cat) + fs = map (prIdent . fst) rules + +isBaseFun :: CId -> Bool +isBaseFun f = "Base" `isPrefixOf` prIdent f + +isConsFun :: CId -> Bool +isConsFun f = "Cons" `isPrefixOf` prIdent f + +baseSize :: (CId, [(CId, [CId])]) -> Int +baseSize (_,rules) = length bs + where Just (_,bs) = find (isBaseFun . fst) rules +-} diff --git a/src/GF/System/NoReadline.hs b/src/GF/System/NoReadline.hs new file mode 100644 index 000000000..1f1050e8c --- /dev/null +++ b/src/GF/System/NoReadline.hs @@ -0,0 +1,33 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.System.NoReadline +-- Maintainer : BB +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/10 15:04:01 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- Do not use readline. +----------------------------------------------------------------------------- + +module GF.System.NoReadline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where + +import System.IO.Error (try) +import System.IO (stdout,hFlush) + +fetchCommand :: String -> IO (String) +fetchCommand s = do + putStr s + hFlush stdout + res <- try getLine + case res of + Left e -> return "q" + Right l -> return l + +setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO () +setCompletionFunction _ = return () + +filenameCompletionFunction :: String -> IO [String] +filenameCompletionFunction _ = return [] diff --git a/src/GF/System/NoSignal.hs b/src/GF/System/NoSignal.hs new file mode 100644 index 000000000..5d82a431e --- /dev/null +++ b/src/GF/System/NoSignal.hs @@ -0,0 +1,29 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.System.NoSignal +-- Maintainer : Bjorn Bringert +-- Stability : (stability) +-- Portability : (portability) +-- +-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- Dummy implementation of signal handling. +----------------------------------------------------------------------------- + +module GF.System.NoSignal where + +import Control.Exception (Exception,catch) +import Prelude hiding (catch) + +{-# NOINLINE runInterruptibly #-} +runInterruptibly :: IO a -> IO (Either Exception a) +--runInterruptibly = fmap Right +runInterruptibly a = + p `catch` h + where p = a >>= \x -> return $! Right $! x + h e = return $ Left e + +blockInterrupt :: IO a -> IO a +blockInterrupt = id diff --git a/src/GF/System/Readline.hs b/src/GF/System/Readline.hs new file mode 100644 index 000000000..db122c3e2 --- /dev/null +++ b/src/GF/System/Readline.hs @@ -0,0 +1,27 @@ +{-# OPTIONS -cpp #-} + +---------------------------------------------------------------------- +-- | +-- Module : GF.System.Readline +-- Maintainer : BB +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/10 15:04:01 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.2 $ +-- +-- Uses the right readline library to read user input. +----------------------------------------------------------------------------- + +module GF.System.Readline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where + +#ifdef USE_READLINE + +import GF.System.UseReadline + +#else + +import GF.System.NoReadline + +#endif diff --git a/src/GF/System/Signal.hs b/src/GF/System/Signal.hs new file mode 100644 index 000000000..fe8a12483 --- /dev/null +++ b/src/GF/System/Signal.hs @@ -0,0 +1,27 @@ +{-# OPTIONS -cpp #-} + +---------------------------------------------------------------------- +-- | +-- Module : GF.System.Signal +-- Maintainer : Bjorn Bringert +-- Stability : (stability) +-- Portability : (portability) +-- +-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.3 $ +-- +-- Import the right singal handling module. +----------------------------------------------------------------------------- + +module GF.System.Signal (runInterruptibly,blockInterrupt) where + +#ifdef USE_INTERRUPT + +import GF.System.UseSignal (runInterruptibly,blockInterrupt) + +#else + +import GF.System.NoSignal (runInterruptibly,blockInterrupt) + +#endif diff --git a/src/GF/System/UseReadline.hs b/src/GF/System/UseReadline.hs new file mode 100644 index 000000000..a0e051601 --- /dev/null +++ b/src/GF/System/UseReadline.hs @@ -0,0 +1,36 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.System.UseReadline +-- Maintainer : BB +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/10 15:04:01 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- Use GNU readline +----------------------------------------------------------------------------- + +module GF.System.UseReadline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where + +import System.Console.Readline + +fetchCommand :: String -> IO (String) +fetchCommand s = do + setCompletionAppendCharacter Nothing + setBasicQuoteCharacters "" + res <- readline s + case res of + Nothing -> return "q" + Just s -> do addHistory s + return s + +setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO () +setCompletionFunction Nothing = setCompletionEntryFunction Nothing +setCompletionFunction (Just fn) = setCompletionEntryFunction (Just my_fn) + where + my_fn prefix = do + s <- getLineBuffer + p <- getPoint + fn s prefix p diff --git a/src/GF/System/UseSignal.hs b/src/GF/System/UseSignal.hs new file mode 100644 index 000000000..628f5888d --- /dev/null +++ b/src/GF/System/UseSignal.hs @@ -0,0 +1,72 @@ +{-# OPTIONS -cpp #-} +---------------------------------------------------------------------- +-- | +-- Module : GF.System.UseSignal +-- Maintainer : Bjorn Bringert +-- Stability : (stability) +-- Portability : (portability) +-- +-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- Allows SIGINT (Ctrl-C) to interrupt computations. +----------------------------------------------------------------------------- + +module GF.System.UseSignal where + +import Control.Concurrent (myThreadId, killThread) +import Control.Exception (Exception,catch) +import Prelude hiding (catch) +import System.IO + +#ifdef mingw32_HOST_OS +import GHC.ConsoleHandler + +myInstallHandler handler = installHandler handler +myCatch = Catch . const +myIgnore = Ignore +#else +import System.Posix.Signals + +myInstallHandler handler = installHandler sigINT handler Nothing +myCatch = Catch +myIgnore = Ignore +#endif + +{-# NOINLINE runInterruptibly #-} + +-- | Run an IO action, and allow it to be interrupted +-- by a SIGINT to the current process. Returns +-- an exception if the process did not complete +-- normally. +-- NOTES: +-- * This will replace any existing SIGINT +-- handler during the action. After the computation +-- has completed the existing handler will be restored. +-- * If the IO action is lazy (e.g. using readFile, +-- unsafeInterleaveIO etc.) the lazy computation will +-- not be interruptible, as it will be performed +-- after the signal handler has been removed. +runInterruptibly :: IO a -> IO (Either Exception a) +runInterruptibly a = + do t <- myThreadId + oldH <- myInstallHandler (myCatch (print "Seek and Destroy" >> killThread t)) + x <- p `catch` h + myInstallHandler oldH + return x + where p = a >>= \x -> return $! Right $! x + h e = return $ Left e + +-- | Like 'runInterruptibly', but always returns (), whether +-- the computation fails or not. +runInterruptibly_ :: IO () -> IO () +runInterruptibly_ = fmap (either (const ()) id) . runInterruptibly + +-- | Run an action with SIGINT blocked. +blockInterrupt :: IO a -> IO a +blockInterrupt a = + do oldH <- myInstallHandler Ignore + x <- a + myInstallHandler oldH + return x diff --git a/src/GF/Text/Lexing.hs b/src/GF/Text/Lexing.hs new file mode 100644 index 000000000..2c6b417b8 --- /dev/null +++ b/src/GF/Text/Lexing.hs @@ -0,0 +1,115 @@ +module GF.Text.Lexing (stringOp) where + +import GF.Text.Transliterations +import GF.Text.UTF8 + +import Data.Char +import Data.List (intersperse) + +-- lexers and unlexers - they work on space-separated word strings + +stringOp :: String -> Maybe (String -> String) +stringOp name = case name of + "chars" -> Just $ appLexer (filter (not . all isSpace) . map return) + "lextext" -> Just $ appLexer lexText + "lexcode" -> Just $ appLexer lexText + "lexmixed" -> Just $ appLexer lexMixed + "words" -> Just $ appLexer words + "bind" -> Just $ appUnlexer bindTok + "uncars" -> Just $ appUnlexer concat + "unlextext" -> Just $ appUnlexer unlexText + "unlexcode" -> Just $ appUnlexer unlexCode + "unlexmixed" -> Just $ appUnlexer unlexMixed + "unwords" -> Just $ appUnlexer unwords + "to_html" -> Just wrapHTML + "to_utf8" -> Just encodeUTF8 + "from_utf8" -> Just decodeUTF8 + "to_cp1251" -> Just encodeCP1251 + "from_cp1251" -> Just decodeCP1251 + _ -> transliterate name + +appLexer :: (String -> [String]) -> String -> String +appLexer f = unwords . filter (not . null) . f + +appUnlexer :: ([String] -> String) -> String -> String +appUnlexer f = unlines . map (f . words) . lines + +wrapHTML :: String -> String +wrapHTML = unlines . tag . intersperse "<br>" . lines where + tag ss = "<html>":"<body>" : ss ++ ["</body>","</html>"] + +lexText :: String -> [String] +lexText s = case s of + c:cs | isPunct c -> [c] : lexText cs + c:cs | isSpace c -> lexText cs + _:_ -> let (w,cs) = break (\x -> isSpace x || isPunct x) s in w : lexText cs + _ -> [s] + +-- | Haskell lexer, usable for much code +lexCode :: String -> [String] +lexCode ss = case lex ss of + [(w@(_:_),ws)] -> w : lexCode ws + _ -> [] + +-- | LaTeX style lexer, with "math" environment using Code between $...$ +lexMixed :: String -> [String] +lexMixed = concat . alternate False where + alternate env s = case s of + _:_ -> case break (=='$') s of + (t,[]) -> lex env t : [] + (t,c:m) -> lex env t : [[c]] : alternate (not env) m + _ -> [] + lex env = if env then lexCode else lexText + +bindTok :: [String] -> String +bindTok ws = case ws of + w:"&+":ws2 -> w ++ bindTok ws2 + w:[] -> w + w:ws2 -> w ++ " " ++ bindTok ws2 + [] -> "" + +unlexText :: [String] -> String +unlexText s = case s of + w:[] -> w + w:[c]:[] | isPunct c -> w ++ [c] + w:[c]:cs | isPunct c -> w ++ [c] ++ " " ++ unlexText cs + w:ws -> w ++ " " ++ unlexText ws + _ -> [] + +unlexCode :: [String] -> String +unlexCode s = case s of + w:[] -> w + [c]:cs | isParen c -> [c] ++ unlexCode cs + w:cs@([c]:_) | isClosing c -> w ++ unlexCode cs + w:ws -> w ++ " " ++ unlexCode ws + _ -> [] + + +unlexMixed :: [String] -> String +unlexMixed = concat . alternate False where + alternate env s = case s of + _:_ -> case break (=="$") s of + (t,[]) -> unlex env t : [] + (t,c:m) -> unlex env t : sep env c : alternate (not env) m + _ -> [] + unlex env = if env then unlexCode else unlexText + sep env c = if env then c ++ " " else " " ++ c + +isPunct = flip elem ".?!,:;" +isParen = flip elem "()[]{}" +isClosing = flip elem ")]}" + + +-- might be in a file of its own: Windows Cyrillic, used in Bulgarian resource + +decodeCP1251 = map convert where + convert c + | c >= '\192' && c <= '\255' = chr (ord c + 848) + | otherwise = c + +encodeCP1251 = map convert where + convert c + | oc >= 1040 && oc <= 1103 = chr (oc - 848) + | otherwise = c + where oc = ord c + diff --git a/src/GF/Text/Transliterations.hs b/src/GF/Text/Transliterations.hs new file mode 100644 index 000000000..30c098df8 --- /dev/null +++ b/src/GF/Text/Transliterations.hs @@ -0,0 +1,97 @@ +module GF.Text.Transliterations (transliterate,transliteration,characterTable) where + +import GF.Text.UTF8 + +import Data.Char +import qualified Data.Map as Map + +-- transliterations between ASCII and a Unicode character set + +-- current transliterations: devanagari, thai + +-- to add a new one: define the Unicode range and the corresponding ASCII strings, +-- which may be one or two characters long + +-- conventions to be followed: +-- each character is either [letter] or [letter+nonletter] +-- when using a sparse range of unicodes, mark missing codes as "-" in transliterations +-- characters can be invisible: ignored in translation to unicode + +transliterate :: String -> Maybe (String -> String) +transliterate s = case s of + 'f':'r':'o':'m':'_':t -> fmap appTransFromUnicode $ transliteration t + 't':'o':'_':t -> fmap appTransToUnicode $ transliteration t + _ -> Nothing + +transliteration :: String -> Maybe Transliteration +transliteration s = case s of + "devanagari" -> Just transDevanagari + "thai" -> Just transThai + _ -> Nothing + +characterTable :: Transliteration -> String +characterTable = unlines . map prOne . Map.assocs . trans_from_unicode where + prOne (i,s) = unwords ["|", show i, "|", encodeUTF8 [toEnum i], "|", s, "|"] + +data Transliteration = Trans { + trans_to_unicode :: Map.Map String Int, + trans_from_unicode :: Map.Map Int String, + invisible_chars :: [String] + } + +appTransToUnicode :: Transliteration -> String -> String +appTransToUnicode trans = + concat . + map (\c -> maybe c (return . toEnum) $ + Map.lookup c (trans_to_unicode trans) + ) . + filter (flip notElem (invisible_chars trans)) . + unchar + +appTransFromUnicode :: Transliteration -> String -> String +appTransFromUnicode trans = + concat . + map (maybe "?" id . + flip Map.lookup (trans_from_unicode trans) + ) . + map fromEnum + + +mkTransliteration :: [String] -> [Int] -> Transliteration +mkTransliteration ts us = Trans (Map.fromList (tzip ts us)) (Map.fromList (uzip us ts)) [] + where + tzip ts us = [(t,u) | (t,u) <- zip ts us, t /= "-"] + uzip us ts = [(u,t) | (u,t) <- zip us ts, t /= "-"] + + +unchar :: String -> [String] +unchar s = case s of + c:d:cs + | isAlpha d -> [c] : unchar (d:cs) + | isSpace d -> [c]:[d]: unchar cs + | otherwise -> [c,d] : unchar cs + [_] -> [s] + _ -> [] + +transThai :: Transliteration +transThai = mkTransliteration allTrans allCodes where + allTrans = words $ + "- k k1 - k2 - k3 g c c1 c2 s' c3 y' d' t' " ++ + "t1 t2 t3 n' d t t4 t5 t6 n b p p1 f p2 f' " ++ + "p3 m y r - l - w s- s. s h l' O h' - " ++ + "a. a a: a+ i i: v v: u u: - - - - - - " ++ + "e e' o: a% a& L R S T1 T2 T3 T4 K - - - " ++ + "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 - - - - - - " + allCodes = [0x0e00 .. 0x0e7f] + +transDevanagari :: Transliteration +transDevanagari = (mkTransliteration allTrans allCodes){invisible_chars = ["a"]} where + allTrans = words $ + "M N - - " ++ + "a- A- i- I- u- U- R- - - - e- E- - - o- O- " ++ + "k K g G N: c C j J n: t. T. d. D. n. t " ++ + "T d D n - p P b B m y r - l - - v " ++ + "S s. s h - - r. - A i I u U R - - " ++ + "- e E o O " + allCodes = [0x0901 .. 0x094c] + diff --git a/src/GF/Text/UTF8.hs b/src/GF/Text/UTF8.hs new file mode 100644 index 000000000..5e9687684 --- /dev/null +++ b/src/GF/Text/UTF8.hs @@ -0,0 +1,48 @@ +---------------------------------------------------------------------- +-- | +-- Module : UTF8 +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:23:42 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.5 $ +-- +-- From the Char module supplied with HBC. +-- code by Thomas Hallgren (Jul 10 1999) +----------------------------------------------------------------------------- + +module GF.Text.UTF8 (decodeUTF8, encodeUTF8) where + +-- | Take a Unicode string and encode it as a string +-- with the UTF8 method. +decodeUTF8 :: String -> String +decodeUTF8 "" = "" +decodeUTF8 (c:cs) | c < '\x80' = c : decodeUTF8 cs +decodeUTF8 (c:c':cs) | '\xc0' <= c && c <= '\xdf' && + '\x80' <= c' && c' <= '\xbf' = + toEnum ((fromEnum c `mod` 0x20) * 0x40 + fromEnum c' `mod` 0x40) : decodeUTF8 cs +decodeUTF8 (c:c':c'':cs) | '\xe0' <= c && c <= '\xef' && + '\x80' <= c' && c' <= '\xbf' && + '\x80' <= c'' && c'' <= '\xbf' = + toEnum ((fromEnum c `mod` 0x10 * 0x1000) + (fromEnum c' `mod` 0x40) * 0x40 + fromEnum c'' `mod` 0x40) : decodeUTF8 cs +decodeUTF8 s = s ---- AR workaround 22/6/2006 +----decodeUTF8 _ = error "UniChar.decodeUTF8: bad data" + +encodeUTF8 :: String -> String +encodeUTF8 "" = "" +encodeUTF8 (c:cs) = + if c > '\x0000' && c < '\x0080' then + c : encodeUTF8 cs + else if c < toEnum 0x0800 then + let i = fromEnum c + in toEnum (0xc0 + i `div` 0x40) : + toEnum (0x80 + i `mod` 0x40) : + encodeUTF8 cs + else + let i = fromEnum c + in toEnum (0xe0 + i `div` 0x1000) : + toEnum (0x80 + (i `mod` 0x1000) `div` 0x40) : + toEnum (0x80 + i `mod` 0x40) : + encodeUTF8 cs diff --git a/src/GFC.hs b/src/GFC.hs new file mode 100644 index 000000000..17c95eb30 --- /dev/null +++ b/src/GFC.hs @@ -0,0 +1,44 @@ +module GFC (mainGFC) where +-- module Main where + +import PGF +import PGF.CId +import PGF.Data +import PGF.Raw.Parse +import PGF.Raw.Convert +import GF.Compile +import GF.Compile.Export +import GF.Infra.UseIO +import GF.Infra.Option +import GF.Data.ErrM + +import Data.Maybe +import System.FilePath + + +mainGFC :: Options -> [FilePath] -> IOE () +mainGFC opts fs = + do gr <- batchCompile opts fs + let cnc = justModuleName (last fs) + if flag optStopAfterPhase opts == Compile + then return () + else do pgf <- link opts cnc gr + writeOutputs opts pgf + +writeOutputs :: Options -> PGF -> IOE () +writeOutputs opts pgf = + sequence_ [writeOutput opts name str + | fmt <- flag optOutputFormats opts, + (name,str) <- exportPGF opts fmt pgf] + +writeOutput :: Options -> FilePath-> String -> IOE () +writeOutput opts file str = + do let path = case flag optOutputDir opts of + Nothing -> file + Just dir -> dir </> file + writeOutputFile path str + +writeOutputFile :: FilePath -> String -> IOE () +writeOutputFile outfile output = ioeIO $ + do writeFile outfile output + putStrLn $ "wrote file " ++ outfile diff --git a/src/GFI.hs b/src/GFI.hs new file mode 100644 index 000000000..8bcc7df14 --- /dev/null +++ b/src/GFI.hs @@ -0,0 +1,237 @@ +module GFI (mainGFI) where + +import GF.Command.Interpreter +import GF.Command.Importing +import GF.Command.Commands +import GF.Command.Abstract +import GF.Command.Parse +import GF.Data.ErrM +import GF.Grammar.API -- for cc command +import GF.Infra.UseIO +import GF.Infra.Option +import GF.System.Readline + +import PGF +import PGF.Data +import PGF.Macros +import PGF.Expr (readTree) + +import Data.Char +import Data.List(isPrefixOf) +import qualified Data.Map as Map +import qualified Text.ParserCombinators.ReadP as RP +import System.Cmd +import System.CPUTime +import Control.Exception + +import Data.Version +import Paths_gf + +mainGFI :: Options -> [FilePath] -> IO () +mainGFI opts files = do + putStrLn welcome + gfenv <- importInEnv emptyGFEnv opts files + loop opts gfenv + return () + +loop :: Options -> GFEnv -> IO GFEnv +loop opts gfenv0 = do + let env = commandenv gfenv0 + let sgr = sourcegrammar gfenv0 + setCompletionFunction (Just (wordCompletion (commandenv gfenv0))) + s <- fetchCommand (prompt env) + let gfenv = gfenv0 {history = s : history gfenv0} + let loopNewCPU gfenv' = do + cpu' <- getCPUTime + putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec") + loop opts $ gfenv' {cputime = cpu'} + let + pwords = case words s of + w:ws -> getCommandOp w :ws + ws -> ws + case pwords of + -- special commands, requiring source grammar in env + "!":ws -> do + system $ unwords ws + loopNewCPU gfenv + "cc":ws -> do + let + (style,term) = case ws of + ('-':w):ws2 -> (pTermPrintStyle w, ws2) + _ -> (TermPrintDefault, ws) + case pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr of ---- pipe! + Ok x -> putStrLn (showTerm style x) + Bad s -> putStrLn s + loopNewCPU gfenv + "i":args -> do + gfenv' <- case parseOptions args of + Ok (opts',files) -> importInEnv gfenv (addOptions opts opts') files + Bad err -> do putStrLn $ "Command parse error: " ++ err + return gfenv + loopNewCPU gfenv' + + -- other special commands, working on GFEnv + "e":_ -> loopNewCPU $ gfenv { + commandenv=emptyCommandEnv, sourcegrammar = emptyGrammar + } + + "dc":f:ws -> do + case readCommandLine (unwords ws) of + Just comm -> loopNewCPU $ gfenv { + commandenv = env { + commandmacros = Map.insert f comm (commandmacros env) + } + } + _ -> putStrLn "command definition not parsed" >> loopNewCPU gfenv + + "dt":f:ws -> do + case readTree (unwords ws) of + Just exp -> loopNewCPU $ gfenv { + commandenv = env { + expmacros = Map.insert f exp (expmacros env) + } + } + _ -> putStrLn "value definition not parsed" >> loopNewCPU gfenv + + "ph":_ -> mapM_ putStrLn (reverse (history gfenv0)) >> loopNewCPU gfenv + "q":_ -> putStrLn "See you." >> return gfenv + + -- ordinary commands, working on CommandEnv + _ -> do + interpretCommandLine env s + loopNewCPU gfenv + +importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv +importInEnv gfenv opts files + | flag optRetainResource opts = + do src <- importSource (sourcegrammar gfenv) opts files + return $ gfenv {sourcegrammar = src} + | otherwise = + do let opts' = addOptions (setOptimization OptCSE False) opts + pgf0 = multigrammar (commandenv gfenv) + pgf1 <- importGrammar pgf0 opts' files + putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1 + return $ gfenv { commandenv = mkCommandEnv pgf1 } + +welcome = unlines [ + " ", + " * * * ", + " * * ", + " * * ", + " * ", + " * ", + " * * * * * * * ", + " * * * ", + " * * * * * * ", + " * * * ", + " * * * ", + " ", + "This is GF version "++showVersion version++". ", + "Some things may work. " + ] + +prompt env = absname ++ "> " where + absname = case abstractName (multigrammar env) of + "_" -> "" --- created by new Ident handling 22/5/2008 + n -> n + +data GFEnv = GFEnv { + sourcegrammar :: Grammar, -- gfo grammar -retain + commandenv :: CommandEnv, + history :: [String], + cputime :: Integer + } + +emptyGFEnv :: GFEnv +emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] 0 + + +wordCompletion cmdEnv line prefix p = + case wc_type (take p line) of + CmplCmd pref + -> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name] + CmplStr (Just (Command _ opts _)) s + -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optCat opts))) + case mb_state0 of + Right state0 -> let ws = words (take (length s - length prefix) s) + state = foldl nextState state0 ws + compls = getCompletions state prefix + in ret ' ' (Map.keys compls) + Left _ -> ret ' ' [] + CmplOpt (Just (Command n _ _)) pref + -> case Map.lookup n (commands cmdEnv) of + Just inf -> do let flg_compls = ['-':flg | (flg,_) <- flags inf, isPrefixOf pref flg] + opt_compls = ['-':opt | (opt,_) <- options inf, isPrefixOf pref opt] + ret (if null flg_compls then ' ' else '=') + (flg_compls++opt_compls) + Nothing -> ret ' ' [] + CmplIdent (Just (Command "i" _ _)) _ -- HACK: file name completion for command i + -> filenameCompletionFunction prefix + CmplIdent _ pref + -> do mb_abs <- try (evaluate (abstract pgf)) + case mb_abs of + Right abs -> ret ' ' [name | cid <- Map.keys (funs abs), let name = prCId cid, isPrefixOf pref name] + Left _ -> ret ' ' [] + _ -> ret ' ' [] + where + pgf = multigrammar cmdEnv + optLang opts = valIdOpts "lang" (head (languages pgf)) opts + optCat opts = valIdOpts "cat" (lookStartCat pgf) opts + + ret c [x] = return [x++[c]] + ret _ xs = return xs + + +data CompletionType + = CmplCmd Ident + | CmplStr (Maybe Command) String + | CmplOpt (Maybe Command) Ident + | CmplIdent (Maybe Command) Ident + deriving Show + +wc_type :: String -> CompletionType +wc_type = cmd_name + where + cmd_name cs = + let cs1 = dropWhile isSpace cs + in go cs1 cs1 + where + go x [] = CmplCmd x + go x (c:cs) + | isIdent c = go x cs + | otherwise = cmd x cs + + cmd x [] = ret CmplIdent x "" 0 + cmd _ ('|':cs) = cmd_name cs + cmd _ (';':cs) = cmd_name cs + cmd x ('"':cs) = str x cs cs + cmd x ('-':cs) = option x cs cs + cmd x (c :cs) + | isIdent c = ident x (c:cs) cs + | otherwise = cmd x cs + + option x y [] = ret CmplOpt x y 1 + option x y (c:cs) + | isIdent c = option x y cs + | otherwise = cmd x cs + + ident x y [] = ret CmplIdent x y 0 + ident x y (c:cs) + | isIdent c = ident x y cs + | otherwise = cmd x cs + + str x y [] = ret CmplStr x y 1 + str x y ('\"':cs) = cmd x cs + str x y ('\\':c:cs) = str x y cs + str x y (c:cs) = str x y cs + + ret f x y d = f cmd y + where + x1 = take (length x - length y - d) x + x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=') x1 + + cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of + [x] -> Just x + _ -> Nothing + + isIdent c = c == '_' || c == '\'' || isAlphaNum c diff --git a/src/HelpFile b/src/HelpFile new file mode 100644 index 000000000..c6b38b313 --- /dev/null +++ b/src/HelpFile @@ -0,0 +1,693 @@ +-- GF help file updated for GF 2.6, 17/6/2006. +-- *: Commands and options marked with * are currently not implemented. +-- +-- Each command has a long and a short name, options, and zero or more +-- arguments. Commands are sorted by functionality. The short name is +-- given first. + +-- Type "h -all" for full help file, "h <CommandName>" for full help on a command. + +-- commands that change the state + +i, import: i File + Reads a grammar from File and compiles it into a GF runtime grammar. + Files "include"d in File are read recursively, nubbing repetitions. + If a grammar with the same language name is already in the state, + it is overwritten - but only if compilation succeeds. + The grammar parser depends on the file name suffix: + .gf normal GF source + .gfc canonical GF + .gfr precompiled GF resource + .gfcm multilingual canonical GF + .gfe example-based grammar files (only with the -ex option) + .gfwl multilingual word list (preprocessed to abs + cncs) + .ebnf Extended BNF format + .cf Context-free (BNF) format + .trc TransferCore format + options: + -old old: parse in GF<2.0 format (not necessary) + -v verbose: give lots of messages + -s silent: don't give error messages + -src from source: ignore precompiled gfc and gfr files + -gfc from gfc: use compiled modules whenever they exist + -retain retain operations: read resource modules (needed in comm cc) + -nocf don't build old-style context-free grammar (default without HOAS) + -docf do build old-style context-free grammar (default with HOAS) + -nocheckcirc don't eliminate circular rules from CF + -cflexer build an optimized parser with separate lexer trie + -noemit do not emit code (default with old grammar format) + -o do emit code (default with new grammar format) + -ex preprocess .gfe files if needed + -prob read probabilities from top grammar file (format --# prob Fun Double) + -treebank read a treebank file to memory (xml format) + flags: + -abs set the name used for abstract syntax (with -old option) + -cnc set the name used for concrete syntax (with -old option) + -res set the name used for resource (with -old option) + -path use the (colon-separated) search path to find modules + -optimize select an optimization to override file-defined flags + -conversion select parsing method (values strict|nondet) + -probs read probabilities from file (format (--# prob) Fun Double) + -preproc use a preprocessor on each source file + -noparse read nonparsable functions from file (format --# noparse Funs) + examples: + i English.gf -- ordinary import of Concrete + i -retain german/ParadigmsGer.gf -- import of Resource to test + +r, reload: r + Executes the previous import (i) command. + +rl, remove_language: rl Language + Takes away the language from the state. + +e, empty: e + Takes away all languages and resets all global flags. + +sf, set_flags: sf Flag* + The values of the Flags are set for Language. If no language + is specified, the flags are set globally. + examples: + sf -nocpu -- stop showing CPU time + sf -lang=Swe -- make Swe the default concrete + +s, strip: s + Prune the state by removing source and resource modules. + +dc, define_command Name Anything + Add a new defined command. The Name must star with '%'. Later, + if 'Name X' is used, it is replaced by Anything where #1 is replaced + by X. + Restrictions: Currently at most one argument is possible, and a defined + command cannot appear in a pipe. + To see what definitions are in scope, use help -defs. + examples: + dc %tnp p -cat=NP -lang=Eng #1 | l -lang=Swe -- translate NPs + %tnp "this man" -- translate and parse + +dt, define_term Name Tree + Add a constant for a tree. The constant can later be called by + prefixing it with '$'. + Restriction: These terms are not yet usable as a subterm. + To see what definitions are in scope, use help -defs. + examples: + p -cat=NP "this man" | dt tm -- define tm as parse result + l -all $tm -- linearize tm in all forms + +-- commands that give information about the state + +pg, print_grammar: pg + Prints the actual grammar (overridden by the -lang=X flag). + The -printer=X flag sets the format in which the grammar is + written. + N.B. since grammars are compiled when imported, this command + generally does not show the grammar in the same format as the + source. In particular, the -printer=latex is not supported. + Use the command tg -printer=latex File to print the source + grammar in LaTeX. + options: + -utf8 apply UTF8-encoding to the grammar + flags: + -printer + -lang + -startcat -- The start category of the generated grammar. + Only supported by some grammar printers. + examples: + pg -printer=cf -- show the context-free skeleton + +pm, print_multigrammar: pm + Prints the current multilingual grammar in .gfcm form. + (Automatically executes the strip command (s) before doing this.) + options: + -utf8 apply UTF8 encoding to the tokens in the grammar + -utf8id apply UTF8 encoding to the identifiers in the grammar + examples: + pm | wf Letter.gfcm -- print the grammar into the file Letter.gfcm + pm -printer=graph | wf D.dot -- then do 'dot -Tps D.dot > D.ps' + +vg, visualize_graph: vg + Show the dependency graph of multilingual grammar via dot and gv. + +po, print_options: po + Print what modules there are in the state. Also + prints those flag values in the current state that differ from defaults. + +pl, print_languages: pl + Prints the names of currently available languages. + +pi, print_info: pi Ident + Prints information on the identifier. + +-- commands that execute and show the session history + +eh, execute_history: eh File + Executes commands in the file. + +ph, print_history; ph + Prints the commands issued during the GF session. + The result is readable by the eh command. + examples: + ph | wf foo.hist" -- save the history into a file + +-- linearization, parsing, translation, and computation + +l, linearize: l PattList? Tree + Shows all linearization forms of Tree by the actual grammar + (which is overridden by the -lang flag). + The pattern list has the form [P, ... ,Q] where P,...,Q follow GF + syntax for patterns. All those forms are generated that match with the + pattern list. Too short lists are filled with variables in the end. + Only the -table flag is available if a pattern list is specified. + HINT: see GF language specification for the syntax of Pattern and Term. + You can also copy and past parsing results. + options: + -struct bracketed form + -table show parameters (not compatible with -record, -all) + -record record, i.e. explicit GF concrete syntax term (not compatible with -table, -all) + -all show all forms and variants (not compatible with -record, -table) + -multi linearize to all languages (can be combined with the other options) + flags: + -lang linearize in this grammar + -number give this number of forms at most + -unlexer filter output through unlexer + examples: + l -lang=Swe -table -- show full inflection table in Swe + +p, parse: p String + Shows all Trees returned for String by the actual + grammar (overridden by the -lang flag), in the category S (overridden + by the -cat flag). + options for batch input: + -lines parse each line of input separately, ignoring empty lines + -all as -lines, but also parse empty lines + -prob rank results by probability + -cut stop after first lexing result leading to parser success + -fail show strings whose parse fails prefixed by #FAIL + -ambiguous show strings that have more than one parse prefixed by #AMBIGUOUS + options for selecting parsing method: + -fcfg parse using a fast variant of MCFG (default is no HOAS in grammar) + -old parse using an overgenerating CFG (default if HOAS in grammar) + -cfg parse using a much less overgenerating CFG + -mcfg parse using an even less overgenerating MCFG + Note: the first time parsing with -cfg, -mcfg, and -fcfg may take a long time + options that only work for the -old default parsing method: + -n non-strict: tolerates morphological errors + -ign ignore unknown words when parsing + -raw return context-free terms in raw form + -v verbose: give more information if parsing fails + flags: + -cat parse in this category + -lang parse in this grammar + -lexer filter input through this lexer + -parser use this parsing strategy + -number return this many results at most + examples: + p -cat=S -mcfg "jag är gammal" -- parse an S with the MCFG + rf examples.txt | p -lines -- parse each non-empty line of the file + +at, apply_transfer: at (Module.Fun | Fun) + Transfer a term using Fun from Module, or the topmost transfer + module. Transfer modules are given in the .trc format. They are + shown by the 'po' command. + flags: + -lang typecheck the result in this lang instead of default lang + examples: + p -lang=Cncdecimal "123" | at num2bin | l -- convert dec to bin + +tb, tree_bank: tb + Generate a multilingual treebank from a list of trees (default) or compare + to an existing treebank. + options: + -c compare to existing xml-formatted treebank + -trees return the trees of the treebank + -all show all linearization alternatives (branches and variants) + -table show tables of linearizations with parameters + -record show linearization records + -xml wrap the treebank (or comparison results) with XML tags + -mem write the treebank in memory instead of a file TODO + examples: + gr -cat=S -number=100 | tb -xml | wf tb.xml -- random treebank into file + rf tb.xml | tb -c -- compare-test treebank from file + rf old.xml | tb -trees | tb -xml -- create new treebank from old + +ut, use_treebank: ut String + Lookup a string in a treebank and return the resulting trees. + Use 'tb' to create a treebank and 'i -treebank' to read one from + a file. + options: + -assocs show all string-trees associations in the treebank + -strings show all strings in the treebank + -trees show all trees in the treebank + -raw return the lookup result as string, without typechecking it + flags: + -treebank use this treebank (instead of the latest introduced one) + examples: + ut "He adds this to that" | l -multi -- use treebank lookup as parser in translation + ut -assocs | grep "ComplV2" -- show all associations with ComplV2 + +tt, test_tokenizer: tt String + Show the token list sent to the parser when String is parsed. + HINT: can be useful when debugging the parser. + flags: + -lexer use this lexer + examples: + tt -lexer=codelit "2*(x + 3)" -- a favourite lexer for program code + +g, grep: g String1 String2 + Grep the String1 in the String2. String2 is read line by line, + and only those lines that contain String1 are returned. + flags: + -v return those lines that do not contain String1. + examples: + pg -printer=cf | grep "mother" -- show cf rules with word mother + +cc, compute_concrete: cc Term + Compute a term by concrete syntax definitions. Uses the topmost + resource module (the last in listing by command po) to resolve + constant names. + N.B. You need the flag -retain when importing the grammar, if you want + the oper definitions to be retained after compilation; otherwise this + command does not expand oper constants. + N.B.' The resulting Term is not a term in the sense of abstract syntax, + and hence not a valid input to a Tree-demanding command. + flags: + -table show output in a similar readable format as 'l -table' + -res use another module than the topmost one + examples: + cc -res=ParadigmsFin (nLukko "hyppy") -- inflect "hyppy" with nLukko + +so, show_operations: so Type + Show oper operations with the given value type. Uses the topmost + resource module to resolve constant names. + N.B. You need the flag -retain when importing the grammar, if you want + the oper definitions to be retained after compilation; otherwise this + command does not find any oper constants. + N.B.' The value type may not be defined in a supermodule of the + topmost resource. In that case, use appropriate qualified name. + flags: + -res use another module than the topmost one + examples: + so -res=ParadigmsFin ResourceFin.N -- show N-paradigms in ParadigmsFin + +t, translate: t Lang Lang String + Parses String in Lang1 and linearizes the resulting Trees in Lang2. + flags: + -cat + -lexer + -parser + examples: + t Eng Swe -cat=S "every number is even or odd" + +gr, generate_random: gr Tree? + Generates a random Tree of a given category. If a Tree + argument is given, the command completes the Tree with values to + the metavariables in the tree. + options: + -prob use probabilities (works for nondep types only) + -cf use a very fast method (works for nondep types only) + flags: + -cat generate in this category + -lang use the abstract syntax of this grammar + -number generate this number of trees (not impl. with Tree argument) + -depth use this number of search steps at most + examples: + gr -cat=Query -- generate in category Query + gr (PredVP ? (NegVG ?)) -- generate a random tree of this form + gr -cat=S -tr | l -- gererate and linearize + +gt, generate_trees: gt Tree? + Generates all trees up to a given depth. If the depth is large, + a small -alts is recommended. If a Tree argument is given, the + command completes the Tree with values to the metavariables in + the tree. + options: + -metas also return trees that include metavariables + -all generate all (can be infinitely many, lazily) + -lin linearize result of -all (otherwise, use pipe to linearize) + flags: + -depth generate to this depth (default 3) + -atoms take this number of atomic rules of each category (default unlimited) + -alts take this number of alternatives at each branch (default unlimited) + -cat generate in this category + -nonub don't remove duplicates (faster, not effective with -mem) + -mem use a memorizing algorithm (often faster, usually more memory-consuming) + -lang use the abstract syntax of this grammar + -number generate (at most) this number of trees (also works with -all) + -noexpand don't expand these categories (comma-separated, e.g. -noexpand=V,CN) + -doexpand only expand these categories (comma-separated, e.g. -doexpand=V,CN) + examples: + gt -depth=10 -cat=NP -- generate all NP's to depth 10 + gt (PredVP ? (NegVG ?)) -- generate all trees of this form + gt -cat=S -tr | l -- generate and linearize + gt -noexpand=NP | l -mark=metacat -- the only NP is meta, linearized "?0 +NP" + gt | l | p -lines -ambiguous | grep "#AMBIGUOUS" -- show ambiguous strings + +ma, morphologically_analyse: ma String + Runs morphological analysis on each word in String and displays + the results line by line. + options: + -short show analyses in bracketed words, instead of separate lines + -status show just the work at success, prefixed with "*" at failure + flags: + -lang + examples: + wf Bible.txt | ma -short | wf Bible.tagged -- analyse the Bible + + +-- elementary generation of Strings and Trees + +ps, put_string: ps String + Returns its argument String, like Unix echo. + HINT. The strength of ps comes from the possibility to receive the + argument from a pipeline, and altering it by the -filter flag. + flags: + -filter filter the result through this string processor + -length cut the string after this number of characters + examples: + gr -cat=Letter | l | ps -filter=text -- random letter as text + +pt, put_tree: pt Tree + Returns its argument Tree, like a specialized Unix echo. + HINT. The strength of pt comes from the possibility to receive + the argument from a pipeline, and altering it by the -transform flag. + flags: + -transform transform the result by this term processor + -number generate this number of terms at most + examples: + p "zero is even" | pt -transform=solve -- solve ?'s in parse result + +* st, show_tree: st Tree + Prints the tree as a string. Unlike pt, this command cannot be + used in a pipe to produce a tree, since its output is a string. + flags: + -printer show the tree in a special format (-printer=xml supported) + +wt, wrap_tree: wt Fun + Wraps the tree as the sole argument of Fun. + flags: + -c compute the resulting new tree to normal form + +vt, visualize_tree: vt Tree + Shows the abstract syntax tree via dot and gv (via temporary files + grphtmp.dot, grphtmp.ps). + flags: + -c show categories only (no functions) + -f show functions only (no categories) + -g show as graph (sharing uses of the same function) + -o just generate the .dot file + examples: + p "hello world" | vt -o | wf my.dot ;; ! open -a GraphViz my.dot + -- This writes the parse tree into my.dot and opens the .dot file + -- with another application without generating .ps. + +-- subshells + +es, editing_session: es + Opens an interactive editing session. + N.B. Exit from a Fudget session is to the Unix shell, not to GF. + options: + -f Fudget GUI (necessary for Unicode; only available in X Window System) + +ts, translation_session: ts + Translates input lines from any of the actual languages to all other ones. + To exit, type a full stop (.) alone on a line. + N.B. Exit from a Fudget session is to the Unix shell, not to GF. + HINT: Set -parser and -lexer locally in each grammar. + options: + -f Fudget GUI (necessary for Unicode; only available in X Windows) + -lang prepend translation results with language names + flags: + -cat the parser category + examples: + ts -cat=Numeral -lang -- translate numerals, show language names + +tq, translation_quiz: tq Lang Lang + Random-generates translation exercises from Lang1 to Lang2, + keeping score of success. + To interrupt, type a full stop (.) alone on a line. + HINT: Set -parser and -lexer locally in each grammar. + flags: + -cat + examples: + tq -cat=NP TestResourceEng TestResourceSwe -- quiz for NPs + +tl, translation_list: tl Lang Lang + Random-generates a list of ten translation exercises from Lang1 + to Lang2. The number can be changed by a flag. + HINT: use wf to save the exercises in a file. + flags: + -cat + -number + examples: + tl -cat=NP TestResourceEng TestResourceSwe -- quiz list for NPs + +mq, morphology_quiz: mq + Random-generates morphological exercises, + keeping score of success. + To interrupt, type a full stop (.) alone on a line. + HINT: use printname judgements in your grammar to + produce nice expressions for desired forms. + flags: + -cat + -lang + examples: + mq -cat=N -lang=TestResourceSwe -- quiz for Swedish nouns + +ml, morphology_list: ml + Random-generates a list of ten morphological exercises, + keeping score of success. The number can be changed with a flag. + HINT: use wf to save the exercises in a file. + flags: + -cat + -lang + -number + examples: + ml -cat=N -lang=TestResourceSwe -- quiz list for Swedish nouns + + +-- IO related commands + +rf, read_file: rf File + Returns the contents of File as a String; error if File does not exist. + +wf, write_file: wf File String + Writes String into File; File is created if it does not exist. + N.B. the command overwrites File without a warning. + +af, append_file: af File + Writes String into the end of File; File is created if it does not exist. + +* tg, transform_grammar: tg File + Reads File, parses as a grammar, + but instead of compiling further, prints it. + The environment is not changed. When parsing the grammar, the same file + name suffixes are supported as in the i command. + HINT: use this command to print the grammar in + another format (the -printer flag); pipe it to wf to save this format. + flags: + -printer (only -printer=latex supported currently) + +* cl, convert_latex: cl File + Reads File, which is expected to be in LaTeX form. + Three environments are treated in special ways: + \begGF - \end{verbatim}, which contains GF judgements, + \begTGF - \end{verbatim}, which contains a GF expression (displayed) + \begInTGF - \end{verbatim}, which contains a GF expressions (inlined). + Moreover, certain macros should be included in the file; you can + get those macros by applying 'tg -printer=latex foo.gf' to any grammar + foo.gf. Notice that the same File can be imported as a GF grammar, + consisting of all the judgements in \begGF environments. + HINT: pipe with 'wf Foo.tex' to generate a new Latex file. + +sa, speak_aloud: sa String + Uses the Flite speech generator to produce speech for String. + Works for American English spelling. + examples: + h | sa -- listen to the list of commands + gr -cat=S | l | sa -- generate a random sentence and speak it aloud + +si, speech_input: si + Uses an ATK speech recognizer to get speech input. + flags: + -lang: The grammar to use with the speech recognizer. + -cat: The grammar category to get input in. + -language: Use acoustic model and dictionary for this language. + -number: The number of utterances to recognize. + +h, help: h Command? + Displays the paragraph concerning the command from this help file. + Without the argument, shows the first lines of all paragraphs. + options + -all show the whole help file + -defs show user-defined commands and terms + -FLAG show the values of FLAG (works for grammar-independent flags) + examples: + h print_grammar -- show all information on the pg command + +q, quit: q + Exits GF. + HINT: you can use 'ph | wf history' to save your session. + +!, system_command: ! String + Issues a system command. No value is returned to GF. + example: + ! ls + +?, system_command: ? String + Issues a system command that receives its arguments from GF pipe + and returns a value to GF. + example: + h | ? 'wc -l' | p -cat=Num + + +-- Flags. The availability of flags is defined separately for each command. + +-cat, category in which parsing is performed. + The default is S. + +-depth, the search depth in e.g. random generation. + The default depends on application. + +-filter, operation performed on a string. The default is identity. + -filter=identity no change + -filter=erase erase the text + -filter=take100 show the first 100 characters + -filter=length show the length of the string + -filter=text format as text (punctuation, capitalization) + -filter=code format as code (spacing, indentation) + +-lang, grammar used when executing a grammar-dependent command. + The default is the last-imported grammar. + +-language, voice used by Festival as its --language flag in the sa command. + The default is system-dependent. + +-length, the maximum number of characters shown of a string. + The default is unlimited. + +-lexer, tokenization transforming a string into lexical units for a parser. + The default is words. + -lexer=words tokens are separated by spaces or newlines + -lexer=literals like words, but GF integer and string literals recognized + -lexer=vars like words, but "x","x_...","$...$" as vars, "?..." as meta + -lexer=chars each character is a token + -lexer=code use Haskell's lex + -lexer=codevars like code, but treat unknown words as variables, ?? as meta + -lexer=textvars like text, but treat unknown words as variables, ?? as meta + -lexer=text with conventions on punctuation and capital letters + -lexer=codelit like code, but treat unknown words as string literals + -lexer=textlit like text, but treat unknown words as string literals + -lexer=codeC use a C-like lexer + -lexer=ignore like literals, but ignore unknown words + -lexer=subseqs like ignore, but then try all subsequences from longest + +-number, the maximum number of generated items in a list. + The default is unlimited. + +-optimize, optimization on generated code. + The default is share for concrete, none for resource modules. + Each of the flags can have the suffix _subs, which performs + common subexpression elimination after the main optimization. + Thus, -optimize=all_subs is the most aggressive one. The _subs + strategy only works in GFC, and applies therefore in concrete but + not in resource modules. + -optimize=share share common branches in tables + -optimize=parametrize first try parametrize then do share with the rest + -optimize=values represent tables as courses-of-values + -optimize=all first try parametrize then do values with the rest + -optimize=none no optimization + +-parser, parsing strategy. The default is chart. If -cfg or -mcfg are + selected, only bottomup and topdown are recognized. + -parser=chart bottom-up chart parsing + -parser=bottomup a more up to date bottom-up strategy + -parser=topdown top-down strategy + -parser=old an old bottom-up chart parser + +-printer, format in which the grammar is printed. The default is + gfc. Those marked with M are (only) available for pm, the rest + for pg. + -printer=gfc GFC grammar + -printer=gf GF grammar + -printer=old old GF grammar + -printer=cf context-free grammar, with profiles + -printer=bnf context-free grammar, without profiles + -printer=lbnf labelled context-free grammar for BNF Converter + -printer=plbnf grammar for BNF Converter, with precedence levels + *-printer=happy source file for Happy parser generator (use lbnf!) + -printer=haskell abstract syntax in Haskell, with transl to/from GF + -printer=haskell_gadt abstract syntax GADT in Haskell, with transl to/from GF + -printer=morpho full-form lexicon, long format + *-printer=latex LaTeX file (for the tg command) + -printer=fullform full-form lexicon, short format + *-printer=xml XML: DTD for the pg command, object for st + -printer=old old GF: file readable by GF 1.2 + -printer=stat show some statistics of generated GFC + -printer=probs show probabilities of all functions + -printer=gsl Nuance GSL speech recognition grammar + -printer=jsgf Java Speech Grammar Format + -printer=jsgf_sisr_old Java Speech Grammar Format with semantic tags in + SISR WD 20030401 format + -printer=srgs_abnf SRGS ABNF format + -printer=srgs_abnf_non_rec SRGS ABNF format, without any recursion. + -printer=srgs_abnf_sisr_old SRGS ABNF format, with semantic tags in + SISR WD 20030401 format + -printer=srgs_xml SRGS XML format + -printer=srgs_xml_non_rec SRGS XML format, without any recursion. + -printer=srgs_xml_prob SRGS XML format, with weights + -printer=srgs_xml_sisr_old SRGS XML format, with semantic tags in + SISR WD 20030401 format + -printer=vxml Generate a dialogue system in VoiceXML. + -printer=slf a finite automaton in the HTK SLF format + -printer=slf_graphviz the same automaton as slf, but in Graphviz format + -printer=slf_sub a finite automaton with sub-automata in the + HTK SLF format + -printer=slf_sub_graphviz the same automaton as slf_sub, but in + Graphviz format + -printer=fa_graphviz a finite automaton with labelled edges + -printer=regular a regular grammar in a simple BNF + -printer=unpar a gfc grammar with parameters eliminated + -printer=functiongraph abstract syntax functions in 'dot' format + -printer=typegraph abstract syntax categories in 'dot' format + -printer=transfer Transfer language datatype (.tr file format) + -printer=cfg-prolog M cfg in prolog format (also pg) + -printer=gfc-prolog M gfc in prolog format (also pg) + -printer=gfcm M gfcm file (default for pm) + -printer=graph M module dependency graph in 'dot' (graphviz) format + -printer=header M gfcm file with header (for GF embedded in Java) + -printer=js M JavaScript type annotator and linearizer + -printer=mcfg-prolog M mcfg in prolog format (also pg) + -printer=missing M the missing linearizations of each concrete + +-startcat, like -cat, but used in grammars (to avoid clash with keyword cat) + +-transform, transformation performed on a syntax tree. The default is identity. + -transform=identity no change + -transform=compute compute by using definitions in the grammar + -transform=nodup return the term only if it has no constants duplicated + -transform=nodupatom return the term only if it has no atomic constants duplicated + -transform=typecheck return the term only if it is type-correct + -transform=solve solve metavariables as derived refinements + -transform=context solve metavariables by unique refinements as variables + -transform=delete replace the term by metavariable + +-unlexer, untokenization transforming linearization output into a string. + The default is unwords. + -unlexer=unwords space-separated token list (like unwords) + -unlexer=text format as text: punctuation, capitals, paragraph <p> + -unlexer=code format as code (spacing, indentation) + -unlexer=textlit like text, but remove string literal quotes + -unlexer=codelit like code, but remove string literal quotes + -unlexer=concat remove all spaces + -unlexer=bind like identity, but bind at "&+" + +-mark, marking of parts of tree in linearization. The default is none. + -mark=metacat append "+CAT" to every metavariable, showing its category + -mark=struct show tree structure with brackets + -mark=java show tree structure with XML tags (used in gfeditor) + +-coding, Some grammars are in UTF-8, some in isolatin-1. + If the letters ä (a-umlaut) and ö (o-umlaut) look strange, either + change your terminal to isolatin-1, or rewrite the grammar with + 'pg -utf8'. + +-- *: Commands and options marked with * are not currently implemented. diff --git a/src/INSTALL b/src/INSTALL new file mode 100644 index 000000000..ef7949b07 --- /dev/null +++ b/src/INSTALL @@ -0,0 +1,93 @@ +To make and install GF (Updated for version 2.4). + +1. Unpack GF and go to the source directory (the place where this + INSTALL file is - so you have probably done this already!) + + tar xvfz GF-2.4.tgz + cd GF-2.4/src + +3. Make sure you have GHC (Glasgow Haskell Compiler), version 6.4 or later. + In Windows, you also need Cygwin. + + ghc --version + +4. If you are building the darcs version, run autoconf (in src/): + + autoconf + +5. Run configure + + ./configure + + If you want to install the GF somewhere other than /usr/local, use + the --prefix flag. E.g. + + ./configure --prefix=/usr + + To compile on Chalmers Solaris systems using VCS, use this configuration: + + ./configure CPPFLAGS="`lib__readline -I` `lib__ncurses -I`" LDFLAGS="`lib__readline -l` `lib__ncurses -l`" + + If you experience problems with readline, try: + + ./configure --with-readline=no + + You may need to run "make clean" after ./configure when you change the + readline setting. + +6. Compile with GNU make: + + make + + or + + gmake + + (if your system has a proprietary make) + + The binary is sent to the file GF/bin/gf . + +7. Move files to their right places: + + make install + +8. To run GF, the following environment variables must be set: + + GFHOME the GF directory, e.g., "$HOME/project/GF-2.4" + GF_LIB_PATH the GF library directory, e.g,, "$HOME/project/GF-2.4/lib" + + (Usually, you do this in ~/.login, if your shell is any *csh, + or in ~/.profile, if your shell is either of sh, ksh, zsh or bash. + Afterwards, you have to start a login shell to have the settings available.) + +9. For a quick test: + Start gf, load a grammar and parse a string: + + cd $GFHOME/examples/tutorial/food + gf FoodIta.gf FoodEng.gf + + -- when gf has started and shows the prompt >: + + > parse "this cheese is very very Italian" | tree_bank + + -- this is the response from GF: + Is (This Cheese) (Very (Very Italian)) + this cheese is very very Italian + questo formaggio è molto molto italiano + +10. If you want to run the Java GUI, go back to $GFHOME/src directory + and also do + + make install-java + + Test the GUI with some grammars: + + cd ../examples/letter + gf <mkLetter.gfs + jgf Letter.gfcm + + When the window opens, push the Random button. + +Author: Aarne Ranta, Björn Bringert 8/11/2004 -- 26/01/2006 -- 3/9/2007 + + diff --git a/src/INSTALL.binary b/src/INSTALL.binary new file mode 100644 index 000000000..ef62b24af --- /dev/null +++ b/src/INSTALL.binary @@ -0,0 +1,38 @@ +Installing a binary GF distribution: + +1. Untar the distribution file: + + $ gtar -zxf GF-2.8-[host].tar.gz + +2. Go to the created directory: + + $ cd GF-2.8-[host] + +3. Run configure: + + $ ./configure + + If you don't want to install the files under /usr/local, + run configure with the right installation prefix. E.g.: + + $ ./configure --prefix=/usr + +4. Install: + + $ make install + +If the above procedure should fail (e.g. you don't have "make" available), you +can do a manual install: + + 1. Untar the package and go to the GF directory, as 1-2 above. + + 2. The executable is the file "gf". You may want to move it somewhere + else, e.g. /usr/local/bin + + 3. The libraries are in the subdirectory "lib/". It is recommended to + create an environment variable GF_LIB_PATH pointing to that directory. + In the bash shell, you do + + $ export GF_LIB_PATH=[your gf directory]/lib + + diff --git a/src/JavaGUI/DynamicTree.java b/src/JavaGUI/DynamicTree.java new file mode 100644 index 000000000..6acc6ff64 --- /dev/null +++ b/src/JavaGUI/DynamicTree.java @@ -0,0 +1,272 @@ +
+/*
+ * This code is based on an example provided by Richard Stanford,
+ * a tutorial reader.
+ */
+
+import java.awt.*;
+import javax.swing.*;
+import javax.swing.tree.*;
+import javax.swing.event.*;
+import java.util.Vector;
+import java.awt.event.*;
+
+public class DynamicTree extends JPanel implements KeyListener,
+ ActionListener{
+ public static DefaultMutableTreeNode rootNode;
+ protected DefaultTreeModel treeModel;
+ public JTree tree;
+ public int oldSelection = 0;
+ private Toolkit toolkit = Toolkit.getDefaultToolkit();
+ JPopupMenu popup = new JPopupMenu();
+ JMenuItem menuItem;
+ Timer timer = new Timer(500, this);
+ MouseEvent m;
+
+ public DynamicTree() {
+ timer.setRepeats(false);
+ rootNode = new DefaultMutableTreeNode("Root Node");
+ treeModel = new DefaultTreeModel(rootNode);
+ treeModel.addTreeModelListener(new MyTreeModelListener());
+
+ tree = new JTree(treeModel);
+ tree.setRootVisible(false);
+ tree.setEditable(false);
+ tree.getSelectionModel().setSelectionMode
+ (TreeSelectionModel.SINGLE_TREE_SELECTION);
+ tree.addKeyListener(this);
+ menuItem = new JMenuItem("Paste");
+ menuItem.addActionListener(this);
+ popup.add(menuItem);
+
+ //Add listener to components that can bring up popup menus.
+ MouseListener popupListener = new PopupListener();
+ tree.addMouseListener(popupListener);
+
+ tree.addTreeSelectionListener(new TreeSelectionListener() {
+ public void valueChanged(TreeSelectionEvent e) {
+ if (tree.getSelectionRows()!=null) {
+ if (GFEditor.nodeTable == null)
+ {if (GFEditor.debug) System.out.println("null node table");}
+ else
+ {if (GFEditor.debug) System.out.println("node table: "+
+ GFEditor.nodeTable.contains(new Integer(0)) +" "+
+ GFEditor.nodeTable.keys().nextElement()); }
+ if (tree.getSelectionPath() == null)
+ {if (GFEditor.debug) System.out.println("null root path"); }
+ else
+ {if (GFEditor.debug) System.out.println("selected path"+
+ tree.getSelectionPath());}
+ int i = ((Integer)GFEditor.nodeTable.get(
+ tree.getSelectionPath())).intValue();
+ int j = oldSelection;
+ GFEditor.treeChanged = true;
+ if (i>j) GFEditor.send("> "+String.valueOf(i-j));
+ else GFEditor.send("< "+String.valueOf(j-i));
+ }
+ }
+ });
+
+ tree.setCellRenderer(new MyRenderer());
+ tree.setShowsRootHandles(true);
+ setPreferredSize(new Dimension(200, 100));
+ JScrollPane scrollPane = new JScrollPane(tree);
+ setLayout(new GridLayout(1,0));
+ add(scrollPane);
+ }
+
+ /** Remove all nodes except the root node. */
+ public void clear() {
+ rootNode.removeAllChildren();
+ treeModel.reload();
+ }
+
+ /** Remove the currently selected node. */
+ public void removeCurrentNode() {
+ TreePath currentSelection = tree.getSelectionPath();
+ if (currentSelection != null) {
+ DefaultMutableTreeNode currentNode = (DefaultMutableTreeNode)
+ (currentSelection.getLastPathComponent());
+ MutableTreeNode parent = (MutableTreeNode)(currentNode.getParent());
+ if (parent != null) {
+ treeModel.removeNodeFromParent(currentNode);
+ return;
+ }
+ }
+
+ // Either there was no selection, or the root was selected.
+ toolkit.beep();
+ }
+
+ /** Add child to the currently selected node. */
+ public DefaultMutableTreeNode addObject(Object child) {
+ DefaultMutableTreeNode parentNode = null;
+ TreePath parentPath = tree.getSelectionPath();
+
+ if (parentPath == null) {
+ parentNode = rootNode;
+ } else {
+ parentNode = (DefaultMutableTreeNode)
+ (parentPath.getLastPathComponent());
+ }
+
+ return addObject(parentNode, child, true);
+ }
+
+ public DefaultMutableTreeNode addObject(DefaultMutableTreeNode parent,
+ Object child) {
+ return addObject(parent, child, false);
+ }
+
+ public DefaultMutableTreeNode addObject(DefaultMutableTreeNode parent,
+ Object child,
+ boolean shouldBeVisible) {
+ DefaultMutableTreeNode childNode =
+ new DefaultMutableTreeNode(child);
+
+ if (parent == null) {
+ parent = rootNode;
+ }
+
+ treeModel.insertNodeInto(childNode, parent,
+ parent.getChildCount());
+
+ // Make sure the user can see the lovely new node.
+ if (shouldBeVisible) {
+ tree.scrollPathToVisible(new TreePath(childNode.getPath()));
+ }
+ return childNode;
+ }
+
+ class MyTreeModelListener implements TreeModelListener {
+ public void treeNodesChanged(TreeModelEvent e) {
+ DefaultMutableTreeNode node;
+ node = (DefaultMutableTreeNode)
+ (e.getTreePath().getLastPathComponent());
+
+ /*
+ * If the event lists children, then the changed
+ * node is the child of the node we've already
+ * gotten. Otherwise, the changed node and the
+ * specified node are the same.
+ */
+ try {
+ int index = e.getChildIndices()[0];
+ node = (DefaultMutableTreeNode)
+ (node.getChildAt(index));
+ } catch (NullPointerException exc) {}
+
+ if (GFEditor.debug) System.out.println
+ ("The user has finished editing the node.");
+ if (GFEditor.debug) System.out.println(
+ "New value: " + node.getUserObject());
+ }
+ public void treeNodesInserted(TreeModelEvent e) {
+ }
+ public void treeNodesRemoved(TreeModelEvent e) {
+ }
+ public void treeStructureChanged(TreeModelEvent e) {
+ }
+ }
+
+ private class MyRenderer extends DefaultTreeCellRenderer {
+ ImageIcon tutorialIcon;
+
+ public MyRenderer() {
+ tutorialIcon = new ImageIcon("images/middle.gif");
+ }
+
+ public Component getTreeCellRendererComponent(
+ JTree tree,
+ Object value,
+ boolean sel,
+ boolean expanded,
+ boolean leaf,
+ int row,
+ boolean hasFocus) {
+
+ super.getTreeCellRendererComponent(
+ tree, value, sel,
+ expanded, leaf, row,
+ hasFocus);
+ if (leaf && isTutorialBook(value))
+ setIcon(tutorialIcon);
+
+ return this;
+ }
+ protected boolean isTutorialBook(Object value) {
+ DefaultMutableTreeNode node =
+ (DefaultMutableTreeNode)value;
+ String nodeInfo =
+ (String)(node.getUserObject());
+
+ if (nodeInfo.indexOf("?") >= 0) {
+ return true;
+ }
+
+ return false;
+ }
+
+ }//class
+
+ class PopupListener extends MouseAdapter {
+ public void mousePressed(MouseEvent e) {
+ int selRow = tree.getRowForLocation(e.getX(), e.getY());
+ tree.setSelectionRow(selRow);
+ if (GFEditor.debug) System.out.println("selection changed!");
+ maybeShowPopup(e);
+ }
+
+ public void mouseReleased(MouseEvent e) {
+ if (GFEditor.debug) System.out.println("mouse released!");
+ maybeShowPopup(e);
+ }
+ }
+ void maybeShowPopup(MouseEvent e) {
+ if (GFEditor.debug) System.out.println("may be!");
+ if (e.isPopupTrigger()) {
+ m=e;
+ timer.start();
+ }
+ }
+ void addMenuItem(String name){
+ menuItem = new JMenuItem(name);
+ menuItem.addActionListener(this);
+ popup.add(menuItem);
+
+ }
+
+ public void actionPerformed(ActionEvent ae)
+ {
+ if (ae.getSource()==timer){
+ if (GFEditor.debug) System.out.println("changing menu!");
+ popup.removeAll();
+ for (int i = 0; i<GFEditor.listModel.size() ; i++)
+ addMenuItem(GFEditor.listModel.elementAt(i).toString());
+ popup.show(m.getComponent(), m.getX(), m.getY());
+ }
+ else{
+ GFEditor.treeChanged = true;
+ GFEditor.send((String)GFEditor.commands.elementAt
+ (popup.getComponentIndex((JMenuItem)(ae.getSource()))));
+ }
+ }
+
+ /** Handle the key pressed event. */
+ public void keyPressed(KeyEvent e) {
+ int keyCode = e.getKeyCode();
+ switch (keyCode){
+ case 32: GFEditor.send("'"); break;
+ case 127: GFEditor.send("d"); break;
+ }
+ }
+ /** Handle the key typed event. */
+ public void keyTyped(KeyEvent e) {
+ }
+ /** Handle the key released event. */
+ public void keyReleased(KeyEvent e) {
+ }
+
+}
+
+
diff --git a/src/JavaGUI/DynamicTree2.java b/src/JavaGUI/DynamicTree2.java new file mode 100644 index 000000000..9d325772d --- /dev/null +++ b/src/JavaGUI/DynamicTree2.java @@ -0,0 +1,272 @@ +
+/*
+ * This code is based on an example provided by Richard Stanford,
+ * a tutorial reader.
+ */
+
+import java.awt.*;
+import javax.swing.*;
+import javax.swing.tree.*;
+import javax.swing.event.*;
+import java.util.Vector;
+import java.awt.event.*;
+
+public class DynamicTree2 extends JPanel implements KeyListener,
+ ActionListener{
+ public static DefaultMutableTreeNode rootNode;
+ protected DefaultTreeModel treeModel;
+ public JTree tree;
+ public int oldSelection = 0;
+ private Toolkit toolkit = Toolkit.getDefaultToolkit();
+ public JPopupMenu popup = new JPopupMenu();
+ JMenuItem menuItem;
+ Timer timer = new Timer(500, this);
+ MouseEvent m;
+
+ public DynamicTree2() {
+ timer.setRepeats(false);
+ rootNode = new DefaultMutableTreeNode("Root Node");
+ treeModel = new DefaultTreeModel(rootNode);
+ treeModel.addTreeModelListener(new MyTreeModelListener());
+
+ tree = new JTree(treeModel);
+ tree.setRootVisible(false);
+ tree.setEditable(false);
+ tree.getSelectionModel().setSelectionMode
+ (TreeSelectionModel.SINGLE_TREE_SELECTION);
+ tree.addKeyListener(this);
+ menuItem = new JMenuItem("Paste");
+ menuItem.addActionListener(this);
+ popup.add(menuItem);
+
+ //Add listener to components that can bring up popup menus.
+ MouseListener popupListener = new PopupListener();
+ tree.addMouseListener(popupListener);
+
+ tree.addTreeSelectionListener(new TreeSelectionListener() {
+ public void valueChanged(TreeSelectionEvent e) {
+ if (tree.getSelectionRows()!=null) {
+ if (GFEditor2.nodeTable == null)
+ {if (GFEditor2.debug) System.out.println("null node table");}
+ else
+ {if (GFEditor2.debug) System.out.println("node table: "+
+ GFEditor2.nodeTable.contains(new Integer(0)) +" "+
+ GFEditor2.nodeTable.keys().nextElement()); }
+ if (tree.getSelectionPath() == null)
+ {if (GFEditor2.debug) System.out.println("null root path"); }
+ else
+ {if (GFEditor2.debug) System.out.println("selected path"+
+ tree.getSelectionPath());}
+ int i = ((Integer)GFEditor2.nodeTable.get(
+ tree.getSelectionPath())).intValue();
+ int j = oldSelection;
+ GFEditor2.treeChanged = true;
+ if (i>j) GFEditor2.send("> "+String.valueOf(i-j));
+ else GFEditor2.send("< "+String.valueOf(j-i));
+ }
+ }
+ });
+
+ tree.setCellRenderer(new MyRenderer());
+ tree.setShowsRootHandles(true);
+ setPreferredSize(new Dimension(200, 100));
+ JScrollPane scrollPane = new JScrollPane(tree);
+ setLayout(new GridLayout(1,0));
+ add(scrollPane);
+ }
+
+ /** Remove all nodes except the root node. */
+ public void clear() {
+ rootNode.removeAllChildren();
+ treeModel.reload();
+ }
+
+ /** Remove the currently selected node. */
+ public void removeCurrentNode() {
+ TreePath currentSelection = tree.getSelectionPath();
+ if (currentSelection != null) {
+ DefaultMutableTreeNode currentNode = (DefaultMutableTreeNode)
+ (currentSelection.getLastPathComponent());
+ MutableTreeNode parent = (MutableTreeNode)(currentNode.getParent());
+ if (parent != null) {
+ treeModel.removeNodeFromParent(currentNode);
+ return;
+ }
+ }
+
+ // Either there was no selection, or the root was selected.
+ toolkit.beep();
+ }
+
+ /** Add child to the currently selected node. */
+ public DefaultMutableTreeNode addObject(Object child) {
+ DefaultMutableTreeNode parentNode = null;
+ TreePath parentPath = tree.getSelectionPath();
+
+ if (parentPath == null) {
+ parentNode = rootNode;
+ } else {
+ parentNode = (DefaultMutableTreeNode)
+ (parentPath.getLastPathComponent());
+ }
+
+ return addObject(parentNode, child, true);
+ }
+
+ public DefaultMutableTreeNode addObject(DefaultMutableTreeNode parent,
+ Object child) {
+ return addObject(parent, child, false);
+ }
+
+ public DefaultMutableTreeNode addObject(DefaultMutableTreeNode parent,
+ Object child,
+ boolean shouldBeVisible) {
+ DefaultMutableTreeNode childNode =
+ new DefaultMutableTreeNode(child);
+
+ if (parent == null) {
+ parent = rootNode;
+ }
+
+ treeModel.insertNodeInto(childNode, parent,
+ parent.getChildCount());
+
+ // Make sure the user can see the lovely new node.
+ if (shouldBeVisible) {
+ tree.scrollPathToVisible(new TreePath(childNode.getPath()));
+ }
+ return childNode;
+ }
+
+ class MyTreeModelListener implements TreeModelListener {
+ public void treeNodesChanged(TreeModelEvent e) {
+ DefaultMutableTreeNode node;
+ node = (DefaultMutableTreeNode)
+ (e.getTreePath().getLastPathComponent());
+
+ /*
+ * If the event lists children, then the changed
+ * node is the child of the node we've already
+ * gotten. Otherwise, the changed node and the
+ * specified node are the same.
+ */
+ try {
+ int index = e.getChildIndices()[0];
+ node = (DefaultMutableTreeNode)
+ (node.getChildAt(index));
+ } catch (NullPointerException exc) {}
+
+ if (GFEditor2.debug) System.out.println
+ ("The user has finished editing the node.");
+ if (GFEditor2.debug) System.out.println(
+ "New value: " + node.getUserObject());
+ }
+ public void treeNodesInserted(TreeModelEvent e) {
+ }
+ public void treeNodesRemoved(TreeModelEvent e) {
+ }
+ public void treeStructureChanged(TreeModelEvent e) {
+ }
+ }
+
+ private class MyRenderer extends DefaultTreeCellRenderer {
+ ImageIcon tutorialIcon;
+
+ public MyRenderer() {
+ tutorialIcon = new ImageIcon("images/middle.gif");
+ }
+
+ public Component getTreeCellRendererComponent(
+ JTree tree,
+ Object value,
+ boolean sel,
+ boolean expanded,
+ boolean leaf,
+ int row,
+ boolean hasFocus) {
+
+ super.getTreeCellRendererComponent(
+ tree, value, sel,
+ expanded, leaf, row,
+ hasFocus);
+ if (leaf && isTutorialBook(value))
+ setIcon(tutorialIcon);
+
+ return this;
+ }
+ protected boolean isTutorialBook(Object value) {
+ DefaultMutableTreeNode node =
+ (DefaultMutableTreeNode)value;
+ String nodeInfo =
+ (String)(node.getUserObject());
+
+ if (nodeInfo.indexOf("?") >= 0) {
+ return true;
+ }
+
+ return false;
+ }
+
+ }//class
+
+ class PopupListener extends MouseAdapter {
+ public void mousePressed(MouseEvent e) {
+ int selRow = tree.getRowForLocation(e.getX(), e.getY());
+ tree.setSelectionRow(selRow);
+ if (GFEditor2.debug) System.out.println("selection changed!");
+ maybeShowPopup(e);
+ }
+
+ public void mouseReleased(MouseEvent e) {
+ if (GFEditor2.debug) System.out.println("mouse released!");
+ maybeShowPopup(e);
+ }
+ }
+ void maybeShowPopup(MouseEvent e) {
+ if (GFEditor2.debug) System.out.println("may be!");
+ if (e.isPopupTrigger()) {
+ m = e;
+ timer.start();
+ }
+ }
+ void addMenuItem(String name){
+ menuItem = new JMenuItem(name);
+ menuItem.addActionListener(this);
+ popup.add(menuItem);
+
+ }
+
+ public void actionPerformed(ActionEvent ae)
+ {
+ if (ae.getSource()==timer){
+ if (GFEditor2.debug) System.out.println("changing menu!");
+ popup.removeAll();
+ for (int i = 0; i<GFEditor2.listModel.size() ; i++)
+ addMenuItem(GFEditor2.listModel.elementAt(i).toString());
+ popup.show(m.getComponent(), m.getX(), m.getY());
+ }
+ else{
+ GFEditor2.treeChanged = true;
+ GFEditor2.send((String)GFEditor2.commands.elementAt
+ (popup.getComponentIndex((JMenuItem)(ae.getSource()))));
+ }
+ }
+
+ /** Handle the key pressed event. */
+ public void keyPressed(KeyEvent e) {
+ int keyCode = e.getKeyCode();
+ switch (keyCode){
+ case 32: GFEditor2.send("'"); break;
+ case 127: GFEditor2.send("d"); break;
+ }
+ }
+ /** Handle the key typed event. */
+ public void keyTyped(KeyEvent e) {
+ }
+ /** Handle the key released event. */
+ public void keyReleased(KeyEvent e) {
+ }
+
+}
+
+
diff --git a/src/JavaGUI/GFEditor.java b/src/JavaGUI/GFEditor.java new file mode 100644 index 000000000..0ebf91e7e --- /dev/null +++ b/src/JavaGUI/GFEditor.java @@ -0,0 +1,1420 @@ +//package javaGUI;
+
+import java.awt.*;
+import java.awt.event.*;
+import javax.swing.*;
+import javax.swing.text.*;
+import javax.swing.event.*;
+import javax.swing.tree.*;
+import java.io.*;
+import java.util.*;
+//import gfWindow.GrammarFilter;
+
+public class GFEditor extends JFrame implements ActionListener, KeyListener {
+
+ public static boolean debug = true;
+ public static boolean newObject = false;
+ public static boolean finished = false;
+ private String parseInput = "";
+ private String alphaInput = "";
+ private static String status = "status";
+ private static String selectedMenuLanguage = "Abstract";
+ private static String linearization = "";
+ private String termInput = "";
+ private static String outputString = "";
+ private static String treeString = "";
+ private static String fileString = "";
+ public static Vector commands = new Vector();
+ public static Hashtable nodeTable = new Hashtable();
+ JFileChooser fc1 = new JFileChooser("./");
+ JFileChooser fc = new JFileChooser("./");
+ private String [] filterMenu = {"Filter", "identity",
+ "erase", "take100", "text", "code", "latexfile",
+ "structured", "unstructured" };
+ private String [] modifyMenu = {"Modify", "identity","transfer",
+ "compute", "paraphrase", "typecheck", "solve", "context" };
+// private String [] modeMenu = {"Menus", "printname",
+// "plain", "short", "long", "typed", "untyped" };
+ private static String [] newMenu = {"New"};
+
+ private static boolean firstLin = true;
+ private static boolean waiting = false;
+ public static boolean treeChanged = true;
+ private static String result;
+ private static int selectionStart;
+ private static int selectionEnd;
+ private static BufferedReader fromProc;
+ private static BufferedWriter toProc;
+ private static String commandPath = new String("GF");
+ private static JTextArea output = new JTextArea();
+ public static DefaultListModel listModel= new DefaultListModel();
+ private JList list = new JList(listModel);
+ private static DynamicTree tree = new DynamicTree();
+
+ private JLabel grammar = new JLabel("No topic ");
+ private JButton save = new JButton("Save");
+ private JButton open = new JButton("Open");
+ private JButton newTopic = new JButton("New Topic");
+ private JButton gfCommand = new JButton("GF command");
+
+ private JButton leftMeta = new JButton("?<");
+ private JButton left = new JButton("<");
+ private JButton top = new JButton("Top");
+ private JButton right = new JButton(">");
+ private JButton rightMeta = new JButton(">?");
+ private JButton read = new JButton("Read");
+ // private JButton parse = new JButton("Parse");
+ // private JButton term = new JButton("Term");
+ private JButton alpha = new JButton("Alpha");
+ private JButton random = new JButton("Random");
+ private JButton undo = new JButton("Undo");
+
+ private JPanel inputPanel = new JPanel();
+ private JPanel inputPanel2 = new JPanel();
+ private JPanel inputPanel3 = new JPanel();
+ private JButton ok = new JButton("OK");
+ private JButton cancel = new JButton("Cancel");
+ private JTextField inputField = new JTextField();
+ private JLabel inputLabel = new JLabel("Read: ");
+ private JButton browse = new JButton("Browse...");
+ private ButtonGroup readGroup = new ButtonGroup();
+ private JRadioButton termReadButton = new JRadioButton("Term");
+ private JRadioButton stringReadButton = new JRadioButton("String");
+
+ private JDialog dialog;
+
+ private static JComboBox menu = new JComboBox(newMenu);
+ private JComboBox filter = new JComboBox(filterMenu);
+ private JComboBox modify = new JComboBox(modifyMenu);
+ // private JComboBox mode = new JComboBox(modeMenu);
+
+ private JPanel downPanel = new JPanel();
+ private JSplitPane treePanel;
+ private JPanel upPanel = new JPanel();
+ private JPanel middlePanel = new JPanel();
+ private JPanel middlePanelUp = new JPanel();
+ private JPanel middlePanelDown = new JPanel();
+ private JSplitPane centerPanel;
+ private static JFrame gui2 = new JFrame();
+ private JPanel centerPanel2= new JPanel();
+ private JPanel centerPanelDown = new JPanel();
+ private JScrollPane outputPanelDown = new JScrollPane(list);
+ private JScrollPane outputPanelCenter = new JScrollPane(output);
+ private JPanel outputPanelUp = new JPanel();
+ private JPanel statusPanel = new JPanel();
+ private static JLabel statusLabel = new JLabel(status);
+ private Container cp;
+
+ private static JMenuBar menuBar= new JMenuBar();;
+ private static ButtonGroup menuGroup = new ButtonGroup();
+ private JMenu viewMenu= new JMenu("View");
+ private JMenu submenu= new JMenu("language");
+ private JMenu modeMenu= new JMenu("Menus");
+ private static JMenu langMenu= new JMenu("Languages");
+ private static JMenu fileMenu= new JMenu("File");
+ private JRadioButtonMenuItem rbMenuItem;
+ private JRadioButtonMenuItem rbMenuItemLong;
+ // private JRadioButtonMenuItem rbMenuItemAbs;
+ private JRadioButtonMenuItem rbMenuItemUnTyped;
+ private static JMenuItem fileMenuItem;
+ private static JCheckBoxMenuItem cbMenuItem;
+ private static RadioListener myListener ;
+ private static ButtonGroup group = new ButtonGroup();
+ private static ButtonGroup languageGroup = new ButtonGroup();
+
+ public GFEditor()
+ {
+ this.addWindowListener(new WindowAdapter() {
+ public void windowClosing(WindowEvent e) {
+ endProgram();
+ }
+ });
+ setJMenuBar(menuBar);
+ setTitle("GF Syntax Editor");
+ viewMenu.setToolTipText("View settings");
+ fileMenu.setToolTipText("Main operations");
+ langMenu.setToolTipText("Language settings");
+ menuBar.add(fileMenu);
+ menuBar.add(langMenu);
+ menuBar.add(viewMenu);
+ menuBar.add(modeMenu);
+
+ cbMenuItem = new JCheckBoxMenuItem("Tree");
+ cbMenuItem.setActionCommand("showTree");
+ myListener = new RadioListener();
+ cbMenuItem.addActionListener(myListener);
+ cbMenuItem.setSelected(true);
+ viewMenu.add(cbMenuItem);
+ viewMenu.addSeparator();
+
+ fileMenuItem = new JMenuItem("Open...");
+ fileMenuItem.setActionCommand("open");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem("New Topic...");
+ fileMenuItem.setActionCommand("newTopic");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem("Reset");
+ fileMenuItem.setActionCommand("reset");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem("Save As...");
+ fileMenuItem.setActionCommand("save");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenu.addSeparator();
+ fileMenuItem = new JMenuItem("Exit");
+ fileMenuItem.setActionCommand("quit");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+
+ rbMenuItem = new JRadioButtonMenuItem("One window");
+ rbMenuItem.setActionCommand("combine");
+ rbMenuItem.addActionListener(myListener);
+ rbMenuItem.setSelected(true);
+/* rbMenuItem.setMnemonic(KeyEvent.VK_R);
+ rbMenuItem.setAccelerator(KeyStroke.getKeyStroke(
+ KeyEvent.VK_1, ActionEvent.ALT_MASK));
+ rbMenuItem.getAccessibleContext().setAccessibleDescription(
+ "This doesn't really do anything");
+*/
+ menuGroup.add(rbMenuItem);
+ viewMenu.add(rbMenuItem);
+
+ rbMenuItem = new JRadioButtonMenuItem("Split windows");
+ rbMenuItem.setMnemonic(KeyEvent.VK_O);
+ rbMenuItem.setActionCommand("split");
+ rbMenuItem.addActionListener(myListener);
+ menuGroup.add(rbMenuItem);
+ viewMenu.add(rbMenuItem);
+
+ modeMenu.add(submenu);
+
+ /* rbMenuItemAbs = new JRadioButtonMenuItem("Abstract");
+ rbMenuItemAbs.setActionCommand("Abstract");
+ rbMenuItemAbs.addActionListener(myListener);
+ languageGroup.add(rbMenuItemAbs);
+ */
+
+ modeMenu.addSeparator();
+ menuGroup = new ButtonGroup();
+ rbMenuItemLong = new JRadioButtonMenuItem("long");
+ rbMenuItemLong.setActionCommand("long");
+ rbMenuItemLong.setSelected(true);
+ rbMenuItemLong.addActionListener(myListener);
+ menuGroup.add(rbMenuItemLong);
+ modeMenu.add(rbMenuItemLong);
+ rbMenuItem = new JRadioButtonMenuItem("short");
+ rbMenuItem.setActionCommand("short");
+ rbMenuItem.addActionListener(myListener);
+ menuGroup.add(rbMenuItem);
+ modeMenu.add(rbMenuItem);
+ modeMenu.addSeparator();
+
+ menuGroup = new ButtonGroup();
+ rbMenuItem = new JRadioButtonMenuItem("typed");
+ rbMenuItem.setActionCommand("typed");
+ rbMenuItem.addActionListener(myListener);
+ rbMenuItem.setSelected(false);
+ menuGroup.add(rbMenuItem);
+ modeMenu.add(rbMenuItem);
+ rbMenuItemUnTyped = new JRadioButtonMenuItem("untyped");
+ rbMenuItemUnTyped.setSelected(true);
+ rbMenuItemUnTyped.setActionCommand("untyped");
+ rbMenuItemUnTyped.addActionListener(myListener);
+ menuGroup.add(rbMenuItemUnTyped);
+ modeMenu.add(rbMenuItemUnTyped);
+
+ cp = getContentPane();
+ cp.setLayout(new BorderLayout());
+ output.setToolTipText("Linearizations' display area");
+ output.setEditable(false);
+ output.setLineWrap(true);
+ output.setWrapStyleWord(true);
+// output.setSelectionColor(Color.green);
+ output.setSelectionColor(Color.white);
+// output.setFont(new Font("Arial Unicode MS", Font.PLAIN, 17));
+ output.setFont(new Font(null, Font.PLAIN, 17));
+// System.out.println(output.getFont().getFontName());
+ gfCommand.setToolTipText("Sending a command to GF");
+ read.setToolTipText("Refining with term or linearization from typed string or file");
+ modify.setToolTipText("Choosing a linearization method");
+ alpha.setToolTipText("Performing alpha-conversion");
+ random.setToolTipText("Generating random refinement");
+ undo.setToolTipText("Going back to the previous state");
+ downPanel.add(gfCommand);
+ //downPanel.add(parse);
+ //downPanel.add(term);
+ downPanel.add(read);
+ downPanel.add(modify);
+ downPanel.add(alpha);
+ downPanel.add(random);
+ downPanel.add(undo);
+
+ leftMeta.setToolTipText("Moving the focus to the previous metavariable");
+ rightMeta.setToolTipText("Moving the focus to the next metavariable");
+ left.setToolTipText("Moving the focus to the previous term");
+ right.setToolTipText("Moving the focus to the next term");
+ top.setToolTipText("Moving the focus to the top term");
+ middlePanelUp.add(leftMeta);
+ middlePanelUp.add(left);
+ middlePanelUp.add(top);
+ middlePanelUp.add(right);
+ middlePanelUp.add(rightMeta);
+ middlePanelDown.add(new JLabel("Select Action on Subterm"));
+ middlePanel.setLayout(new BorderLayout());
+ middlePanel.add(middlePanelUp, BorderLayout.NORTH);
+ middlePanel.add(middlePanelDown, BorderLayout.CENTER);
+
+ menu.setToolTipText("The list of available categories to start editing");
+ open.setToolTipText("Reading both a new environment and an editing object from file. Current editing will be discarded");
+ save.setToolTipText("Writing the current editing object to file in the term or text format");
+ grammar.setToolTipText("Current Topic");
+ newTopic.setToolTipText("Reading a new environment from file. Current editing will be discarded.");
+ upPanel.add(grammar);
+ upPanel.add(menu);
+ upPanel.add(open);
+ upPanel.add(save);
+ upPanel.add(newTopic);
+
+ filter.setToolTipText("Choosing the linearization representation format");
+ modeMenu.setToolTipText("Choosing the refinement options' representation");
+ statusLabel.setToolTipText("The current focus type");
+ list.setToolTipText("The list of current refinment options");
+ tree.setToolTipText("The abstract syntax tree representation of the current editing object");
+ upPanel.add(filter);
+ //upPanel.add(mode);
+ populateTree(tree);
+ outputPanelUp.setLayout(new BorderLayout());
+ outputPanelUp.add(outputPanelCenter, BorderLayout.CENTER);
+ outputPanelUp.add(statusPanel, BorderLayout.SOUTH);
+ statusPanel.setLayout(new GridLayout(1,1));
+ statusPanel.add(statusLabel);
+ treePanel = new JSplitPane(JSplitPane.HORIZONTAL_SPLIT,
+ tree, outputPanelUp);
+ treePanel.setDividerSize(5);
+ treePanel.setDividerLocation(100);
+ centerPanel2.setLayout(new BorderLayout());
+ gui2.setSize(350,150);
+ gui2.setTitle("Select Action on Subterm");
+ gui2.setLocationRelativeTo(treePanel);
+ centerPanelDown.setLayout(new BorderLayout());
+ centerPanel = new JSplitPane(JSplitPane.VERTICAL_SPLIT,
+ treePanel, centerPanelDown);
+ centerPanel.addKeyListener(tree);
+ centerPanel.setOneTouchExpandable(true);
+ centerPanelDown.add(middlePanel, BorderLayout.NORTH);
+ centerPanelDown.add(outputPanelDown, BorderLayout.CENTER);
+ cp.add(centerPanel, BorderLayout.CENTER);
+ cp.add(upPanel, BorderLayout.NORTH);
+ cp.add(downPanel, BorderLayout.SOUTH);
+
+ list.setSelectionMode(ListSelectionModel.SINGLE_SELECTION);
+
+ MouseListener mouseListener = new MouseAdapter() {
+ public void mouseClicked(MouseEvent e) {
+ if (e.getClickCount() == 2) {
+ listAction(list.locationToIndex(e.getPoint()));
+ }
+ }
+ };
+ list.addMouseListener(mouseListener);
+ list.addKeyListener(this);
+ menu.addActionListener(this);
+ save.addActionListener(this);
+ open.addActionListener(this);
+ newTopic.addActionListener(this);
+ gfCommand.addActionListener(this);
+
+ filter.addActionListener(this);
+ filter.setMaximumRowCount(9);
+ leftMeta.addActionListener(this);
+ left.addActionListener(this);
+
+ menu.setFocusable(false);
+ save.setFocusable(false);
+ save.setActionCommand("save");
+ open.setFocusable(false);
+ open.setActionCommand("open");
+ newTopic.setFocusable(false);
+ newTopic.setActionCommand("newTopic");
+ gfCommand.setFocusable(false);
+
+ filter.setFocusable(false);
+ leftMeta.setFocusable(false);
+ left.setFocusable(false);
+
+ top.addActionListener(this);
+ right.addActionListener(this);
+ rightMeta.addActionListener(this);
+ //parse.addActionListener(this);
+ //term.addActionListener(this);
+ read.addActionListener(this);
+ modify.addActionListener(this);
+ //mode.addActionListener(this);
+ alpha.addActionListener(this);
+ random.addActionListener(this);
+ undo.addActionListener(this);
+
+ top.setFocusable(false);
+ right.setFocusable(false);
+ rightMeta.setFocusable(false);
+ //parse.setFocusable(false);
+ //term.setFocusable(false);
+ read.setFocusable(false);
+ modify.setFocusable(false);
+ //mode.setFocusable(false);
+ alpha.setFocusable(false);
+ random.setFocusable(false);
+ undo.setFocusable(false);
+
+ output.addKeyListener(tree);
+ setSize(800,730);
+ outputPanelUp.setPreferredSize(new Dimension(500,300));
+ treePanel.setDividerLocation(0.3);
+ nodeTable.put(new TreePath(DynamicTree.rootNode.getPath()), new Integer(0));
+ setVisible(true);
+
+ JRadioButton termButton = new JRadioButton("Term");
+ termButton.setActionCommand("term");
+ termButton.setSelected(true);
+ JRadioButton linButton = new JRadioButton("Text");
+ linButton.setActionCommand("lin");
+ // Group the radio buttons.
+ group.add(linButton);
+ group.add(termButton);
+ JPanel buttonPanel = new JPanel();
+ buttonPanel.setPreferredSize(new Dimension(70, 70));
+ buttonPanel.add(new JLabel("Format:"));
+ buttonPanel.add(linButton);
+ buttonPanel.add(termButton);
+ fc1.setAccessory(buttonPanel);
+
+ termReadButton.setActionCommand("term");
+ stringReadButton.setSelected(true);
+ stringReadButton.setActionCommand("lin");
+ // Group the radio buttons.
+ readGroup.add(stringReadButton);
+ readGroup.add(termReadButton);
+ JPanel readButtonPanel = new JPanel();
+ readButtonPanel.setLayout(new GridLayout(3,1));
+ readButtonPanel.setPreferredSize(new Dimension(70, 70));
+ readButtonPanel.add(new JLabel("Format:"));
+ readButtonPanel.add(stringReadButton);
+ readButtonPanel.add(termReadButton);
+ dialog= new JDialog(this, "Input");
+ dialog.setLocationRelativeTo(this);
+ dialog.getContentPane().add(inputPanel);
+ inputPanel.setLayout(new BorderLayout(10,10));
+ inputPanel3.setLayout(new GridLayout(2,1,5,5));
+ inputPanel3.add(inputLabel);
+ inputPanel3.add(inputField);
+ ok.addActionListener(this);
+ browse.addActionListener(this);
+ cancel.addActionListener(this);
+ inputField.setPreferredSize(new Dimension(300,23));
+ inputPanel.add(inputPanel3, BorderLayout.CENTER);
+ inputPanel.add(new JLabel(" "), BorderLayout.WEST);
+ inputPanel.add(readButtonPanel, BorderLayout.EAST);
+ inputPanel.add(inputPanel2, BorderLayout.SOUTH);
+ inputPanel2.add(ok);
+ inputPanel2.add(cancel);
+ inputPanel2.add(browse);
+ dialog.setSize(350,135);
+
+ try {
+ result = fromProc.readLine();
+ while(result != null) {
+ finished = false;
+ if (debug) System.out.println("1 "+result);
+ while (result.indexOf("gf")==-1){
+ outputString +=result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("1 "+result);
+ }
+ output.append(outputString);
+ while ((result.indexOf("newcat")==-1)&&(result.indexOf("<lin ")==-1)){
+ result = fromProc.readLine();
+ if (debug) System.out.println("1 "+result);
+ }
+ if (result.indexOf("<lin ")==-1)
+ formNewMenu();
+
+ if (!finished) {
+
+ while ((result.length()==0)||(result.indexOf("<lin ")==-1)) {
+ result = fromProc.readLine();
+ if (result!=null){
+ if (debug) System.out.println("10 "+result);
+ }
+ else System.exit(0);
+ }
+ readLin();
+ readTree();
+ readMessage();
+ if (newObject)
+ formSelectMenu();
+ else {
+ while(result.indexOf("</menu")==-1) {
+ result = fromProc.readLine();
+ if (debug) System.out.println("12 "+result);
+ }
+ }
+ for (int i=0; i<3; i++){
+ result = fromProc.readLine();
+ if (debug) System.out.println("11 "+result);
+ }
+ }
+ }
+ output.append("*** NOTHING MORE TO READ FROM " + commandPath + "\n");
+ } catch (IOException e) {
+ System.out.println("Could not read from external process");
+ }
+ }
+
+ public static void send(String text){
+ try {
+ output.setText("");
+ outputString = "";
+ if (debug) System.out.println("output cleared");
+ toProc.write(text, 0, text.length());
+ toProc.newLine();
+ toProc.flush();
+ } catch (IOException e) {
+ System.out.println("Could not write to external process");
+ }
+ }
+
+ public void endProgram(){
+ send("q");
+ System.exit(0);
+ }
+
+ public static void main(String args[])
+ {
+ Locale.setDefault(Locale.US);
+ try {
+ Process extProc = Runtime.getRuntime().exec(args[0]);
+ fromProc = new BufferedReader (new InputStreamReader(
+ extProc.getInputStream(),"UTF8"));
+ toProc = new BufferedWriter(new OutputStreamWriter(extProc.getOutputStream()));
+ /* try {
+ UIManager.setLookAndFeel(
+ //UIManager.getSystemLookAndFeelClassName() );
+ "com.sun.java.swing.plaf.windows.WindowsLookAndFeel");
+ } catch (Exception e) { }
+ */
+ GFEditor gui = new GFEditor();
+
+ } catch (IOException e) {
+ System.out.println("Could not start " + commandPath);
+ }
+ }
+
+ public static void formSelectMenu (){
+ if (debug) System.out.println("list model changing! ");
+ String s ="";
+ try {
+ //read item
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ listModel.clear();
+ commands.clear();
+ while (result.indexOf("/menu")==-1){
+ //read show
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ while (result.indexOf("/show")==-1){
+ result = fromProc.readLine();
+ if (debug) System.out.println("9 "+result);
+ if (result.indexOf("/show")==-1)
+ {
+ if (result.length()>8)
+ s+=result.trim();
+ else
+ s+=result;
+ }
+ }
+// if (s.charAt(0)!='d')
+// listModel.addElement("Refine " + s);
+// else
+ listModel.addElement(s);
+ s="";
+ //read /show
+ //read send
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ saveCommand();
+ // read /item
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ }
+ } catch(IOException e){ }
+ }
+
+ public static void saveCommand(){
+ if (newObject) commands.add(result);
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("9 "+result);
+ } catch(IOException e){ }
+ }
+
+ public void readLin(){
+ try {
+ linearization="";
+ linearization += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ while (result.indexOf("/linearization")==-1){
+ linearization += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ }
+ if (newObject) formLin();
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ } catch(IOException e){ }
+ }
+
+ public static void readTree(){
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ while (result.indexOf("/tree")==-1){
+ treeString += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ }
+ if (treeChanged && (newObject)) {
+ formTree(tree);
+ treeChanged = false;
+ }
+ treeString="";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ } catch(IOException e){ }
+ }
+
+ public static void readMessage(){
+ String s ="";
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("7 "+result);
+ while (result.indexOf("/message")==-1){
+ s += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("7 "+result);
+ }
+ if (s.length()>1)
+ output.append("-------------"+'\n'+s);
+ result = fromProc.readLine();
+ if (debug) System.out.println("7 "+result);
+ } catch(IOException e){ }
+ }
+
+ public void formNewMenu () {
+ boolean more = true;
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+
+ while (more){
+ if (result.indexOf("language")==-1) {
+ menu.addItem(result.substring(6));
+ }
+ else
+ more = false;
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("3 "+result);
+ if (result.indexOf("language")!=-1)
+ more = false;
+ result = fromProc.readLine();
+ if (debug) System.out.println("4 "+result);
+ }
+
+ more = true;
+ while (more){
+ if ((result.indexOf("/gf")==-1)&&(result.indexOf("lin")==-1)) {
+ //form lang and Menu menu:
+ cbMenuItem = new JCheckBoxMenuItem(result.substring(4));
+ if (debug) System.out.println ("menu item: "+result.substring(4));
+ cbMenuItem.setSelected(true);
+ cbMenuItem.setActionCommand("lang");
+ cbMenuItem.addActionListener(myListener);
+ langMenu.add(cbMenuItem);
+/* if ((result.substring(4)).equals("Abstract"))
+ {
+ submenu.add(rbMenuItemAbs);
+ if (selectedMenuLanguage.equals("Abstract"))
+ rbMenuItemAbs.setSelected(true);
+ languageGroup.add(rbMenuItemAbs);
+ }
+ else
+ {
+*/
+ rbMenuItem = new JRadioButtonMenuItem(result.substring(4));
+ rbMenuItem.setActionCommand(result.substring(4));
+ rbMenuItem.addActionListener(myListener);
+ languageGroup.add(rbMenuItem);
+ if ((result.substring(4)).equals(selectedMenuLanguage))
+ {
+ System.out.println("Selecting "+selectedMenuLanguage);
+ rbMenuItem.setSelected(true);
+ }
+
+ submenu.add(rbMenuItem);
+// }
+ }
+ else
+ more = false;
+ // read </language>
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+ // read <language> or </gf...>
+ result = fromProc.readLine();
+ if (debug) System.out.println("3 "+result);
+ if ((result.indexOf("/gf")!=-1)||(result.indexOf("lin")!=-1))
+ more = false;
+ if (result.indexOf("/gf")!=-1)
+ finished = true;
+ // registering the file name:
+ if (result.indexOf("language")!=-1) {
+ String path = result.substring(result.indexOf('=')+1,
+ result.indexOf('>'));
+ path =path.substring(path.lastIndexOf('/')+1);
+ if (debug) System.out.println("name: "+path);
+ fileString +="--" + path +"\n";
+ if (path.lastIndexOf('.')!=path.indexOf('.'))
+ grammar.setText(path.substring(0,
+ path.indexOf('.')).toUpperCase()+" ");
+ }
+ result = fromProc.readLine();
+ if (debug) System.out.println("4 "+result);
+ }
+ System.out.println("languageGroupElement formed"+
+ languageGroup.getButtonCount());
+ langMenu.addSeparator();
+ fileMenuItem = new JMenuItem("Add...");
+ fileMenuItem.setActionCommand("import");
+ fileMenuItem.addActionListener(this);
+ langMenu.add(fileMenuItem);
+ // in order to get back in main in the beggining of while:
+ result = fromProc.readLine();
+ } catch(IOException e){ }
+ }
+
+ public void outputAppend(){
+ int i, j, k, l, l2, m;
+ l = result.indexOf("<focus");
+ i=result.indexOf("type=",l);
+ j=result.indexOf('>',i);
+ l2 = result.indexOf("focus");
+ if (l2!=-1){
+
+ // in case focus tag is cut into two lines:
+ if (l==-1) l=l2-7;
+
+ if (debug) System.out.println("form Lin1: "+result);
+ statusLabel.setText(" "+result.substring(i+5,j));
+ //cutting <focus>
+ result= result.substring(0,l)+result.substring(j+1);
+ i=result.indexOf("/focus",l);
+ if (debug) System.out.println("/ is at the position"+i);
+ j=result.indexOf('>',i);
+ k=result.length()-j;
+ if (debug) System.out.println("form Lin2: "+result);
+ m = output.getText().length();
+
+ //cutting </focus>
+ // in case focus tag is cut into two lines:
+ if (debug)
+ System.out.println("char at the previous position"+result.charAt(i-1));
+ if (result.charAt(i-1)!='<')
+ result= result.substring(0,i-8)+result.substring(j+1);
+ else
+ result= result.substring(0,i-1)+result.substring(j+1);
+ j= result.indexOf("<focus");
+ l2 = result.indexOf("focus");
+ // in case focus tag is cut into two lines:
+ if ((l2!=-1)&&(j==-1)) j=l2-7;
+ // only one focus
+ if (j==-1){
+ output.append(result+'\n');
+ selectionStart=m+l;
+ selectionEnd=output.getText().length()-k;
+ try {
+ output.getHighlighter().addHighlight(selectionStart, selectionEnd, new DefaultHighlighter.DefaultHighlightPainter(Color.green) );
+// output.getHighlighter().addHighlight(selectionStart, selectionEnd, new DefaultHighlighter.DefaultHighlightPainter(Color.white) );
+ } catch (Exception e) {}
+ }
+ //several focuses
+ else {
+ output.append(result.substring(0,j));
+ result = result.substring(j);
+ selectionStart=m+l;
+ selectionEnd=m+i-1;
+ try {
+// output.getHighlighter().addHighlight(selectionStart, selectionEnd, new DefaultHighlighter.DefaultHighlightPainter(Color.green) );
+ output.getHighlighter().addHighlight(selectionStart, selectionEnd, new DefaultHighlighter.DefaultHighlightPainter(Color.white) );
+ } catch (Exception e) {}
+ outputAppend();
+ }
+ if (debug) System.out.println("form Lin3: "+result);
+ }
+ else
+ output.append(result+'\n');
+ firstLin=false;
+ }
+
+ public void formLin(){
+ boolean visible=true;
+ firstLin=true;
+ result = linearization.substring(0,linearization.indexOf('\n'));
+ String lin = linearization.substring(linearization.indexOf('\n')+1);
+ //extract the language from result
+ int ind = result.indexOf('=');
+ int ind2 = result.indexOf('>');
+ String s = result.substring(ind+1,ind2);
+ result = lin.substring(0,lin.indexOf("</lin>"));
+ lin = lin.substring(lin.indexOf("</lin>"));
+ while (lin.length()>1) {
+ //check if the language is on
+ if (!visible) visible = true;
+ // in the list?
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if (langMenu.getItem(i).getText().equals(s))
+ {
+ visible = false;
+ break;
+ }
+ if (!visible) visible = true;
+ else {
+ //add item to the language list:
+ cbMenuItem = new JCheckBoxMenuItem(s);
+ if (debug) System.out.println ("menu item: "+s);
+ cbMenuItem.setSelected(true);
+ cbMenuItem.setActionCommand("lang");
+ cbMenuItem.addActionListener(myListener);
+ if (langMenu.getItemCount()<2)
+ langMenu.add(cbMenuItem, langMenu.getItemCount());
+ else
+ langMenu.add(cbMenuItem, langMenu.getItemCount()-2);
+
+ rbMenuItem = new JRadioButtonMenuItem(s);
+ rbMenuItem.setActionCommand(s);
+ rbMenuItem.addActionListener(myListener);
+ languageGroup.add(rbMenuItem);
+ submenu.add(rbMenuItem);
+
+ }
+ // selected?
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if ((langMenu.getItem(i).getText().equals(s))&&
+ !(langMenu.getItem(i).isSelected()) ) {
+ visible = false;
+ break;
+ }
+ if (visible) {
+ if (!firstLin)
+ output.append("************"+'\n');
+ if (debug) System.out.println("linearization for the language: "+result);
+ outputAppend();
+ }
+ // read </lin>
+ lin = lin.substring(lin.indexOf('\n')+1);
+ // read lin or 'end'
+ if (lin.length()<1) break;
+
+ result = lin.substring(0,lin.indexOf('\n'));
+ lin = lin.substring(lin.indexOf('\n')+1);
+ if (result.indexOf("<lin ")!=-1){
+ //extract the language from result
+ ind = result.indexOf('=');
+ ind2 = result.indexOf('>');
+ s = result.substring(ind+1,ind2);
+ result = lin.substring(0,lin.indexOf("</lin>"));
+ lin = lin.substring(lin.indexOf("</lin>"));
+ }
+ }
+ }
+
+ public void actionPerformed(ActionEvent ae)
+ {
+ boolean abs = true;
+ Object obj = ae.getSource();
+ if ( obj == menu ) {
+ if (!menu.getSelectedItem().equals("New"))
+ {
+ treeChanged = true;
+ send("n " + menu.getSelectedItem());
+ newObject = true;
+ menu.setSelectedIndex(0);
+ }
+ }
+ if ( obj == filter ) {
+ if (!filter.getSelectedItem().equals("Filter"))
+ {
+ send("f " + filter.getSelectedItem());
+ filter.setSelectedIndex(0);
+ }
+ }
+ if ( obj == modify ) {
+ if (!modify.getSelectedItem().equals("Modify"))
+ {
+ treeChanged = true;
+ send("c " + modify.getSelectedItem());
+ modify.setSelectedIndex(0);
+ }
+ }
+/* if ( obj == mode ) {
+ if (!mode.getSelectedItem().equals("Menus"))
+ {
+ send("o " + mode.getSelectedItem());
+ mode.setSelectedIndex(0);
+ }
+ }
+*/
+ // buttons and menu items:
+ try {
+ if (Class.forName("javax.swing.AbstractButton").isInstance(obj)) {
+ String name =((AbstractButton)obj).getActionCommand();
+
+ if ( name.equals("quit")) {
+ endProgram();
+ }
+
+ if ( name.equals("save") ) {
+
+ if (fc1.getChoosableFileFilters().length<2)
+ fc1.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc1.showSaveDialog(GFEditor.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc1.getSelectedFile();
+ if (debug) System.out.println("saving ... ");
+
+ // checking if the abstract syntax is on:
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if ((langMenu.getItem(i).getText().equals("Abstract"))&&
+ !(langMenu.getItem(i).isSelected()) ) {
+ if (debug) System.out.println("No Abstract syntax !!!!");
+ abs = false;
+ break;
+ }
+
+ String text = output.getText();
+ int end = text.indexOf("******");
+
+ // saving as a term:
+ if (group.getSelection().getActionCommand().equals("term")) {
+ if (end !=-1)
+ if (abs) {
+ writeOutput(fileString+text.substring(0, end), file.getPath());
+ abs=true;
+ }
+ else {
+ int i = linearization.indexOf('\n');
+ int j = linearization.indexOf("/lin");
+ writeOutput(fileString+linearization.substring(i+1, j-1), file.getPath());
+ }
+ else
+ JOptionPane.showMessageDialog(this, "No term to save");
+ }
+ // saving as a linearization:
+ else
+ // abstract syntax is shown:
+ if (abs){
+ end = text.indexOf('\n', end);
+ writeOutput(fileString+text.substring(end), file.getPath());
+ abs = true;
+ }
+ else
+ writeOutput(fileString+text, file.getPath());
+ }
+ }
+
+ if ( name.equals("open") ) {
+ if (fc1.getChoosableFileFilters().length<2)
+ fc1.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc1.showOpenDialog(GFEditor.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+
+ /* "sending" should be fixed on the GF side:
+ rbMenuItemLong.setSelected(true);
+ send("ms long");
+ rbMenuItemUnTyped.setSelected(true);
+ send("mt untyped");
+ selectedMenuLanguage = "Abstract";
+ rbMenuItemAbs.setSelected(true);
+ send("ml Abs");
+ */
+
+ treeChanged = true;
+ newObject = true;
+ menu.removeAllItems();
+ menu.addItem("New");
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+ submenu.removeAll();
+
+ File file = fc1.getSelectedFile();
+ // opening the file for editing :
+ if (debug) System.out.println("opening: "+ file.getPath().replace('\\','/'));
+ if (group.getSelection().getActionCommand().equals("term")) {
+ if (debug) System.out.println(" opening as a term ");
+ send("open "+ file.getPath().replace('\\','/'));
+ }
+ else {
+ if (debug) System.out.println(" opening as a linearization ");
+ send("openstring "+ file.getPath().replace('\\','/'));
+ }
+
+ fileString ="";
+ grammar.setText("No Topic ");
+ }
+ }
+
+ if ( name.equals("import") ) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc.showOpenDialog(GFEditor.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc.getSelectedFile();
+ // importing a new language :
+ if (debug) System.out.println("importing: "+ file.getPath());
+
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+
+ submenu.removeAll();
+
+ menu.removeAllItems();
+ menu.addItem("New");
+ fileString ="";
+ send("i "+ file.getPath().replace('\\','/'));
+
+ }
+ }
+ if ( name.equals("newTopic") ) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc.showOpenDialog(GFEditor.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ int n = JOptionPane.showConfirmDialog(this,
+ "This will dismiss the previous editing. Would you like to continue?",
+ "Starting a new topic", JOptionPane.YES_NO_OPTION);
+ if (n == JOptionPane.YES_OPTION){
+ File file = fc.getSelectedFile();
+ // importing a new grammar :
+ newObject = false;
+ statusLabel.setText(status);
+ listModel.clear();
+ tree.clear();
+ populateTree(tree);
+ menu.removeAllItems();
+ menu.addItem("New");
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+
+ selectedMenuLanguage = "Abstract";
+ rbMenuItemLong.setSelected(true);
+ rbMenuItemUnTyped.setSelected(true);
+ submenu.removeAll();
+
+ fileString="";
+ grammar.setText("No Topic ");
+ send("e "+ file.getPath().replace('\\','/'));
+ }
+ }
+ }
+
+ if ( obj == gfCommand ){
+ String s = JOptionPane.showInputDialog("Command:", parseInput);
+ if (s!=null) {
+ parseInput = s;
+ s = "gf "+s;
+ //treeChanged = true;
+ send(s);
+ }
+ }
+
+ if ( name.equals("reset") ) {
+ newObject = false;
+ statusLabel.setText(status);
+ listModel.clear();
+ tree.clear();
+ populateTree(tree);
+ menu.removeAllItems();
+ menu.addItem("New");
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+
+ selectedMenuLanguage = "Abstract";
+
+ submenu.removeAll();
+ rbMenuItemLong.setSelected(true);
+ rbMenuItemUnTyped.setSelected(true);
+
+ fileString="";
+ grammar.setText("No Topic ");
+ send("e");
+ }
+
+ if ( obj == leftMeta ) {
+ treeChanged = true;
+ send("<<");
+ }
+ if ( obj == left ) {
+ treeChanged = true;
+ send("<");
+ }
+ if ( obj == top ) {
+ treeChanged = true;
+ send("'");
+ }
+ if ( obj == right ) {
+ treeChanged = true;
+ send(">");
+ }
+ if ( obj == rightMeta ) {
+ treeChanged = true;
+ send(">>");
+ }
+
+ if ( obj == cancel ) {
+ dialog.hide();
+ }
+
+ if ( obj == browse ) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc.showOpenDialog(GFEditor.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc.getSelectedFile();
+ inputField.setText(file.getPath().replace('\\','/'));
+ }
+ }
+
+ if ( obj == ok ) {
+ treeChanged = true;
+ if (termReadButton.isSelected()) {
+ termInput = inputField.getText();
+ if (termInput.indexOf('/')==-1){
+ send("g "+termInput);
+ System.out.println("sending term string");
+ }
+ else {
+ send("tfile "+termInput);
+ System.out.println("sending file term: "+termInput);
+ }
+ }
+ else {
+ parseInput = inputField.getText();
+ if (parseInput.indexOf('/')==-1){
+ send("p "+parseInput);
+ System.out.println("sending parse string"+parseInput);
+ }
+ else {
+ send("pfile "+parseInput);
+ System.out.println("sending file parse string: "+parseInput);
+ }
+ }
+ dialog.hide();
+ }
+
+ if ( obj == read ) {
+ if (stringReadButton.isSelected())
+ inputField.setText(parseInput);
+ else
+ inputField.setText(termInput);
+ dialog.show();
+ }
+
+/* if ( obj == term ) {
+ inputLabel.setText("Term:");
+ inputField.setText(termInput);
+ dialog.show();
+ }
+ if ( obj == parse ) {
+ inputLabel.setText("Parse:");
+ inputField.setText(parseInput);
+ dialog.show();
+ }
+*/
+ if ( obj == alpha){
+ String s = JOptionPane.showInputDialog("Type string:", alphaInput);
+ if (s!=null) {
+ alphaInput = s;
+ treeChanged = true;
+ send("x "+s);
+ }
+ }
+ if ( obj == random){
+ treeChanged = true;
+ send("a");
+ }
+ if ( obj == undo){
+ treeChanged = true;
+ send("u");
+ }
+ }
+ } catch (Exception e){}
+ }
+ static void writeOutput(String str, String fileName) {
+
+ try {
+ FileOutputStream fos = new FileOutputStream(fileName);
+ Writer out = new OutputStreamWriter(fos, "UTF8");
+ out.write(str);
+ out.close();
+ } catch (IOException e) {
+ JOptionPane.showMessageDialog(null,
+ "Document is empty!","Error", JOptionPane.ERROR_MESSAGE);
+ }
+ }
+ public static void populateTree(DynamicTree treePanel) {
+ String p1Name = new String("Root");
+ DefaultMutableTreeNode p1;
+ p1 = treePanel.addObject(null, p1Name);
+ }
+
+ public static void formTree(DynamicTree treePanel) {
+ Hashtable table = new Hashtable();
+ TreePath path=null;
+ boolean treeStarted = false, selected = false;
+ String s = treeString;
+ String name ="";
+ treePanel.clear();
+ int j, shift=0, star=0, index = 0;
+ DefaultMutableTreeNode p2=null, p1=null;
+ if (debug) System.out.print("treeString: "+ s);
+ if (s.indexOf('*')!=-1) star = 1;
+ while (s.length()>0) {
+ while ((s.length()>0) && ((s.charAt(0)=='*')||(s.charAt(0)==' '))){
+ if (s.charAt(0) == '*') selected = true;
+ s = s.substring(1);
+ shift++;
+ }
+ if (s.length()>0) {
+ j = s.indexOf("\n");
+ name = s.substring(0, j);
+ index++;
+ s = s.substring(j+1);
+ shift = (shift - star)/2;
+
+ p1 = (DefaultMutableTreeNode)table.get(new Integer(shift));
+ p2 = treePanel.addObject(p1, name);
+ table.put(new Integer(shift+1), p2);
+ path = new TreePath(p2.getPath());
+ nodeTable.put(path, new Integer(index));
+ if (selected) {
+ treePanel.tree.setSelectionPath(path);
+ treePanel.oldSelection = index;
+ if (debug) System.out.println("new selected index "+ index);
+ selected = false;
+ }
+ treeStarted=true;
+ }
+ shift = 0;
+ }
+ if ((p2!=null)) {
+ treePanel.tree.makeVisible(path);
+ gui2.toFront();
+ index = 0;
+ }
+ }
+
+ /** Listens to the radio buttons. */
+ class RadioListener implements ActionListener {
+ public void actionPerformed(ActionEvent e) {
+ String action = e.getActionCommand();
+ if (action.equals("split") ) {
+ cp.remove(centerPanel);
+ centerPanel2.add(middlePanelUp, BorderLayout.SOUTH);
+ if (((JCheckBoxMenuItem)viewMenu.getItem(0)).isSelected()) {
+ centerPanel2.add(treePanel, BorderLayout.CENTER);
+ }
+ else {
+ centerPanel2.add(outputPanelUp, BorderLayout.CENTER);
+ }
+ cp.add(centerPanel2, BorderLayout.CENTER);
+ gui2.getContentPane().add(outputPanelDown);
+ gui2.setVisible(true);
+ pack();
+ repaint();
+ }
+ if (action.equals("combine") ) {
+ cp.remove(centerPanel2);
+ middlePanel.add(middlePanelUp, BorderLayout.NORTH);
+ if (((JCheckBoxMenuItem)viewMenu.getItem(0)).isSelected()) { gui2.setVisible(false);
+ centerPanel.setLeftComponent(treePanel);
+ }
+ else {
+ centerPanel.setLeftComponent(outputPanelUp);
+ gui2.setVisible(false);
+ }
+ cp.add(centerPanel, BorderLayout.CENTER);
+ centerPanelDown.add(outputPanelDown, BorderLayout.CENTER);
+ pack();
+ repaint();
+ }
+ if (action.equals("showTree") ) {
+ if (!((JCheckBoxMenuItem)e.getSource()).isSelected()){
+ if (debug) System.out.println("was selected");
+ cbMenuItem.setSelected(false);
+ if (((JRadioButtonMenuItem)viewMenu.getItem(2)).isSelected()) {
+ centerPanel.remove(treePanel);
+ centerPanel.setLeftComponent(outputPanelUp);
+ }
+ else {
+ centerPanel2.remove(treePanel);
+ centerPanel2.add(outputPanelUp, BorderLayout.CENTER);
+ }
+ }
+ else {
+ if (debug) System.out.println("was not selected");
+ cbMenuItem.setSelected(true);
+ if (((JRadioButtonMenuItem)viewMenu.getItem(2)).isSelected()) {
+ centerPanel.remove(outputPanelUp);
+ treePanel.setRightComponent(outputPanelUp);
+ centerPanel.setLeftComponent(treePanel);
+ }
+ else {
+ centerPanel2.remove(outputPanelUp);
+ treePanel.setRightComponent(outputPanelUp);
+ centerPanel2.add(treePanel, BorderLayout.CENTER);
+ }
+ }
+ pack();
+ repaint();
+ }
+ if (action.equals("lang")) {
+ if (newObject) {
+ output.setText("");
+ formLin();
+ }
+ if (debug)
+ System.out.println("language option has changed "+((JCheckBoxMenuItem)e.getSource()).getText());
+ if (((JCheckBoxMenuItem)e.getSource()).isSelected()){
+ System.out.println("turning on");
+ send("on "+((JCheckBoxMenuItem)e.getSource()).getText());
+ }
+ else{
+ System.out.println("turning off");
+ send("off "+((JCheckBoxMenuItem)e.getSource()).getText());
+ }
+ }
+ //modeMenus actions:
+ else {
+ if ((action.equals("long")) || (action.equals("short")))
+ {
+ send("ms " + action);
+ }
+ else
+ if ((action.equals("typed")) || (action.equals("untyped")))
+ {
+ send("mt " + action);
+ }
+ else
+ {
+ selectedMenuLanguage = action;
+ if (action.equals("Abstract"))
+ {
+ send("ml Abs");
+ }
+ else
+ {
+ System.out.println("sending "+action);
+ send("ml " + action);
+ }
+ }
+ }
+ }
+ }
+
+ /** Handle the key pressed event. */
+ public void keyPressed(KeyEvent e) {
+ int keyCode = e.getKeyCode();
+ if (keyCode == 10) {
+ listAction(list.getSelectedIndex());
+ }
+ }
+ /** Handle the key typed event. */
+ public void keyTyped(KeyEvent e) {
+ }
+ /** Handle the key released event. */
+ public void keyReleased(KeyEvent e) {
+ }
+
+ public void listAction(int index) {
+ if (index == -1)
+ {if (debug) System.out.println("no selection");}
+ else {
+ treeChanged = true;
+ send((String)commands.elementAt(list.getSelectedIndex()));
+ }
+ }
+}
diff --git a/src/JavaGUI/GFEditor2.java b/src/JavaGUI/GFEditor2.java new file mode 100644 index 000000000..f71210d7c --- /dev/null +++ b/src/JavaGUI/GFEditor2.java @@ -0,0 +1,2357 @@ +//package javaGUI;
+
+import java.awt.*;
+import java.beans.*;
+import java.awt.event.*;
+import javax.swing.*;
+import javax.swing.text.*;
+import javax.swing.event.*;
+import javax.swing.tree.*;
+import java.io.*;
+import java.util.*;
+//import gfWindow.GrammarFilter;
+
+public class GFEditor2 extends JFrame implements ActionListener, CaretListener,
+ KeyListener, FocusListener {
+
+ private static Color color = Color.green;
+ private int[] sizes = {14,18,22,26,30};
+ private String[] envfonts;
+ private Font font;
+ Font[] fontObjs;
+ private static int DEFAULT_FONT_SIZE = 14;
+ private JComboBox fontList;
+ private JLabel fontLabel = new JLabel(" Font: ");
+ private JComboBox sizeList;
+ private JLabel sizeLabel = new JLabel(" Size: ");
+
+ public JPopupMenu popup2 = new JPopupMenu();
+ public JMenuItem menuItem2;
+ public static JTextField field = new JTextField("textField!");
+ public javax.swing.Timer timer2 = new javax.swing.Timer(500, this);
+ public MouseEvent m2;
+ public static String selectedText="";
+
+ // XML parsing:
+ public static boolean debug = false;
+ // pop-up/mouse handling:
+ public static boolean debug3 = false;
+ // red mark-up && html:
+ public static boolean debug4 = false;
+ // linearization marking:
+ public static boolean debug2 = false;
+
+ public static boolean selectionCheck = false;
+ public static LinPosition focusPosition ;
+ public static String stringToAppend = "";
+
+ //stack for storing the current position:
+ public static Vector currentPosition = new Vector();
+ public static int selStart = -1;
+ public static int selEnd = -1;
+ //public static int oldSelStart = 0;
+ public static String restString = "";
+ public static int currentLength = 0;
+ public static int newLength = 0;
+ public static int oldLength = 0;
+ public static int addedLength = 0;
+
+ public static boolean newObject = false;
+ public static boolean finished = false;
+ private String parseInput = "";
+ private String alphaInput = "";
+ private static String status = "status";
+ private static String selectedMenuLanguage = "Abstract";
+ private static String linearization = "";
+ private String termInput = "";
+ private static String outputString = "";
+ private static String treeString = "";
+ private static String fileString = "";
+ public static Vector commands = new Vector();
+ public static Vector outputVector = new Vector();
+ public static Hashtable nodeTable = new Hashtable();
+ JFileChooser fc1 = new JFileChooser("./");
+ JFileChooser fc = new JFileChooser("./");
+ private String [] filterMenu = {"Filter", "identity",
+ "erase", "take100", "text", "code", "latexfile",
+ "structured", "unstructured" };
+ private String [] modifyMenu = {"Modify", "identity","transfer",
+ "compute", "paraphrase", "generate","typecheck", "solve", "context" };
+// private String [] modeMenu = {"Menus", "printname",
+// "plain", "short", "long", "typed", "untyped" };
+ private static String [] newMenu = {"New"};
+
+ private static boolean firstLin = true;
+ private static boolean waiting = false;
+ public static boolean treeChanged = true;
+ private static String result;
+ private static BufferedReader fromProc;
+ private static BufferedWriter toProc;
+ private static String commandPath = new String("GF");
+ private static JTextArea output = new JTextArea();
+ public static DefaultListModel listModel= new DefaultListModel();
+ private JList list = new JList(listModel);
+ private static DynamicTree2 tree = new DynamicTree2();
+
+ private JLabel grammar = new JLabel("No topic ");
+ private JButton save = new JButton("Save");
+ private JButton open = new JButton("Open");
+ private JButton newTopic = new JButton("New Topic");
+ private JButton gfCommand = new JButton("GF command");
+
+ private JButton leftMeta = new JButton("?<");
+ private JButton left = new JButton("<");
+ private JButton top = new JButton("Top");
+ private JButton right = new JButton(">");
+ private JButton rightMeta = new JButton(">?");
+ private JButton read = new JButton("Read");
+ // private JButton parse = new JButton("Parse");
+ // private JButton term = new JButton("Term");
+ private JButton alpha = new JButton("Alpha");
+ private JButton random = new JButton("Random");
+ private JButton undo = new JButton("Undo");
+ private JPanel coverPanel = new JPanel();
+ private JPanel inputPanel = new JPanel();
+
+ private JPanel inputPanel2 = new JPanel();
+ private JPanel inputPanel3 = new JPanel();
+ private JButton ok = new JButton("OK");
+ private JButton cancel = new JButton("Cancel");
+ private JTextField inputField = new JTextField();
+ private JLabel inputLabel = new JLabel("Read: ");
+ private JButton browse = new JButton("Browse...");
+ private ButtonGroup readGroup = new ButtonGroup();
+ private JRadioButton termReadButton = new JRadioButton("Term");
+ private JRadioButton stringReadButton = new JRadioButton("String");
+
+ private JDialog dialog;
+
+ private static JComboBox menu = new JComboBox(newMenu);
+ private JComboBox filter = new JComboBox(filterMenu);
+ private JComboBox modify = new JComboBox(modifyMenu);
+ // private JComboBox mode = new JComboBox(modeMenu);
+
+ private JPanel downPanel = new JPanel();
+ private JSplitPane treePanel;
+ private JPanel upPanel = new JPanel();
+ private JPanel middlePanel = new JPanel();
+ private JPanel middlePanelUp = new JPanel();
+ private JPanel middlePanelDown = new JPanel();
+ private JSplitPane centerPanel;
+ private static JFrame gui2 = new JFrame();
+ private JPanel centerPanel2= new JPanel();
+ private JPanel centerPanelDown = new JPanel();
+ private JScrollPane outputPanelDown = new JScrollPane(list);
+ private JScrollPane outputPanelCenter = new JScrollPane(output);
+ private JPanel outputPanelUp = new JPanel();
+ private JPanel statusPanel = new JPanel();
+ private static JLabel statusLabel = new JLabel(status);
+ private Container cp;
+
+ private static JMenuBar menuBar= new JMenuBar();;
+ private static ButtonGroup menuGroup = new ButtonGroup();
+ private JMenu viewMenu= new JMenu("View");
+ private JMenu submenu= new JMenu("language");
+ private JMenu modeMenu= new JMenu("Menus");
+ private static JMenu langMenu= new JMenu("Languages");
+ private static JMenu fileMenu= new JMenu("File");
+ private JRadioButtonMenuItem rbMenuItem;
+ private JRadioButtonMenuItem rbMenuItemLong;
+ // private JRadioButtonMenuItem rbMenuItemAbs;
+ private JRadioButtonMenuItem rbMenuItemUnTyped;
+ private static JMenuItem fileMenuItem;
+ private static JCheckBoxMenuItem cbMenuItem;
+ private static JCheckBoxMenuItem treeCbMenuItem;
+ private static RadioListener myListener ;
+ private static ButtonGroup group = new ButtonGroup();
+ private static ButtonGroup languageGroup = new ButtonGroup();
+
+ public GFEditor2()
+ {
+ this.addWindowListener(new WindowAdapter() {
+ public void windowClosing(WindowEvent e) {
+ endProgram();
+ }
+ });
+
+
+ //Add listener to components that can bring up popup menus.
+ MouseListener popupListener2 = new PopupListener();
+ output.addMouseListener(popupListener2);
+ timer2.setRepeats(false);
+
+ setJMenuBar(menuBar);
+ setTitle("GF Syntax Editor");
+ viewMenu.setToolTipText("View settings");
+ fileMenu.setToolTipText("Main operations");
+ langMenu.setToolTipText("Language settings");
+ menuBar.add(fileMenu);
+ menuBar.add(langMenu);
+ menuBar.add(viewMenu);
+ menuBar.add(modeMenu);
+
+ treeCbMenuItem = new JCheckBoxMenuItem("Tree");
+ treeCbMenuItem.setActionCommand("showTree");
+ myListener = new RadioListener();
+ treeCbMenuItem.addActionListener(myListener);
+ treeCbMenuItem.setSelected(true);
+ viewMenu.add(treeCbMenuItem);
+ viewMenu.addSeparator();
+
+ fileMenuItem = new JMenuItem("Open...");
+ fileMenuItem.setActionCommand("open");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem("New Topic...");
+ fileMenuItem.setActionCommand("newTopic");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem("Reset");
+ fileMenuItem.setActionCommand("reset");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem("Save As...");
+ fileMenuItem.setActionCommand("save");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenu.addSeparator();
+ fileMenuItem = new JMenuItem("Exit");
+ fileMenuItem.setActionCommand("quit");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+
+ rbMenuItem = new JRadioButtonMenuItem("One window");
+ rbMenuItem.setActionCommand("combine");
+ rbMenuItem.addActionListener(myListener);
+ rbMenuItem.setSelected(true);
+/* rbMenuItem.setMnemonic(KeyEvent.VK_R);
+ rbMenuItem.setAccelerator(KeyStroke.getKeyStroke(
+ KeyEvent.VK_1, ActionEvent.ALT_MASK));
+ rbMenuItem.getAccessibleContext().setAccessibleDescription(
+ "This doesn't really do anything");
+*/
+ menuGroup.add(rbMenuItem);
+ viewMenu.add(rbMenuItem);
+
+ rbMenuItem = new JRadioButtonMenuItem("Split windows");
+ rbMenuItem.setMnemonic(KeyEvent.VK_O);
+ rbMenuItem.setActionCommand("split");
+ rbMenuItem.addActionListener(myListener);
+ menuGroup.add(rbMenuItem);
+ viewMenu.add(rbMenuItem);
+
+ modeMenu.add(submenu);
+
+ /* rbMenuItemAbs = new JRadioButtonMenuItem("Abstract");
+ rbMenuItemAbs.setActionCommand("Abstract");
+ rbMenuItemAbs.addActionListener(myListener);
+ languageGroup.add(rbMenuItemAbs);
+ */
+
+ modeMenu.addSeparator();
+ menuGroup = new ButtonGroup();
+ rbMenuItemLong = new JRadioButtonMenuItem("long");
+ rbMenuItemLong.setActionCommand("long");
+ rbMenuItemLong.setSelected(true);
+ rbMenuItemLong.addActionListener(myListener);
+ menuGroup.add(rbMenuItemLong);
+ modeMenu.add(rbMenuItemLong);
+ rbMenuItem = new JRadioButtonMenuItem("short");
+ rbMenuItem.setActionCommand("short");
+ rbMenuItem.addActionListener(myListener);
+ menuGroup.add(rbMenuItem);
+ modeMenu.add(rbMenuItem);
+ modeMenu.addSeparator();
+
+ menuGroup = new ButtonGroup();
+ rbMenuItem = new JRadioButtonMenuItem("typed");
+ rbMenuItem.setActionCommand("typed");
+ rbMenuItem.addActionListener(myListener);
+ rbMenuItem.setSelected(false);
+ menuGroup.add(rbMenuItem);
+ modeMenu.add(rbMenuItem);
+ rbMenuItemUnTyped = new JRadioButtonMenuItem("untyped");
+ rbMenuItemUnTyped.setSelected(true);
+ rbMenuItemUnTyped.setActionCommand("untyped");
+ rbMenuItemUnTyped.addActionListener(myListener);
+ menuGroup.add(rbMenuItemUnTyped);
+ modeMenu.add(rbMenuItemUnTyped);
+
+ cp = getContentPane();
+ JScrollPane cpPanelScroll = new JScrollPane(coverPanel);
+ cp.add(cpPanelScroll);
+ coverPanel.setLayout(new BorderLayout());
+ output.setToolTipText("Linearizations' display area");
+ output.addCaretListener(this);
+ output.setEditable(false);
+ output.setLineWrap(true);
+ output.setWrapStyleWord(true);
+ output.setSelectionColor(Color.green);
+// output.setSelectionColor(Color.white);
+// output.setFont(new Font("Arial Unicode MS", Font.PLAIN, 17));
+ font = new Font(null, Font.PLAIN, DEFAULT_FONT_SIZE);
+ output.setFont(font);
+ field.setFont(font);
+ field.setFocusable(true);
+ field.addKeyListener(this);
+ field.addFocusListener(this);
+// System.out.println(output.getFont().getFontName());
+ gfCommand.setToolTipText("Sending a command to GF");
+ read.setToolTipText("Refining with term or linearization from typed string or file");
+ modify.setToolTipText("Choosing a linearization method");
+ alpha.setToolTipText("Performing alpha-conversion");
+ random.setToolTipText("Generating random refinement");
+ undo.setToolTipText("Going back to the previous state");
+ downPanel.add(gfCommand);
+ //downPanel.add(parse);
+ //downPanel.add(term);
+ downPanel.add(read);
+ downPanel.add(modify);
+ downPanel.add(alpha);
+ downPanel.add(random);
+ downPanel.add(undo);
+
+ leftMeta.setToolTipText("Moving the focus to the previous metavariable");
+ rightMeta.setToolTipText("Moving the focus to the next metavariable");
+ left.setToolTipText("Moving the focus to the previous term");
+ right.setToolTipText("Moving the focus to the next term");
+ top.setToolTipText("Moving the focus to the top term");
+ middlePanelUp.add(leftMeta);
+ middlePanelUp.add(left);
+ middlePanelUp.add(top);
+ middlePanelUp.add(right);
+ middlePanelUp.add(rightMeta);
+ middlePanelDown.add(new JLabel("Select Action on Subterm"));
+ middlePanel.setLayout(new BorderLayout());
+ middlePanel.add(middlePanelUp, BorderLayout.NORTH);
+ middlePanel.add(middlePanelDown, BorderLayout.CENTER);
+
+ menu.setToolTipText("The list of available categories to start editing");
+ open.setToolTipText("Reading both a new environment and an editing object from file. Current editing will be discarded");
+ save.setToolTipText("Writing the current editing object to file in the term or text format");
+ grammar.setToolTipText("Current Topic");
+ newTopic.setToolTipText("Reading a new environment from file. Current editing will be discarded.");
+ upPanel.add(grammar);
+ upPanel.add(menu);
+ upPanel.add(open);
+ upPanel.add(save);
+ upPanel.add(newTopic);
+ upPanel.add(filter);
+
+ filter.setToolTipText("Choosing the linearization representation format");
+ modeMenu.setToolTipText("Choosing the refinement options' representation");
+ statusLabel.setToolTipText("The current focus type");
+ list.setToolTipText("The list of current refinment options");
+
+ GraphicsEnvironment gEnv = GraphicsEnvironment.getLocalGraphicsEnvironment();
+ envfonts = gEnv.getAvailableFontFamilyNames();
+ fontObjs = new Font[envfonts.length];
+ for (int fi = 0; fi < envfonts.length; fi++) {
+ fontObjs[fi] = new Font(envfonts[fi], Font.PLAIN, DEFAULT_FONT_SIZE);
+ }
+ fontList = new JComboBox(envfonts);
+ fontList.addActionListener(this);
+ fontList.setToolTipText("Changing font type");
+
+ sizeList = new JComboBox();
+ sizeList.setToolTipText("Changing font size");
+ for (int i = 0; i<sizes.length; i++)
+ {
+ sizeList.addItem(new Integer(sizes[i]));
+ }
+ sizeList.addActionListener(this);
+
+ fontEveryWhere(font);
+
+ upPanel.add(sizeLabel);
+ upPanel.add(sizeList);
+ upPanel.add(fontLabel);
+ upPanel.add(fontList);
+
+ tree.setToolTipText("The abstract syntax tree representation of the current editing object");
+ populateTree(tree);
+ outputPanelUp.setLayout(new BorderLayout());
+ outputPanelUp.add(outputPanelCenter, BorderLayout.CENTER);
+ outputPanelUp.add(statusPanel, BorderLayout.SOUTH);
+ statusPanel.setLayout(new GridLayout(1,1));
+ statusPanel.add(statusLabel);
+ treePanel = new JSplitPane(JSplitPane.HORIZONTAL_SPLIT,
+ tree, outputPanelUp);
+ treePanel.setDividerSize(5);
+ treePanel.setDividerLocation(100);
+ centerPanel2.setLayout(new BorderLayout());
+ gui2.setSize(350,100);
+ gui2.setTitle("Select Action on Subterm");
+ gui2.setLocationRelativeTo(treePanel);
+ centerPanelDown.setLayout(new BorderLayout());
+ centerPanel = new JSplitPane(JSplitPane.VERTICAL_SPLIT,
+ treePanel, centerPanelDown);
+ centerPanel.setDividerSize(5);
+ centerPanel.setDividerLocation(250);
+ centerPanel.addKeyListener(tree);
+ centerPanel.setOneTouchExpandable(true);
+ centerPanelDown.add(middlePanel, BorderLayout.NORTH);
+ centerPanelDown.add(outputPanelDown, BorderLayout.CENTER);
+ coverPanel.add(centerPanel, BorderLayout.CENTER);
+ coverPanel.add(upPanel, BorderLayout.NORTH);
+ coverPanel.add(downPanel, BorderLayout.SOUTH);
+
+ list.setSelectionMode(ListSelectionModel.SINGLE_SELECTION);
+
+ MouseListener mouseListener = new MouseAdapter() {
+ public void mouseClicked(MouseEvent e) {
+ if (e.getClickCount() == 2) {
+ listAction(list.locationToIndex(e.getPoint()));
+ }
+ }
+ };
+ list.addMouseListener(mouseListener);
+ list.addKeyListener(this);
+ menu.addActionListener(this);
+ save.addActionListener(this);
+ open.addActionListener(this);
+ newTopic.addActionListener(this);
+ gfCommand.addActionListener(this);
+
+ filter.addActionListener(this);
+ filter.setMaximumRowCount(9);
+ leftMeta.addActionListener(this);
+ left.addActionListener(this);
+
+ menu.setFocusable(false);
+ save.setFocusable(false);
+ save.setActionCommand("save");
+ open.setFocusable(false);
+ open.setActionCommand("open");
+ newTopic.setFocusable(false);
+ newTopic.setActionCommand("newTopic");
+ gfCommand.setFocusable(false);
+
+ filter.setFocusable(false);
+ leftMeta.setFocusable(false);
+ left.setFocusable(false);
+
+ top.addActionListener(this);
+ right.addActionListener(this);
+ rightMeta.addActionListener(this);
+ //parse.addActionListener(this);
+ //term.addActionListener(this);
+ read.addActionListener(this);
+ modify.addActionListener(this);
+ //mode.addActionListener(this);
+ alpha.addActionListener(this);
+ random.addActionListener(this);
+ undo.addActionListener(this);
+
+ top.setFocusable(false);
+ right.setFocusable(false);
+ rightMeta.setFocusable(false);
+ //parse.setFocusable(false);
+ //term.setFocusable(false);
+ read.setFocusable(false);
+ modify.setFocusable(false);
+ //mode.setFocusable(false);
+ alpha.setFocusable(false);
+ random.setFocusable(false);
+ undo.setFocusable(false);
+
+ output.addKeyListener(tree);
+ setSize(800,600);
+ outputPanelUp.setPreferredSize(new Dimension(400,230));
+ treePanel.setDividerLocation(0.3);
+ nodeTable.put(new TreePath(DynamicTree2.rootNode.getPath()), new Integer(0));
+ setVisible(true);
+
+ JRadioButton termButton = new JRadioButton("Term");
+ termButton.setActionCommand("term");
+ termButton.setSelected(true);
+ JRadioButton linButton = new JRadioButton("Text");
+ linButton.setActionCommand("lin");
+ // Group the radio buttons.
+ group.add(linButton);
+ group.add(termButton);
+ JPanel buttonPanel = new JPanel();
+ buttonPanel.setPreferredSize(new Dimension(70, 70));
+ buttonPanel.add(new JLabel("Format:"));
+ buttonPanel.add(linButton);
+ buttonPanel.add(termButton);
+ fc1.setAccessory(buttonPanel);
+
+ termReadButton.setActionCommand("term");
+ stringReadButton.setSelected(true);
+ stringReadButton.setActionCommand("lin");
+ // Group the radio buttons.
+ readGroup.add(stringReadButton);
+ readGroup.add(termReadButton);
+ JPanel readButtonPanel = new JPanel();
+ readButtonPanel.setLayout(new GridLayout(3,1));
+ readButtonPanel.setPreferredSize(new Dimension(70, 70));
+ readButtonPanel.add(new JLabel("Format:"));
+ readButtonPanel.add(stringReadButton);
+ readButtonPanel.add(termReadButton);
+ dialog= new JDialog(this, "Input");
+ dialog.setLocationRelativeTo(this);
+ dialog.getContentPane().add(inputPanel);
+ inputPanel.setLayout(new BorderLayout(10,10));
+ inputPanel3.setLayout(new GridLayout(2,1,5,5));
+ inputPanel3.add(inputLabel);
+ inputPanel3.add(inputField);
+ ok.addActionListener(this);
+ browse.addActionListener(this);
+ cancel.addActionListener(this);
+ inputField.setPreferredSize(new Dimension(300,23));
+ inputPanel.add(inputPanel3, BorderLayout.CENTER);
+ inputPanel.add(new JLabel(" "), BorderLayout.WEST);
+ inputPanel.add(readButtonPanel, BorderLayout.EAST);
+ inputPanel.add(inputPanel2, BorderLayout.SOUTH);
+ inputPanel2.add(ok);
+ inputPanel2.add(cancel);
+ inputPanel2.add(browse);
+ dialog.setSize(350,135);
+
+
+ try {
+ result = fromProc.readLine();
+ while(result != null) {
+ finished = false;
+ if (debug) System.out.println("1 "+result);
+ while (result.indexOf("gf")==-1){
+ outputString +=result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("1 "+result);
+ }
+ appendMarked(outputString, -1,-1);
+
+ while ((result!=null)&&(result.indexOf("newcat")==-1)&&(result.indexOf("<lin ")==-1)){
+ result = fromProc.readLine();
+ if (debug) System.out.println("1 "+result);
+ }
+ if ((result!=null)&&(result.indexOf("<lin ")==-1))
+ formNewMenu();
+
+ if (!finished) {
+
+ while ((result!=null)&&((result.length()==0)||(result.indexOf("<lin ")==-1))) {
+ result = fromProc.readLine();
+ if (result!=null){
+ if (debug) System.out.println("10 "+result);
+ }
+ else System.exit(0);
+ }
+ readLin();
+ readTree();
+ readMessage();
+ if (newObject)
+ formSelectMenu();
+ else {
+ while(result.indexOf("</menu")==-1) {
+ result = fromProc.readLine();
+ if (debug) System.out.println("12 "+result);
+ }
+ }
+ for (int i=0; i<3; i++){
+ result = fromProc.readLine();
+ if (debug) System.out.println("11 "+result);
+ }
+ }
+ }
+ appendMarked("*** NOTHING MORE TO READ FROM " + commandPath + "\n", -1,-1);
+ } catch (IOException e) {
+ System.out.println("Could not read from external process");
+ }
+ }
+
+ /*
+ sending a command text to GF
+ */
+ public static void send(String text){
+ try {
+ output.setText("");
+ outputString = "";
+ if (debug)
+ System.out.println("output cleared\n\n\n");
+ outputVector = new Vector();
+ toProc.write(text, 0, text.length());
+ toProc.newLine();
+ toProc.flush();
+ } catch (IOException e) {
+ System.out.println("Could not write to external process");
+ }
+ }
+
+ public void endProgram(){
+ send("q");
+ System.exit(0);
+ }
+
+ public static void main(String args[])
+ {
+ Locale.setDefault(Locale.US);
+ try {
+ commandPath = args[0]; + Process extProc = Runtime.getRuntime().exec(commandPath);
+ InputStreamReader isr = new InputStreamReader(
+ extProc.getInputStream(),"UTF8");
+ // extProc.getInputStream());
+
+ fromProc = new BufferedReader (isr);
+ String defaultEncoding = isr.getEncoding();
+ if (debug) System.out.println("encoding "+defaultEncoding);
+ toProc = new BufferedWriter(
+ new OutputStreamWriter(extProc.getOutputStream(),"UTF8"));
+ /* try {
+ UIManager.setLookAndFeel(
+ //UIManager.getSystemLookAndFeelClassName() );
+ "com.sun.java.swing.plaf.windows.WindowsLookAndFeel");
+ } catch (Exception e) { }
+ */
+ GFEditor2 gui = new GFEditor2();
+
+ } catch (IOException e) {
+ System.out.println("Could not start " + commandPath + + ": " + e);
+ }
+ }
+
+ /*
+ Parses the GF-output between <menu> and </menu> tags
+ and fills the corrsponding GUI list -"Select Action".
+ */
+
+ public static void formSelectMenu (){
+ if (debug) System.out.println("list model changing! ");
+ String s ="";
+ try {
+ //read item
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ listModel.clear();
+ commands.clear();
+ while (result.indexOf("/menu")==-1){
+ //read show
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ while (result.indexOf("/show")==-1){
+ result = fromProc.readLine();
+ if (debug) System.out.println("9 "+result);
+ if (result.indexOf("/show")==-1)
+ {
+ if (result.length()>8)
+ s+=result.trim();
+ else
+ s+=result;
+ }
+ }
+// if (s.charAt(0)!='d')
+// listModel.addElement("Refine " + s);
+// else
+ listModel.addElement(s);
+ s="";
+ //read /show
+ //read send
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ saveCommand();
+ // read /item
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ }
+ } catch(IOException e){ }
+ }
+
+ /* put the command into the list of commands */
+ public static void saveCommand(){
+ if (newObject) commands.add(result);
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("9 "+result);
+ } catch(IOException e){ }
+ }
+
+ /*
+ Accumulates the GF-output between <linearization> </linearization> tags
+ */
+
+ public void readLin(){
+ try {
+ linearization="";
+ linearization += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ while ((result!=null)&&(result.indexOf("/linearization")==-1)){
+ linearization += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ }
+ if (newObject) formLin();
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ } catch(IOException e){ }
+ }
+
+ /*
+ Accumulates the GF-output between <tree> </tree> tags
+ */
+
+ public static void readTree(){
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ while (result.indexOf("/tree")==-1){
+ treeString += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ }
+ if (treeChanged && (newObject)) {
+ formTree(tree);
+ treeChanged = false;
+ }
+ treeString="";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ } catch(IOException e){ }
+ }
+
+ /*
+ Parses the GF-output between <message> </message> tags
+ and puts it in the linearization area.
+ */
+
+ public static void readMessage(){
+ String s ="";
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("7 "+result);
+ while (result.indexOf("/message")==-1){
+ s += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("7 "+result);
+ }
+ if (s.length()>1)
+ appendMarked("-------------"+'\n'+s,-1,-1);
+ result = fromProc.readLine();
+ if (debug) System.out.println("7 "+result);
+ } catch(IOException e){ }
+ }
+ /*
+ Parses the GF-output between <gfinit> tags
+ and fill the New combobox in the GUI.
+ */
+
+ public void formNewMenu () {
+ boolean more = true;
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+
+ while (more){
+ if (result.indexOf("topic")==-1) {
+ menu.addItem(result.substring(6));
+ }
+ else
+ more = false;
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("3 "+result);
+ if (result.indexOf("topic")!=-1)
+ more = false;
+ result = fromProc.readLine();
+ if (debug) System.out.println("4 "+result);
+ }
+
+ grammar.setText(result.substring(4)+" ");
+
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("3 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("4 "+result);
+
+ more = true;
+ while (more){
+ if ((result.indexOf("/gfinit")==-1)&&(result.indexOf("lin")==-1)) {
+ //form lang and Menu menu:
+ cbMenuItem = new JCheckBoxMenuItem(result.substring(4));
+ if (debug) System.out.println ("menu item: "+result.substring(4));
+ if ((result.substring(4)).equals("Abstract"))
+ cbMenuItem.setSelected(false);
+ else
+ cbMenuItem.setSelected(true);
+ cbMenuItem.setActionCommand("lang");
+ cbMenuItem.addActionListener(myListener);
+ langMenu.add(cbMenuItem);
+/*
+ {
+ submenu.add(rbMenuItemAbs);
+ if (selectedMenuLanguage.equals("Abstract"))
+ rbMenuItemAbs.setSelected(true);
+ languageGroup.add(rbMenuItemAbs);
+ }
+ else
+ {
+*/
+ rbMenuItem = new JRadioButtonMenuItem(result.substring(4));
+ rbMenuItem.setActionCommand(result.substring(4));
+ rbMenuItem.addActionListener(myListener);
+ languageGroup.add(rbMenuItem);
+ if ((result.substring(4)).equals(selectedMenuLanguage))
+ {
+ if (debug) System.out.println("Selecting "+selectedMenuLanguage);
+ rbMenuItem.setSelected(true);
+ }
+
+ submenu.add(rbMenuItem);
+// }
+ }
+ else
+ more = false;
+ // read </language>
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+ // read <language> or </gfinit...>
+ result = fromProc.readLine();
+ if (debug) System.out.println("3 "+result);
+ if ((result.indexOf("/gfinit")!=-1)||(result.indexOf("lin")!=-1))
+ more = false;
+ if (result.indexOf("/gfinit")!=-1)
+ finished = true;
+ // registering the file name:
+ if (result.indexOf("language")!=-1) {
+ String path = result.substring(result.indexOf('=')+1,
+ result.indexOf('>'));
+ path =path.substring(path.lastIndexOf('/')+1);
+ if (debug) System.out.println("name: "+path);
+ fileString +="--" + path +"\n";
+ if (path.lastIndexOf('.')!=path.indexOf('.'))
+ grammar.setText(path.substring(0,
+ path.indexOf('.')).toUpperCase()+" ");
+ }
+ result = fromProc.readLine();
+ if (debug) System.out.println("4 "+result);
+ }
+ if (debug)
+ System.out.println("languageGroupElement formed"+
+ languageGroup.getButtonCount());
+ langMenu.addSeparator();
+ fileMenuItem = new JMenuItem("Add...");
+ fileMenuItem.setActionCommand("import");
+ fileMenuItem.addActionListener(this);
+ langMenu.add(fileMenuItem);
+ // in order to get back in main in the beggining of while:
+ result = fromProc.readLine();
+ } catch(IOException e){ }
+ }
+
+ /*
+ Parses the GF-output between <lin> </lin> tags
+ and puts the string in the linearization area on the screen
+ */
+
+ public void outputAppend(){
+ int i, j, j2, k, l, l2, selectionLength, m=0, n=0;
+ //result=result.replace('\n',' ');
+ if (debug2)
+ System.out.println("INPUT:"+result);
+ l = result.indexOf("<focus");
+ i=result.indexOf("type=",l);
+ j=result.indexOf('>',i);
+ // status incorrect ?:
+ if (result.substring(i,j).indexOf("incorrect")!=-1)
+ {
+ j2 = result.indexOf("status");
+ color = Color.red;
+ }
+ else
+ {
+ j2 = j;
+ color = Color.green;
+ }
+ l2 = result.indexOf("focus");
+ if (l2!=-1){
+ // in case focus tag is cut into two lines:
+ if (l==-1) l=l2-7;
+ m=result.indexOf("position",l);
+ if (debug2) System.out.println("POSITION START: "+m);
+ n=result.indexOf("]",m);
+ if (debug2) System.out.println("POSITION END: "+n);
+ if (debug)
+ System.out.println("form Lin1: "+result);
+ focusPosition = new LinPosition(result.substring(m+9,n+1),
+ result.substring(m,j).indexOf("incorrect")==-1);
+ statusLabel.setText(" "+result.substring(i+5,j2));
+ //cutting <focus>
+ result= result.substring(0,l)+result.substring(j+2);
+ i=result.indexOf("/focus",l);
+ selectionLength = i-l-1;
+ if (debug2)
+ System.out.println("selection length: "+selectionLength);
+ j=result.indexOf('>',i);
+ k=result.length()-j-1;
+ if (debug) System.out.println("form Lin2: "+result);
+
+ if (debug)
+ System.out.println("char at the previous position"+result.charAt(i-1));
+ //cutting </focus>
+ // in case focus tag is cut into two lines:
+ if (result.charAt(i-1)!='<')
+ // check if punktualtion marks like . ! ? are at the end of a sentence:
+ if (result.charAt(j+1)==' ')
+ result= result.substring(0,i-8)+result.substring(j+2);
+ else
+ result= result.substring(0,i-9)+result.substring(j+1);
+ else
+ if (result.charAt(j+1)==' ')
+ result= result.substring(0,i-1)+result.substring(j+2);
+ else
+ result= result.substring(0,i-2)+result.substring(j+1);
+ j= result.indexOf("<focus");
+ l2 = result.indexOf("focus");
+ // in case focus tag is cut into two lines:
+ if ((l2!=-1)&&(j==-1)) j=l2-7;
+
+ // appending the resulting string
+ // only one focus
+ if (j==-1){
+ if (debug2)
+ System.out.println("ONE FOCUS");
+ // last space is not included!:
+ appendMarked(result+'\n',l,l+selectionLength-2);
+ }
+ //several focuses
+ else {
+ if (debug2)
+ System.out.println("MANY FOCUSes");
+ appendMarked(result.substring(0,j),l,l+selectionLength-2);
+ result = result.substring(j);
+ outputAppend();
+ }
+ if (debug) System.out.println("form Lin3: "+result);
+ }
+ else //no focus at all (message?):
+ appendMarked(result+'\n', -1,-1);
+ firstLin=false;
+ }
+
+ /*
+ Parses the GF-output between <linearization> </linearization> tags
+ */
+ public void formLin(){
+ boolean visible=true;
+ firstLin=true;
+ result = linearization.substring(0,linearization.indexOf('\n'));
+ String lin = linearization.substring(linearization.indexOf('\n')+1);
+ //extract the language from result
+ int ind = result.indexOf('=');
+ int ind2 = result.indexOf('>');
+ String s = result.substring(ind+1,ind2);
+ result = lin.substring(0,lin.indexOf("</lin>"));
+ lin = lin.substring(lin.indexOf("</lin>"));
+ while (lin.length()>1) {
+ //check if the language is on
+ if (!visible) visible = true;
+ // in the list?
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if (langMenu.getItem(i).getText().equals(s))
+ {
+ visible = false;
+ break;
+ }
+ if (!visible) visible = true;
+ else {
+ //add item to the language list:
+ cbMenuItem = new JCheckBoxMenuItem(s);
+ if (debug) System.out.println ("menu item: "+s);
+ cbMenuItem.setSelected(true);
+ cbMenuItem.setActionCommand("lang");
+ cbMenuItem.addActionListener(myListener);
+ if (langMenu.getItemCount()<2)
+ langMenu.add(cbMenuItem, langMenu.getItemCount());
+ else
+ langMenu.add(cbMenuItem, langMenu.getItemCount()-2);
+
+ rbMenuItem = new JRadioButtonMenuItem(s);
+ rbMenuItem.setActionCommand(s);
+ rbMenuItem.addActionListener(myListener);
+ languageGroup.add(rbMenuItem);
+ submenu.add(rbMenuItem);
+
+ }
+ // selected?
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if ((langMenu.getItem(i).getText().equals(s))&&
+ !(langMenu.getItem(i).isSelected()) ) {
+ visible = false;
+ break;
+ }
+ if (visible) {
+ if (!firstLin)
+ appendMarked("\n************"+'\n',-1,-1);
+ if (debug) System.out.println("linearization for the language: "+result);
+ outputAppend();
+ }
+ // read </lin>
+ lin = lin.substring(lin.indexOf('\n')+1);
+ // read lin or 'end'
+ if (lin.length()<1) break;
+
+ result = lin.substring(0,lin.indexOf('\n'));
+ lin = lin.substring(lin.indexOf('\n')+1);
+ if (result.indexOf("<lin ")!=-1){
+ //extract the language from result
+ ind = result.indexOf('=');
+ ind2 = result.indexOf('>');
+ s = result.substring(ind+1,ind2);
+ result = lin.substring(0,lin.indexOf("</lin>"));
+ lin = lin.substring(lin.indexOf("</lin>"));
+ }
+ }
+ for (int i = 0; i<outputVector.size(); i++)
+ {
+ MarkedArea ma = (MarkedArea)outputVector.elementAt(i) ;
+ int begin = ma.begin ;
+ int end = ma.end ;
+ if (debug4)
+ System.out.println("BEGIN: "+ begin +" END: "+end+" "+ma.words+" "+ma.position.position);
+ if (!ma.position.correctPosition)
+ try {
+ output.getHighlighter().addHighlight(begin, end, new DefaultHighlighter.DefaultHighlightPainter(Color.red));
+ if (debug4)
+ System.out.println("HIGHLIGHT: "+output.getText().substring(begin, end));
+ } catch (Exception e) {System.out.println("highlighting problem!");}
+ }
+ }
+
+ /* Sets the font on all the GUI-elements to font.*/
+ public void fontEveryWhere(Font font)
+ {
+ output.setFont(font);
+ field.setFont(font);
+ tree.tree.setFont(font);
+ list.setFont(font);
+ sizeList.setFont(font);
+ popup2.setFont(font);
+ sizeLabel.setFont(font);
+ save.setFont(font);
+ fontList.setFont(font);
+ fontLabel.setFont(font);
+ grammar.setFont(font);
+ open.setFont(font);
+ newTopic.setFont(font);
+ gfCommand.setFont(font);
+ leftMeta.setFont(font);
+ left.setFont(font);
+ top.setFont(font);
+ right.setFont(font);
+ rightMeta.setFont(font);
+ read.setFont(font);
+ alpha.setFont(font);
+ random.setFont(font);
+ undo.setFont(font);
+ ok.setFont(font);
+ cancel.setFont(font);
+ inputLabel.setFont(font);
+ browse.setFont(font);
+ termReadButton.setFont(font);
+ stringReadButton.setFont(font);
+ filter.setFont(font);
+ modify.setFont(font);
+ statusLabel.setFont(font);
+ menuBar.setFont(font);
+ menu.setFont(font);
+
+ submenu.setFont(font);
+ recursion(submenu, font);
+ modeMenu.setFont(font);
+ recursion(modeMenu, font);
+ langMenu.setFont(font);
+ recursion(langMenu, font);
+ fileMenu.setFont(font);
+ recursion(fileMenu, font);
+ viewMenu.setFont(font);
+ recursion(viewMenu, font);
+
+}
+
+ /* Set the font in the submenus */
+ public void recursion(JMenu subMenu, Font font)
+ {
+ for (int i = 0; i<subMenu.getItemCount(); i++)
+ {
+ JMenuItem item = subMenu.getItem(i);
+ if (item != null)
+ {
+ item.setFont(font);
+ String name = item.getClass().getName();
+ if (debug) System.out.println(name);
+ }
+ }
+ }
+
+ public void actionPerformed(ActionEvent ae)
+ {
+ boolean abs = true;
+ Object obj = ae.getSource();
+
+ if ( obj == fontList ) {
+ font = new Font((String)fontList.getSelectedItem(), Font.PLAIN, ((Integer)sizeList.getSelectedItem()).intValue());
+ //output.setFont(font);
+ fontEveryWhere(font);
+ if (cbMenuItem!=null) cbMenuItem.setFont(font);
+ if (rbMenuItem!=null) rbMenuItem.setFont(font);
+ if (fileMenuItem!=null) fileMenuItem.setFont(font);
+ }
+
+ if ( obj == sizeList ) {
+ font = new Font((String)fontList.getSelectedItem(), Font.PLAIN, ((Integer)sizeList.getSelectedItem()).intValue());
+ fontEveryWhere(font);
+ if (cbMenuItem!=null) cbMenuItem.setFont(font);
+ if (rbMenuItem!=null) rbMenuItem.setFont(font);
+ if (fileMenuItem!=null) fileMenuItem.setFont(font);
+ }
+
+ if ( obj == menu ) {
+ if (!menu.getSelectedItem().equals("New"))
+ {
+ treeChanged = true;
+ send("n " + menu.getSelectedItem());
+ newObject = true;
+ menu.setSelectedIndex(0);
+ }
+ }
+ if ( obj == filter ) {
+ if (!filter.getSelectedItem().equals("Filter"))
+ {
+ send("f " + filter.getSelectedItem());
+ System.out.println("sending f " + filter.getSelectedItem());
+ filter.setSelectedIndex(0);
+ }
+ }
+ if ( obj == modify ) {
+ if (!modify.getSelectedItem().equals("Modify"))
+ {
+ treeChanged = true;
+ send("c " + modify.getSelectedItem());
+ modify.setSelectedIndex(0);
+ }
+ }
+ if (obj==timer2){
+ if (debug3) System.out.println("changing pop-up menu2!");
+ popup2.removeAll();
+ for (int i = 0; i<listModel.size() ; i++)
+ addMenuItem(listModel.elementAt(i).toString());
+ popup2.show(m2.getComponent(), m2.getX(), m2.getY());
+ }
+
+/* if ( obj == mode ) {
+ if (!mode.getSelectedItem().equals("Menus"))
+ {
+ send("o " + mode.getSelectedItem());
+ mode.setSelectedIndex(0);
+ }
+ }
+*/
+ // buttons and menu items:
+ try {
+ if (Class.forName("javax.swing.AbstractButton").isInstance(obj)) {
+ String name =((AbstractButton)obj).getActionCommand();
+
+ if (name.equals("popupMenuItem")){
+ treeChanged = true;
+ send((String)commands.elementAt
+ (popup2.getComponentIndex((JMenuItem)(ae.getSource()))));
+ }
+
+ if ( name.equals("quit")) {
+ endProgram();
+ }
+
+ if ( name.equals("save") ) {
+
+ if (fc1.getChoosableFileFilters().length<2)
+ fc1.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc1.showSaveDialog(GFEditor2.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc1.getSelectedFile();
+ if (debug) System.out.println("saving ... ");
+
+ // checking if the abstract syntax is on:
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if ((langMenu.getItem(i).getText().equals("Abstract"))&&
+ !(langMenu.getItem(i).isSelected()) ) {
+ if (debug) System.out.println("No Abstract syntax !!!!");
+ abs = false;
+ break;
+ }
+
+ String text = output.getText();
+ int end = text.indexOf("******");
+
+ // saving as a term:
+ if (group.getSelection().getActionCommand().equals("term")) {
+ if (end !=-1)
+ if (abs) {
+ // writeOutput(fileString+text.substring(0, end), file.getPath());
+ writeOutput(text.substring(0, end), file.getPath());
+ abs=true;
+ }
+ else {
+ int i = linearization.indexOf('\n');
+ int j = linearization.indexOf("/lin");
+ //writeOutput(fileString+linearization.substring(i+1, j-1), file.getPath());
+ writeOutput(linearization.substring(i+1, j-1), file.getPath());
+ }
+ else
+ JOptionPane.showMessageDialog(this, "No term to save");
+ }
+ // saving as a linearization:
+ else
+ // abstract syntax is shown:
+ if (abs){
+ end = text.indexOf('\n', end);
+ //writeOutput(fileString+text.substring(end), file.getPath());
+ writeOutput(text.substring(end), file.getPath());
+ abs = true;
+ }
+ else
+ //writeOutput(fileString+text, file.getPath());
+ writeOutput(text, file.getPath());
+ }
+ }
+
+ if ( name.equals("open") ) {
+ if (fc1.getChoosableFileFilters().length<2)
+ fc1.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc1.showOpenDialog(GFEditor2.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+
+ /* "sending" should be fixed on the GF side:
+ rbMenuItemLong.setSelected(true);
+ send("ms long");
+ rbMenuItemUnTyped.setSelected(true);
+ send("mt untyped");
+ selectedMenuLanguage = "Abstract";
+ rbMenuItemAbs.setSelected(true);
+ send("ml Abs");
+ */
+
+ treeChanged = true;
+ newObject = true;
+ while (1< menu.getItemCount())
+ menu.removeItemAt(1);
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ if (debug) System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ if (debug) System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+ submenu.removeAll();
+
+
+ File file = fc1.getSelectedFile();
+ // opening the file for editing :
+ if (debug) System.out.println("opening: "+ file.getPath().replace('\\','/'));
+ if (group.getSelection().getActionCommand().equals("term")) {
+ if (debug) System.out.println(" opening as a term ");
+ send("open "+ file.getPath().replace('\\','/'));
+ }
+ else {
+ if (debug) System.out.println(" opening as a linearization ");
+ send("openstring "+ file.getPath().replace('\\','/'));
+ }
+
+ fileString ="";
+ grammar.setText("No Topic ");
+ }
+ }
+
+ if ( name.equals("import") ) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc.showOpenDialog(GFEditor2.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc.getSelectedFile();
+ // importing a new language :
+ langMenu.removeAll();
+ AbstractButton ab = null;
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ if (debug) System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ if (debug) System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+
+ submenu.removeAll();
+ while (1< menu.getItemCount())
+ menu.removeItemAt(1);
+ if (debug) System.out.println("importing: "+ file.getPath().replace('\\','/'));
+
+ fileString ="";
+ send("i "+ file.getPath().replace('\\','/'));
+
+ }
+ }
+ if ( name.equals("newTopic") ) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc.showOpenDialog(GFEditor2.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ int n = JOptionPane.showConfirmDialog(this,
+ "This will dismiss the previous editing. Would you like to continue?",
+ "Starting a new topic", JOptionPane.YES_NO_OPTION);
+ if (n == JOptionPane.YES_OPTION){
+ File file = fc.getSelectedFile();
+ // importing a new grammar :
+ newObject = false;
+ statusLabel.setText(status);
+ listModel.clear();
+ tree.clear();
+ populateTree(tree);
+ while (1< menu.getItemCount())
+ menu.removeItemAt(1);
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ if (debug) System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ if (debug) System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+
+ selectedMenuLanguage = "Abstract";
+ rbMenuItemLong.setSelected(true);
+ rbMenuItemUnTyped.setSelected(true);
+ submenu.removeAll();
+
+ fileString="";
+ grammar.setText("No Topic ");
+ send(" e "+ file.getPath().replace('\\','/'));
+ }
+ }
+ }
+
+ if ( obj == gfCommand ){
+ String s = JOptionPane.showInputDialog("Command:", parseInput);
+ if (s!=null) {
+ parseInput = s;
+ //s = "gf "+s; This is for debugging, otherwise shift the comment to the next line.
+ treeChanged = true;
+ if (debug) System.out.println("sending: "+ s);
+ send(s);
+ }
+ }
+
+ if ( name.equals("reset") ) {
+ newObject = false;
+ statusLabel.setText(status);
+ listModel.clear();
+ tree.clear();
+ populateTree(tree);
+ while (1< menu.getItemCount())
+ menu.removeItemAt(1);
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ if (debug) System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ if (debug) System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+
+ selectedMenuLanguage = "Abstract";
+
+ submenu.removeAll();
+ rbMenuItemLong.setSelected(true);
+ rbMenuItemUnTyped.setSelected(true);
+
+ fileString="";
+ grammar.setText("No Topic ");
+ send("e");
+ }
+
+ if ( obj == leftMeta ) {
+ treeChanged = true;
+ send("<<");
+ }
+ if ( obj == left ) {
+ treeChanged = true;
+ send("<");
+ }
+ if ( obj == top ) {
+ treeChanged = true;
+ send("'");
+ }
+ if ( obj == right ) {
+ treeChanged = true;
+ send(">");
+ }
+ if ( obj == rightMeta ) {
+ treeChanged = true;
+ send(">>");
+ }
+
+ if ( obj == cancel ) {
+ dialog.hide();
+ }
+
+ if ( obj == browse ) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc.showOpenDialog(GFEditor2.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc.getSelectedFile();
+ inputField.setText(file.getPath().replace('\\','/'));
+ }
+ }
+
+ if ( obj == ok ) {
+ treeChanged = true;
+ if (termReadButton.isSelected()) {
+ termInput = inputField.getText();
+ if (termInput.indexOf('/')==-1){
+ send("g "+termInput);
+ if (debug) System.out.println("sending term string");
+ }
+ else {
+ send("tfile "+termInput);
+ System.out.println("sending file term: "+termInput);
+ }
+ }
+ else {
+ parseInput = inputField.getText();
+ if (parseInput.indexOf('/')==-1){
+ send("p "+parseInput);
+ if (debug) System.out.println("sending parse string: "+parseInput);
+ }
+ else {
+ send("pfile "+parseInput);
+ if (debug) System.out.println("sending file parse string: "+parseInput);
+ }
+ }
+ dialog.hide();
+ }
+
+ if ( obj == read ) {
+ if (stringReadButton.isSelected())
+ inputField.setText(parseInput);
+ else
+ inputField.setText(termInput);
+ dialog.show();
+ }
+
+/* if ( obj == term ) {
+ inputLabel.setText("Term:");
+ inputField.setText(termInput);
+ dialog.show();
+ }
+ if ( obj == parse ) {
+ inputLabel.setText("Parse:");
+ inputField.setText(parseInput);
+ dialog.show();
+ }
+*/
+ if ( obj == alpha){
+ String s = JOptionPane.showInputDialog("Type string:", alphaInput);
+ if (s!=null) {
+ alphaInput = s;
+ treeChanged = true;
+ send("x "+s);
+ }
+ }
+ if ( obj == random){
+ treeChanged = true;
+ send("a");
+ }
+ if ( obj == undo){
+ treeChanged = true;
+ send("u");
+ }
+ }
+ } catch (Exception e){}
+ }
+ static void writeOutput(String str, String fileName) {
+
+ try {
+ FileOutputStream fos = new FileOutputStream(fileName);
+ Writer out = new OutputStreamWriter(fos, "UTF8");
+ out.write(str);
+ out.close();
+ } catch (IOException e) {
+ JOptionPane.showMessageDialog(null,
+ "Document is empty!","Error", JOptionPane.ERROR_MESSAGE);
+ }
+ }
+
+ /* Form a dummy tree in treePanel */
+ public static void populateTree(DynamicTree2 treePanel) {
+ String p1Name = new String("Root");
+ DefaultMutableTreeNode p1;
+ p1 = treePanel.addObject(null, p1Name);
+ }
+
+ /*
+ Parses the GF-output between <tree> </tree> tags
+ and build the corresponding tree.
+ */
+
+ public static void formTree(DynamicTree2 treePanel) {
+ Hashtable table = new Hashtable();
+ TreePath path=null;
+ boolean treeStarted = false, selected = false;
+ String s = treeString;
+ String name ="";
+ treePanel.clear();
+ int j, shift=0, star=0, index = 0;
+ DefaultMutableTreeNode p2=null, p1=null;
+ if (debug) System.out.print("treeString: "+ s);
+ if (s.indexOf('*')!=-1) star = 1;
+ while (s.length()>0) {
+ while ((s.length()>0) && ((s.charAt(0)=='*')||(s.charAt(0)==' '))){
+ if (s.charAt(0) == '*') selected = true;
+ s = s.substring(1);
+ shift++;
+ }
+ if (s.length()>0) {
+ j = s.indexOf("\n");
+ name = s.substring(0, j);
+ index++;
+ s = s.substring(j+1);
+ shift = (shift - star)/2;
+
+ p1 = (DefaultMutableTreeNode)table.get(new Integer(shift));
+ p2 = treePanel.addObject(p1, name);
+ table.put(new Integer(shift+1), p2);
+ path = new TreePath(p2.getPath());
+ nodeTable.put(path, new Integer(index));
+ if (selected) {
+ treePanel.tree.setSelectionPath(path);
+ treePanel.oldSelection = index;
+ if (debug) System.out.println("new selected index "+ index);
+ selected = false;
+ }
+ treeStarted=true;
+ }
+ shift = 0;
+ }
+ if ((p2!=null)) {
+ treePanel.tree.makeVisible(path);
+ gui2.toFront();
+ index = 0;
+ }
+ }
+
+ /** Listens to the radio buttons. */
+ class RadioListener implements ActionListener {
+ public void actionPerformed(ActionEvent e) {
+ String action = e.getActionCommand();
+ if (action.equals("split") ) {
+ coverPanel.remove(centerPanel);
+ centerPanel2.add(middlePanelUp, BorderLayout.SOUTH);
+ if (((JCheckBoxMenuItem)viewMenu.getItem(0)).isSelected()) {
+ centerPanel2.add(treePanel, BorderLayout.CENTER);
+ }
+ else {
+ centerPanel2.add(outputPanelUp, BorderLayout.CENTER);
+ }
+ coverPanel.add(centerPanel2, BorderLayout.CENTER);
+ gui2.getContentPane().add(outputPanelDown);
+ gui2.setVisible(true);
+ pack();
+ repaint();
+ }
+ if (action.equals("combine") ) {
+ coverPanel.remove(centerPanel2);
+ middlePanel.add(middlePanelUp, BorderLayout.NORTH);
+ if (((JCheckBoxMenuItem)viewMenu.getItem(0)).isSelected()) { gui2.setVisible(false);
+ centerPanel.setLeftComponent(treePanel);
+ }
+ else {
+ centerPanel.setLeftComponent(outputPanelUp);
+ gui2.setVisible(false);
+ }
+ coverPanel.add(centerPanel, BorderLayout.CENTER);
+ centerPanelDown.add(outputPanelDown, BorderLayout.CENTER);
+ pack();
+ repaint();
+ }
+
+ if (action.equals("showTree") ) {
+ if (!((JCheckBoxMenuItem)e.getSource()).isSelected()){
+ if (debug) System.out.println("was selected");
+ treeCbMenuItem.setSelected(false);
+ if (((JRadioButtonMenuItem)viewMenu.getItem(2)).isSelected()) {
+ centerPanel.remove(treePanel);
+ centerPanel.setLeftComponent(outputPanelUp);
+ }
+ else {
+ centerPanel2.remove(treePanel);
+ centerPanel2.add(outputPanelUp, BorderLayout.CENTER);
+ }
+ }
+ else {
+ if (debug) System.out.println("was not selected");
+ treeCbMenuItem.setSelected(true);
+ if (((JRadioButtonMenuItem)viewMenu.getItem(2)).isSelected()) {
+ centerPanel.remove(outputPanelUp);
+ treePanel.setRightComponent(outputPanelUp);
+ centerPanel.setLeftComponent(treePanel);
+ }
+ else {
+ centerPanel2.remove(outputPanelUp);
+ treePanel.setRightComponent(outputPanelUp);
+ centerPanel2.add(treePanel, BorderLayout.CENTER);
+ }
+ }
+ pack();
+ repaint();
+ }
+ if (action.equals("lang")) {
+ if (newObject) {
+ output.setText("");
+ formLin();
+ }
+ if (debug)
+ System.out.println("language option has changed "+((JCheckBoxMenuItem)e.getSource()).getText());
+ if (((JCheckBoxMenuItem)e.getSource()).isSelected()){
+ if (debug) System.out.println("turning on");
+ send("on "+((JCheckBoxMenuItem)e.getSource()).getText());
+ }
+ else{
+ if (debug) System.out.println("turning off");
+ send("off "+((JCheckBoxMenuItem)e.getSource()).getText());
+ }
+ }
+ //modeMenus actions:
+ else {
+ if ((action.equals("long")) || (action.equals("short")))
+ {
+ send("ms " + action);
+ }
+ else
+ if ((action.equals("typed")) || (action.equals("untyped")))
+ {
+ send("mt " + action);
+ }
+ else
+ {
+ selectedMenuLanguage = action;
+ if (action.equals("Abstract"))
+ {
+ send("ml Abs");
+ }
+ else
+ if (!action.equals("split")&&!action.equals("combine")&&!action.equals("showTree"))
+ {
+ if (debug) System.out.println("sending "+action);
+ send("ml " + action);
+ }
+ }
+ }
+ }
+ }
+
+ /** Handle the key pressed event. */
+ public void keyPressed(KeyEvent e) {
+ int keyCode = e.getKeyCode();
+ Object obj = e.getSource();
+ if ((keyCode == 10)&&(obj==list)) {
+ listAction(list.getSelectedIndex());
+ }
+ // Processing Enter:
+ if ((keyCode == 10)&&(obj==field)) {
+ getLayeredPane().remove(field);
+ treeChanged = true;
+ send("p "+field.getText());
+ if (debug) System.out.println("sending parse string: "+field.getText());
+ repaint();
+ }
+ // Processing Escape:
+ if ((keyCode == 27)&&(obj==field)) {
+ getLayeredPane().remove(field);
+ repaint();
+ }
+
+ }
+ /** Handle the key typed event. */
+ public void keyTyped(KeyEvent e) {
+ }
+ /** Handle the key released event. */
+ public void keyReleased(KeyEvent e) {
+ }
+
+ /**
+ Returns the biggest position of first and second.
+ Each word in the linearization area has the corresponding
+ position in the tree. The position-notion is taken from
+ GF-Haskell, where empty position ("[]")
+ represents tree-root, "[0]" represents first child of the root,
+ "[0,0]" represents the first grandchild of the root etc.
+ So comparePositions("[0]","[0,0]")="[0]"
+
+ */
+ public String comparePositions(String first, String second)
+ {
+ String common ="[]";
+ int i = 1;
+ while ((i<Math.min(first.length()-1,second.length()-1))&&(first.substring(0,i+1).equals(second.substring(0,i+1))))
+ {
+ common=first.substring(0,i+1);
+ i+=2;
+ }
+ if (common.charAt(common.length()-1)==']')
+ return common;
+ else
+ return common+"]";
+ }
+
+ /*
+ Returns the widest position (see comments to comparePositions)
+ covered in the string from begin to end in the
+ linearization area.
+ */
+ public String findMax(int begin, int end)
+ {
+ String max = (((MarkedArea)outputVector.elementAt(begin)).position).position;
+ for (int i = begin+1; i <= end; i++)
+ max = comparePositions(max,(((MarkedArea)outputVector.elementAt(i)).position).position);
+ return max;
+ }
+
+ public void caretUpdate(CaretEvent e)
+ {
+ String jPosition ="", iPosition="", position="";
+ MarkedArea jElement = null;
+ MarkedArea iElement = null;
+ int j = 0;
+ int i = outputVector.size()-1;
+ int start = output.getSelectionStart();
+ int end = output.getSelectionEnd();
+ if (debug3)
+ System.out.println("SELECTION START POSITION: "+start);
+ if (debug3)
+ System.out.println("SELECTION END POSITION: "+end);
+ if (debug3)
+ System.out.println("CARET POSITION: "+output.getCaretPosition());
+ if ((debug2)&&(end>0&&(end<output.getText().length())))
+ System.out.println("CHAR: "+output.getText().charAt(end));
+ // not null selection:
+ if ((i>-1)&&(start<output.getText().length()-1))
+ {
+ if (debug2)
+ for (int k=0; k<outputVector.size(); k++)
+ {
+ System.out.print("element: "+k+" begin "+((MarkedArea)outputVector.elementAt(k)).begin+" ");
+ System.out.print(" end: "+((MarkedArea)outputVector.elementAt(k)).end+" ");
+ System.out.print(" position: "+(((MarkedArea)outputVector.elementAt(k)).position).position+" ");
+ System.out.println(" words: "+((MarkedArea)outputVector.elementAt(k)).words);
+ }
+ // localizing end:
+ while ((j< outputVector.size())&&(((MarkedArea)outputVector.elementAt(j)).end < end))
+ j++;
+ // localising start:
+ while ((i>=0)&&(((MarkedArea)outputVector.elementAt(i)).begin > start))
+ i--;
+ if (debug2)
+ System.out.println("i: "+i+" j: "+j);
+ if ((j<outputVector.size()))
+ {
+ jElement = (MarkedArea)outputVector.elementAt(j);
+ jPosition = jElement.position.position;
+ // less & before: + if (i==-1)
+ { // less:
+ if (end>=jElement.begin)
+ {
+ iElement = (MarkedArea)outputVector.elementAt(0);
+ iPosition = iElement.position.position;
+ if (debug2)
+ System.out.println("Less: "+jPosition+" and "+iPosition);
+ position = findMax(0,j);
+ if (debug2)
+ System.out.println("SELECTEDTEXT: "+position+"\n");
+ treeChanged = true;
+ send("mp "+position);
+ }
+ // before:
+ else
+ if (debug2)
+ System.out.println("BEFORE vector of size: "+outputVector.size());
+ }
+ // just:
+ else
+ {
+ iElement = (MarkedArea)outputVector.elementAt(i);
+ iPosition = iElement.position.position;
+ if (debug2)
+ System.out.println("SELECTED TEXT Just: "+iPosition +" and "+jPosition+"\n");
+ position = findMax(i,j);
+ if (debug2)
+ System.out.println("SELECTEDTEXT: "+position+"\n");
+ treeChanged = true;
+ send("mp "+position);
+ }
+ }
+ else
+ // more && after:
+ if (i>=0)
+ {
+ iElement = (MarkedArea)outputVector.elementAt(i);
+ iPosition = iElement.position.position;
+ // more
+ if (start<=iElement.end)
+ {
+ jElement = (MarkedArea)outputVector.elementAt(outputVector.size()-1);
+ jPosition = jElement.position.position;
+ if (debug2)
+ System.out.println("MORE: "+iPosition+ " and "+jPosition);
+ position = findMax(i,outputVector.size()-1);
+ if (debug2)
+ System.out.println("SELECTEDTEXT: "+position+"\n");
+ treeChanged = true;
+ send("mp "+position);
+ }
+ else
+ // after:
+ if (debug2)
+ System.out.println("AFTER vector of size: "+outputVector.size());
+ }
+ else
+ // bigger:
+ {
+ iElement = (MarkedArea)outputVector.elementAt(0);
+ iPosition = iElement.position.position;
+ jElement = (MarkedArea)outputVector.elementAt(outputVector.size()-1);
+ jPosition = jElement.position.position;
+ if (debug2)
+ System.out.println("BIGGER: "+iPosition +" and "+jPosition+"\n");
+ if (debug2)
+ System.out.println("SELECTEDTEXT: []\n");
+ treeChanged = true;
+ send("mp []");
+ }
+ }//not null selection
+ }
+
+ /*
+ Appends the string s to the text in the linearization area
+ on the screen.
+ s - string to append
+ selectionStart, selectionEnd - selection coordinates
+ (focus tag is already cut)
+ */
+ public static void appendMarked(String s, int selectionStart, int selectionEnd)
+ { if (s.length()>0)
+ {
+ if (debug2)
+ {
+ System.out.println("STRING: "+s);
+ System.out.println("where selection start is: "+selectionStart);
+ System.out.println("where selection end is: "+selectionEnd);
+ if ((selectionStart>-1)&&(selectionEnd>selectionStart))
+ System.out.println("where selection is: "+s.substring(selectionStart,selectionEnd));
+ }
+ currentLength = 0;
+ newLength=0;
+ oldLength = output.getText().length();
+ int j, l, l2, n, pos, selStartTotal, selEndTotal, selEndT;
+ restString = s;
+ int m2, m1;
+ LinPosition position ;
+
+ if (selectionStart>-1)
+ {
+ selStart = selectionStart;
+ selEnd = selectionEnd;
+ if (debug2)
+ System.out.println("SELECTION: " + selStart + " "+selEnd+ "TOTAL: "+s.length());
+ if (selEnd>selStart)
+ selectionCheck = (getCharacter(s.substring(selStart, selEnd),"<",0)==-1);
+ l = restString.indexOf("<subtree");
+ l2 = restString.indexOf("</subtree");
+ // cutting subtree-tags:
+ while ((l2>-1)||(l>-1))
+ {
+ if ((l2==-1)||((l<l2)&&(l>-1)))
+ {
+ j = restString.indexOf('>',l);
+ n = getCharacter(restString,"<",j);
+ m1 = restString.indexOf('[',l);
+ m2 = restString.indexOf(']',l);
+ //getting position:
+ position = new LinPosition(restString.substring(m1,m2+1),
+ restString.substring(l,j).indexOf("incorrect")==-1);
+ // something before the tag:
+ if (l-currentLength>1)
+ {
+ if (debug2)
+ System.out.println("SOMETHING BEFORE THE TAG");
+ if (currentPosition.size()>0)
+ register(currentLength, l, (LinPosition)currentPosition.elementAt(currentPosition.size()-1));
+ else
+ register(currentLength, l, new LinPosition("[]",
+ restString.substring(l,j).indexOf("incorrect")==-1));
+ }
+ // nothing before the tag:
+ else
+ {
+ if (debug2)
+ System.out.println("NOTHING BEFORE THE TAG");
+ if (n>0)
+ register(j+2, n, position);
+ else
+ register(j+2, restString.length(), position);
+ removeSubTreeTag(l,j+1);
+ }
+ currentLength += newLength ;
+ } // l<l2
+ else
+ {
+ // something before the </subtree> tag:
+ if (l2-currentLength>1)
+ {
+ if (debug2)
+ System.out.println("SOMETHING BEFORE THE </subtree> TAG");
+ if (currentPosition.size()>0)
+ register(currentLength, l2, (LinPosition)currentPosition.elementAt(currentPosition.size()-1));
+ else
+ register(currentLength, l2, new LinPosition("[]",
+ restString.substring(l,l2).indexOf("incorrect")==-1));
+ currentLength += newLength ;
+ }
+ // nothing before the tag:
+ else
+ // punctuation after the </subtree> tag:
+ if (restString.substring(l2+10,l2+11).trim().length()>0)
+ {
+ if (debug2)
+ System.out.println("PUNCTUATION AFTER THE </subtree> TAG");
+ if (debug2) System.out.println("STRING: "+restString);
+ //cutting the tag first!:
+ if (l2>0)
+ removeSubTreeTag(l2-1,l2+9);
+ else
+ removeSubTreeTag(l2,l2+9);
+ if (debug2) System.out.println("STRING after cutting the </subtree> tag: "+restString);
+ // cutting the space in the last registered component:
+ if (outputVector.size()>0)
+ {
+ ((MarkedArea)outputVector.elementAt(outputVector.size()-1)).end -=1;
+ if (currentLength>0) currentLength -=1;
+ }
+ if (debug2) System.out.println("currentLength: "+currentLength +" old length " +oldLength);
+ // register the punctuation:
+ if (currentPosition.size()>0)
+ register(currentLength, currentLength+2, (LinPosition)currentPosition.elementAt(currentPosition.size()-1));
+ else
+ register(currentLength, currentLength+2, new LinPosition("[]",
+ true));
+ currentLength += newLength ;
+ }
+ else
+ // just cutting the </subtree> tag:
+ removeSubTreeTag(l2,l2+10);
+ }
+ l2 = restString.indexOf("</subtree");
+ l = restString.indexOf("<subtree");
+// if (debug2)
+// System.out.println("/subtree index: "+l2 + "<subtree"+l);
+ if (debug2)
+ {
+ System.out.print("<-POSITION: "+l+" CURRLENGTH: "+currentLength);
+ System.out.println(" STRING: "+restString.substring(currentLength));
+ }
+ } //while
+ if ((selEnd>=selStart)&&(outputVector.size()>0))
+ {
+ // exclamation sign etc.:
+ if (currentLength>selEnd)
+ selStartTotal = selStart+oldLength;
+ else
+ selStartTotal = currentLength+oldLength;
+ selEndTotal = selEnd+oldLength;
+ selEndT = selEndTotal+1;
+ pos = ((MarkedArea)outputVector.elementAt(outputVector.size()-1)).end;
+ if (debug2)
+ System.out.print("the last registered position: "+ pos);
+ if (debug2)
+ System.out.println(" selStart: "+ selStartTotal+ " selEnd: "+selEndTotal);
+ if (selEnd+oldLength>pos)
+ {
+ addedLength = selEndTotal-selStartTotal+2;
+ outputVector.addElement(new MarkedArea(selStartTotal, selEndTotal+1, focusPosition,restString.substring(currentLength)));
+ if (debug2)
+ System.out.println("APPENDING Selection Last:"+restString.substring(currentLength)+
+ "Length: "+addedLength+" POSITION: "+selStartTotal + " "+selEndT);
+ }
+ }
+ } //if selectionStart>-1
+ else
+ {
+ if (debug2) System.out.println("NO SELECTION IN THE TEXT TO BE APPENDED!");
+ //cutting tags from previous focuses if any:
+ int r = restString.indexOf("</subtree>");
+ while (r>-1)
+ {
+ // check if punktualtion marks like . ! ? are at the end of a sentence:
+ if (restString.charAt(r+10)==' ')
+ restString = restString.substring(0,r)+restString.substring(r+11);
+ else
+ restString = restString.substring(0,r)+restString.substring(r+10);
+ r = restString.indexOf("</subtree>");
+ }
+ r = restString.indexOf("<subtree");
+ while (r>-1)
+ {
+ int t = getCharacter(restString,">",r);
+ if (t<restString.length()-2)
+ restString = restString.substring(0,r)+restString.substring(t+2);
+ else
+ restString = restString.substring(0,r);
+ r = restString.indexOf("<subtree");
+ }
+ }
+ // appending:
+ String more = "\\"+">";
+ String less = "\\"+"<";
+ restString = replaceSubstring(restString,more,"> ");
+ restString = replaceSubstring(restString,less," <");
+ restString= replaceSubstring(restString,"\\\\"," \\");
+ if (debug4)
+ System.out.println(restString);
+ output.append(restString.replaceAll("&-","\n "));
+ if ((selectionEnd>=selectionStart)&&(selectionStart>-1))
+ try {
+ output.getHighlighter().addHighlight(selStart+oldLength, selEnd+oldLength+1, new DefaultHighlighter.DefaultHighlightPainter(color) );
+ selectedText = output.getText().substring(selStart+oldLength, selEnd+oldLength+1);
+ // output.getHighlighter().addHighlight(selStart+oldLength, selEnd+oldLength+1, new DefaultHighlighter.DefaultHighlightPainter(Color.white) );
+ } catch (Exception e) {System.out.println("highlighting problem!");}
+ }// s.length()>0
+ }
+
+ /*
+ Replaces the occurences of old by newString in the s
+ */
+ public static String replaceSubstring(String s, String old, String newString)
+ {
+ String ss = s;
+ int i =ss.indexOf(old);
+ while (i!=-1)
+ {
+ ss = ss.substring(0,i) + newString + ss.substring(i+old.length());
+ i =ss.indexOf(old);
+ }
+ return ss;
+ }
+
+ /*
+ Finding position of the charactern not starting with escape symbol (//)
+ in the string s from position.
+ */
+ public static int getCharacter(String s, String character, int position)
+ {
+ int t = restString.indexOf(character, position);
+ int i = t-1;
+ int k = 0;
+ while ((i>-1)&&(restString.charAt(i)=='\\'))
+ {
+ k++;
+ i--;
+ }
+ if (k % 2 == 0)
+ return t;
+ else
+ return getCharacter(s, character, t+1);
+ }
+
+ /* Assigns the position to the substring from start to end in the linearization */
+ public static void register(int start, int end, LinPosition position)
+ {
+ oldLength = output.getText().length();
+ addedLength = 0;
+ int resultCurrent = 0;
+ int resultNew = 0;
+ newLength = end-start;
+ // the tag has some words to register:
+ if (newLength>0)
+ {
+ //focus has a separate position:
+ if (selectionCheck&&(end>selStart))
+ {
+ selectionCheck=false;
+ if (debug2)
+ System.out.println("SELECTION HAS A SEPARATE POSITION");
+ if (debug2)
+ System.out.println("SELECTION: "+ selStart+" "+selEnd);
+ if (debug2)
+ System.out.println("TEXT to REGISTER: "+ start+" "+end);
+ if (debug2)
+ System.out.println("CURRLENGTH: "+ currentLength);
+
+ resultCurrent = currentLength+oldLength;
+
+ if (selStart>start+1)
+ {
+ // register text before selection:
+ addedLength = selStart - start;
+ resultNew = resultCurrent+ addedLength -1;
+ outputVector.addElement(new MarkedArea(resultCurrent, resultNew, position, restString.substring(start,start+addedLength)));
+ if (debug2)
+ System.out.println("APPENDING ZONE Before selection:"+restString.substring(start,start+addedLength)+
+ "Length: "+addedLength+" POSITION: "+resultCurrent + " "+resultNew);
+ }
+
+ //selection:
+ resultCurrent += addedLength;
+ addedLength = selEnd - selStart + 2;
+ resultNew = resultCurrent + addedLength - 1;
+ outputVector.addElement(new MarkedArea(resultCurrent, resultNew, focusPosition,restString.substring(selStart,selEnd+2)));
+ if (debug2)
+ System.out.println("APPENDING SelectedZONE: "+restString.substring(selStart,selEnd+2)+
+ "Length: "+newLength+" POSITION: "+resultCurrent + " "+resultNew);
+
+
+ if (end>selEnd+2)
+ {
+ // register the rest:
+ resultCurrent += addedLength;
+ addedLength = end-selEnd-2;
+ resultNew = resultCurrent + addedLength -1;
+ outputVector.addElement(new MarkedArea(resultCurrent, resultNew, position,restString.substring(selEnd+2,end)));
+ if (debug2)
+ System.out.println("APPENDING ZONE after:"+
+ restString.substring(selEnd+2,end)+
+ "Length: "+newLength+" POSITION: "+resultCurrent + " "+resultNew);
+ }
+ }// focus has a separate position
+ else
+ {
+ resultCurrent = currentLength + oldLength ;
+ resultNew = newLength + resultCurrent - 1;
+ if (debug2) System.out.println("Start: "+ start + " end: "+end);
+ if (debug2) System.out.println("STRING: "+ restString + " which length is: "+restString.length());
+ stringToAppend = restString.substring(start,end);
+ if (stringToAppend.trim().length()>0)
+ {
+ outputVector.addElement(new MarkedArea(resultCurrent, resultNew, position,stringToAppend));
+ if (debug2)
+ System.out.println("APPENDING ZONE:"+stringToAppend+
+ "Length: "+newLength+" POSITION: "+resultCurrent + " "+resultNew+" "+position.position);
+ }
+ else
+ if (debug2)
+ System.out.println("whiteSpaces: "+newLength);
+ }
+ } //some words to register
+ }
+
+ /* removing subtree-tag in the interval start-end
+ and updating the coordinates after that
+ */
+ public static void removeSubTreeTag (int start, int end)
+ {
+ if (debug2)
+ System.out.println("removing: "+ start +" to "+ end);
+ int difference =end-start+1;
+ int positionStart, positionEnd;
+ if (difference>20)
+ {
+ positionStart = restString.indexOf("[", start);
+ positionEnd = restString.indexOf("]", start);
+
+ currentPosition.addElement(new LinPosition(
+ restString.substring(positionStart, positionEnd+1),
+ restString.substring(start,end).indexOf("incorrect")==-1));
+ }
+ else
+ if (currentPosition.size()>0)
+ currentPosition.removeElementAt(currentPosition.size()-1);
+ if (start>0)
+ restString = restString.substring(0,start)+restString.substring(end+1);
+ else
+ restString = restString.substring(end+1);
+ if (selStart > end)
+ { selStart -=difference;
+ selEnd -=difference;
+ }
+ else
+ if (selEnd < start) ;
+ else selEnd -=difference;
+ }
+
+ /* handling the event of choosing the action at index from the list*/
+ public void listAction(int index) {
+ if (index == -1)
+ {if (debug) System.out.println("no selection");}
+ else {
+ treeChanged = true;
+ send((String)commands.elementAt(list.getSelectedIndex()));
+ }
+ }
+
+ // pop-up menu (adapted from DynamicTree2):
+ class PopupListener extends MouseAdapter {
+ public void mousePressed(MouseEvent e) {
+// int selStart = tree.getRowForLocation(e.getX(), e.getY());
+// output.setSelectionRow(selStart);
+ if (debug3)
+ System.out.println("mouse pressed2: "+output.getSelectionStart()+" "+output.getSelectionEnd());
+ //maybeShowPopup(e);
+ }
+
+ public void mouseReleased(MouseEvent e) {
+ if (debug3) System.out.println("mouse released2!"+output.getSelectionStart()+" "+output.getSelectionEnd());
+ maybeShowPopup(e);
+ }
+ }
+ void maybeShowPopup(MouseEvent e) {
+ int i=outputVector.size()-1;
+ // right click:
+ if (e.isPopupTrigger()) {
+ m2 = e;
+ timer2.start();
+ }
+ // middle click
+ if (e.getButton() == MouseEvent.BUTTON2)
+ {
+ // selection Exists:
+ if (!selectedText.equals(""))
+ {
+ if (debug3) System.out.println(e.getX() + " " + e.getY());
+ if (selectedText.length()<5)
+ if (treeCbMenuItem.isSelected())
+ field.setBounds(e.getX()+(int)Math.round(tree.getBounds().getWidth()), e.getY()+80, 400, 40);
+ else
+ field.setBounds(e.getX(), e.getY()+80, 400, 40);
+ else
+ if (treeCbMenuItem.isSelected())
+ field.setBounds(e.getX()+(int)Math.round(tree.getBounds().getWidth()), e.getY()+80, selectedText.length()*20, 40);
+ else
+ field.setBounds(e.getX(), e.getY()+80, selectedText.length()*20, 40);
+ getLayeredPane().add(field, new Integer(1), 0);
+ field.setText(selectedText);
+ field.requestFocusInWindow();
+ }
+ }
+ }
+ void addMenuItem(String name){
+ menuItem2 = new JMenuItem(name);
+ menuItem2.setFont(font);
+ menuItem2.setActionCommand("popupMenuItem");
+ menuItem2.addActionListener(this);
+ popup2.add(menuItem2);
+
+ }
+ public void focusGained(FocusEvent e)
+ {
+ }
+ public void focusLost(FocusEvent e)
+ {
+ getLayeredPane().remove(field);
+ repaint();
+ }
+}
+
+ /*focus has a separate position:
+ if (selectionCheck&&(selEnd<end))
+ {
+ selectionCheck=false;
+ if (debug2)
+ System.out.println("SELECTION HAS A SEPARATE POSITION");
+ if (debug2)
+ System.out.println("SELECTION: "+ selStart+" "+selEnd);
+ if (debug2)
+ System.out.println("TEXT to REGISTER: "+ start+" "+end);
+ if (debug2)
+ System.out.println("CURRLENGTH: "+ currentLength);
+
+ // selection Second:
+ if (end-selEnd<=3)
+ if (selStart-start<=1)
+ { // only selection is to register:
+ resultCurrent = currentLength + oldLength ;
+ resultNew = newLength + resultCurrent - 1;
+ outputVector.addElement(new MarkedArea(resultCurrent, resultNew, focusPosition,restString.substring(selStart,selEnd+2)));
+ if (debug2)
+ System.out.println("APPENDING SelectedZONE ONLy:"+restString.substring(selStart,selEnd+2)+
+ "Length: "+newLength+" POSITION: "+resultCurrent + " "+resultNew);
+ }
+ else
+ {
+ // register the rest:
+ resultCurrent = currentLength+oldLength;
+ resultNew = resultCurrent+ selStart-start -1;
+ addedLength = selStart -start;
+ outputVector.addElement(new MarkedArea(resultCurrent, resultNew, position, restString.substring(start,start+addedLength)));
+ if (debug2)
+ System.out.println("APPENDING ZONE First:"+restString.substring(start,start+addedLength)+
+ "Length: "+addedLength+" POSITION: "+resultCurrent + " "+resultNew);
+ currentLength += addedLength;
+
+ //selection second:
+ newLength = selEnd - selStart+2;
+ resultCurrent = currentLength+oldLength;
+ resultNew = resultCurrent+ newLength -1;
+ outputVector.addElement(new MarkedArea(resultCurrent, resultNew, focusPosition,restString.substring(selStart,selEnd+2)));
+ if (debug2)
+ System.out.println("APPENDING SelectedZONE Second:"+restString.substring(selStart,selEnd+2)+
+ "Length: "+newLength+" POSITION: "+resultCurrent + " "+resultNew);
+ }
+ else
+ { // selection first:
+ addedLength = selEnd - selStart +2;
+ resultCurrent = currentLength+oldLength;
+ resultNew = resultCurrent + addedLength-1;
+ outputVector.addElement(new MarkedArea(resultCurrent, resultNew, focusPosition,restString.substring(selStart,selEnd+2)));
+ if (debug2)
+ System.out.println("APPENDING SelectedZONE First:"+restString.substring(selStart,selEnd+2)+
+ "Length: "+addedLength+" POSITION: "+resultCurrent + " "+resultNew);
+ currentLength += addedLength;
+
+ // register the rest:
+ newLength = end-selEnd-2;
+ resultCurrent = currentLength+oldLength;
+ resultNew = resultCurrent + newLength -1;
+ outputVector.addElement(new MarkedArea(resultCurrent, resultNew, position,restString.substring(selEnd+2,end)));
+ if (debug2)
+ System.out.println("APPENDING ZONE Second:"+restString.substring(selEnd+2,end)+
+ "Length: "+newLength+" POSITION: "+resultCurrent + " "+resultNew);
+ }
+ }// focus has a separate position
+ */ diff --git a/src/JavaGUI/GrammarFilter.java b/src/JavaGUI/GrammarFilter.java new file mode 100644 index 000000000..5180a9f6e --- /dev/null +++ b/src/JavaGUI/GrammarFilter.java @@ -0,0 +1,30 @@ +import java.io.File; +import javax.swing.*; +import javax.swing.filechooser.*; + +public class GrammarFilter extends FileFilter { + + // Accept all directories and all gf, gfcm files. + public boolean accept(File f) { + if (f.isDirectory()) { + return true; + } + + String extension = Utils.getExtension(f); + if (extension != null) { + if (extension.equals(Utils.gf) || + extension.equals(Utils.gfcm)) { + return true; + } else { + return false; + } + } + + return false; + } + + // The description of this filter + public String getDescription() { + return "Just Grammars"; + } +} diff --git a/src/JavaGUI/LinPosition.java b/src/JavaGUI/LinPosition.java new file mode 100644 index 000000000..2419de1df --- /dev/null +++ b/src/JavaGUI/LinPosition.java @@ -0,0 +1,13 @@ +//package javaGUI;
+ public class LinPosition
+ {
+ public String position;
+ public boolean correctPosition = true;
+
+ LinPosition(String p, boolean cor)
+ {
+ position = p;
+ correctPosition = cor ;
+ }
+ }
+
diff --git a/src/JavaGUI/MarkedArea.java b/src/JavaGUI/MarkedArea.java new file mode 100644 index 000000000..3299db9aa --- /dev/null +++ b/src/JavaGUI/MarkedArea.java @@ -0,0 +1,18 @@ +//package javaGUI;
+ public class MarkedArea
+ {
+ public int begin;
+ public int end;
+ public LinPosition position;
+ public String words;
+
+ MarkedArea(int b, int e, LinPosition p, String w)
+ {
+ begin = b;
+ end = e;
+ position = p;
+ words = w;
+ }
+
+ }
+
diff --git a/src/JavaGUI/Numerals.java b/src/JavaGUI/Numerals.java new file mode 100644 index 000000000..752cf232c --- /dev/null +++ b/src/JavaGUI/Numerals.java @@ -0,0 +1,1552 @@ +import java.awt.*;
+import java.awt.event.*;
+import javax.swing.*;
+import javax.swing.text.*;
+import javax.swing.event.*;
+import javax.swing.tree.*;
+import java.io.*;
+import java.util.*;
+
+public class Numerals extends JFrame implements ActionListener, KeyListener {
+ private JComboBox fontList;
+ private JLabel fontLabel = new JLabel(" Font: ");
+ private JPanel up = new JPanel();
+ public static boolean debug = true;
+ public static boolean newObject = false;
+ public static boolean finished = false;
+ private String parseInput = "";
+ private String alphaInput = "";
+ private static String status = "status";
+ private static String selectedMenuLanguage = "Abstract";
+ private static String linearization = "";
+ private String termInput = "";
+ private static String outputString = "";
+ private static String treeString = "";
+ private static String fileString = "";
+ public static Vector commands = new Vector();
+ public static Hashtable nodeTable = new Hashtable();
+ JFileChooser fc1 = new JFileChooser("./");
+ JFileChooser fc = new JFileChooser("./");
+ private String [] filterMenu = {"Filter", "identity",
+ "erase", "take100", "text", "code", "latexfile",
+ "structured", "unstructured" };
+ private String [] modifyMenu = {"Modify", "identity",
+ "compute", "paraphrase", "typecheck", "solve", "context" };
+// private String [] modeMenu = {"Menus", "printname",
+// "plain", "short", "long", "typed", "untyped" };
+ private static String [] newMenu = {"New"};
+
+ private static boolean firstLin = true;
+ private static boolean waiting = false;
+ public static boolean treeChanged = true;
+ private static String result;
+ private static int selectionStart;
+ private static int selectionEnd;
+ private static BufferedReader fromProc;
+ private static BufferedWriter toProc;
+ private static String commandPath = new String("GF");
+ private static JTextArea output = new JTextArea();
+ public static DefaultListModel listModel= new DefaultListModel();
+ private JList list = new JList(listModel);
+ private static DynamicTree tree = new DynamicTree();
+
+ private JLabel grammar = new JLabel("No topic ");
+ private JButton save = new JButton("Save");
+ private JButton open = new JButton("Open");
+ private JButton newTopic = new JButton("New Topic");
+ private JButton gfCommand = new JButton("GF command");
+ private JButton send = new JButton("Show");
+ private JTextField input = new JTextField(25);
+
+ private JButton leftMeta = new JButton("?<");
+ private JButton left = new JButton("<");
+ private JButton top = new JButton("Top");
+ private JButton right = new JButton(">");
+ private JButton rightMeta = new JButton(">?");
+ private JButton read = new JButton("Read");
+ // private JButton parse = new JButton("Parse");
+ // private JButton term = new JButton("Term");
+ private JButton alpha = new JButton("Alpha");
+ private JButton random = new JButton("Random");
+ private JButton undo = new JButton("Undo");
+
+ private JPanel inputPanel = new JPanel();
+ private JPanel inputPanel2 = new JPanel();
+ private JPanel inputPanel3 = new JPanel();
+ private JButton ok = new JButton("OK");
+ private JButton cancel = new JButton("Cancel");
+ private JTextField inputField = new JTextField();
+ private JLabel inputLabel = new JLabel("Read: ");
+ private JButton browse = new JButton("Browse...");
+ private ButtonGroup readGroup = new ButtonGroup();
+ private JRadioButton termReadButton = new JRadioButton("Term");
+ private JRadioButton stringReadButton = new JRadioButton("String");
+
+ private JDialog dialog;
+
+ private static JComboBox menu = new JComboBox(newMenu);
+ private JComboBox filter = new JComboBox(filterMenu);
+ private JComboBox modify = new JComboBox(modifyMenu);
+ // private JComboBox mode = new JComboBox(modeMenu);
+
+ private JPanel downPanel = new JPanel();
+ private JSplitPane treePanel;
+ private JPanel upPanel = new JPanel();
+ private JPanel middlePanel = new JPanel();
+ private JPanel middlePanelUp = new JPanel();
+ private JPanel middlePanelDown = new JPanel();
+ private JSplitPane centerPanel;
+ private static JFrame gui2 = new JFrame();
+ private JPanel centerPanel2= new JPanel();
+ private JPanel centerPanelDown = new JPanel();
+ private JScrollPane outputPanelDown = new JScrollPane(list);
+ private JScrollPane outputPanelCenter = new JScrollPane(output);
+ private JPanel outputPanelUp = new JPanel();
+ private JPanel statusPanel = new JPanel();
+ private static JLabel statusLabel = new JLabel(status);
+ private Container cp;
+
+ private static JMenuBar menuBar= new JMenuBar();;
+ private static ButtonGroup menuGroup = new ButtonGroup();
+ private JMenu viewMenu= new JMenu("View");
+ private JMenu submenu= new JMenu("Language");
+ private JMenu submenuFont= new JMenu("TextSize");
+ private JMenu modeMenu= new JMenu("Menus");
+ private static JMenu langMenu= new JMenu("Languages");
+ private static JMenu fileMenu= new JMenu("File");
+ private JRadioButtonMenuItem rbMenuItem;
+ private JRadioButtonMenuItem rbMenuItemLong;
+ // private JRadioButtonMenuItem rbMenuItemAbs;
+ private JRadioButtonMenuItem rbMenuItemUnTyped;
+ private static JMenuItem fileMenuItem;
+ private static JCheckBoxMenuItem cbMenuItem;
+ private static RadioListener myListener ;
+ private static ButtonGroup group = new ButtonGroup();
+ private static ButtonGroup languageGroup = new ButtonGroup();
+ private static ButtonGroup fontGroup = new ButtonGroup();
+
+ public Numerals()
+ {
+ this.addWindowListener(new WindowAdapter() {
+ public void windowClosing(WindowEvent e) {
+ endProgram();
+ }
+ });
+ setJMenuBar(menuBar);
+ setTitle("Numerals");
+
+ GraphicsEnvironment gEnv = GraphicsEnvironment.getLocalGraphicsEnvironment();
+ String envfonts[] = gEnv.getAvailableFontFamilyNames();
+ fontList = new JComboBox(envfonts);
+ fontList.addActionListener(this);
+ //fontList.setFont(font);
+ //fontLabel.setFont(font);
+ up.add(fontLabel);
+ up.add(fontList);
+
+ viewMenu.setToolTipText("View settings");
+ fileMenu.setToolTipText("File operations");
+ langMenu.setToolTipText("Language settings");
+ menuBar.add(fileMenu);
+ menuBar.add(langMenu);
+ menuBar.add(viewMenu);
+ //menuBar.add(modeMenu);
+
+ //cbMenuItem = new JCheckBoxMenuItem("Tree");
+ //cbMenuItem.setActionCommand("showTree");
+ myListener = new RadioListener();
+ //cbMenuItem.addActionListener(myListener);
+ //cbMenuItem.setSelected(true);
+ //viewMenu.add(cbMenuItem);
+ //viewMenu.addSeparator();
+ rbMenuItem = new JRadioButtonMenuItem("large");
+ rbMenuItem.setActionCommand("large");
+ rbMenuItem.addActionListener(myListener);
+ fontGroup.add(rbMenuItem);
+ rbMenuItem.setSelected(false);
+ submenuFont.add(rbMenuItem);
+ rbMenuItem = new JRadioButtonMenuItem("medium");
+ rbMenuItem.setActionCommand("medium");
+ rbMenuItem.addActionListener(myListener);
+ fontGroup.add(rbMenuItem);
+ rbMenuItem.setSelected(true);
+ submenuFont.add(rbMenuItem);
+ rbMenuItem = new JRadioButtonMenuItem("small");
+ rbMenuItem.setActionCommand("small");
+ rbMenuItem.addActionListener(myListener);
+ fontGroup.add(rbMenuItem);
+ rbMenuItem.setSelected(false);
+ submenuFont.add(rbMenuItem);
+
+ viewMenu.add(submenuFont);
+ //viewMenu.addSeparator();
+
+ /* fileMenuItem = new JMenuItem("Open...");
+ fileMenuItem.setActionCommand("open");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem("New Topic...");
+ fileMenuItem.setActionCommand("newTopic");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem("Reset");
+ fileMenuItem.setActionCommand("reset");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ */
+ fileMenuItem = new JMenuItem("Save As...");
+ fileMenuItem.setActionCommand("save");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+ fileMenu.addSeparator();
+ fileMenuItem = new JMenuItem("Exit");
+ fileMenuItem.setActionCommand("quit");
+ fileMenuItem.addActionListener(this);
+ fileMenu.add(fileMenuItem);
+
+ // rbMenuItem = new JRadioButtonMenuItem("One window");
+ // rbMenuItem.setActionCommand("combine");
+ // rbMenuItem.addActionListener(myListener);
+ // rbMenuItem.setSelected(true);
+/* rbMenuItem.setMnemonic(KeyEvent.VK_R);
+ rbMenuItem.setAccelerator(KeyStroke.getKeyStroke(
+ KeyEvent.VK_1, ActionEvent.ALT_MASK));
+ rbMenuItem.getAccessibleContext().setAccessibleDescription(
+ "This doesn't really do anything");
+*/
+ /* menuGroup.add(rbMenuItem);
+ viewMenu.add(rbMenuItem);
+
+ rbMenuItem = new JRadioButtonMenuItem("Split windows");
+ rbMenuItem.setMnemonic(KeyEvent.VK_O);
+ rbMenuItem.setActionCommand("split");
+ rbMenuItem.addActionListener(myListener);
+ menuGroup.add(rbMenuItem);
+ viewMenu.add(rbMenuItem);
+
+ modeMenu.add(submenu);
+ */
+
+ /* rbMenuItemAbs = new JRadioButtonMenuItem("Abstract");
+ rbMenuItemAbs.setActionCommand("Abstract");
+ rbMenuItemAbs.addActionListener(myListener);
+ languageGroup.add(rbMenuItemAbs);
+ */
+
+ /* modeMenu.addSeparator();
+ menuGroup = new ButtonGroup();
+ rbMenuItemLong = new JRadioButtonMenuItem("long");
+ rbMenuItemLong.setActionCommand("long");
+ rbMenuItemLong.setSelected(true);
+ rbMenuItemLong.addActionListener(myListener);
+ menuGroup.add(rbMenuItemLong);
+ modeMenu.add(rbMenuItemLong);
+ rbMenuItem = new JRadioButtonMenuItem("short");
+ rbMenuItem.setActionCommand("short");
+ rbMenuItem.addActionListener(myListener);
+ menuGroup.add(rbMenuItem);
+ modeMenu.add(rbMenuItem);
+ modeMenu.addSeparator();
+
+ menuGroup = new ButtonGroup();
+ rbMenuItem = new JRadioButtonMenuItem("typed");
+ rbMenuItem.setActionCommand("typed");
+ rbMenuItem.addActionListener(myListener);
+ rbMenuItem.setSelected(false);
+ menuGroup.add(rbMenuItem);
+ modeMenu.add(rbMenuItem);
+ rbMenuItemUnTyped = new JRadioButtonMenuItem("untyped");
+ rbMenuItemUnTyped.setSelected(true);
+ rbMenuItemUnTyped.setActionCommand("untyped");
+ rbMenuItemUnTyped.addActionListener(myListener);
+ menuGroup.add(rbMenuItemUnTyped);
+ modeMenu.add(rbMenuItemUnTyped);
+ */
+ cp = getContentPane();
+ cp.setLayout(new BorderLayout());
+ cp.add(outputPanelCenter, BorderLayout.CENTER);
+ cp.add(downPanel, BorderLayout.SOUTH);
+ cp.add(up, BorderLayout.NORTH);
+ downPanel.add(random);
+ downPanel.add(input);
+ input.addKeyListener(this);
+ downPanel.add(send);
+
+ // output.setToolTipText("Linearizations' display area");
+ output.setEditable(false);
+ output.setLineWrap(true);
+ output.setWrapStyleWord(true);
+// output.setSelectionColor(Color.green);
+ output.setSelectionColor(Color.white);
+// output.setFont(new Font("Arial Unicode MS", Font.PLAIN, 17));
+ output.setFont(new Font(null, Font.PLAIN, 17));
+// System.out.println(output.getFont().getFontName());
+ send.setToolTipText("Showing the translation of a numeral");
+ random.setToolTipText("Generating a random numeral");
+/* gfCommand.setToolTipText("Sending a command to GF");
+ read.setToolTipText("Refining with term or linearization from typed string or file");
+ modify.setToolTipText("Choosing a linearization method");
+ alpha.setToolTipText("Performing alpha-conversion");
+ random.setToolTipText("Generating random refinement");
+ undo.setToolTipText("Going back to the previous state");
+ downPanel.add(gfCommand);
+ //downPanel.add(parse);
+ //downPanel.add(term);
+ downPanel.add(read);
+ downPanel.add(modify);
+ downPanel.add(alpha);
+ downPanel.add(random);
+ downPanel.add(undo);
+
+ leftMeta.setToolTipText("Moving the focus to the previous metavariable");
+ rightMeta.setToolTipText("Moving the focus to the next metavariable");
+ left.setToolTipText("Moving the focus to the previous term");
+ right.setToolTipText("Moving the focus to the next term");
+ top.setToolTipText("Moving the focus to the top term");
+ middlePanelUp.add(leftMeta);
+ middlePanelUp.add(left);
+ middlePanelUp.add(top);
+ middlePanelUp.add(right);
+ middlePanelUp.add(rightMeta);
+ middlePanelDown.add(new JLabel("Select Action on Subterm"));
+ middlePanel.setLayout(new BorderLayout());
+ middlePanel.add(middlePanelUp, BorderLayout.NORTH);
+ middlePanel.add(middlePanelDown, BorderLayout.CENTER);
+
+ menu.setToolTipText("The list of available categories to start editing");
+ open.setToolTipText("Reading both a new environment and an editing object from file. Current editing will be discarded");
+ save.setToolTipText("Writing the current editing object to file in the term or text format");
+ grammar.setToolTipText("Current Topic");
+ newTopic.setToolTipText("Reading a new environment from file. Current editing will be discarded.");
+ upPanel.add(grammar);
+ upPanel.add(menu);
+ upPanel.add(open);
+ upPanel.add(save);
+ upPanel.add(newTopic);
+
+ filter.setToolTipText("Choosing the linearization representation format");
+ modeMenu.setToolTipText("Choosing the refinement options' representation");
+ statusLabel.setToolTipText("The current focus type");
+ list.setToolTipText("The list of current refinment options");
+ tree.setToolTipText("The abstract syntax tree representation of the current editing object");
+ upPanel.add(filter);
+ //upPanel.add(mode);
+ populateTree(tree);
+ outputPanelUp.setLayout(new BorderLayout());
+ outputPanelUp.add(outputPanelCenter, BorderLayout.CENTER);
+ outputPanelUp.add(statusPanel, BorderLayout.SOUTH);
+ statusPanel.setLayout(new GridLayout(1,1));
+ statusPanel.add(statusLabel);
+ treePanel = new JSplitPane(JSplitPane.HORIZONTAL_SPLIT,
+ tree, outputPanelUp);
+ treePanel.setDividerSize(5);
+ treePanel.setDividerLocation(100);
+ centerPanel2.setLayout(new BorderLayout());
+ gui2.setSize(500,150);
+ gui2.setTitle("Select Action on Subterm");
+ gui2.setLocationRelativeTo(treePanel);
+ centerPanelDown.setLayout(new BorderLayout());
+ centerPanel = new JSplitPane(JSplitPane.VERTICAL_SPLIT,
+ treePanel, centerPanelDown);
+ centerPanel.addKeyListener(tree);
+ centerPanel.setOneTouchExpandable(true);
+ centerPanelDown.add(middlePanel, BorderLayout.NORTH);
+ centerPanelDown.add(outputPanelDown, BorderLayout.CENTER);
+ cp.add(centerPanel, BorderLayout.CENTER);
+ cp.add(upPanel, BorderLayout.NORTH);
+ cp.add(downPanel, BorderLayout.SOUTH);
+
+ list.setSelectionMode(ListSelectionModel.SINGLE_SELECTION);
+
+ MouseListener mouseListener = new MouseAdapter() {
+ public void mouseClicked(MouseEvent e) {
+ if (e.getClickCount() == 2) {
+ listAction(list.locationToIndex(e.getPoint()));
+ }
+ }
+ };
+ list.addMouseListener(mouseListener);
+ list.addKeyListener(this);
+ menu.addActionListener(this);
+ save.addActionListener(this);
+ open.addActionListener(this);
+ newTopic.addActionListener(this);
+ gfCommand.addActionListener(this);
+
+ filter.addActionListener(this);
+ filter.setMaximumRowCount(9);
+ leftMeta.addActionListener(this);
+ left.addActionListener(this);
+
+ menu.setFocusable(false);
+ save.setFocusable(false);
+ save.setActionCommand("save");
+ open.setFocusable(false);
+ open.setActionCommand("open");
+ newTopic.setFocusable(false);
+ newTopic.setActionCommand("newTopic");
+ gfCommand.setFocusable(false);
+
+ filter.setFocusable(false);
+ leftMeta.setFocusable(false);
+ left.setFocusable(false);
+
+ top.addActionListener(this);
+ right.addActionListener(this);
+ rightMeta.addActionListener(this);
+ //parse.addActionListener(this);
+ //term.addActionListener(this);
+ read.addActionListener(this);
+ modify.addActionListener(this);
+ //mode.addActionListener(this);
+ alpha.addActionListener(this);
+ random.addActionListener(this);
+ undo.addActionListener(this);
+
+ top.setFocusable(false);
+ right.setFocusable(false);
+ rightMeta.setFocusable(false);
+ //parse.setFocusable(false);
+ //term.setFocusable(false);
+ read.setFocusable(false);
+ modify.setFocusable(false);
+ //mode.setFocusable(false);
+ alpha.setFocusable(false);
+ random.setFocusable(false);
+ undo.setFocusable(false);
+
+ output.addKeyListener(tree);
+
+ outputPanelUp.setPreferredSize(new Dimension(500,300));
+ treePanel.setDividerLocation(0.3);
+ nodeTable.put(new TreePath(DynamicTree.rootNode.getPath()), new Integer(0));
+
+ JRadioButton termButton = new JRadioButton("Term");
+ termButton.setActionCommand("term");
+ termButton.setSelected(true);
+ JRadioButton linButton = new JRadioButton("Text");
+ linButton.setActionCommand("lin");
+ // Group the radio buttons.
+ group.add(linButton);
+ group.add(termButton);
+ JPanel buttonPanel = new JPanel();
+ buttonPanel.setPreferredSize(new Dimension(70, 70));
+ buttonPanel.add(new JLabel("Format:"));
+ buttonPanel.add(linButton);
+ buttonPanel.add(termButton);
+ fc1.setAccessory(buttonPanel);
+
+ termReadButton.setActionCommand("term");
+ stringReadButton.setSelected(true);
+ stringReadButton.setActionCommand("lin");
+ // Group the radio buttons.
+ readGroup.add(stringReadButton);
+ readGroup.add(termReadButton);
+ JPanel readButtonPanel = new JPanel();
+ readButtonPanel.setLayout(new GridLayout(3,1));
+ readButtonPanel.setPreferredSize(new Dimension(70, 70));
+ readButtonPanel.add(new JLabel("Format:"));
+ readButtonPanel.add(stringReadButton);
+ readButtonPanel.add(termReadButton);
+ dialog= new JDialog(this, "Input");
+ dialog.setLocationRelativeTo(this);
+ dialog.getContentPane().add(inputPanel);
+ inputPanel.setLayout(new BorderLayout(10,10));
+ inputPanel3.setLayout(new GridLayout(2,1,5,5));
+ inputPanel3.add(inputLabel);
+ inputPanel3.add(inputField);
+ ok.addActionListener(this);
+ browse.addActionListener(this);
+ cancel.addActionListener(this);
+ inputField.setPreferredSize(new Dimension(300,23));
+ inputPanel.add(inputPanel3, BorderLayout.CENTER);
+ inputPanel.add(new JLabel(" "), BorderLayout.WEST);
+ inputPanel.add(readButtonPanel, BorderLayout.EAST);
+ inputPanel.add(inputPanel2, BorderLayout.SOUTH);
+ inputPanel2.add(ok);
+ inputPanel2.add(cancel);
+ inputPanel2.add(browse);
+ dialog.setSize(350,135);
+ */
+ send.addActionListener(this);
+ random.addActionListener(this);
+ setSize(400,700);
+ setVisible(true);
+
+ try {
+ result = fromProc.readLine();
+ boolean firstCall = true;
+ while(result != null) {
+ boolean newCommand = true;
+ finished = false;
+ if (debug) System.out.println("01 "+result);
+ while (result.indexOf("gf")==-1){
+ outputString +=result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("001 "+result);
+ }
+ output.append(outputString);
+ if (newCommand)
+ {
+ if (firstCall)
+ {
+ output.setText("Welcome to Numerals! \n Print a number in the text field below and \n press Enter or use the Random button.");
+ firstCall = false;
+ }
+ else
+ output.setText("");
+ System.out.println("!!!!!!! output cleared !");
+ newCommand = false;
+ }
+
+ while ((result.indexOf("newcat")==-1)&&(result.indexOf("<lin ")==-1)){
+ result = fromProc.readLine();
+ if (debug) System.out.println("0001 "+result);
+ }
+ if (result.indexOf("<lin ")==-1)
+ formNewMenu();
+
+ if (!finished) {
+
+ while ((result.length()==0)||(result.indexOf("<lin ")==-1)) {
+ result = fromProc.readLine();
+ if (result!=null){
+ if (debug) System.out.println("10 "+result);
+ newCommand =true;
+ }
+ else System.exit(0);
+ }
+ readLin();
+ readTree();
+ readMessage();
+ if (newObject)
+ formSelectMenu();
+ else {
+ while(result.indexOf("</menu")==-1) {
+ result = fromProc.readLine();
+// if (debug) System.out.println("12 "+result);
+ }
+ }
+ for (int i=0; i<3; i++){
+ result = fromProc.readLine();
+ if (debug) System.out.println("11 "+result);
+ }
+ }
+ }
+ output.append("*** NOTHING MORE TO READ FROM " + commandPath + "\n");
+ } catch (IOException e) {
+ System.out.println("Could not read from external process");
+ }
+ }
+
+ public static void send(String text){
+ try {
+ output.setText("");
+ outputString = "";
+ if (debug) System.out.println("output cleared");
+ toProc.write(text, 0, text.length());
+ toProc.newLine();
+ toProc.flush();
+ } catch (IOException e) {
+ System.out.println("Could not write to external process");
+ }
+ }
+
+ public void endProgram(){
+ send("q");
+ System.exit(0);
+ }
+
+ public static void main(String args[])
+ {
+ Locale.setDefault(Locale.US);
+ try {
+ Process extProc = Runtime.getRuntime().exec(args[0]);
+ fromProc = new BufferedReader (new InputStreamReader(
+ extProc.getInputStream(),"UTF8"));
+ toProc = new BufferedWriter(new OutputStreamWriter(extProc.getOutputStream(),"UTF8"));
+ /* try {
+ UIManager.setLookAndFeel(
+ //UIManager.getSystemLookAndFeelClassName() );
+ "com.sun.java.swing.plaf.windows.WindowsLookAndFeel");
+ } catch (Exception e) { }
+ */
+ Numerals gui = new Numerals();
+
+ } catch (IOException e) {
+ System.out.println("Could not start " + commandPath);
+ }
+ }
+
+ public static void formSelectMenu (){
+ if (debug) System.out.println("list model changing! ");
+ String s ="";
+ try {
+ //read item
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ listModel.clear();
+ commands.clear();
+ while (result.indexOf("/menu")==-1){
+ //read show
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ while (result.indexOf("/show")==-1){
+ result = fromProc.readLine();
+ if (debug) System.out.println("9 "+result);
+ if (result.indexOf("/show")==-1)
+ {
+ if (result.length()>8)
+ s+=result.trim();
+ else
+ s+=result;
+ }
+ }
+// if (s.charAt(0)!='d')
+// listModel.addElement("Refine " + s);
+// else
+ listModel.addElement(s);
+ s="";
+ //read /show
+ //read send
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ saveCommand();
+ // read /item
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("8 "+result);
+ }
+ } catch(IOException e){ }
+ }
+
+ public static void saveCommand(){
+ if (newObject) commands.add(result);
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("9 "+result);
+ } catch(IOException e){ }
+ }
+
+ public void readLin(){
+ try {
+ linearization="";
+ linearization += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ while (result.indexOf("/linearization")==-1){
+ linearization += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ }
+ if (newObject) formLin();
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ } catch(IOException e){ }
+ }
+
+ public static void readTree(){
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ while (result.indexOf("/tree")==-1){
+ treeString += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ }
+ if (treeChanged && (newObject)) {
+ formTree(tree);
+ treeChanged = false;
+ }
+ treeString="";
+ result = fromProc.readLine();
+ if (debug) System.out.println("6 "+result);
+ } catch(IOException e){ }
+ }
+
+ public static void readMessage(){
+ String s ="";
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("7 "+result);
+ while (result.indexOf("/message")==-1){
+ s += result+"\n";
+ result = fromProc.readLine();
+ if (debug) System.out.println("7 "+result);
+ }
+ if ((s.length()>1)&&(s.indexOf("to start")==-1))
+ output.append("-------------"+'\n'+s);
+ result = fromProc.readLine();
+ if (debug) System.out.println("7 "+result);
+ } catch(IOException e){ }
+ }
+
+ public void formNewMenu () {
+ boolean more = true;
+ try {
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+
+ while (more){
+ if (result.indexOf("language")==-1) {
+ menu.addItem(result.substring(6));
+ }
+ else
+ more = false;
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+ result = fromProc.readLine();
+ if (debug) System.out.println("3 "+result);
+ if (result.indexOf("language")!=-1)
+ more = false;
+ result = fromProc.readLine();
+ if (debug) System.out.println("4 "+result);
+ }
+
+ more = true;
+ while (more){
+ if ((result.indexOf("/gf")==-1)&&(result.indexOf("lin")==-1)) {
+ //form lang and Menu menu:
+ cbMenuItem = new JCheckBoxMenuItem(result.substring(4));
+ System.out.println ("menu item: "+result.substring(4));
+ if (!(result.substring(4).equals("Abstract")))
+ cbMenuItem.setSelected(true);
+ cbMenuItem.setActionCommand("lang");
+ cbMenuItem.addActionListener(myListener);
+ langMenu.add(cbMenuItem);
+/* if ((result.substring(4)).equals("Abstract"))
+ {
+ submenu.add(rbMenuItemAbs);
+ if (selectedMenuLanguage.equals("Abstract"))
+ rbMenuItemAbs.setSelected(true);
+ languageGroup.add(rbMenuItemAbs);
+ }
+ else
+ {
+*/
+ rbMenuItem = new JRadioButtonMenuItem(result.substring(4));
+ rbMenuItem.setActionCommand("language"+result.substring(4));
+ rbMenuItem.addActionListener(myListener);
+ languageGroup.add(rbMenuItem);
+ if ((result.substring(4)).equals(selectedMenuLanguage))
+ {
+ if (debug) System.out.println("Selecting "+selectedMenuLanguage);
+ rbMenuItem.setSelected(true);
+ }
+
+ submenu.add(rbMenuItem);
+// }
+ }
+ else
+ more = false;
+ // read </language>
+ result = fromProc.readLine();
+ if (debug) System.out.println("2 "+result);
+ // read <language> or </gf...>
+ result = fromProc.readLine();
+ if (debug) System.out.println("3 "+result);
+ if ((result.indexOf("/gf")!=-1)||(result.indexOf("lin")!=-1))
+ more = false;
+ if (result.indexOf("/gf")!=-1)
+ finished = true;
+ // registering the file name:
+ if (result.indexOf("language")!=-1) {
+ String path = result.substring(result.indexOf('=')+1,
+ result.indexOf('>'));
+ path =path.substring(path.lastIndexOf('/')+1);
+ if (debug) System.out.println("name: "+path);
+ fileString +="--" + path +"\n";
+ if (path.lastIndexOf('.')!=path.indexOf('.'))
+ grammar.setText(path.substring(0,
+ path.indexOf('.')).toUpperCase()+" ");
+ }
+ result = fromProc.readLine();
+ if (debug) System.out.println("4 "+result);
+ }
+ if (debug) System.out.println("languageGroupElement formed"+
+ languageGroup.getButtonCount());
+ langMenu.addSeparator();
+ fileMenuItem = new JMenuItem("Add...");
+ fileMenuItem.setActionCommand("import");
+ fileMenuItem.addActionListener(this);
+ langMenu.add(fileMenuItem);
+ // in order to get back in main in the beggining of while:
+ result = fromProc.readLine();
+ } catch(IOException e){ }
+ }
+
+ public void outputAppend(){
+ int i, j, k, l, l2, m;
+ i=result.indexOf("type=");
+ j=result.indexOf('>',i);
+ l = result.indexOf("<focus");
+ l2 = result.indexOf("focus");
+ if (l2!=-1){
+
+ // in case focus tag is cut into two lines:
+ if (l==-1) l=l2-7;
+
+ if (debug) System.out.println("form Lin1: "+result);
+ statusLabel.setText(" "+result.substring(i+5,j));
+ //cutting <focus>
+ result= result.substring(0,l)+result.substring(j+1);
+ i=result.indexOf("/f",l);
+ if (debug) System.out.println("/ is at the position"+i);
+ j=result.indexOf('>',i);
+ k=result.length()-j;
+ if (debug) System.out.println("form Lin2: "+result);
+ m = output.getText().length();
+
+ //cutting </focus>
+ // in case focus tag is cut into two lines:
+ if (debug)
+ System.out.println("char at the previous position"+result.charAt(i-1));
+ if (result.charAt(i-1)!='<')
+ result= result.substring(0,i-8)+result.substring(j+1);
+ else
+ result= result.substring(0,i-1)+result.substring(j+1);
+ j= result.indexOf("<focus");
+ l2 = result.indexOf("focus");
+ // in case focus tag is cut into to lines:
+ if ((l2!=-1)&&(j==-1)) j=l2-7;
+ // only one focus
+ if (j==-1){
+ output.append(result+'\n');
+ selectionStart=m+l;
+ selectionEnd=output.getText().length()-k;
+ try {
+// output.getHighlighter().addHighlight(selectionStart, selectionEnd, new DefaultHighlighter.DefaultHighlightPainter(Color.green) );
+ output.getHighlighter().addHighlight(selectionStart, selectionEnd, new DefaultHighlighter.DefaultHighlightPainter(Color.white) );
+ } catch (Exception e) {}
+ }
+ //several focuses
+ else {
+ output.append(result.substring(0,j));
+ result = result.substring(j);
+ selectionStart=m+l;
+ selectionEnd=m+i-1;
+ try {
+// output.getHighlighter().addHighlight(selectionStart, selectionEnd, new DefaultHighlighter.DefaultHighlightPainter(Color.green) );
+ output.getHighlighter().addHighlight(selectionStart, selectionEnd, new DefaultHighlighter.DefaultHighlightPainter(Color.white) );
+ } catch (Exception e) {}
+ outputAppend();
+ }
+ if (debug) System.out.println("form Lin3: "+result);
+ }
+ else
+ output.append(result+'\n');
+ firstLin=false;
+ }
+
+ public void formLin(){
+ boolean visible=true;
+ firstLin=true;
+ result = linearization.substring(0,linearization.indexOf('\n'));
+ String lin = linearization.substring(linearization.indexOf('\n')+1);
+ //extract the language from result
+ int ind = result.indexOf('=');
+ int ind2 = result.indexOf('>');
+ String s = result.substring(ind+1,ind2);
+ result = lin.substring(0,lin.indexOf("</lin>"));
+ lin = lin.substring(lin.indexOf("</lin>"));
+ while (lin.length()>1) {
+ //check if the language is on
+ if (!visible) visible = true;
+ // in the list?
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if (langMenu.getItem(i).getText().equals(s))
+ {
+ visible = false;
+ break;
+ }
+ if (!visible) visible = true;
+ else {
+ //add item to the language list:
+ cbMenuItem = new JCheckBoxMenuItem(s);
+ if (debug) System.out.println ("menu item: "+s);
+ cbMenuItem.setSelected(true);
+ cbMenuItem.setActionCommand("lang");
+ cbMenuItem.addActionListener(myListener);
+ if (langMenu.getItemCount()<2)
+ langMenu.add(cbMenuItem, langMenu.getItemCount());
+ else
+ langMenu.add(cbMenuItem, langMenu.getItemCount()-2);
+
+ rbMenuItem = new JRadioButtonMenuItem(s);
+ rbMenuItem.setActionCommand(s);
+ rbMenuItem.addActionListener(myListener);
+ languageGroup.add(rbMenuItem);
+ submenu.add(rbMenuItem);
+
+ }
+ // selected?
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if ((langMenu.getItem(i).getText().equals(s))&&
+ !(langMenu.getItem(i).isSelected()) ) {
+ visible = false;
+ break;
+ }
+ if (visible) {
+ if (!firstLin)
+ output.append("************"+'\n');
+ if (debug) System.out.println("linearization for the language: "+result);
+ outputAppend();
+ }
+ // read </lin>
+ lin = lin.substring(lin.indexOf('\n')+1);
+ // read lin or 'end'
+ if (lin.length()<1) break;
+
+ result = lin.substring(0,lin.indexOf('\n'));
+ lin = lin.substring(lin.indexOf('\n')+1);
+ if (result.indexOf("<lin ")!=-1){
+ //extract the language from result
+ ind = result.indexOf('=');
+ ind2 = result.indexOf('>');
+ s = result.substring(ind+1,ind2);
+ result = lin.substring(0,lin.indexOf("</lin>"));
+ lin = lin.substring(lin.indexOf("</lin>"));
+ }
+ }
+ }
+
+ public void showAction(){
+ treeChanged = true;
+ send("n Numeral");
+ newObject = true;
+ System.out.println("!!!!!!!sending newNumeral");
+ treeChanged = true;
+ send("p "+ input.getText());
+ System.out.println("!!!!!!!sending parse string: "+input.getText());
+ }
+
+ public void actionPerformed(ActionEvent ae)
+ {
+ boolean abs = true;
+ Object obj = ae.getSource();
+
+ if ( obj == fontList ) {
+ Font font = new Font((String)fontList.getSelectedItem(), Font.PLAIN, 13);
+ output.setFont(font);
+ }
+
+ if ( obj == send ) {
+ showAction();
+ }
+
+ if ( obj == menu ) {
+ if (menu.getItemCount()>0)
+ if (!menu.getSelectedItem().equals("New"))
+ {
+ treeChanged = true;
+ send("n " + menu.getSelectedItem());
+ newObject = true;
+ menu.setSelectedIndex(0);
+ }
+ }
+
+ if ( obj == filter ) {
+ if (!filter.getSelectedItem().equals("Filter"))
+ {
+ send("f " + filter.getSelectedItem());
+ filter.setSelectedIndex(0);
+ }
+ }
+ if ( obj == modify ) {
+ if (!modify.getSelectedItem().equals("Modify"))
+ {
+ treeChanged = true;
+ send("c " + modify.getSelectedItem());
+ modify.setSelectedIndex(0);
+ }
+ }
+/* if ( obj == mode ) {
+ if (!mode.getSelectedItem().equals("Menus"))
+ {
+ send("o " + mode.getSelectedItem());
+ mode.setSelectedIndex(0);
+ }
+ }
+*/
+ // buttons and menu items:
+ boolean objectInstance = false;
+ try {
+ objectInstance =
+ Class.forName("javax.swing.AbstractButton").isInstance(obj);
+ } catch (Exception e) {System.out.println("Class not found!");}
+
+ if (objectInstance) {
+ String name =((AbstractButton)obj).getActionCommand();
+
+ if ( name.equals("quit")) {
+ endProgram();
+ }
+
+ if ( name.equals("save") ) {
+
+ if (fc1.getChoosableFileFilters().length<2)
+ fc1.addChoosableFileFilter(new GrammarFilter());
+ fc1.setFileFilter(fc1.getAcceptAllFileFilter());
+ int returnVal = fc1.showSaveDialog(Numerals.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc1.getSelectedFile();
+ if (debug) System.out.println("saving ... ");
+
+ /* // checking if the abstract syntax is on:
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if ((langMenu.getItem(i).getText().equals("Abstract"))&&
+ !(langMenu.getItem(i).isSelected()) ) {
+ JOptionPane.showMessageDialog(this,
+ "Turn on Abs, then save again.",
+ "Error", JOptionPane.ERROR_MESSAGE);
+ abs = false;
+ break;
+ }
+
+ String text = output.getText();
+ int end = text.indexOf("******");
+
+ // saving as a term:
+ if (group.getSelection().getActionCommand().equals("term")) {
+ if (end !=-1)
+ if (abs) {
+ writeOutput(fileString+text.substring(0, end), file.getPath());
+ abs=true;
+ }
+ else {
+ int i = linearization.indexOf('\n');
+ int j = linearization.indexOf("/lin");
+ writeOutput(fileString+linearization.substring(i+1, j-1), file.getPath());
+ }
+ else
+ JOptionPane.showMessageDialog(this, "No term to save");
+ }
+ // saving as a linearization:
+ else
+ // abstract syntax is shown:
+ if (abs)
+ {
+ end = text.indexOf('\n', end);
+ writeOutput(fileString+text.substring(end), file.getPath());
+ abs = true;
+ }
+ else
+ writeOutput(fileString+text, file.getPath());
+ */ writeOutput(output.getText(), file.getPath());
+ }
+ }
+
+ if ( name.equals("open") ) {
+ if (fc1.getChoosableFileFilters().length<2)
+ fc1.addChoosableFileFilter(new GrammarFilter());
+ fc1.setFileFilter(fc1.getAcceptAllFileFilter());
+ int returnVal = fc1.showOpenDialog(Numerals.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+
+ /* "sending" should be fixed on the GF side:
+ rbMenuItemLong.setSelected(true);
+ send("ms long");
+ rbMenuItemUnTyped.setSelected(true);
+ send("mt untyped");
+ selectedMenuLanguage = "Abstract";
+ rbMenuItemAbs.setSelected(true);
+ send("ml Abs");
+ */
+
+ int m = JOptionPane.showConfirmDialog(this,
+ "This will dismiss the previous editing. Would you like to continue?",
+ "Opening a new file", JOptionPane.YES_NO_OPTION);
+ if (m == JOptionPane.YES_OPTION){
+ treeChanged = true;
+ newObject = true;
+ menu.removeAllItems();
+ menu.addItem("New");
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ if (debug) System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ if (debug) System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+ submenu.removeAll();
+
+ File file = fc1.getSelectedFile();
+ // opening the file for editing :
+ if (debug) System.out.println("opening: "+ file.getPath().replace('\\','/'));
+ if (group.getSelection().getActionCommand().equals("term")) {
+ if (debug) System.out.println(" opening as a term ");
+ send("open "+ file.getPath().replace('\\','/'));
+ }
+ else {
+ if (debug) System.out.println(" opening as a linearization ");
+ send("openstring "+ file.getPath().replace('\\','/'));
+ }
+
+ fileString ="";
+ grammar.setText("No Topic ");
+ }
+ }
+ }
+
+ if ( name.equals("import") ) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ fc.setFileFilter(fc.getAcceptAllFileFilter());
+ int returnVal = fc.showOpenDialog(Numerals.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc.getSelectedFile();
+ // importing a new language :
+ if (debug) System.out.println("importing: "+ file.getPath());
+
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ if (debug) System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ if (debug) System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+
+ submenu.removeAll();
+
+ menu.removeAllItems();
+ menu.addItem("New");
+ fileString ="";
+ send("i "+ file.getPath().replace('\\','/'));
+
+ }
+ }
+ if ( name.equals("newTopic") ) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ fc.setFileFilter(fc.getAcceptAllFileFilter());
+ int returnVal = fc.showOpenDialog(Numerals.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ int n = JOptionPane.showConfirmDialog(this,
+ "This will dismiss the previous editing. Would you like to continue?",
+ "Starting a new topic", JOptionPane.YES_NO_OPTION);
+ if (n == JOptionPane.YES_OPTION){
+ File file = fc.getSelectedFile();
+ // importing a new grammar :
+ newObject = false;
+ statusLabel.setText(status);
+ listModel.clear();
+ tree.clear();
+ populateTree(tree);
+ System.out.println("tree populated!");
+ menu.removeAllItems();
+ System.out.println("removed all from menu!"+menu);
+ menu.addItem("New");
+ System.out.println("added new!");
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ if (debug) System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ if (debug) System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+
+ selectedMenuLanguage = "Abstract";
+ rbMenuItemLong.setSelected(true);
+ rbMenuItemUnTyped.setSelected(true);
+ submenu.removeAll();
+
+ fileString="";
+ grammar.setText("No Topic ");
+ System.out.println("e "+ file.getPath().replace('\\','/'));
+ //send("e \""+ file.getPath().replace('\\','/')+"\"");
+ send("e "+ file.getPath().replace('\\','/'));
+ }
+ }
+ }
+
+ if ( obj == gfCommand ){
+ String s = JOptionPane.showInputDialog("Command:", parseInput);
+ if (s!=null) {
+ parseInput = s;
+ s = "gf "+s;
+ //treeChanged = true;
+ send(s);
+ }
+ }
+
+ if ( name.equals("reset") ) {
+ newObject = false;
+ statusLabel.setText(status);
+ listModel.clear();
+ tree.clear();
+ populateTree(tree);
+ menu.removeAllItems();
+ menu.addItem("New");
+ langMenu.removeAll();
+
+ AbstractButton ab = null;
+
+ while (languageGroup.getButtonCount()>0)
+ {
+ for (Enumeration e = languageGroup.getElements();
+ e.hasMoreElements() ;)
+ {
+ ab = (AbstractButton)e.nextElement();
+ if (debug) System.out.println("more to remove ! "+ab.getText());
+ languageGroup.remove(ab);
+ }
+ if (debug) System.out.println("languageGroupElement after import removal "+
+ languageGroup.getButtonCount());
+ }
+
+ selectedMenuLanguage = "Abstract";
+
+ submenu.removeAll();
+ rbMenuItemLong.setSelected(true);
+ rbMenuItemUnTyped.setSelected(true);
+
+ fileString="";
+ grammar.setText("No Topic ");
+ send("e");
+ }
+
+ if ( obj == leftMeta ) {
+ treeChanged = true;
+ send("<<");
+ }
+ if ( obj == left ) {
+ treeChanged = true;
+ send("<");
+ }
+ if ( obj == top ) {
+ treeChanged = true;
+ send("'");
+ }
+ if ( obj == right ) {
+ treeChanged = true;
+ send(">");
+ }
+ if ( obj == rightMeta ) {
+ treeChanged = true;
+ send(">>");
+ }
+
+ if ( obj == cancel ) {
+ dialog.hide();
+ }
+
+ if ( obj == browse ) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ fc.setFileFilter(fc.getAcceptAllFileFilter());
+ int returnVal = fc.showOpenDialog(Numerals.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc.getSelectedFile();
+ inputField.setText(file.getPath().replace('\\','/'));
+ }
+ }
+
+ if ( obj == ok ) {
+ treeChanged = true;
+ if (termReadButton.isSelected()) {
+ termInput = inputField.getText();
+ if (termInput.indexOf('/')==-1){
+ send("g "+termInput);
+ if (debug) System.out.println("sending term string");
+ }
+ else {
+ send("tfile "+termInput);
+ if (debug) System.out.println("sending file term: "+termInput);
+ }
+ }
+ else {
+ parseInput = inputField.getText();
+ if (parseInput.indexOf('/')==-1){
+ send("p "+parseInput);
+ if (debug) System.out.println("sending parse string"+parseInput);
+ }
+ else {
+ send("pfile "+parseInput);
+ if (debug) System.out.println("sending file parse string: "+parseInput);
+ }
+ }
+ dialog.hide();
+ }
+
+ if ( obj == read ) {
+ if (stringReadButton.isSelected())
+ inputField.setText(parseInput);
+ else
+ inputField.setText(termInput);
+ dialog.show();
+ }
+
+/* if ( obj == term ) {
+ inputLabel.setText("Term:");
+ inputField.setText(termInput);
+ dialog.show();
+ }
+ if ( obj == parse ) {
+ inputLabel.setText("Parse:");
+ inputField.setText(parseInput);
+ dialog.show();
+ }
+*/
+ if ( obj == alpha){
+ String s = JOptionPane.showInputDialog("Type string:", alphaInput);
+ if (s!=null) {
+ alphaInput = s;
+ treeChanged = true;
+ send("x "+s);
+ }
+ }
+ if ( obj == random){
+ treeChanged = true;
+ send("n Numeral");
+ newObject = true;
+ System.out.println("!!!!!!!sending newNumeral");
+ treeChanged = true;
+ send("a");
+ }
+ if ( obj == undo){
+ treeChanged = true;
+ send("u");
+ }
+ }
+ //} catch (Exception e) { System.out.println("exception!!!"); }
+ }
+ static void writeOutput(String str, String fileName) {
+
+ try {
+ FileOutputStream fos = new FileOutputStream(fileName);
+ Writer out = new OutputStreamWriter(fos, "UTF8");
+ out.write(str);
+ out.close();
+ } catch (IOException e) {
+ JOptionPane.showMessageDialog(null,
+ "Document is empty!","Error", JOptionPane.ERROR_MESSAGE);
+ }
+ }
+ public static void populateTree(DynamicTree treePanel) {
+ String p1Name = new String("Root");
+ DefaultMutableTreeNode p1;
+ p1 = treePanel.addObject(null, p1Name);
+ }
+
+ public static void formTree(DynamicTree treePanel) {
+ Hashtable table = new Hashtable();
+ TreePath path=null;
+ boolean treeStarted = false, selected = false;
+ String s = treeString;
+ String name ="";
+ treePanel.clear();
+ int j, shift=0, star=0, index = 0;
+ DefaultMutableTreeNode p2=null, p1=null;
+ if (debug) System.out.print("treeString: "+ s);
+ if (s.indexOf('*')!=-1) star = 1;
+ while (s.length()>0) {
+ while ((s.length()>0) && ((s.charAt(0)=='*')||(s.charAt(0)==' '))){
+ if (s.charAt(0) == '*') selected = true;
+ s = s.substring(1);
+ shift++;
+ }
+ if (s.length()>0) {
+ j = s.indexOf("\n");
+ name = s.substring(0, j);
+ index++;
+ s = s.substring(j+1);
+ shift = (shift - star)/2;
+
+ p1 = (DefaultMutableTreeNode)table.get(new Integer(shift));
+ p2 = treePanel.addObject(p1, name);
+ table.put(new Integer(shift+1), p2);
+ path = new TreePath(p2.getPath());
+ nodeTable.put(path, new Integer(index));
+ if (selected) {
+ treePanel.tree.setSelectionPath(path);
+ treePanel.oldSelection = index;
+ if (debug) System.out.println("new selected index "+ index);
+ selected = false;
+ }
+ treeStarted=true;
+ }
+ shift = 0;
+ }
+ if ((p2!=null)) {
+ treePanel.tree.makeVisible(path);
+ gui2.toFront();
+ index = 0;
+ }
+ }
+
+ /** Listens to the radio buttons. */
+ class RadioListener implements ActionListener {
+ public void actionPerformed(ActionEvent e) {
+ String action = e.getActionCommand();
+ if (action.equals("large") )
+ {
+ output.setFont(new Font((String)fontList.getSelectedItem(), Font.PLAIN, 26));
+ }
+ if (action.equals("medium") )
+ {
+ output.setFont(new Font((String)fontList.getSelectedItem(), Font.PLAIN, 17));
+ }
+ if (action.equals("small") )
+ {
+ output.setFont(new Font((String)fontList.getSelectedItem(), Font.PLAIN, 12));
+ }
+
+ if (action.equals("split") ) {
+ cp.remove(centerPanel);
+ centerPanel2.add(middlePanelUp, BorderLayout.SOUTH);
+ if (((JCheckBoxMenuItem)viewMenu.getItem(0)).isSelected()) {
+ centerPanel2.add(treePanel, BorderLayout.CENTER);
+ }
+ else {
+ centerPanel2.add(outputPanelUp, BorderLayout.CENTER);
+ }
+ cp.add(centerPanel2, BorderLayout.CENTER);
+ gui2.getContentPane().add(outputPanelDown);
+ gui2.setVisible(true);
+ pack();
+ repaint();
+ }
+
+ if (action.equals("combine") ) {
+ cp.remove(centerPanel2);
+ middlePanel.add(middlePanelUp, BorderLayout.NORTH);
+ if (((JCheckBoxMenuItem)viewMenu.getItem(0)).isSelected()) { gui2.setVisible(false);
+ centerPanel.setLeftComponent(treePanel);
+ }
+ else {
+ centerPanel.setLeftComponent(outputPanelUp);
+ gui2.setVisible(false);
+ }
+ cp.add(centerPanel, BorderLayout.CENTER);
+ centerPanelDown.add(outputPanelDown, BorderLayout.CENTER);
+ pack();
+ repaint();
+ }
+
+ if (action.equals("showTree") ) {
+ if (!((JCheckBoxMenuItem)e.getSource()).isSelected()){
+ if (debug) System.out.println("was selected");
+ cbMenuItem.setSelected(false);
+ if (((JRadioButtonMenuItem)viewMenu.getItem(2)).isSelected()) {
+ centerPanel.remove(treePanel);
+ centerPanel.setLeftComponent(outputPanelUp);
+ }
+ else {
+ centerPanel2.remove(treePanel);
+ centerPanel2.add(outputPanelUp, BorderLayout.CENTER);
+ }
+ }
+ else {
+ if (debug) System.out.println("was not selected");
+ cbMenuItem.setSelected(true);
+ if (((JRadioButtonMenuItem)viewMenu.getItem(2)).isSelected()) {
+ centerPanel.remove(outputPanelUp);
+ treePanel.setRightComponent(outputPanelUp);
+ centerPanel.setLeftComponent(treePanel);
+ }
+ else {
+ centerPanel2.remove(outputPanelUp);
+ treePanel.setRightComponent(outputPanelUp);
+ centerPanel2.add(treePanel, BorderLayout.CENTER);
+ }
+ }
+ pack();
+ repaint();
+ }
+
+ if (action.equals("lang")) {
+ if (newObject) {
+ output.setText("");
+ formLin();
+ }
+ if (debug)
+ System.out.println("language option has changed "+((JCheckBoxMenuItem)e.getSource()).getText());
+ if (((JCheckBoxMenuItem)e.getSource()).isSelected()){
+ if (debug) System.out.println("turning on");
+ send("on "+((JCheckBoxMenuItem)e.getSource()).getText());
+ }
+ else{
+ if (debug) System.out.println("turning off");
+ send("off "+((JCheckBoxMenuItem)e.getSource()).getText());
+ }
+ }
+
+ //modeMenus actions:
+
+ if ((action.equals("long")) || (action.equals("short")))
+ {
+ send("ms " + action);
+ }
+
+ if ((action.equals("typed")) || (action.equals("untyped")))
+ {
+ send("mt " + action);
+ }
+ if (action.equals("languageAbstract"))
+ {
+ send("ml Abs");
+ }
+ else if (action.length()>7)
+ if (action.substring(0,8).equals("language"))
+ {
+ selectedMenuLanguage = action.substring(8);
+ if (debug) System.out.println("sending ml "+selectedMenuLanguage);
+ send("ml " + selectedMenuLanguage);
+ }
+ }
+ }
+
+ /** Handle the key pressed event. */
+ public void keyPressed(KeyEvent e) {
+ int keyCode = e.getKeyCode();
+ if (keyCode == 10) {
+ //listAction(list.getSelectedIndex());
+ showAction();
+ }
+ }
+ /** Handle the key typed event. */
+ public void keyTyped(KeyEvent e) {
+ }
+ /** Handle the key released event. */
+ public void keyReleased(KeyEvent e) {
+ }
+
+ public void listAction(int index) {
+ if (index == -1)
+ {if (debug) System.out.println("no selection");}
+ else {
+ treeChanged = true;
+ send((String)commands.elementAt(list.getSelectedIndex()));
+ }
+ }
+}
diff --git a/src/JavaGUI/Utils.java b/src/JavaGUI/Utils.java new file mode 100644 index 000000000..b10f54712 --- /dev/null +++ b/src/JavaGUI/Utils.java @@ -0,0 +1,22 @@ + +import java.io.File; + +public class Utils { + + public final static String gf = "gf"; + public final static String gfcm = "gfcm"; + + /* + * Get the extension of a file. + */ + public static String getExtension(File f) { + String ext = null; + String s = f.getName(); + int i = s.lastIndexOf('.'); + + if (i > 0 && i < s.length() - 1) { + ext = s.substring(i+1).toLowerCase(); + } + return ext; + } +} diff --git a/src/JavaGUI/manifest.txt b/src/JavaGUI/manifest.txt new file mode 100644 index 000000000..006d8adfd --- /dev/null +++ b/src/JavaGUI/manifest.txt @@ -0,0 +1 @@ +Main-Class: GFEditor2 diff --git a/src/JavaGUI/runNumerals b/src/JavaGUI/runNumerals new file mode 100644 index 000000000..3445220cc --- /dev/null +++ b/src/JavaGUI/runNumerals @@ -0,0 +1 @@ +java -cp ./ Numerals "GF +java ../../grammars/numerals/old/numerals.Ita.gf ../../grammars/numerals/old/numerals.Mag.gf ../../grammars/numerals/old/numerals.Tam.gf ../../grammars/numerals/old/numerals.Suo.gf ../../grammars/numerals/old/numerals.NorB.gf ../../grammars/numerals/old/numerals.Slo.gf ../../grammars/numerals/old/numerals.Spa.gf ../../grammars/numerals/old/numerals.Swe.gf ../../grammars/numerals/old/numerals.Deu.gf ../../grammars/numerals/old/numerals.Fra.gf ../../grammars/numerals/old/numerals.Malay.gf ../../grammars/numerals/old/numerals.Ned.gf ../../grammars/numerals/old/numerals.Pol.gf ../../grammars/numerals/old/numerals.ChiU.gf ../../grammars/numerals/old/numerals.Dec.gf "
diff --git a/src/JavaGUI2/LICENCE_jargs b/src/JavaGUI2/LICENCE_jargs new file mode 100644 index 000000000..509c1b7cb --- /dev/null +++ b/src/JavaGUI2/LICENCE_jargs @@ -0,0 +1,29 @@ +Copyright (c) 2001-2003 Steve Purcell. +Copyright (c) 2002 Vidar Holen. +Copyright (c) 2002 Michal Ceresna. +Copyright (c) 2005 Ewan Mellor. + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. Redistributions in +binary form must reproduce the above copyright notice, this list of +conditions and the following disclaimer in the documentation and/or other +materials provided with the distribution. Neither the name of the copyright +holder nor the names of its contributors may be used to endorse or promote +products derived from this software without specific prior written +permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/src/JavaGUI2/ManifestMain.txt b/src/JavaGUI2/ManifestMain.txt new file mode 100644 index 000000000..b398ff78d --- /dev/null +++ b/src/JavaGUI2/ManifestMain.txt @@ -0,0 +1,3 @@ +Manifest-Version: 1.0 +Main-Class: de.uka.ilkd.key.ocl.gf.GFEditor2 +Class-Path: log4j-1.2.8.jar jargs-1.0.jar diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/AbstractProber.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/AbstractProber.java new file mode 100644 index 000000000..0439ec6a4 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/AbstractProber.java @@ -0,0 +1,182 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.io.IOException; +import java.util.logging.*; + +/** + * A class that offers a basic readGfEdit method with a lot of + * hot spots where subclasses can plug in + * @author daniels + * + */ +abstract class AbstractProber { + /** + * reference to the editor whose readRefinementMenu method is used + */ + protected final GfCapsule gfCapsule; + protected static Logger logger = Logger.getLogger(AbstractProber.class.getName()); + + /** + * A constructor which sets some fields + * @param gfCapsule The encapsulation of GF + */ + public AbstractProber(GfCapsule gfCapsule) { + this.gfCapsule = gfCapsule; + } + + /** + * reads the hmsg part + * @param readresult the first line + * @return the first line of the next XML child. + * if no hmsg is present @see readresult is returned. + */ + protected String readHmsg(String readresult) { + if (readresult.equals("<hmsg>")) { + gfCapsule.skipChild("<hmsg>"); + try { + String next = gfCapsule.fromProc.readLine(); + if (logger.isLoggable(Level.FINER)) { + logger.finer("2 " + next); + } + return next; + } catch (IOException e) { + System.err.println("Could not read from external process:\n" + e); + return ""; + } + } else { + return readresult; + } + } + + /** + * reads the linearization subtree. + * The first line should be already read + * @param readresult the first line with the opening tag + */ + protected void readLinearizations(String readresult) { + gfCapsule.skipChild("<linearizations>"); + } + + /** + * Reads the tree child of the XML from beginning to end + */ + protected void readTree() { + gfCapsule.skipChild("<tree>"); + } + + /** + * Reads the message child of the XML from beginning to end + */ + protected void readMessage() { + gfCapsule.skipChild("<message>"); + } + + /** + * Reads the menu child of the XML from beginning to end + */ + protected void readMenu() { + gfCapsule.skipChild("<menu>"); + } + + /** + * reads the output from GF starting with >gfedit< + * and last reads >/gfedit<. + */ + protected void readGfedit() { + try { + String next = ""; + //read <gfedit> + String readresult = gfCapsule.fromProc.readLine(); + if (logger.isLoggable(Level.FINER)) { + logger.finer("1 " + next); + } + //read either <hsmg> or <lineatization> + readresult = gfCapsule.fromProc.readLine(); + if (logger.isLoggable(Level.FINER)) { + logger.finer("1 " + next); + } + + Hmsg hmsg = gfCapsule.readHmsg(readresult); + next = hmsg.lastline; + + //in case there comes sth. unexpected before <linearizations> + //usually the while body is never entered + // %%% + while ((next!=null)&&((next.length()==0)||(!next.trim().equals("<linearizations>")))) { + next = gfCapsule.fromProc.readLine(); + if (next!=null){ + if (logger.isLoggable(Level.FINER)) { + logger.finer("1 " + next); + } + } else { + System.exit(0); + } + } + readLinearizations(next); + readTree(); + readMessage(); + readMenu(); + + for (int i=0; i<3 && !next.equals(""); i++){ + next = gfCapsule.fromProc.readLine(); + if (logger.isLoggable(Level.FINER)) { + logger.finer("1 " + next); + } + } + + } catch (IOException e) { + System.err.println("Could not read from external process:\n" + e); + } + + } + + /** + * send a command to GF + * @param text the command, exactly the string that is going to be sent + */ + protected void send(String text) { + if (logger.isLoggable(Level.FINE)) { + logger.fine("## send: '" + text + "'"); + } + gfCapsule.realSend(text); + } + + /** + * Just reads the complete output of a GF run and ignores it. + */ + protected void readAndIgnore() { + try { + StringBuffer debugCollector = new StringBuffer(); + String readresult = gfCapsule.fromProc.readLine(); + debugCollector.append(readresult).append('\n'); + if (logger.isLoggable(Level.FINER)) logger.finer("14 "+readresult); + while (readresult.indexOf("</gfedit>") == -1) { + readresult = gfCapsule.fromProc.readLine(); + debugCollector.append(readresult).append('\n'); + if (logger.isLoggable(Level.FINER)) logger.finer("14 "+readresult); + } + //read trailing newline: + readresult = gfCapsule.fromProc.readLine(); + debugCollector.append(readresult).append('\n'); + if (logger.isLoggable(Level.FINER)) logger.finer("14 "+readresult); + + } catch (IOException e) { + System.err.println("Could not read from external process:\n" + e); + } + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/AstNodeData.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/AstNodeData.java new file mode 100644 index 000000000..9a4c48911 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/AstNodeData.java @@ -0,0 +1,105 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.util.logging.*; + +/** + * @author hdaniels + * An object of this type knows how it self should be rendered, + * via Printname how its children should be rendered. + * This means the tooltip information it got from there. + * Knows nothing directly of the type of the node, which an object of this class + * represents. That's whats GfAstNode is for. + */ +abstract class AstNodeData { + protected static Logger logger = Logger.getLogger(DynamicTree2.class.getName()); + /** + * @return the printname associated with this object + */ + public abstract Printname getPrintname(); + + /** + * @return the parameter tooltip that this node has as a child + * of its parent (who gave it to it depending on its position) + */ + public abstract String getParamTooltip(); + + /** + * keeps track of the number of children of this node. + * It has to be increased whenever a new child of this node is + * added. + */ + public int childNum = 0; + /** + * The position String in the GF AST for this node + * in Haskell notation. + */ + public final String position; + /** + * the GF node connected to this NodeData, not the JTree node + */ + public final GfAstNode node; + + /** + * If a subtyping witness is missing, then this flag is false + */ + public boolean subtypingStatus = true; + + /** + * if this is the active, selected, focused node + */ + public final boolean selected; + + /** + * The constraint, that is valid on this node. + * If this node introduced a node itself and did not just inherit + * one, they are just concatenated. + * Until now, only the presence of a non-empty string here is used, + * so that is not important yet. + */ + public final String constraint; + + /** + * some nodes like coerce should, if possible, be covered from the + * users eyes. If this variable is greater than -1, the child + * with that number is shown instead of this node. + * This node will not appear in the tree. + */ + public int showInstead = -1; + + /** + * A simple setter constructor, that sets the fields of this class (except showInstead) + * @param node the GF node connected to this NodeData, not the JTree node + * @param pos The position String in the GF AST for this node + * in Haskell notation. + * @param selected if this is the active, selected, focused node + * @param constraint The GF constraint introduced in this node + */ + protected AstNodeData(GfAstNode node, String pos, boolean selected, String constraint) { + this.node = node; + this.position = pos; + this.selected = selected; + // I have no better idea, how to clutch them together, since + // I don't need the content of this field right now. + this.constraint = node.constraint + constraint; + } + + public String toString() { + return this.node.getLine(); + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ChainCommandTuple.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ChainCommandTuple.java new file mode 100644 index 000000000..c0f6f0c0d --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ChainCommandTuple.java @@ -0,0 +1,60 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application +package de.uka.ilkd.key.ocl.gf; + +/** + * @author hdaniels + * For chain commands, it is not just enough, to save the command sent to GF + * and the respective show text. + * Then it would be unclear, which fun should determine the used printname. + * If none is given, the last one of a chain command is taken. + * But if a solve for example is to follow, this does not work. + * Thus, this class has some other fields to define the appearance of a + * chain command. + */ +class ChainCommandTuple extends StringTuple { + /** + * the fun, that selects the printname + */ + final public String fun; + /** + * Here the subcat of fun can be overwritten. + * Is used for the attributes of self. + */ + final public String subcat; + /** + * normally, the ';;' are counted. But if we know, how many commands we + * chain to each other, we can skip that step and use undoSteps instead + */ + final public int undoSteps; + + /** + * A simple setter constructor + * @param command The command sent to GF + * @param showtext The text, that GF would display if no matching + * printname is found. + * @param fun The fun that selects the used printname + * @param subcat the subcategory for the refinement menu, overwrites + * the one defined in the printname + * @param undoSteps how many undos are needed to undo this command + */ + public ChainCommandTuple(String command, String showtext, String fun, String subcat, int undoSteps) { + super(command, showtext); + this.fun = fun; + this.subcat = subcat; + this.undoSteps = undoSteps; + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ConstraintCallback.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ConstraintCallback.java new file mode 100644 index 000000000..3a9432960 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ConstraintCallback.java @@ -0,0 +1,64 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.util.logging.*; + +/** + * @author daniels + * Offers the interface that GFEditor2 uses to send back the constraint after editing. + * Has no dependancies on KeY or TogetherCC. + */ +abstract class ConstraintCallback { + + /** + * Does the logging. What else should it do? + */ + protected static Logger logger = Logger.getLogger(ConstraintCallback.class.getName()); + + /** + * The path name of the directory where the grammars reside + */ + String grammarsDir; + /** + * sets the directory where the grammars reside + * @param grammarsDir + */ + void setGrammarsDir(final String grammarsDir) { + this.grammarsDir = grammarsDir; + } + + /** + * gets the directory where the grammars reside + */ + String getGrammarsDir() { + return this.grammarsDir; + } + + /** + * Sends the finished OCL constraint back to Together to save it + * as a JavaDoc comment. + * @param constraint The OCL constraint in question. + */ + abstract void sendConstraint(String constraint); + + /** + * Sends the unfinished OCL constraint back to Together to save it + * as a GF tree as a JavaDoc comment. + * @param abs The GF tree in question + */ + abstract void sendAbstract(String abs); +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Display.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Display.java new file mode 100644 index 000000000..9ca39fc49 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Display.java @@ -0,0 +1,249 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.awt.Font; +import java.awt.Rectangle; +import java.util.Vector; +import javax.swing.JEditorPane; + +/** + * @author daniels + * Takes care of collecting the linearized text and the length calculations + */ +class Display { + /** + * If the linearization should be displayed as pure text + */ + private boolean doText; + /** + * If the linearization should be displayed as HTML + */ + private boolean doHtml; + /** + * collects the linearization after each append. + * what's in here are Strings + */ + private Vector linStagesHtml = new Vector(); + /** + * collects the linearization after each append. + * what's in here are Strings + */ + private Vector linStagesText = new Vector(); + /** + * Is used to calculate the length of a HTML snipplet. + * This pane is not displayed in hope to avoid any actual renderings + * which would just slow the length calculation down. + * Perhaps that's an abuse ... + * And perhaps this pane is not needed + */ + private JEditorPane htmlLengthPane = new JEditorPane(); + + /** + * initializes this object, nothing special + * @param dt 1 if only text is to be shown, 2 for only HTML, 3 for both. + * Other values are forbidden. + */ + public Display(int dt) { + setDisplayType(dt); + this.htmlLengthPane.setContentType("text/html"); + this.htmlLengthPane.setEditable(false); + } + + /** + * (de-)activates display of text and HTML according to dt + * @param dt 1 if only text is to be shown, 2 for only HTML, 3 for both. + */ + protected void setDisplayType(int dt) { + switch (dt) { + case 1: + doText = true; + doHtml = false; + break; + case 2: + doText = false; + doHtml = true; + break; + case 3: + doText = true; + doHtml = true; + break; + default: + doText = true; + doHtml = true; + break; + } + } + /** + * Resets the stored text, but leaves the scroll markers untouched. + */ + public void resetLin() { + linStagesHtml.clear(); + linStagesText.clear(); + htmlLengthPane.setText(""); + } + + /** + * @param font The Font, that is to be used. If null, the default of JTextPane is taken. + * @return the collected HTML text, that has been added to this object. + * <html> tags are wrapped around the result, if not already there. + */ + protected String getHtml(Font font) { + if (!doHtml) { + return ""; + } + String result; + if (this.linStagesHtml.size() > 0) { + String fontface; + if (font != null) { + //fontface = " style=\"font-size:" + font.getSize()+ "pt\""; + fontface = " style=\"font: " + font.getSize()+ "pt " + font.getName() + "\""; + } else { + fontface = ""; + } + result ="<html><body" + fontface + ">" + this.linStagesHtml.get(this.linStagesHtml.size() - 1).toString() + "</body></html>"; + } else { + result = ""; + } + return result; + } + + /** + * @return The collected pure text, that has been added to this object. + */ + protected String getText() { + if (!doText) { + return ""; + } + String result; + if (this.linStagesText.size() > 0) { + result = this.linStagesText.lastElement().toString(); + } else { + result = ""; + } + return result; + } + + /** + * Appends the given text to the respective fields from + * where it can be displayed later + * @param text The pure text that is to be appended. + * @param html The HTML text that is to be appended. + * Most likely the same as text + */ + protected void addToStages(final String text, final String html) { + //add to HTML + if (doHtml) { + final String newStageHtml; + if (this.linStagesHtml.size() > 0) { + newStageHtml = this.linStagesHtml.get(this.linStagesHtml.size() - 1) + html; + } else { + newStageHtml = html; + } + this.linStagesHtml.add(newStageHtml); + } + + //add to Text + if (doText) { + final String newStageText; + if (this.linStagesText.size() > 0) { + newStageText = linStagesText.get(linStagesText.size() - 1) + text; + } else { + newStageText = text; + } + this.linStagesText.add(newStageText); + } + } + + /** + * Adds toAdd to both the pure text as the HTML fields, they are inherently the same, + * since they are mapped to the same position in the AST. + * On the way of adding, some length calculations are done, which are used to + * create an HtmlMarkedArea object, which is ready to be used in GFEditor2. + * @param toAdd The String that the to-be-produced MarkedArea should represent + * @param position The position String in Haskell notation + * @param language the language of the current linearization + * @return the HtmlMarkedArea object that represents the given information + * and knows about its beginning and end in the display areas. + */ + protected MarkedArea addAsMarked(String toAdd, LinPosition position, String language) { + /** the length of the displayed HTML before the current append */ + int oldLengthHtml = 0; + if (doHtml) { + if (this.linStagesHtml.size() > 0) { + // is still in there. Does not absolutely need to be + // cached in a global variable + oldLengthHtml = this.htmlLengthPane.getDocument().getLength(); + } else { + oldLengthHtml = 0; + } + } + /** the length of the text before the current append */ + int oldLengthText = 0; + if (doText) { + if (this.linStagesText.size() > 0) { + // is still in there. Does not absolutely need to be + // cached in a global variable + oldLengthText = this.linStagesText.lastElement().toString().length(); + } else { + oldLengthText = 0; + } + } + addToStages(toAdd, toAdd); + //calculate beginning and end + //for HTML + int newLengthHtml = 0; + if (doHtml) { + final String newStageHtml = this.linStagesHtml.lastElement().toString(); + final String newHtml = Printname.htmlPrepend(newStageHtml, ""); + //yeah, daniels admits, this IS expensive + this.htmlLengthPane.setText(newHtml); + newLengthHtml = htmlLengthPane.getDocument().getLength(); + if (newLengthHtml < oldLengthHtml) { + newLengthHtml = oldLengthHtml; + } + } + //for text + int newLengthText = 0; + if (doText) { + newLengthText = this.linStagesText.lastElement().toString().length(); + } + final MarkedArea hma = new MarkedArea(oldLengthText, newLengthText, position, toAdd, oldLengthHtml, newLengthHtml, language); + return hma; + } + /** + * To store the scroll state of the pure text linearization area + */ + Rectangle recText = new Rectangle(); + /** + * To store the scroll state of the HTML linearization area + */ + Rectangle recHtml = new Rectangle(); + /** + * To store the scroll state of the pure text linearization area + */ + int scrollText = 0; + /** + * To store the scroll state of the HTML linearization area + */ + int scrollHtml = 0; + + + + public String toString() { + return getText(); + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/DynamicTree2.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/DynamicTree2.java new file mode 100644 index 000000000..5c88955d3 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/DynamicTree2.java @@ -0,0 +1,366 @@ +//Copyright (c) Janna Khegai 2004, Hans-Joachim Daniels 2005
+//
+//This program is free software; you can redistribute it and/or modify
+//it under the terms of the GNU General Public License as published by
+//the Free Software Foundation; either version 2 of the License, or
+//(at your option) any later version.
+//
+//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. See the
+//GNU General Public License for more details.
+//
+//You can either finde the file LICENSE or LICENSE.TXT in the source
+//distribution or in the .jar file of this application
+
+package de.uka.ilkd.key.ocl.gf;
+/*
+ * This code is based on an example provided by Richard Stanford,
+ * a tutorial reader.
+ */
+
+import java.awt.*;
+import javax.swing.*;
+import javax.swing.tree.*;
+import javax.swing.event.*;
+
+import java.util.logging.*;
+
+//import de.uka.ilkd.key.util.KeYResourceManager;
+
+import java.awt.event.*;
+
+/**
+ * A GUI class, does store the tree, but does not create it.
+ * The tree is created in GFEditor2.
+ * This class displays the tree and let the user interact with it via mouse clicks.
+ */
+public class DynamicTree2 extends JPanel implements KeyListener {
+ protected static Logger logger = Logger.getLogger(DynamicTree2.class.getName());
+
+ public DefaultMutableTreeNode rootNode;
+ private DefaultTreeModel treeModel;
+ public JTree tree;
+ private Toolkit toolkit = Toolkit.getDefaultToolkit();
+ private GFEditor2 gfeditor;
+ protected TreePath oldSelection = null;
+
+ /**
+ * Initializes the display state of the tree panel, sets up the
+ * event handlers.
+ * Does not initialize the tree.
+ * @param gfe The editor object this object belongs to.
+ */
+ public DynamicTree2(GFEditor2 gfe) {
+
+ this.gfeditor = gfe;
+ rootNode = new DefaultMutableTreeNode("Root Node");
+ treeModel = new DefaultTreeModel(rootNode);
+ treeModel.addTreeModelListener(new MyTreeModelListener());
+
+ tree = new JTree(treeModel);
+ tree.setRootVisible(false);
+ tree.setEditable(false);
+ tree.getSelectionModel().setSelectionMode(TreeSelectionModel.SINGLE_TREE_SELECTION);
+ tree.addKeyListener(this);
+
+ //Add listener to components that can bring up popup menus.
+ MouseListener popupListener = new PopupListener();
+ tree.addMouseListener(popupListener);
+
+ tree.addTreeSelectionListener(new TreeSelectionListener() {
+ /**
+ * Moves to the position of the selected node in GF.
+ * the following is assumed:
+ * gfeditor.nodeTable contains the positions for all selectionPathes.
+ */
+ public void valueChanged(TreeSelectionEvent e) {
+ if ((tree.getSelectionPath() != null) && tree.getSelectionPath().equals(oldSelection)) {
+ //nothing to be done here, probably
+ //triggered by showTree
+ return;
+ }
+ if (tree.getSelectionRows() != null) {
+ if (tree.getSelectionPath() == null) {
+ if (logger.isLoggable(Level.FINER)) {
+ logger.finer("null root path");
+ }
+ } else {
+ if (logger.isLoggable(Level.FINER)) {
+ logger.finer("selected path" + tree.getSelectionPath());
+ }
+ }
+ String pos = gfeditor.getNodePosition(tree.getSelectionPath());
+ if (pos == null || "".equals(pos)) {
+ //default to sth. sensible
+ pos = "[]";
+ }
+ gfeditor.send("[t] mp " + pos);
+ }
+ oldSelection = tree.getSelectionPath();
+ }
+ });
+
+ tree.setCellRenderer(new MyRenderer());
+ tree.setShowsRootHandles(true);
+ ToolTipManager.sharedInstance().registerComponent(tree);
+ ToolTipManager.sharedInstance().setDismissDelay(60000);
+ setPreferredSize(new Dimension(200, 100));
+ JScrollPane scrollPane = new JScrollPane(tree);
+ setLayout(new GridLayout(1,0));
+ add(scrollPane);
+ }
+
+ /**
+ * Remove all nodes in the tree and
+ * form a dummy tree in treePanel
+ */
+ protected void resetTree() {
+ ((DefaultTreeModel)(tree.getModel())).setRoot(new DefaultMutableTreeNode("Root"));
+ ((DefaultTreeModel)(tree.getModel())).reload();
+ }
+
+ /** Remove all nodes except the root node. */
+ public void clear() {
+ ((DefaultTreeModel)(tree.getModel())).setRoot(null);
+ oldSelection = null;
+ //((DefaultTreeModel)(tree.getModel())).reload();
+ }
+
+ /** Remove the currently selected node. */
+ public void removeCurrentNode() {
+ TreePath currentSelection = tree.getSelectionPath();
+ if (currentSelection != null) {
+ DefaultMutableTreeNode currentNode = (DefaultMutableTreeNode)
+ (currentSelection.getLastPathComponent());
+ MutableTreeNode parent = (MutableTreeNode)(currentNode.getParent());
+ if (parent != null) {
+ treeModel.removeNodeFromParent(currentNode);
+ return;
+ }
+ }
+
+ // Either there was no selection, or the root was selected.
+ toolkit.beep();
+ }
+
+ /**
+ * Add child to the root node.
+ * It will come last in this node.
+ * @param child the payload of the new node
+ * @return the tree node having child as the node data
+ */
+ public DefaultMutableTreeNode addObject(Object child) {
+ DefaultMutableTreeNode parentNode = null;
+ TreePath parentPath = tree.getSelectionPath();
+
+ if (parentPath == null) {
+ parentNode = rootNode;
+ } else {
+ parentNode = (DefaultMutableTreeNode)
+ (parentPath.getLastPathComponent());
+ }
+
+ return addObject(parentNode, child, true);
+ }
+
+ /**
+ * Add a new node containing child to the node parent.
+ * It will come last in this node.
+ * This method gets actually called
+ * @param parent the parent node of the to be created node
+ * @param child the wannabe node data
+ * @return the tree node having child as the node data and parent as the parent
+ */
+ public DefaultMutableTreeNode addObject(DefaultMutableTreeNode parent,
+ Object child) {
+ return addObject(parent, child, false);
+ }
+
+ /**
+ * Add child to the currently selected node (parent?).
+ * It will come last in this node.
+ * @param parent the parent node of the to be created node
+ * @param child the wannabe node data
+ * @param shouldBeVisible true iff the viewport should show the
+ * new node afterwards
+ * @return the tree node having child as the node data and parent
+ * as the parent
+ */
+ public DefaultMutableTreeNode addObject(DefaultMutableTreeNode parent, Object child, boolean shouldBeVisible) {
+ if (logger.isLoggable(Level.FINER)) {
+ logger.finer("node added: '" + child + "', parent: '" + parent + "'");
+ }
+ DefaultMutableTreeNode childNode = new DefaultMutableTreeNode(child);
+
+ if (parent == null) {
+ parent = rootNode;
+ }
+
+ treeModel.insertNodeInto(childNode, parent,
+ parent.getChildCount());
+
+ // Make sure the user can see the lovely new node.
+ if (shouldBeVisible) {
+ tree.scrollPathToVisible(new TreePath(childNode.getPath()));
+ }
+ return childNode;
+ }
+
+ class MyTreeModelListener implements TreeModelListener {
+ public void treeNodesChanged(TreeModelEvent e) {
+ DefaultMutableTreeNode node;
+ node = (DefaultMutableTreeNode)
+ (e.getTreePath().getLastPathComponent());
+
+ /*
+ * If the event lists children, then the changed
+ * node is the child of the node we've already
+ * gotten. Otherwise, the changed node and the
+ * specified node are the same.
+ */
+ try {
+ int index = e.getChildIndices()[0];
+ node = (DefaultMutableTreeNode)(node.getChildAt(index));
+ } catch (NullPointerException exc) {
+ System.err.println(exc.getMessage());
+ exc.printStackTrace();
+ }
+
+ if (logger.isLoggable(Level.FINER)) {
+ logger.finer("The user has finished editing the node.");
+ logger.finer("New value: " + node.getUserObject());
+ }
+ }
+ public void treeNodesInserted(TreeModelEvent e) {
+ //nothing to be done here
+ }
+ public void treeNodesRemoved(TreeModelEvent e) {
+ //nothing to be done here
+ }
+ public void treeStructureChanged(TreeModelEvent e) {
+ //nothing to be done here
+ }
+ }
+
+ /**
+ * This tree cell renderer got overwritten to make it possible to show
+ * tooltips according to the user object
+ */
+ private class MyRenderer extends DefaultTreeCellRenderer {
+ //int counter = 0;
+ //final ImageIcon iconFilled;
+ //final ImageIcon iconOpen;
+
+// public MyRenderer() {
+// final URL urlOpen = KeYResourceManager.getManager().getResourceFile(DynamicTree2.class, "metal_leaf_open.png");
+// final URL urlFilled = KeYResourceManager.getManager().getResourceFile(DynamicTree2.class, "metal_leaf_filled.png");
+// iconOpen = new ImageIcon(urlOpen);
+// iconFilled = new ImageIcon(urlFilled);
+// }
+
+ /**
+ * The heart of this class, sets display and tooltip text
+ * depending on the user data
+ */
+ public Component getTreeCellRendererComponent(
+ JTree tree,
+ Object value,
+ boolean sel,
+ boolean expanded,
+ boolean leaf,
+ int row,
+ boolean hasFocus) {
+
+ super.getTreeCellRendererComponent(
+ tree, value, sel,
+ expanded, leaf, row,
+ hasFocus);
+ if (value instanceof DefaultMutableTreeNode) {
+ DefaultMutableTreeNode node = (DefaultMutableTreeNode)value;
+ if (node.getUserObject() instanceof AstNodeData) {
+ AstNodeData and = (AstNodeData)node.getUserObject();
+ String ptt = and.getParamTooltip();
+ if (!and.subtypingStatus ) {
+ this.setForeground(Color.RED);
+ ptt = Printname.htmlAppend(ptt, "<p>Subtyping proof is missing. <br>If no refinements are offered here, then there is a subtyping error.");
+ }
+ this.setToolTipText(ptt);
+ this.setText(and.toString());
+// if (and.isMeta()) {
+// this.setLeafIcon(this.iconOpen);
+// } else {
+// this.setLeafIcon(this.iconFilled);
+// }
+ } else {
+ this.setToolTipText(null);
+ this.setText(value.toString());
+ }
+ } else {
+ this.setToolTipText(null);
+ this.setText(value.toString());
+ }
+ return this;
+ }
+
+ /**
+ * Checks if the current node represents an open metavariable
+ * or question mark
+ * @param value The payload of the node
+ * @return true iff value begins with a '?'
+ */
+ protected boolean isMetavariable(Object value) {
+ try {
+ DefaultMutableTreeNode node =
+ (DefaultMutableTreeNode)value;
+ String nodeInfo =
+ (String)(node.getUserObject());
+ if (nodeInfo.indexOf("?") == 0) {
+ return true;
+ }
+ } catch (Exception e) {
+ e.printStackTrace();
+ return false;
+ }
+
+ return false;
+ }
+
+ }//class
+
+ class PopupListener extends MouseAdapter {
+ public void mousePressed(MouseEvent e) {
+ gfeditor.maybeShowPopup(e);
+ }
+
+ public void mouseReleased(MouseEvent e) {
+ //nothing to be done here
+ }
+ }
+
+ /**
+ * Handle the key pressed event.
+ */
+ public void keyPressed(KeyEvent e) {
+ int keyCode = e.getKeyCode();
+ switch (keyCode){
+ case KeyEvent.VK_SPACE : gfeditor.send("'"); break;
+ case KeyEvent.VK_DELETE : gfeditor.send("d"); break;
+ }
+ }
+ /**
+ * Handle the key typed event.
+ */
+ public void keyTyped(KeyEvent e) {
+ //nothing to be done here
+ }
+ /**
+ * Handle the key released event.
+ */
+ public void keyReleased(KeyEvent e) {
+ //nothing to be done here
+ }
+
+}
+
+
diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ExportFormatMenu.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ExportFormatMenu.java new file mode 100644 index 000000000..076a9778f --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ExportFormatMenu.java @@ -0,0 +1,67 @@ +// This file is part of KeY - Integrated Deductive Software Design +// Copyright (C) 2001-2005 Universitaet Karlsruhe, Germany +// Universitaet Koblenz-Landau, Germany +// Chalmers University of Technology, Sweden +// +// The KeY system is protected by the GNU General Public License. +// See LICENSE.TXT for details. +// + +package de.uka.ilkd.key.ocl.gf; + +import javax.swing.*; +import java.awt.*; +import java.awt.event.*; + +/** Provide a choice of output formats: OCL or Natural Language. NL can be + * formatted using either HTML or LaTeX. + */ +public class ExportFormatMenu extends JPanel +{ + public static int OCL = 0, HTML=1, LATEX=2; + + private static String[] menuStrings = { "OCL", + "Natural Language/HTML (requires GF)", + "Natural Language/LaTeX (requires GF)" + }; + + private JComboBox formatMenu; + private int selection; + + private ActionListener al = new ActionListener() { + public void actionPerformed(ActionEvent e) { + JComboBox cb = (JComboBox) e.getSource(); + String s = (String) cb.getSelectedItem(); + if (s.equals("OCL")) { + selection = OCL; + } else if (s.equals("Natural Language/HTML (requires GF)")) { + selection = HTML; + } else if (s.equals("Natural Language/LaTeX (requires GF)")) { + selection = LATEX; + } else { // should never occur + selection = OCL; + }; + } + }; + + public ExportFormatMenu() + { + super(); + this.setLayout(new BoxLayout(this,BoxLayout.Y_AXIS)); + formatMenu = new JComboBox(menuStrings); + formatMenu.setSelectedIndex(0); + formatMenu.addActionListener(al); + this.add(Box.createVerticalGlue()); + JLabel text = new JLabel("Choose output format:"); + this.add(text); + text.setAlignmentX(Component.CENTER_ALIGNMENT); + this.add(formatMenu); + } + + + public int getSelection() + { + return selection; + } +} + diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GFCommand.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GFCommand.java new file mode 100644 index 000000000..6e420a62b --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GFCommand.java @@ -0,0 +1,137 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; +/** + * @author daniels + * A class that represents a GF command together with its printname. + * It also gives easy access to all the abuses of the printname like + * the subcategory, the tooltip, it knows about wrapping and so on. + * + * The static stuff could produce problems if the editor is started + * several times without closing it first. It probably should be moved + * into a manager class. + * Or the instances that get generated during one run all share the same + * "pseudo-static" Hashtables. This is probably better. + * + */ +abstract class GFCommand implements Comparable{ + + /** + * the subcategory of this command + */ + public abstract String getSubcat(); + /** + * the type of the command, r,w,ch,d,ac,... + */ + protected String commandType; + /** + * the type of the command, r,w,ch,d,ac,... + */ + public String getCommandType(){ + return commandType; + } + /** + * for wrap, the number of the argument the current node should become + */ + protected int argument; + + /** + * the actual command that this object should represent + */ + protected String command; + /** + * the actual command that this object should represent + */ + public String getCommand() { + return command; + } + + /** + * the Printname corresponding to the GF fun of this command + */ + protected Printname printname; + /** + * the Printname corresponding to the GF fun of this command + */ + public Printname getPrintname(){ + return printname; + } + + /** + * the text that is to be displayed as the tooltip + */ + public abstract String getTooltipText(); + + /** + * the text that is to be displayed in the refinement lists + */ + public abstract String getDisplayText(); + + /** + * the name of the fun that is used in this command + */ + protected String funName; + + /** + * if this is the first occurence of the current subcat + */ + protected boolean newSubcat; + + /** + * if this is the first occurence of the current subcat + */ + public boolean isNewSubcat() { + return newSubcat; + } + + /** + * Compares two GFCommands. + * LinkCommands are the least. Then the InputCommand (more than one + * does not happen). If that does not decide, the display name as a String does. + * @param o the other command. + * @return see above. + */ + public int compareTo(Object o) { + if (this.equals(o)) { + return 0; + } + if (this instanceof LinkCommand && !(o instanceof LinkCommand)) { + return -1; + } + if (!(this instanceof LinkCommand) && (o instanceof LinkCommand)) { + return 1; + } + //LinkCommands are dealt with, so from now on, they don't occur + if (this instanceof InputCommand && !(o instanceof InputCommand)) { + return -1; + } + if (!(this instanceof InputCommand) && (o instanceof InputCommand)) { + return 1; + } + if (! (o instanceof GFCommand)) { + //This should never occur! + return -1; + } else { + GFCommand ocmd = (GFCommand)o; + return this.getDisplayText().compareTo(ocmd.getDisplayText()); + } + } + + public String toString() { + return getDisplayText() + " \n " + getTooltipText(); + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GFEditor2.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GFEditor2.java new file mode 100644 index 000000000..cdda74168 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GFEditor2.java @@ -0,0 +1,2978 @@ +//Copyright (c) Janna Khegai 2004, Kristofer Johanisson 2004,
+// Hans-Joachim Daniels 2005
+//
+//This program is free software; you can redistribute it and/or modify
+//it under the terms of the GNU General Public License as publisrhed by
+//the Free Software Foundation; either version 2 of the License, or
+//(at your option) any later version.
+//
+//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. See the
+//GNU General Public License for more details.
+//
+//You can either finde the file LICENSE or LICENSE.TXT in the source
+//distribution or in the .jar file of this application
+
+package de.uka.ilkd.key.ocl.gf;
+
+import java.awt.*;
+import java.awt.event.*;
+import javax.swing.*;
+import javax.swing.text.*;
+import javax.swing.event.*;
+import javax.swing.tree.*;
+import java.io.*;
+import java.util.*;
+import java.net.URL;
+import javax.swing.text.html.HTMLDocument;
+import java.net.MalformedURLException;
+import java.util.logging.*;
+import jargs.gnu.CmdLineParser;
+
+public class GFEditor2 extends JFrame {
+ /**
+ * the main logger for this class
+ */
+ private static Logger logger = Logger.getLogger(GFEditor2.class.getName());
+ /**
+ * debug stuff for the tree
+ */
+ private static Logger treeLogger = Logger.getLogger(DynamicTree2.class.getName());
+ /**
+ * red mark-up && html debug messages
+ */
+ private static Logger redLogger = Logger.getLogger(GFEditor2.class.getName() + "_Red");
+ /**
+ * pop-up/mouse handling debug messages
+ */
+ private static Logger popUpLogger = Logger.getLogger(GFEditor2.class.getName() + "_PopUp");
+ /**
+ * linearization marking debug messages
+ */
+ private static Logger linMarkingLogger = Logger.getLogger(GFEditor2.class.getName() + "_LinMarking");
+ /**
+ * keyPressedEvents & Co.
+ */
+ private static Logger keyLogger = Logger.getLogger(GFEditor2.class.getName() + "_key");
+ /**
+ * everything that is sent to GF
+ */
+ private static Logger sendLogger = Logger.getLogger(GFEditor2.class.getName() + ".send");
+ /**
+ * the first part of the name of the GF grammar file
+ */
+ public final static String modelModulName = "FromUMLTypes";
+ /**
+ * Does the saving of constraints in Together.
+ * Or to be more precise, itself knows nothing about Together.
+ * Only its subclasses. That way it can be compiled without KeY.
+ */
+ final private ConstraintCallback callback;
+ /**
+ * if the OCL features should be switched on
+ */
+ final private boolean oclMode;
+
+ /**
+ * does all direct interaction with GF
+ * (except for the probers)
+ */
+ private GfCapsule gfCapsule = null;
+ /**
+ * current Font
+ */
+ private Font font;
+ /**
+ * contains the offered fonts by name
+ */
+ private JMenu fontMenu;
+ /**
+ * offers a list of font sizes
+ */
+ private JMenu sizeMenu;
+
+ /**
+ * what is written here is parsed and the result inserted instead of tbe selection.
+ * No idea how this element is displayed
+ */
+ private JTextField parseField = new JTextField("textField!");
+
+ /**
+ * The position of the focus, that is, the currently selected node in the AST
+ */
+ private LinPosition focusPosition ;
+ /**
+ * When a new category is chosen, it is set to true.
+ * In the reset or a completely new state it is falsed.
+ * The structure of the GF output is different then and this must be taken
+ * care of.
+ */
+ private boolean newObject = false;
+ /**
+ * if the user enters text for the alpha conversion, he perhaps wants to input the same text again.
+ * Therefore it is saved.
+ */
+ private String alphaInput = "";
+ /**
+ * if a user sends a custom command to GF, he might want to do this
+ * again with the same command.
+ * Therefore it is saved.
+ */
+ private String commandInput = "";
+
+ /**
+ * default status text, just status
+ */
+ private final static String status = "status";
+ /**
+ * the language the possible actions are displayed
+ */
+ private String selectedMenuLanguage = "Abstract";
+ /**
+ * write-only variable, stores the current import paths
+ * reset after each reset.
+ */
+ private String fileString = "";
+ /**
+ * The mapping between Java tree pathes and GF AST positions
+ * is stored here.
+ */
+ private Hashtable nodeTable = new Hashtable();
+ /**
+ * This is necessary to map clicks in the tree, where in the event handler
+ * only the selection path is availble, to AST positions which can be
+ * sent to GF.
+ * @param key The TreeSelectionPath, that identifies the wanted node
+ * @return The AST position string of the given TreePath in the table
+ * of stored nodes.
+ */
+ protected String getNodePosition(Object key) {
+ return nodeTable.get(key).toString();
+ }
+ /**
+ * this FileChooser gets enriched with the Term/Text option
+ */
+ private JFileChooser saveFc = new JFileChooser("./");
+ /** used for new Topic, Import and Browse (readDialog) */
+ private JFileChooser fc = new JFileChooser("./");
+ private final static String [] modifyMenu = {"Modify", "identity","transfer",
+ "compute", "paraphrase", "generate","typecheck", "solve", "context" };
+ private static final String [] newMenu = {"New"};
+
+ /**
+ * Linearizations' display area
+ */
+ private JTextArea linearizationArea = new JTextArea();
+ /**
+ * The abstract syntax tree representation of the current editing object
+ */
+ private DynamicTree2 tree = new DynamicTree2(this);
+
+ /**
+ * Current Topic
+ */
+ private JLabel grammar = new JLabel("No topic ");
+ /**
+ * Writing the current editing object to file in the term or text
+ * format
+ */
+ private JButton save = new JButton("Save");
+ /**
+ * Reading both a new environment and an editing object from file.
+ * Current editing will be discarded
+ */
+ private JButton open = new JButton("Open");
+ /**
+ * Reading a new environment from file. Current editing will be
+ * discarded.
+ */
+ private JButton newTopic;
+ /** Sending a command to GF */
+ private JButton gfCommand;
+
+ /** Moving the focus to the previous metavariable */
+ private JButton leftMeta = new JButton("?<");
+ /** Moving the focus to the previous term */
+ private JButton left = new JButton("<");
+ /** Moving the focus to the top term */
+ private JButton top = new JButton("Top");
+ /** Moving the focus to the next term */
+ private JButton right = new JButton(">");
+ /** Moving the focus to the next metavariable */
+ private JButton rightMeta = new JButton(">?");
+ private final static String actionOnSubtermString = "Select Action on Subterm";
+ private JLabel subtermNameLabel = new JLabel();
+ private JLabel subtermDescLabel = new JLabel();
+ /** Refining with term or linearization from typed string or file */
+ private JButton read = new JButton("Read");
+ /** Performing alpha-conversion of bound variables */
+ private JButton alpha;
+ /** Generating random refinement */
+ private JButton random;
+ /** Going back to the previous state */
+ private JButton undo;
+ /** The main panel on which the others are put */
+ private JPanel coverPanel = new JPanel();
+ /** the dialog to read in Strings or Terms */
+ private ReadDialog readDialog;
+
+ /** The list of available categories to start editing */
+ private JComboBox newCategoryMenu = new JComboBox(newMenu);
+ /** Choosing a linearization method */
+ private JComboBox modify = new JComboBox(modifyMenu);
+ /** the panel with the more general command buttons */
+ private JPanel downPanel = new JPanel();
+ /** the splitpane containing tree on the left and linearization area on the right*/
+ private JSplitPane treePanel;
+ /** the upper button bar for New, Save */
+ private JPanel upPanel = new JPanel();
+ /** the panel that contains the navigation buttons and some explanatory text */
+ private JPanel middlePanel = new JPanel();
+ /** the panel that contains only the navigation buttons */
+ private JPanel middlePanelUp = new JPanel();
+ /** the panel that vontains the the explanatory text for the refinement menu */
+ private JPanel middlePanelDown = new JPanel(new BorderLayout());
+ /** splits between tree and lin above and nav buttons and refinements below */
+ private JSplitPane centerPanel;
+ /** the window that contains the refinements when in split mode */
+ private JFrame gui2 = new JFrame();
+ /** the main window with tree, lin and buttons when in split mode */
+ private JPanel centerPanel2= new JPanel();
+ /** contains refinment list and navigation buttons */
+ private JPanel centerPanelDown = new JPanel();
+ /** only contains the linearization area */
+ private JScrollPane outputPanelText = new JScrollPane(this.linearizationArea);
+ /** HTML Linearizations' display area */
+ private JTextPane htmlLinPane = new JTextPane();
+ /** only contains the HTML linearization area */
+ private JScrollPane outputPanelHtml = new JScrollPane(this.htmlLinPane);
+ /** contains both pure text and HTML areas */
+ private JSplitPane linSplitPane;
+ /** contains the linSplitPane and the status field below it */
+ private JPanel outputPanelUp = new JPanel(new BorderLayout());
+ /** contains statusLabel */
+ private JPanel statusPanel = new JPanel();
+ /** The type the currently focused term has */
+ private JLabel statusLabel = new JLabel(status);
+ /** the main menu in the top */
+ private JMenuBar menuBar= new JMenuBar();
+ /** View settings */
+ private JMenu viewMenu= new JMenu("View");
+ /**
+ * stores a list of all languages + abstract to select the language,
+ * in which the selectMenu will be filled.
+ */
+ private JMenu mlMenu= new JMenu("language");
+ /** Choosing the refinement options' representation */
+ private JMenu modeMenu= new JMenu("Menus");
+ /** Language settings */
+ private JMenu langMenu= new JMenu("Languages");
+ /** Main operations */
+ private JMenu fileMenu= new JMenu("File");
+ /** stores whether the refinement list should be in 'long' format */
+ private JRadioButtonMenuItem rbMenuItemLong;
+ /** stores whether the refinement list should be in 'short' format */
+ private JRadioButtonMenuItem rbMenuItemShort;
+ /** stores whether the refinement list should be in 'untyped' format */
+ private JRadioButtonMenuItem rbMenuItemUnTyped;
+ /**
+ * linked to rbMenuItemUnTyped.
+ * Is true if type information should be appended in the refinement menu
+ */
+ private boolean typedMenuItems = false;
+ /** stores whether the AST is visible or not */
+ private JCheckBoxMenuItem treeCbMenuItem;
+ /** in the save dialog whether to save as a Term or as linearized Text */
+ private ButtonGroup saveTypeGroup = new ButtonGroup();
+ /** the entries of the filter menu */
+ private final static String [] filterMenuContents = {"identity",
+ "erase", "take100", "text", "code", "latexfile",
+ "structured", "unstructured" };
+ /** Choosing the linearization representation format */
+ private JMenu filterMenu = new JMenu("Filter");
+ /** for managing the filter menu entries*/
+ private ButtonGroup filterButtonGroup = new ButtonGroup();
+
+ /** Some usability things can be switched off here for testing */
+ private JMenu usabilityMenu= new JMenu("Usability");
+ /**
+ * stores whether self and result should only be made visible
+ * if applicable
+ */
+ private JCheckBoxMenuItem selfresultCbMenuItem;
+ /** to switch grouping of entries in the refinement menu on and off */
+ private JCheckBoxMenuItem subcatCbMenuItem;
+ /** to switch sorting of entries in the refinement menu on and off */
+ private JCheckBoxMenuItem sortCbMenuItem;
+ /** to switch autocoercing */
+ private JCheckBoxMenuItem coerceCbMenuItem;
+ /** to switch reducing the argument 3 refinement menu of coerce on or off */
+ private JCheckBoxMenuItem coerceReduceCbMenuItem;
+ /** to switch highlighting subtyping errors on or off */
+ private JCheckBoxMenuItem highlightSubtypingErrorsCbMenuItem;
+ /** to switch hiding coerce on or off */
+ private JCheckBoxMenuItem hideCoerceCbMenuItem;
+ /** to switch hiding coerce even if parts are unrefined on or off */
+ private JCheckBoxMenuItem hideCoerceAggressiveCbMenuItem;
+ /** to switch the attributes of self in the refinement menu on or off */
+ private JCheckBoxMenuItem easyAttributesCbMenuItem;
+
+ /**
+ * if true, self and result are only shown if applicable,
+ * tied to @see selfresultCbMenuItem
+ */
+ private boolean showSelfResult = true;
+ /**
+ * if true, refinements are grouped by subcat
+ * tied to @see subcatCbMenuItem.
+ */
+ private boolean groupSubcat = true;
+ /**
+ * @return Returns whether subcategories should be grouped or not
+ */
+ protected boolean isGroupSubcat() {
+ return groupSubcat;
+ }
+ /**
+ * if true, refinements are grouped by subcat.
+ * tied to @see subcatCbMenuItem.
+ */
+ private boolean sortRefinements = true;
+ /**
+ * @return Returns if the refinements should get sorted.
+ */
+ protected boolean isSortRefinements() {
+ return sortRefinements;
+ }
+ /**
+ * if true, then Instances will automatically get wrapped with a coerce
+ * if encountered as meta in the active node
+ */
+ private boolean autoCoerce = false;
+ /**
+ * If this is true, the refinementmenu for argument 3 of coerce
+ * will be populated only with suiting refinements.
+ */
+ private boolean coerceReduceRM = false;
+ /**
+ * If true, then the AST will be checked for missing subtyping witnesses
+ */
+ private boolean highlightSubtypingErrors = false;
+ /**
+ * if true, filled in coercions will be hidden from the user
+ */
+ private boolean hideCoerce = false;
+ /**
+ * if true, filled in coercions will be hidden from the user
+ * even if they lack filled in type arguments
+ */
+ private boolean hideCoerceAggressive = false;
+ /**
+ * offer the attributes of self directly in the refinement menu
+ */
+ private boolean easyAttributes = false;
+
+
+ /**
+ * handles all the Printname naming and so on.
+ */
+ private PrintnameManager printnameManager;
+ /**
+ * @return Returns the printnameManager.
+ */
+ protected PrintnameManager getPrintnameManager() {
+ return printnameManager;
+ }
+
+
+ /**
+ * stores the current type. Since the parsing often fails, this is
+ * most often null, except for Int and String, which can be parsed.
+ */
+ private GfAstNode currentNode = null;
+ /** stores the displayed parts of the linearization */
+ private Display display = new Display(3);
+
+ /** takes care of the menus that display the available languages */
+ private LangMenuModel langMenuModel = new LangMenuModel();
+
+ //Now the stuff for choosing the wanted output type (pure text or HTML)
+ /**
+ * 1 for text, 2 for HTML, 3 for both
+ */
+ private int displayType = 1;
+ /**
+ * rbText, rbHtml and rbTextHtml are grouped here.
+ */
+ private ButtonGroup bgDisplayType = new ButtonGroup();
+ /**
+ * The button that switches the linearization view to text only
+ */
+ private JRadioButtonMenuItem rbText = new JRadioButtonMenuItem(new AbstractAction("pure text") {
+ public void actionPerformed(ActionEvent ae) {
+ int oldDisplayType = displayType;
+ displayType = 1;
+ display.setDisplayType(displayType);
+ outputPanelUp.removeAll();
+ outputPanelUp.add(outputPanelText, BorderLayout.CENTER);
+ outputPanelUp.add(statusPanel, BorderLayout.SOUTH);
+ if (ae != null && oldDisplayType == 2) { //not manually called in the beginning and only HTML
+ formLin();
+ }
+ outputPanelUp.validate();
+ }
+ });
+ /**
+ * The button that switches the linearization view to HTML only
+ */
+ private JRadioButtonMenuItem rbHtml = new JRadioButtonMenuItem(new AbstractAction("HTML") {
+ public void actionPerformed(ActionEvent ae) {
+ int oldDisplayType = displayType;
+ displayType = 2;
+ display.setDisplayType(displayType);
+ outputPanelUp.removeAll();
+ outputPanelUp.add(outputPanelHtml, BorderLayout.CENTER);
+ outputPanelUp.add(statusPanel, BorderLayout.SOUTH);
+ if (ae != null && oldDisplayType == 1) { //not manually called in the beginning and only text
+ formLin();
+ }
+ outputPanelUp.validate();
+ }
+ });
+ /**
+ * The button that switches the linearization view to both text and
+ * HTML separated with a JSplitpane
+ */
+ private JRadioButtonMenuItem rbTextHtml = new JRadioButtonMenuItem(new AbstractAction("text and HTML") {
+ public void actionPerformed(ActionEvent ae) {
+ int oldDisplayType = displayType;
+ displayType = 3;
+ display.setDisplayType(displayType);
+ linSplitPane.setLeftComponent(outputPanelText);
+ linSplitPane.setRightComponent(outputPanelHtml);
+ outputPanelUp.removeAll();
+ outputPanelUp.add(linSplitPane, BorderLayout.CENTER);
+ outputPanelUp.add(statusPanel, BorderLayout.SOUTH);
+ if (ae != null && oldDisplayType != 3) { //not manually called in the beginning and not both (the latter should always be true)
+ formLin();
+ }
+ outputPanelUp.validate();
+ }
+ });
+
+ /**
+ * Since the user will be able to send chain commands to GF,
+ * the editor has to keep track of them, since GF does not undo
+ * all parts with one undo, instead 'u n' with n as the number of
+ * individual commands, has to be sent.
+ */
+ private final Stack undoStack = new Stack();
+
+ /**
+ * for starting a SubtypingProber run
+ */
+ private JButton checkSubtyping;
+
+ /**
+ * handles the commands and how they are presented to the user
+ */
+ private RefinementMenu refinementMenu;
+ /**
+ * handles parsing and preparing for display
+ * of the linearization XML from GF.
+ * Also takes care of the click-in functionality.
+ */
+ private Linearization linearization;
+
+ /**
+ * Initializes GF with the given command, sets up the GUI
+ * and reads the first GF output
+ * @param gfcmd The command with all parameters, including -java
+ * that is to be executed. Will set up the GF side of this session.
+ * @param isHtml true iff the editor should start in HTML mode.
+ * @param baseURL the URL that is the base for all relative links in HTML
+ * @param isOcl if the OCL special features should be available
+ */
+ public GFEditor2(String gfcmd, boolean isHtml, URL baseURL, boolean isOcl) {
+ this.callback = null;
+ this.oclMode = isOcl;
+ Image icon = null;
+ try {
+ final URL iconURL = ClassLoader.getSystemResource("gf-icon.gif");
+ icon = Toolkit.getDefaultToolkit().getImage(iconURL);
+ } catch (NullPointerException npe) {
+ logger.info("gf-icon.gif could not be found.\n" + npe.getLocalizedMessage());
+ }
+ initializeGUI(baseURL, isHtml, icon);
+ initializeGF(gfcmd, null);
+ }
+
+ /**
+ * a specialized constructor for OCL comstraints
+ * Starts with a new Constraint and an initial syntax tree
+ * @param gfcmd The command with all parameters, including -java
+ * that is to be executed. Will set up the GF side of this session.
+ * @param callback The class responsible for saving the OCL constraint
+ * as a JavaDoc comment
+ * @param initAbs the initial abstract syntax tree
+ * @param pm to monitor the loading progress. May be null
+ */
+ public GFEditor2(String gfcmd, ConstraintCallback callback, String initAbs, ProgressMonitor pm) {
+ this.oclMode = true;
+ this.callback = callback;
+
+ Utils.tickProgress(pm, 5220, "Loading grammars");
+ initializeGF(gfcmd, pm);
+ Utils.tickProgress(pm, 9350, "Initializing GUI");
+ initializeGUI(null, true, null);
+
+ // send correct term (syntax tree)
+ //The initial GF constraint has until now always been
+ //automatically solvable. So don't startle the user
+ //with painting everything red.
+ send(initAbs + " ;; c solve ", false, 2);
+ processGfedit();
+ Utils.tickProgress(pm, 9700, "Loading finished");
+ pm.close();
+ logger.finer("GFEditor2 constructor finished");
+ }
+
+ /**
+ * Starts GF and sets up the reading facilities.
+ * Shouldn't be called twice.
+ * @param gfcmd The command for GF to be executed.
+ * expects the -java parameters and all grammar modules
+ * to be specified. Simply executes this command without any
+ * modifications.
+ * @param pm to monitor the loading progress. May be null
+ */
+ private void initializeGF(String gfcmd, ProgressMonitor pm){
+ Utils.tickProgress(pm, 5250, "Starting GF");
+ logger.fine("Trying: "+gfcmd);
+ gfCapsule = new GfCapsule(gfcmd);
+ processInit(pm, true);
+ resetPrintnames(false);
+ }
+
+ /**
+ * (re-)initializes this.printnameManager and loads the printnames from
+ * GF.
+ * @param replayState If GF should be called to give the same state as before,
+ * but without the message. Is needed, when this function is started by the user.
+ * If sth. else is sent to GF automatically, this is not needed.
+ */
+ private void resetPrintnames(boolean replayState) {
+ this.printnameManager = new PrintnameManager();
+ PrintnameLoader pl = new PrintnameLoader(gfCapsule, this.printnameManager, this.typedMenuItems);
+ if (!selectedMenuLanguage.equals("Abstract")) {
+ String sendString = selectedMenuLanguage;
+ pl.readPrintnames(sendString);
+ //empty GF command, clears the message, so that the printnames
+ //are not printed again when for example a 'ml' command comes
+ //next
+ if (replayState) {
+ send("gf ", true, 0);
+ }
+ }
+ }
+ /**
+ * reliefs the constructor from setting up the GUI stuff
+ * @param baseURL the base URL for relative links in the HTML view
+ * @param showHtml if the linearization area for HTML should be active
+ * instead of the pure text version
+ * @param icon The icon in the title bar of the main window.
+ * For KeY-usage, no icon is given and the Swing default is chosen
+ * instead.
+ */
+ private void initializeGUI(URL baseURL, boolean showHtml, Image icon) {
+ refinementMenu = new RefinementMenu(this);
+ this.setDefaultCloseOperation(DO_NOTHING_ON_CLOSE);
+ this.addWindowListener(new WindowAdapter() {
+ public void windowClosing(WindowEvent e) {
+ endProgram();
+ }
+ });
+ setIconImage(icon);
+ this.readDialog = new ReadDialog(this);
+
+ //Add listener to components that can bring up popup menus.
+ MouseListener popupListener2 = new PopupListener();
+ linearizationArea.addMouseListener(popupListener2);
+ htmlLinPane.addMouseListener(popupListener2);
+
+ //now for the menus
+
+ setJMenuBar(menuBar);
+ setTitle("GF Syntax Editor");
+ viewMenu.setToolTipText("View settings");
+ fileMenu.setToolTipText("Main operations");
+ langMenu.setToolTipText("Language settings");
+ usabilityMenu.setToolTipText("Usability settings");
+ menuBar.add(fileMenu);
+ menuBar.add(langMenu);
+ menuBar.add(viewMenu);
+ menuBar.add(modeMenu);
+ menuBar.add(usabilityMenu);
+ modeMenu.setToolTipText("Choosing the refinement options' representation");
+
+ /**
+ * listens to the showTree JCheckBoxMenuItem and
+ * switches displaying the AST on or off
+ */
+ final ActionListener showTreeListener = new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ if (!((JCheckBoxMenuItem)e.getSource()).isSelected()){
+ if (logger.isLoggable(Level.FINER)) logger.finer("showTree was selected");
+ treeCbMenuItem.setSelected(false);
+ if (((JRadioButtonMenuItem)viewMenu.getItem(2)).isSelected()) {
+ centerPanel.remove(treePanel);
+ centerPanel.setLeftComponent(outputPanelUp);
+ }
+ else {
+ centerPanel2.remove(treePanel);
+ centerPanel2.add(outputPanelUp, BorderLayout.CENTER);
+ }
+ }
+ else {
+ if (logger.isLoggable(Level.FINER)) logger.finer("showTree was not selected");
+ treeCbMenuItem.setSelected(true);
+ if (((JRadioButtonMenuItem)viewMenu.getItem(2)).isSelected()) {
+ centerPanel.remove(outputPanelUp);
+ treePanel.setRightComponent(outputPanelUp);
+ centerPanel.setLeftComponent(treePanel);
+ }
+ else {
+ centerPanel2.remove(outputPanelUp);
+ treePanel.setRightComponent(outputPanelUp);
+ centerPanel2.add(treePanel, BorderLayout.CENTER);
+ }
+ }
+ pack();
+ repaint();
+ }
+
+ };
+
+ treeCbMenuItem = new JCheckBoxMenuItem("Tree");
+ treeCbMenuItem.setActionCommand("showTree");
+ treeCbMenuItem.addActionListener(showTreeListener);
+ treeCbMenuItem.setSelected(true);
+
+ viewMenu.add(treeCbMenuItem);
+ viewMenu.addSeparator();
+
+ final Action saveAction = new SaveAction();
+ final Action openAction = new OpenAction();
+ final Action newTopicAction = new NewTopicAction();
+ final Action resetAction = new ResetAction();
+ final Action quitAction = new QuitAction();
+ final Action undoAction = new UndoAction();
+ final Action randomAction = new RandomAction();
+ final Action alphaAction = new AlphaAction();
+ final Action gfCommandAction = new GfCommandAction();
+ final Action readAction = new ReadAction();
+ final Action splitAction = new SplitAction();
+ final Action combineAction = new CombineAction();
+
+ JMenuItem fileMenuItem = new JMenuItem(openAction);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem(newTopicAction);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem(resetAction);
+ fileMenu.add(fileMenuItem);
+ fileMenuItem = new JMenuItem(saveAction);
+ fileMenu.add(fileMenuItem);
+ fileMenu.addSeparator();
+ fileMenuItem = new JMenuItem(quitAction);
+ fileMenu.add(fileMenuItem);
+
+ JRadioButtonMenuItem rbMenuItem = new JRadioButtonMenuItem(combineAction);
+ rbMenuItem.setSelected(true);
+ /* rbMenuItem.setMnemonic(KeyEvent.VK_R);
+ rbMenuItem.setAccelerator(KeyStroke.getKeyStroke(
+ KeyEvent.VK_1, ActionEvent.ALT_MASK));
+ rbMenuItem.getAccessibleContext().setAccessibleDescription(
+ "This doesn't really do anything");
+ */
+ ButtonGroup menuGroup = new ButtonGroup();
+ menuGroup.add(rbMenuItem);
+ viewMenu.add(rbMenuItem);
+
+ rbMenuItem = new JRadioButtonMenuItem(splitAction);
+ menuGroup.add(rbMenuItem);
+ viewMenu.add(rbMenuItem);
+
+ //Font stuff
+ final int DEFAULT_FONT_SIZE = 14;
+ GraphicsEnvironment gEnv = GraphicsEnvironment.getLocalGraphicsEnvironment();
+ /** The list of font names our environment offers us */
+ String[] envfonts = gEnv.getAvailableFontFamilyNames();
+
+ /** the list of fonts the environment offers us */
+ Font[] fontObjs = new Font[envfonts.length];
+ for (int fi = 0; fi < envfonts.length; fi++) {
+ fontObjs[fi] = new Font(envfonts[fi], Font.PLAIN,
+ DEFAULT_FONT_SIZE);
+ }
+ font = new Font(null, Font.PLAIN, DEFAULT_FONT_SIZE);
+ //font menus
+ viewMenu.addSeparator();
+ fontMenu = new JMenu("Font");
+ fontMenu.setToolTipText("Change font");
+ sizeMenu = new JMenu("Font Size");
+ sizeMenu.setToolTipText("Change font size");
+ viewMenu.add(sizeMenu);
+ viewMenu.add(fontMenu);
+
+ {
+ JMenuItem fontItem;
+ ActionListener fontListener = new ActionListener(){
+ public void actionPerformed(ActionEvent ae) {
+ try {
+ JMenuItem source = (JMenuItem)ae.getSource();
+ font = new Font(source.getText(), Font.PLAIN, font.getSize());
+ fontEveryWhere(font);
+ } catch (ClassCastException e) {
+ logger.warning("Font change started on strange object\n" + e.getLocalizedMessage());
+ }
+ }
+ };
+ for (int i = 0; i < envfonts.length; i++) {
+ fontItem = new JMenuItem(envfonts[i]);
+ fontItem.addActionListener(fontListener);
+ fontItem.setFont(new Font(envfonts[i], Font.PLAIN, font.getSize()));
+ fontMenu.add(fontItem);
+ }
+ }
+ {
+ JMenuItem sizeItem;
+ ActionListener sizeListener = new ActionListener(){
+ public void actionPerformed(ActionEvent ae) {
+ try {
+ JMenuItem source = (JMenuItem)ae.getSource();
+ font = new Font(font.getFontName(), Font.PLAIN, Integer.parseInt(source.getText()));
+ fontEveryWhere(font);
+ } catch (ClassCastException e) {
+ logger.warning("Font change started on strange object\n" + e.getLocalizedMessage());
+ } catch (NumberFormatException e) {
+ logger.warning("strange size entry\n" + e.getLocalizedMessage());
+ }
+ }
+ };
+ /** The list of offered font sizes */
+ int[] sizes = {14,18,22,26,30};
+ for (int i = 0; i < sizes.length; i++) {
+ sizeItem = new JMenuItem("" + sizes[i]);
+ sizeItem.addActionListener(sizeListener);
+ sizeMenu.add(sizeItem);
+ }
+ }
+ //font stuff over
+
+ filterMenu.setToolTipText("Choosing the linearization representation format");
+ {
+ ActionListener filterActionListener = new ActionListener() {
+ public void actionPerformed(ActionEvent ae) {
+ JMenuItem jmi = (JMenuItem)ae.getSource();
+ final String sendString = "f " + jmi.getActionCommand();
+ send(sendString);
+ }
+ };
+ JRadioButtonMenuItem jrbmi;
+ for (int i = 0; i < filterMenuContents.length; i++) {
+ jrbmi = new JRadioButtonMenuItem(filterMenuContents[i]);
+ jrbmi.setActionCommand(filterMenuContents[i]);
+ jrbmi.addActionListener(filterActionListener);
+ filterButtonGroup.add(jrbmi);
+ filterMenu.add(jrbmi);
+ }
+ }
+ viewMenu.addSeparator();
+ viewMenu.add(filterMenu);
+
+ mlMenu.setToolTipText("the language of the entries in the refinement menu");
+ modeMenu.add(mlMenu);
+ /**
+ * switches GF to either display the refinement menu commands
+ * either in long or short format
+ */
+ final ActionListener longShortListener = new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ String action = e.getActionCommand();
+ if ((action.equals("long")) || (action.equals("short"))) {
+ send("ms " + action);
+ return;
+ } else {
+ logger.warning("RadioListener on wrong object: " + action + "should either be 'typed' or 'untyped'");
+ }
+ }
+ };
+
+ modeMenu.addSeparator();
+ menuGroup = new ButtonGroup();
+ rbMenuItemLong = new JRadioButtonMenuItem("long");
+ rbMenuItemLong.setToolTipText("long format in the refinement menu, e.g. 'refine' instead of 'r'");
+ rbMenuItemLong.setActionCommand("long");
+ rbMenuItemLong.addActionListener(longShortListener);
+ menuGroup.add(rbMenuItemLong);
+ modeMenu.add(rbMenuItemLong);
+ rbMenuItemShort = new JRadioButtonMenuItem("short");
+ rbMenuItemShort.setToolTipText("short format in the refinement menu, e.g. 'r' instead of 'refine'");
+ rbMenuItemShort.setActionCommand("short");
+ rbMenuItemShort.setSelected(true);
+ rbMenuItemShort.addActionListener(longShortListener);
+ menuGroup.add(rbMenuItemShort);
+ modeMenu.add(rbMenuItemShort);
+ modeMenu.addSeparator();
+
+ /**
+ * switches GF to either display the refinement menu with or
+ * without type annotation ala " : Type"
+ */
+ final ActionListener unTypedListener = new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ String action = e.getActionCommand();
+ if ((action.equals("typed")) || (action.equals("untyped"))) {
+ send("mt " + action);
+ if ((action.equals("typed"))) {
+ typedMenuItems = true;
+ } else {
+ typedMenuItems = false;
+ }
+ resetPrintnames(true);
+ return;
+ } else {
+ logger.warning("RadioListener on wrong object: " + action + "should either be 'typed' or 'untyped'");
+ }
+ }
+ };
+ menuGroup = new ButtonGroup();
+ rbMenuItem = new JRadioButtonMenuItem("typed");
+ rbMenuItem.setToolTipText("append the respective types to the entries of the refinement menu");
+ rbMenuItem.setActionCommand("typed");
+ rbMenuItem.addActionListener(unTypedListener);
+ rbMenuItem.setSelected(false);
+ menuGroup.add(rbMenuItem);
+ modeMenu.add(rbMenuItem);
+ rbMenuItemUnTyped = new JRadioButtonMenuItem("untyped");
+ rbMenuItemUnTyped.setToolTipText("omit the types of the entries of the refinement menu");
+ rbMenuItemUnTyped.setSelected(true);
+ rbMenuItemUnTyped.setActionCommand("untyped");
+ rbMenuItemUnTyped.addActionListener(unTypedListener);
+ menuGroup.add(rbMenuItemUnTyped);
+ modeMenu.add(rbMenuItemUnTyped);
+
+
+ //usability menu
+ subcatCbMenuItem = new JCheckBoxMenuItem("group possible refinements");
+ subcatCbMenuItem.setActionCommand("subcat");
+ subcatCbMenuItem.setToolTipText("group the entries of the refinement menus as defined in the printnames for the selected menu language");
+ subcatCbMenuItem.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ groupSubcat = subcatCbMenuItem.isSelected();
+ send("gf");
+ }
+ });
+ subcatCbMenuItem.setSelected(groupSubcat);
+ usabilityMenu.add(subcatCbMenuItem);
+
+ sortCbMenuItem = new JCheckBoxMenuItem("sort refinements");
+ sortCbMenuItem.setActionCommand("sortRefinements");
+ sortCbMenuItem.setToolTipText("sort the entries of the refinement menu");
+ sortCbMenuItem.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ sortRefinements = sortCbMenuItem.isSelected();
+ send("gf");
+ }
+ });
+ sortCbMenuItem.setSelected(sortRefinements);
+ usabilityMenu.add(sortCbMenuItem);
+
+ //OCL specific stuff
+
+ if (oclMode) {
+ usabilityMenu.addSeparator();
+ }
+ selfresultCbMenuItem = new JCheckBoxMenuItem("skip self&result if possible");
+ selfresultCbMenuItem.setToolTipText("do not display self and result in the refinement menu, if they don't fit");
+ selfresultCbMenuItem.setActionCommand("selfresult");
+ selfresultCbMenuItem.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ showSelfResult = selfresultCbMenuItem.isSelected();
+ send("gf");
+ }
+ });
+ selfresultCbMenuItem.setSelected(showSelfResult);
+ if (oclMode) {
+ // only visible, if we really do OCL constraints
+ usabilityMenu.add(selfresultCbMenuItem);
+ }
+
+ coerceReduceCbMenuItem = new JCheckBoxMenuItem("only suiting subtype instances for coerce");
+ coerceReduceCbMenuItem.setToolTipText("For coerce, where the target type is already known, show only the functions that return a subtype of this type.");
+ coerceReduceCbMenuItem.setActionCommand("coercereduce");
+ coerceReduceCbMenuItem.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ coerceReduceRM = coerceReduceCbMenuItem.isSelected();
+ }
+ });
+ if (oclMode) {
+ // only visible, if we really do OCL constraints
+ usabilityMenu.add(coerceReduceCbMenuItem);
+ coerceReduceRM = true;
+ }
+ coerceReduceCbMenuItem.setSelected(coerceReduceRM);
+
+ coerceCbMenuItem = new JCheckBoxMenuItem("coerce automatically");
+ coerceCbMenuItem.setToolTipText("Fill in coerce automatically where applicable");
+ coerceCbMenuItem.setActionCommand("autocoerce");
+ coerceCbMenuItem.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ autoCoerce = coerceCbMenuItem.isSelected();
+ }
+ });
+ if (oclMode) {
+ // only visible, if we really do OCL constraints
+ usabilityMenu.add(coerceCbMenuItem);
+ autoCoerce = true;
+ }
+ coerceCbMenuItem.setSelected(autoCoerce);
+
+ highlightSubtypingErrorsCbMenuItem = new JCheckBoxMenuItem("highlight suptyping errors");
+ highlightSubtypingErrorsCbMenuItem.setToolTipText("Mark nodes in situations, if where a non-existing subtyping is expected.");
+ highlightSubtypingErrorsCbMenuItem.setActionCommand("highlightsubtypingerrors");
+ highlightSubtypingErrorsCbMenuItem.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ highlightSubtypingErrors = highlightSubtypingErrorsCbMenuItem.isSelected();
+ send("[t] gf");
+ }
+ });
+ if (oclMode) {
+ // only visible, if we really do OCL constraints
+ usabilityMenu.add(highlightSubtypingErrorsCbMenuItem);
+ highlightSubtypingErrors = true;
+ }
+ highlightSubtypingErrorsCbMenuItem.setSelected(highlightSubtypingErrors);
+
+ hideCoerceCbMenuItem = new JCheckBoxMenuItem("hide coerce if completely refined");
+ hideCoerceCbMenuItem.setToolTipText("<html>Hide coerce functions when all arguments are filled in.<br>Note that, when a subtyping error is introduced, they will be shown.</html>");
+ hideCoerceCbMenuItem.setActionCommand("hideCoerce");
+ hideCoerceCbMenuItem.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ hideCoerce = hideCoerceCbMenuItem.isSelected();
+ //hideCoerceAggressiveCbMenuItem can only be used,
+ //if hideCoerce is active. But its state should survive.
+ hideCoerceAggressiveCbMenuItem.setEnabled(hideCoerce);
+ if (hideCoerce) {
+ hideCoerceAggressive = hideCoerceAggressiveCbMenuItem.isSelected();
+ } else {
+ hideCoerceAggressive = false;
+ }
+ send("[t] gf ", true, 0);
+ }
+ });
+ if (oclMode) {
+ // only visible, if we really do OCL constraints
+ usabilityMenu.add(hideCoerceCbMenuItem);
+ hideCoerce = true;
+ }
+ hideCoerceCbMenuItem.setSelected(hideCoerce);
+
+
+ hideCoerceAggressiveCbMenuItem = new JCheckBoxMenuItem("hide coerce always");
+ hideCoerceAggressiveCbMenuItem.setActionCommand("hideCoerceAggressive");
+ hideCoerceAggressiveCbMenuItem.setToolTipText("<html>Hide coerce functions even if the type arguments are incomplete.<br>Note that, when a subtyping error is introduced, they will be shown.</html>");
+ hideCoerceAggressiveCbMenuItem.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ hideCoerceAggressive = hideCoerceAggressiveCbMenuItem.isSelected();
+ send("[t] gf ", true, 0);
+ }
+ });
+ if (oclMode) {
+ // only visible, if we really do OCL constraints
+ usabilityMenu.add(hideCoerceAggressiveCbMenuItem);
+ hideCoerceAggressive = true;
+ }
+ hideCoerceAggressiveCbMenuItem.setSelected(hideCoerceAggressive);
+
+
+ easyAttributesCbMenuItem = new JCheckBoxMenuItem("directly offer attributes of 'self'");
+ easyAttributesCbMenuItem.setActionCommand("easyAttributes");
+ easyAttributesCbMenuItem.setToolTipText("list suiting attributes of self directly in the refinement menu");
+ easyAttributesCbMenuItem.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ easyAttributes = easyAttributesCbMenuItem.isSelected();
+ send("[t] gf ", true, 0);
+ }
+ });
+ if (oclMode) {
+ // only visible, if we really do OCL constraints
+ usabilityMenu.add(easyAttributesCbMenuItem);
+ easyAttributes = true;
+ }
+ easyAttributesCbMenuItem.setSelected(easyAttributes);
+
+ //now for the other elements
+
+ //HTML components
+ this.htmlLinPane.setContentType("text/html");
+ this.htmlLinPane.setEditable(false);
+ if (this.htmlLinPane.getStyledDocument() instanceof HTMLDocument) {
+ try {
+ URL base;
+ if (baseURL == null) {
+ base = (new File("./")).toURL();
+ } else {
+ base = baseURL;
+ }
+ if (logger.isLoggable(Level.FINER)) {
+ logger.finer("base for HTML: " + base);
+ }
+ ((HTMLDocument)this.htmlLinPane.getDocument()).setBase(base);
+ } catch (MalformedURLException me) {
+ logger.severe(me.getLocalizedMessage());
+ }
+ } else {
+ logger.warning("No HTMLDocument: " + this.htmlLinPane.getDocument().getClass().getName());
+ }
+ this.htmlLinPane.addCaretListener(new CaretListener() {
+ /**
+ * One can either click on a leaf in the lin area, or select a larger subtree.
+ * The corresponding tree node is selected.
+ */
+ public void caretUpdate(CaretEvent e) {
+ int start = htmlLinPane.getSelectionStart();
+ int end = htmlLinPane.getSelectionEnd();
+ if (popUpLogger.isLoggable(Level.FINER)) {
+ popUpLogger.finer("CARET POSITION: " + htmlLinPane.getCaretPosition()
+ + "\n-> SELECTION START POSITION: "+start
+ + "\n-> SELECTION END POSITION: "+end);
+ }
+ if (linMarkingLogger.isLoggable(Level.FINER)) {
+ if (end > 0 && (end < htmlLinPane.getDocument().getLength())) {
+ try {
+ linMarkingLogger.finer("CHAR: " + htmlLinPane.getDocument().getText(end, 1));
+ } catch (BadLocationException ble) {
+ linMarkingLogger.warning(ble.getLocalizedMessage());
+ }
+ }
+ }
+ // not null selection:
+ if (start < htmlLinPane.getDocument().getLength()) {
+ String position = linearization.markedAreaForPosHtml(start, end);
+ if (position != null) {
+ send("[t] mp " + position);
+ }
+ }//not null selection
+ }
+
+ });
+ this.linSplitPane = new JSplitPane(JSplitPane.HORIZONTAL_SPLIT,
+ this.outputPanelText, outputPanelHtml);
+
+ //cp = getContentPane();
+ JScrollPane cpPanelScroll = new JScrollPane(coverPanel);
+ this.getContentPane().add(cpPanelScroll);
+ coverPanel.setLayout(new BorderLayout());
+ linearizationArea.setToolTipText("Linearizations' display area");
+ linearizationArea.addCaretListener(new CaretListener() {
+ /**
+ * One can either click on a leaf in the lin area, or select a larger subtree.
+ * The corresponding tree node is selected.
+ */
+ public void caretUpdate(CaretEvent e) {
+ int start = linearizationArea.getSelectionStart();
+ int end = linearizationArea.getSelectionEnd();
+ if (popUpLogger.isLoggable(Level.FINER)) {
+ popUpLogger.finer("CARET POSITION: "+linearizationArea.getCaretPosition()
+ + "\n-> SELECTION START POSITION: "+start
+ + "\n-> SELECTION END POSITION: "+end);
+ }
+ final int displayedTextLength = linearizationArea.getText().length();
+ if (linMarkingLogger.isLoggable(Level.FINER)) {
+ if (end>0&&(end<displayedTextLength)) {
+ linMarkingLogger.finer("CHAR: "+linearizationArea.getText().charAt(end));
+ }
+ }
+ // not null selection:
+ if (start < displayedTextLength) { //TODO was -1 before, why?
+ String position = linearization.markedAreaForPosPureText(start, end);
+ if (position != null) {
+ send("[t] mp " + position);
+ }
+ }//not null selection
+ }
+
+ });
+ linearizationArea.setEditable(false);
+ linearizationArea.setLineWrap(true);
+ linearizationArea.setWrapStyleWord(true);
+
+ parseField.setFocusable(true);
+ parseField.addKeyListener(new KeyListener() {
+ /** Handle the key pressed event. */
+ public void keyPressed(KeyEvent e) {
+ int keyCode = e.getKeyCode();
+ if (keyLogger.isLoggable(Level.FINER)) {
+ keyLogger.finer("Key pressed: " + e.toString());
+ }
+
+ if (keyCode == KeyEvent.VK_ENTER) {
+ getLayeredPane().remove(parseField);
+ send("[t] p "+parseField.getText());
+ if (logger.isLoggable(Level.FINE)) logger.fine("sending parse string: "+parseField.getText());
+ repaint();
+ } else if (keyCode == KeyEvent.VK_ESCAPE) {
+ getLayeredPane().remove(parseField);
+ repaint();
+ }
+ }
+
+ /**
+ * Handle the key typed event.
+ * We are not really interested in typed characters, thus empty
+ */
+ public void keyTyped(KeyEvent e) {
+ //needed for KeyListener, but not used
+ }
+
+ /** Handle the key released event. */
+ public void keyReleased(KeyEvent e) {
+ //needed for KeyListener, but not used
+ }
+ });
+ parseField.addFocusListener(new FocusListener() {
+ public void focusGained(FocusEvent e) {
+ //do nothing
+ }
+ public void focusLost(FocusEvent e) {
+ getLayeredPane().remove(parseField);
+ repaint();
+ }
+ });
+ // System.out.println(output.getFont().getFontName());
+
+
+ //Now for the command buttons in the lower part
+ gfCommand = new JButton(gfCommandAction);
+ read = new JButton(readAction);
+ modify.setToolTipText("Choosing a linearization method");
+ alpha = new JButton(alphaAction);
+ random = new JButton(randomAction);
+ undo = new JButton(undoAction);
+ checkSubtyping = new JButton(new SubtypeAction());
+ downPanel.add(gfCommand);
+ downPanel.add(read);
+ downPanel.add(modify);
+ downPanel.add(alpha);
+ downPanel.add(random);
+ downPanel.add(undo);
+ if (oclMode) {
+ // only visible, if we really do OCL constraints
+ downPanel.add(checkSubtyping);
+ }
+
+ //now for the navigation buttons
+ leftMeta.setToolTipText("Moving the focus to the previous metavariable");
+ rightMeta.setToolTipText("Moving the focus to the next metavariable");
+ left.setToolTipText("Moving the focus to the previous term");
+ right.setToolTipText("Moving the focus to the next term");
+ top.setToolTipText("Moving the focus to the top term");
+ middlePanelUp.add(leftMeta);
+ middlePanelUp.add(left);
+ middlePanelUp.add(top);
+ middlePanelUp.add(right);
+ middlePanelUp.add(rightMeta);
+ middlePanelDown.add(subtermNameLabel, BorderLayout.WEST);
+ middlePanelDown.add(subtermDescLabel, BorderLayout.CENTER);
+ middlePanel.setLayout(new BorderLayout());
+ middlePanel.add(middlePanelUp, BorderLayout.NORTH);
+ middlePanel.add(middlePanelDown, BorderLayout.CENTER);
+
+ //now for the upper button bar
+ newTopic = new JButton(newTopicAction);
+ newCategoryMenu.setToolTipText("The list of available categories to start editing");
+ open.setToolTipText("Reading both a new environment and an editing object from file. Current editing will be discarded");
+ save.setToolTipText("Writing the current editing object to file in the term or text format");
+ grammar.setToolTipText("Current Topic");
+ newTopic.setToolTipText("Reading a new environment from file. Current editing will be discarded.");
+ upPanel.add(grammar);
+ upPanel.add(newCategoryMenu);
+ upPanel.add(open);
+ upPanel.add(save);
+ upPanel.add(newTopic);
+
+ statusLabel.setToolTipText("The current focus type");
+
+ tree.setToolTipText("The abstract syntax tree representation of the current editing object");
+ tree.resetTree();
+
+ bgDisplayType.add(rbText);
+ bgDisplayType.add(rbHtml);
+ bgDisplayType.add(rbTextHtml);
+ if (showHtml) {
+ rbHtml.setSelected(true);
+ rbHtml.getAction().actionPerformed(null);
+ } else {
+ rbText.setSelected(true);
+ rbText.getAction().actionPerformed(null);
+ }
+
+ viewMenu.addSeparator();
+ viewMenu.add(rbText);
+ viewMenu.add(rbHtml);
+ viewMenu.add(rbTextHtml);
+ display = new Display(displayType);
+ linearization = new Linearization(display);
+
+ statusPanel.setLayout(new GridLayout(1,1));
+ statusPanel.add(statusLabel);
+ treePanel = new JSplitPane(JSplitPane.HORIZONTAL_SPLIT,
+ tree, outputPanelUp);
+ treePanel.setDividerSize(5);
+ treePanel.setDividerLocation(100);
+ centerPanel2.setLayout(new BorderLayout());
+ gui2.setSize(350,100);
+ gui2.setTitle("Select Action on Subterm");
+ gui2.setLocationRelativeTo(treePanel);
+ centerPanelDown.setLayout(new BorderLayout());
+ centerPanel = new JSplitPane(JSplitPane.VERTICAL_SPLIT,
+ treePanel, centerPanelDown);
+ centerPanel.setDividerSize(5);
+ centerPanel.setDividerLocation(250);
+ centerPanel.addKeyListener(tree);
+ centerPanel.setOneTouchExpandable(true);
+
+
+
+ centerPanelDown.add(middlePanel, BorderLayout.NORTH);
+ centerPanelDown.add(refinementMenu.getRefinementListsContainer(), BorderLayout.CENTER);
+ coverPanel.add(centerPanel, BorderLayout.CENTER);
+ coverPanel.add(upPanel, BorderLayout.NORTH);
+ coverPanel.add(downPanel, BorderLayout.SOUTH);
+
+
+
+ newCategoryMenu.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent ae) {
+ if (!newCategoryMenu.getSelectedItem().equals("New")) {
+ send("[nt] n " + newCategoryMenu.getSelectedItem());
+ newCategoryMenu.setSelectedIndex(0);
+ }
+ }
+
+ });
+ save.setAction(saveAction);
+ open.setAction(openAction);
+
+ newCategoryMenu.setFocusable(false);
+ save.setFocusable(false);
+ open.setFocusable(false);
+ newTopic.setFocusable(false);
+ gfCommand.setFocusable(false);
+
+ leftMeta.setFocusable(false);
+ left.setFocusable(false);
+
+ /** handles the clicking of the navigation buttons */
+ ActionListener naviActionListener = new ActionListener() {
+ /**
+ * convenience method instead of 5 single ones
+ */
+ public void actionPerformed(ActionEvent ae) {
+ Object obj = ae.getSource();
+ if ( obj == leftMeta ) {
+ send("[t] <<");
+ }
+ if ( obj == left ) {
+ send("[t] <");
+ }
+ if ( obj == top ) {
+ send("[t] '");
+ }
+ if ( obj == right ) {
+ send("[t] >");
+ }
+ if ( obj == rightMeta ) {
+ send("[t] >>");
+ }
+ }
+ };
+
+ top.addActionListener(naviActionListener);
+ right.addActionListener(naviActionListener);
+ rightMeta.addActionListener(naviActionListener);
+ leftMeta.addActionListener(naviActionListener);
+ left.addActionListener(naviActionListener);
+ modify.addActionListener(new ActionListener() {
+ public void actionPerformed(ActionEvent ae) {
+ if (!modify.getSelectedItem().equals("Modify")) {
+ send("[t] c " + modify.getSelectedItem());
+ modify.setSelectedIndex(0);
+ }
+ }
+ });
+
+ top.setFocusable(false);
+ right.setFocusable(false);
+ rightMeta.setFocusable(false);
+ read.setFocusable(false);
+ modify.setFocusable(false);
+ alpha.setFocusable(false);
+ random.setFocusable(false);
+ undo.setFocusable(false);
+
+ linearizationArea.addKeyListener(tree);
+ this.setSize(800, 600);
+ outputPanelUp.setPreferredSize(new Dimension(400,230));
+ treePanel.setDividerLocation(0.3);
+ //nodeTable.put(new TreePath(tree.rootNode.getPath()), "");
+
+ JRadioButton termButton = new JRadioButton("Term");
+ termButton.setActionCommand("term");
+ termButton.setSelected(true);
+ JRadioButton linButton = new JRadioButton("Text");
+ linButton.setActionCommand("lin");
+ // Group the radio buttons.
+ saveTypeGroup.add(linButton);
+ saveTypeGroup.add(termButton);
+ JPanel buttonPanel = new JPanel();
+ buttonPanel.setPreferredSize(new Dimension(70, 70));
+ buttonPanel.add(new JLabel("Format:"));
+ buttonPanel.add(linButton);
+ buttonPanel.add(termButton);
+ saveFc.setAccessory(buttonPanel);
+
+ fontEveryWhere(font);
+ this.setVisible(true);
+
+ }
+
+ /**
+ * send a command to GF and reads the returned XML
+ * @param text the command, exacltly the string that is going to be sent
+ */
+ protected void send(String text){
+ send(text, true, 1);
+ }
+
+ /**
+ * send a command to GF (indirectly).
+ * @param text the command, exactly the string that is going to be sent
+ * @param andRead if true, the returned XML will be read an displayed accordingly
+ * @param undoSteps How many undo steps need to be done to undo this command.
+ * If undoSteps == 0, then nothing is done. If it is < 0, it gets
+ * subtracted from the last number on the undoStack. That way, both
+ * this command and the last one get undone together (since the undo
+ * value is actually increased).
+ */
+ protected void send(String text, boolean andRead, int undoSteps) {
+ if (sendLogger.isLoggable(Level.FINE)) {
+ sendLogger.fine("## send: '" + text + "', undo steps: " + undoSteps);
+ }
+
+ this.display.resetLin();
+ display(false, true, false);
+ linearization.reset();
+ if (undoSteps > 0) { //undo itself should not push sth. on the stack, only pop
+ undoStack.push(new Integer(undoSteps));
+ } else if (undoSteps < 0) {
+ final int oldUndo = ((Integer)undoStack.pop()).intValue();
+ final int newUndo = oldUndo - undoSteps;
+ if (sendLogger.isLoggable(Level.FINER)) {
+ sendLogger.finer("modified undoStack, top was " + oldUndo + ", but is now: " + newUndo);
+ }
+ undoStack.push(new Integer(newUndo));
+ }
+ gfCapsule.realSend(text);
+
+ if (andRead) {
+ processGfedit();
+ }
+ }
+
+
+
+ /**
+ * Asks the respective read methods to read the front matter of GF.
+ * That can be the greetings and loading messages.
+ * The latter are always read.
+ * When <gfinit> is read, the function returns.
+ * @param pm to monitor the loading progress. May be null
+ * @param greetingsToo if the greeting text from GF is expected
+ */
+ private void processInit(ProgressMonitor pm, boolean greetingsToo) {
+ String next = null;
+ if (greetingsToo) {
+ StringTuple greetings = gfCapsule.readGfGreetings();
+ next = greetings.first;
+ this.display.addToStages(greetings.second, greetings.second.replaceAll("\\n", "<br>"));
+ display(true, true, false);
+ }
+ Utils.tickProgress(pm, 5300, null);
+ StringTuple loading = gfCapsule.readGfLoading(next, pm);
+ next = loading.first;
+ this.display.addToStages(loading.second, Utils.replaceAll(loading.second, "\n", "<br>\n"));
+ display(true, true, false);
+
+ if (next.equals("<gfinit>")) {
+ processGfinit();
+ }
+ }
+
+
+ /**
+ * Takes care of reading the <gfinit> part
+ * Fills the new category menu.
+ */
+ private void processGfinit() {
+ NewCategoryMenuResult ncmr = gfCapsule.readGfinit();
+ if (ncmr != null) {
+ formNewMenu(ncmr);
+ }
+ }
+
+ /**
+ * Takes care of reading the output from GF starting with
+ * >gfedit< and last reads >/gfedit<.
+ * Feeds the editor with what was read.
+ * This makes this method nearly the central method of the editor.
+ */
+ private void processGfedit() {
+ final GfeditResult gfedit = gfCapsule.readGfedit(newObject);
+ formHmsg(gfedit.hmsg);
+ //now the form methods are called:
+ DefaultMutableTreeNode topNode = null;
+ TreeAnalysisResult tar = new TreeAnalysisResult(null, -1, false, true, false, false, null, null);
+ TreeAnalyser treeAnalyser = new TreeAnalyser(autoCoerce, coerceReduceRM, easyAttributes, hideCoerce, hideCoerceAggressive, highlightSubtypingErrors, showSelfResult);
+ if (gfedit.hmsg.treeChanged && newObject) {
+ topNode = formTree(gfedit.treeString);
+ tar = treeAnalyser.analyseTree(topNode);
+ focusPosition = tar.focusPosition;
+ currentNode = tar.currentNode;
+ }
+ //only sent sth. to GF directly, if we have sth. to send, and if it is not forbidden
+ if (tar.command == null || !gfedit.hmsg.recurse) {
+ //for normal grammars (not the OCL ones),
+ //the nextCommand feature is not used, thus
+ //only this branch is executed.
+
+ // nothing special is to be done here,
+ // the tree analysis has
+ // not told us to send sth. to GF,
+ // so display the rest and do most of the
+ // expensive stuff
+
+ if (topNode != null) { //the case of !treeChanged or !newObject
+ DefaultMutableTreeNode transformedTreeRoot = TreeAnalyser.transformTree(topNode);
+ showTree(tree, transformedTreeRoot);
+ }
+
+
+ if (gfedit.gfCommands != null) {
+ final Vector usedCommandVector = RefinementMenuTransformer.transformRefinementMenu(tar, gfedit.gfCommands, gfCapsule);
+ final boolean isAbstract = "Abstract".equals(selectedMenuLanguage);
+ refinementMenu.formRefinementMenu(usedCommandVector, gfedit.hmsg.appendix, currentNode, isAbstract, tar.easyAttributes && tar.reduceCoerce, focusPosition, gfCapsule);
+ }
+ if (newObject) {
+ //MUST come after readLin, but since formLin is called later on too,
+ //this cannot be enforced with a local this.linearization
+ String linString = gfedit.linearizations;
+ //is set only here, when it is fresh
+ linearization.setLinearization(linString);
+ formLin();
+ }
+ if (gfedit.message != null && gfedit.message.length()>1) {
+ logger.fine("message found: '" + gfedit.message + "'");
+ this.display.addToStages("\n-------------\n" + gfedit.message, "<br><hr>" + gfedit.message);
+ //in case no language is displayed
+ display(true, false, false);
+ }
+ } else {
+ // OK, sth. has to be sent to GF without displaying
+ // the linearization of this run
+ send(tar.command, true, - tar.undoSteps);
+ }
+ refinementMenu.requestFocus();
+ }
+
+ /**
+ * prints the available command line options
+ */
+ private static void printUsage() {
+ System.err.println("Usage: java -jar [-h/--html] [-b/--base baseURL] [-o/--ocl] [grammarfile(s)]");
+ System.err.println("where -h activates the HTML mode");
+ System.err.println("and -b sets the base location to which links in HTML are relative to. "
+ + "Default is the current directory.");
+ }
+
+ /**
+ * starts the editor
+ * @param args only the first parameter is used, it has to be a complete GF command,
+ * which is executed and thus should load the needed grammars
+ */
+ public static void main(String args[]) {
+ //command line parsing
+ CmdLineParser parser = new CmdLineParser();
+ CmdLineParser.Option optHtml = parser.addBooleanOption('h', "html");
+ CmdLineParser.Option optBase = parser.addStringOption('b', "base");
+ CmdLineParser.Option optOcl = parser.addBooleanOption('o', "ocl");
+ CmdLineParser.Option gfBin = parser.addStringOption('g', "gfbin");
+ // Parse the command line options.
+
+ try {
+ parser.parse(args);
+ }
+ catch (CmdLineParser.OptionException e) {
+ System.err.println(e.getMessage());
+ printUsage();
+ System.exit(2);
+ }
+ Boolean isHtml = (Boolean)parser.getOptionValue(optHtml, Boolean.FALSE);
+ String baseString = (String)parser.getOptionValue(optBase, null);
+ String gfBinString = (String)parser.getOptionValue(gfBin, null);
+ Boolean isOcl = (Boolean)parser.getOptionValue(optOcl, Boolean.FALSE);
+ String[] otherArgs = parser.getRemainingArgs();
+
+ URL myBaseURL;
+ if (baseString != null) {
+ try {
+ myBaseURL = new URL(baseString);
+ } catch (MalformedURLException me) {
+ logger.warning(me.getLocalizedMessage());
+ me.printStackTrace();
+ myBaseURL = null;
+ }
+ } else {
+ myBaseURL = null;
+ }
+
+// if (logger.isLoggable(Level.FINER)) {
+// logger.finer(isHtml + " : " + baseString + " : " + otherArgs);
+// }
+ //construct the call to GF
+ String gfCall = ((gfBinString != null && !gfBinString.equals(""))? gfBinString : "gf");
+ gfCall += " -java";
+ for (int i = 0; i < otherArgs.length; i++) {
+ gfCall = gfCall + " " + otherArgs[i];
+ }
+ Locale.setDefault(Locale.US);
+ logger.info("call to GF: " + gfCall);
+ GFEditor2 gui = new GFEditor2(gfCall, isHtml.booleanValue(), myBaseURL, isOcl.booleanValue());
+ if (logger.isLoggable(Level.FINER)) {
+ logger.finer("main finished");
+ }
+ }
+
+ /**
+ * Calls the Java GF GUI to edit an OCL constraint. To be called by GFinterface
+ * @param gfCmd the command to start the GF, must include the -java and all modules
+ * @param callback the callback class that knows how to store the constraints
+ * @param initAbs the initial abstract syntax tree (not OCL)
+ * @param initDefault if initAbs is empty, then initDefault is used
+ * @param pm to monitor the loading progress. May be null
+ */
+ static void mainConstraint(String gfCmd, ConstraintCallback callback, String initAbs, String initDefault, ProgressMonitor pm) {
+ Locale.setDefault(Locale.US);
+ GFEditor2 gui;
+ if (initAbs.equals("")) {
+ gui = new GFEditor2(gfCmd, callback, "[ctn] g " + initDefault, pm);
+ } else {
+ gui = new GFEditor2(gfCmd, callback, "[ctn] g " + initAbs, pm);
+ }
+
+ }
+
+
+ /**
+ * we should not end the program, just close the GF editor
+ * possibly sending something back to KeY
+ */
+ private void endProgram(){
+ String saveQuestion;
+ if (this.callback == null) {
+ saveQuestion = "Save text before exiting?";
+ } else {
+ send("' ;; >>");
+ if (this.currentNode.isMeta()) {
+ saveQuestion = "Incomplete OCL found.\nThis can only be saved (and loaded again) in an internal representation.\nStill save before exiting?";
+ } else {
+ saveQuestion = "Save constraint before exiting?";
+ }
+ }
+ int returnStatus;
+ if (this.newObject) {
+ returnStatus = JOptionPane.showConfirmDialog(this, saveQuestion, "Save before quitting?", JOptionPane.YES_NO_CANCEL_OPTION, JOptionPane.QUESTION_MESSAGE );
+ } else {
+ returnStatus = JOptionPane.NO_OPTION;
+ }
+ if (returnStatus == JOptionPane.CANCEL_OPTION) {
+ return;
+ } else if (returnStatus == JOptionPane.NO_OPTION) {
+ shutDown();
+ return;
+ }
+ if (this.callback != null) {
+ try {
+ // quit should always work even if we cannot send something proper
+ // back to Together/KeY.
+ // Hence this try-catch
+ if (returnStatus == JOptionPane.YES_OPTION) {
+ //check, if there are open metavariables
+ //send("' ;; >>"); already done above
+ if (!this.currentNode.isMeta()) {
+ logger.info("No metavariables found, saving OCL");
+ //no open nodes, we can save OCL
+ String ocl = (String)linearization.getLinearizations().get(modelModulName + "OCL");
+ if (ocl == null) {
+ //OCL not present, so switch it on
+ langMenuModel.setActive(modelModulName + "OCL", true);
+ send("on " + modelModulName + "OCL");
+ ocl = (String)linearization.getLinearizations().get(modelModulName + "OCL");
+ }
+ ocl = Utils.compactSpaces(ocl.trim()).trim();
+
+ this.callback.sendConstraint(ocl);
+ } else {
+ logger.info("Metavariables found, saving AST");
+ //Abstract is always present
+ String abs = (String)linearization.getLinearizations().get("Abstract");
+ //then remove duplicate white space
+ abs = removeMetavariableNumbers(abs).replaceAll("\\s+", " ").trim();
+ this.callback.sendAbstract(abs);
+ }
+
+ }
+ } catch (Exception e) { // just print information about the exception
+ System.err.println("GFEditor2.endProgram() Caught an Exception.");
+ System.err.println("e.getLocalizedMessage(): " + e.getLocalizedMessage());
+ System.err.println("e.toString(): " + e);
+ System.err.println("e.printStackTrace():");
+ e.printStackTrace(System.err);
+ } finally {
+ if (this.callback != null) { // send linearization as a class invariant
+ Utils.cleanupFromUMLTypes(callback.getGrammarsDir());
+ }
+ shutDown();
+ }
+ } else if (returnStatus == JOptionPane.YES_OPTION) {
+ final Action saveAction = new SaveAction();
+ saveAction.actionPerformed(null);
+ shutDown();
+ }
+ }
+
+ /**
+ * In the GF AST, all metavariables have numbers behind them,
+ * like ?4. But GF cannot parse these, so the numbers have to be
+ * removed.
+ * Be aware, that this method also replaces ?n inside String literals!
+ * @param abs The GF AST
+ * @return abs, but without numbers behind the '?'
+ */
+ private static String removeMetavariableNumbers(String abs) {
+ return abs.replaceAll("\\?\\d+", "\\?");
+ }
+
+
+ /**
+ * Shuts down GF and terminates the edior
+ */
+ private void shutDown() {
+ try {
+ send("q", false, 1); // tell external GF process to quit
+ } finally {
+ removeAll();
+ dispose();
+ }
+ }
+
+ /**
+ * Performs some global settings like setting treeChanged and newObject,
+ * which can depend on the hmsg.
+ * Also the display gets cleared of wished so.
+ * @param hmsg The parsed hmsg.
+ */
+ private void formHmsg(Hmsg hmsg){
+ if (hmsg.clear) {
+ //clear output before linearization
+ this.display.resetLin();
+ display(true, false, false);
+ linearization.reset();
+ }
+ if (hmsg.newObject) {
+ this.newObject = true;
+ }
+ }
+
+ /**
+ * Fills the new category menu and sets the label 'grammar' to
+ * display the name of the abstract grammar.
+ * Fills langMenuModel and registers the presence of the
+ * loaded languages in linearization.linearizations.
+ */
+ private void formNewMenu (NewCategoryMenuResult nmr) {
+ //fill newCategoryMenu
+ for (int i = 0; i < nmr.menuContent.length; i++) {
+ newCategoryMenu.addItem(nmr.menuContent[i]);
+ }
+ //add the languages to the menu
+ for (int i = 0; i < nmr.languages.length; i++) {
+ final boolean active;
+ if (nmr.languages[i].equals("Abstract")) {
+ active = false;
+ } else {
+ active = true;
+ }
+ this.langMenuModel.add(nmr.languages[i], active);
+
+ //select FromUMLTypesOCL by default
+ if (nmr.languages[i].equals(modelModulName + "OCL")) {
+ this.selectedMenuLanguage = modelModulName + "OCL";
+ //TODO select OCL also in the menu
+ }
+ //'register' the presence of this language if possible
+ if (linearization != null) {
+ linearization.getLinearizations().put(nmr.languages[i], null);
+ }
+ }
+ //tell the user, which abstract grammar is used
+ //and save the import path
+ grammar.setText(nmr.grammarName);
+ for (int i = 0; i < nmr.paths.length; i++) {
+ fileString +="--" + nmr.paths[i] +"\n";
+ if (nmr.paths[i].lastIndexOf('.')!=nmr.paths[i].indexOf('.'))
+ grammar.setText(nmr.paths[i].substring(0,
+ nmr.paths[i].indexOf('.')).toUpperCase()+" ");
+ }
+
+ }
+
+
+
+
+ /**
+ * Parses the GF-output between <linearization> </linearization> tags
+ *
+ * Expects the linearization string to be given to this.linearization.
+ */
+ private void formLin(){
+ //reset previous output
+ this.display.resetLin();
+
+ linearization.parseLin(langMenuModel);
+ display(true, false, true);
+
+ //do highlighting
+ this.linearizationArea.getHighlighter().removeAllHighlights();
+ this.htmlLinPane.getHighlighter().removeAllHighlights();
+
+ Vector mahsVector = linearization.calculateHighlights(focusPosition);
+ for (Iterator it = mahsVector.iterator(); it.hasNext();) {
+ MarkedAreaHighlightingStatus mahs = (MarkedAreaHighlightingStatus)it.next();
+ //now highlight
+ if (mahs.focused && mahs.incorrect) {
+ highlight(mahs.ma, Color.ORANGE);
+ highlightHtml(mahs.ma, Color.ORANGE);
+ } else if (mahs.focused) {
+ highlight(mahs.ma, linearizationArea.getSelectionColor());
+ highlightHtml(mahs.ma, linearizationArea.getSelectionColor());
+ } else if (mahs.incorrect) {
+ highlight(mahs.ma, Color.RED);
+ highlightHtml(mahs.ma, Color.RED);
+ }
+ }
+ }
+
+
+
+
+
+ /**
+ * Small method that takes this.display and displays its content
+ * accordingly to what it is (pure text/HTML)
+ * @param doDisplay If the text should get displayed
+ * @param saveScroll if the old scroll state should be saved
+ * @param restoreScroll if the old scroll state should be restored
+ */
+ private void display(boolean doDisplay, boolean saveScroll, boolean restoreScroll) {
+ //Display the pure text
+ final String text = this.display.getText();
+ if (doDisplay) {
+ this.linearizationArea.setText(text);
+ }
+ if (restoreScroll) {
+ //this.outputPanelText.getVerticalScrollBar().setValue(this.display.scrollText);
+ this.linearizationArea.scrollRectToVisible(this.display.recText);
+ }
+ if (saveScroll) {
+ //this.display.scrollText = this.outputPanelText.getVerticalScrollBar().getValue();
+ this.display.recText = this.linearizationArea.getVisibleRect();
+ }
+
+ //Display the HTML
+ final String html = this.display.getHtml(this.font);
+ if (doDisplay) {
+ this.htmlLinPane.setText(html);
+ }
+ if (restoreScroll) {
+ //this.outputPanelHtml.getVerticalScrollBar().setValue(this.display.scrollHtml);
+ this.htmlLinPane.scrollRectToVisible(this.display.recHtml);
+ }
+ if (saveScroll) {
+ //this.display.scrollHtml = this.outputPanelHtml.getVerticalScrollBar().getValue();
+ this.display.recHtml = this.htmlLinPane.getVisibleRect();
+ }
+ }
+
+ /**
+ * Highlights the given MarkedArea in htmlLinPane
+ * @param ma the MarkedArea
+ * @param color the color the highlight should get
+ */
+ private void highlightHtml(final MarkedArea ma, Color color) {
+ try {
+ int begin = ma.htmlBegin;
+ int end = ma.htmlEnd;
+ //When creating the HtmlMarkedArea, we don't know, if
+ //it is going to be the last or not.
+ if (end > this.htmlLinPane.getDocument().getLength()) {
+ end = this.htmlLinPane.getDocument().getLength();
+ }
+ this.htmlLinPane.getHighlighter().addHighlight(begin, end, new DefaultHighlighter.DefaultHighlightPainter(color));
+ if (redLogger.isLoggable(Level.FINER)) {
+ redLogger.finer("HTML HIGHLIGHT: " + this.htmlLinPane.getDocument().getText(begin, end - begin) + "; Color:" + color);
+ }
+ } catch (BadLocationException e) {
+ redLogger.warning("HTML highlighting problem!\n" + e.getLocalizedMessage() + " : " + e.offsetRequested() + "\nHtmlMarkedArea: " + ma + "\nhtmlLinPane length: " + this.htmlLinPane.getDocument().getLength());
+ }
+ }
+
+ /**
+ * Highlights the given MarkedArea in linearizationArea
+ * @param ma the MarkedArea
+ * @param color the color the highlight should get
+ */
+ private void highlight(final MarkedArea ma, Color color) {
+ try {
+ int begin = ma.begin;
+ int end = ma.end ;
+ //When creating the MarkedArea, we don't know, if
+ //it is going to be the last or not.
+ if (end > this.linearizationArea.getText().length()) {
+ end = this.linearizationArea.getText().length() + 1;
+ }
+ this.linearizationArea.getHighlighter().addHighlight(begin, end, new DefaultHighlighter.DefaultHighlightPainter(color));
+ if (redLogger.isLoggable(Level.FINER)) {
+ redLogger.finer("HIGHLIGHT: " + this.linearizationArea.getText(begin, end - begin) + "; Color:" + color);
+ }
+ } catch (BadLocationException e) {
+ redLogger.warning("highlighting problem!\n" + e.getLocalizedMessage() + " : " + e.offsetRequested() + "\nMarkedArea: " + ma + "\nlinearizationArea length: " + this.linearizationArea.getText().length());
+ }
+ }
+
+
+ /**
+ * Sets the font on all the GUI-elements to font.
+ * @param newFont the font everything should have afterwards
+ */
+ private void fontEveryWhere(Font newFont) {
+ linearizationArea.setFont(newFont);
+ htmlLinPane.setFont(newFont);
+ parseField.setFont(newFont);
+ tree.tree.setFont(newFont);
+ refinementMenu.setFont(newFont);
+ save.setFont(newFont);
+ grammar.setFont(newFont);
+ open.setFont(newFont);
+ newTopic.setFont(newFont);
+ gfCommand.setFont(newFont);
+ leftMeta.setFont(newFont);
+ left.setFont(newFont);
+ top.setFont(newFont);
+ right.setFont(newFont);
+ rightMeta.setFont(newFont);
+ subtermDescLabel.setFont(newFont);
+ subtermNameLabel.setFont(newFont);
+ read.setFont(newFont);
+ alpha.setFont(newFont);
+ random.setFont(newFont);
+ undo.setFont(newFont);
+ checkSubtyping.setFont(newFont);
+ filterMenu.setFont(newFont);
+ setSubmenuFont(filterMenu, newFont, false);
+ modify.setFont(newFont);
+ statusLabel.setFont(newFont);
+ menuBar.setFont(newFont);
+ newCategoryMenu.setFont(newFont);
+ readDialog.setFont(newFont);
+ mlMenu.setFont(newFont);
+ setSubmenuFont(mlMenu, newFont, false);
+ modeMenu.setFont(newFont);
+ setSubmenuFont(modeMenu, newFont, false);
+ langMenu.setFont(newFont);
+ setSubmenuFont(langMenu, newFont, false);
+ fileMenu.setFont(newFont);
+ setSubmenuFont(fileMenu, newFont, false);
+ usabilityMenu.setFont(newFont);
+ setSubmenuFont(usabilityMenu, newFont, false);
+ viewMenu.setFont(newFont);
+ setSubmenuFont(viewMenu, newFont, false);
+ setSubmenuFont(sizeMenu, newFont, false);
+ setSubmenuFont(fontMenu, newFont, true);
+ //update also the HTML with the new size
+ display(true, false, true);
+ }
+
+ /**
+ * Set the font in the submenus of menu.
+ * Recursion depth is 1, so subsubmenus don't get fontified.
+ * @param subMenu The menu whose submenus should get fontified
+ * @param font the chosen font
+ * @param onlySize If only the font size or the whole font should
+ * be changed
+ */
+ private void setSubmenuFont(JMenu subMenu, Font font, boolean onlySize) {
+ for (int i = 0; i<subMenu.getItemCount(); i++)
+ {
+ JMenuItem item = subMenu.getItem(i);
+ if (item != null) {
+ //due to a bug in the jvm (already reported) deactivated
+ if (false && onlySize) {
+ Font newFont = new Font(item.getFont().getName(), Font.PLAIN, font.getSize());
+ item.setFont(newFont);
+ } else {
+ item.setFont(font);
+ }
+ //String name = item.getClass().getName();
+ //if (logger.isLoggable(Level.FINER)) logger.finer(name);
+ }
+ }
+ }
+
+ /**
+ * Writes the given String to the given Filename
+ * @param str the text to be written
+ * @param fileName the name of the file that is to be filled
+ */
+ static void writeOutput(String str, String fileName) {
+
+ try {
+ FileOutputStream fos = new FileOutputStream(fileName);
+ Writer out = new OutputStreamWriter(fos, "UTF8");
+ out.write(str);
+ out.close();
+ } catch (IOException e) {
+ JOptionPane.showMessageDialog(null,
+ "Document is empty!","Error", JOptionPane.ERROR_MESSAGE);
+ }
+ }
+
+ /**
+ * Parses the GF-output between <tree> </tree> tags
+ * and build the corresponding tree.
+ *
+ * parses the already read XML for the tree and stores the tree nodes
+ * in nodeTable with their numbers as keys
+ *
+ * Also does some tree analyzing, if other actions have to be taken.
+ *
+ * @param treeString the string representation for the XML tree
+ * @return null, if no commands have to be executed afterwards.
+ * If the result is non-null, then result.s should be sent to GF
+ * afterwards, and no other form-method on this read-run is to be executed.
+ * result.i is the amount of undo steps that this command needs.
+ */
+ private DefaultMutableTreeNode formTree(String treeString) {
+ if (treeLogger.isLoggable(Level.FINER)) {
+ treeLogger.finer("treeString: "+ treeString);
+ }
+
+ /**
+ * stores the nodes and the indention of their children.
+ * When all children of a node are read,
+ * the next brethren / uncle node 'registers' with the same
+ * indention depth to show that the next children are his.
+ */
+ Hashtable parentNodes = new Hashtable();
+ String s = treeString;
+ /** consecutive node numbering */
+ int index = 0;
+ /** the node that gets created from the current line */
+ DefaultMutableTreeNode newChildNode=null;
+ /** is a star somewhere in treestring? 1 if so, 0 otherwise */
+ int star = 0;
+ if (s.indexOf('*')!=-1) {
+ star = 1;
+ }
+ DefaultMutableTreeNode topNode = null;
+ while (s.length()>0) {
+ /**
+ * every two ' ' indicate one tree depth level
+ * shift first gets assigned the indention depth in
+ * characters, later the tree depth
+ */
+ int shift = 0;
+ boolean selected = false;
+ while ((s.length()>0) && ((s.charAt(0)=='*')||(s.charAt(0)==' '))){
+ if (s.charAt(0) == '*') {
+ selected = true;
+ }
+ s = s.substring(1);
+ shift++;
+ }
+ if (s.length()>0) {
+ /** to save the top node*/
+ boolean isTop = false;
+ int j = s.indexOf("\n");
+ //is sth like "andS : Sent ", i.e. "fun : type " before trimming
+ String gfline = s.substring(0, j).trim();
+ GfAstNode node = new GfAstNode(gfline);
+ // use indentation to calculate the parent
+ index++;
+ s = s.substring(j+1);
+ shift = (shift - star)/2;
+
+ /**
+ * we know the parent, so we can ask it for the param information
+ * for the next child (the parent knows how many it has already)
+ * and save it in an AstNodeData
+ */
+ DefaultMutableTreeNode parent = (DefaultMutableTreeNode)parentNodes.get(new Integer(shift));
+
+ /** compute the now child's position */
+ String newPos;
+ if ((parent != null) && (parent.getUserObject() instanceof AstNodeData) && parent.getUserObject() != null) {
+ AstNodeData pand = (AstNodeData)parent.getUserObject();
+ newPos = LinPosition.calculateChildPosition(pand.position, pand.childNum++);
+ } else {
+ //only the case for the root node
+ newPos = "[]";
+ isTop = true;
+ }
+
+ //default case, if we can get more information, this is overwritten
+ AstNodeData and;
+ Printname childPrintname = null;
+ if (!node.isMeta()) {
+ childPrintname = this.printnameManager.getPrintname(node.getFun());
+ }
+ Printname parentPrintname = null;
+ AstNodeData parentAnd = null;
+ String parentConstraint = "";
+ if (parent != null) {
+ parentAnd = (AstNodeData)parent.getUserObject();
+ if (parentAnd != null) {
+ parentConstraint = parentAnd.constraint;
+ }
+ }
+ if (childPrintname != null) {
+ //we know this one
+ and = new RefinedAstNodeData(childPrintname, node, newPos, selected, parentConstraint);
+ } else if (parent != null && node.isMeta()) {
+ //new child without refinement
+ if (parentAnd != null) {
+ parentPrintname = parentAnd.getPrintname();
+ }
+ if (parentPrintname != null) {
+ int paramPosition = parent.getChildCount();
+ String paramName = parentPrintname.getParamName(paramPosition);
+ if (paramName == null) {
+ paramName = node.getFun();
+ }
+ //if tooltip turns out to be null that's OK
+ String paramTooltip = parentPrintname.htmlifySingleParam(paramPosition);
+// if (logger.isLoggable(Level.FINER)) {
+// logger.finer("new node-parsing: '" + name + "', fun: '" + fun + "', type: '" + paramType + "'");
+// }
+ and = new UnrefinedAstNodeData(paramTooltip, node, newPos, selected, parentConstraint);
+
+ } else {
+ and = new RefinedAstNodeData(null, node, newPos, selected, parentConstraint);
+ }
+ } else {
+ //something unparsable, bad luck
+ //or refined and not described
+ and = new RefinedAstNodeData(null, node, newPos, selected, parentConstraint);
+ }
+
+ //add to the parent node
+ newChildNode = new DefaultMutableTreeNode(and);
+ if ((parent != null) && (newChildNode != null)) {
+ parent.add(newChildNode);
+ }
+ parentNodes.put(new Integer(shift+1), newChildNode);
+ if (isTop) {
+ topNode = newChildNode;
+ }
+ }
+ }
+ //to be deferred to later step in readGfEdit
+ return topNode;
+ }
+
+ /**
+ * Shows the tree, scrolls to the selected node and updates the
+ * mapping table between displayed node paths and AST positions.
+ * @param myTreePanel the panel of GFEditor2
+ * @param topNode The root node of the tree, that has the other nodes
+ * already as its children
+ */
+ private void showTree(DynamicTree2 myTreePanel, DefaultMutableTreeNode topNode) {
+ myTreePanel.clear();
+ nodeTable.clear();
+ //the rootNode is not shown, therefore, a dummy node plays this role
+ final DefaultMutableTreeNode rootNode = new DefaultMutableTreeNode();
+ rootNode.add(topNode);
+ ((DefaultTreeModel)(myTreePanel.tree.getModel())).setRoot(rootNode);
+ /**
+ * the path in the JTree (not in GF repesentation!) to the
+ * current new node.
+ */
+ TreePath path=null;
+ TreePath selectionPath = null;
+ // now fill nodeTable
+ for (Enumeration e = rootNode.breadthFirstEnumeration() ; e.hasMoreElements() ;) {
+ DefaultMutableTreeNode currNode = (DefaultMutableTreeNode)e.nextElement();
+ AstNodeData and = (AstNodeData)currNode.getUserObject();
+
+ path = new TreePath(currNode.getPath());
+ if (and == null) {
+ //only the case for the root node
+ nodeTable.put(path, "[]");
+ } else {
+ nodeTable.put(path, and.position);
+ if (and.selected) {
+ selectionPath = path;
+ if (treeLogger.isLoggable(Level.FINE)) {
+ treeLogger.fine("new selectionPath: " + selectionPath);
+ }
+
+ DefaultMutableTreeNode parent = null;
+ if (currNode.getParent() instanceof DefaultMutableTreeNode) {
+ parent = (DefaultMutableTreeNode)currNode.getParent();
+ }
+ Printname parentPrintname = null;
+ //display the current refinement description
+ if ((parent != null)
+ && (parent.getUserObject() != null)
+ && (parent.getUserObject() instanceof AstNodeData)
+ ) {
+ AstNodeData parentAnd = (AstNodeData)parent.getUserObject();
+ parentPrintname = parentAnd.getPrintname();
+ }
+ // set the description of the current parameter to a more
+ // prominent place
+ String paramName = null;
+ int paramPosition = -1;
+ if (parentPrintname != null) {
+ paramPosition = parent.getIndex(currNode);
+ paramName = parentPrintname.getParamName(paramPosition);
+ }
+ if (paramName == null) {
+ subtermNameLabel.setText(actionOnSubtermString);
+ subtermDescLabel.setText("");
+ } else {
+ subtermNameLabel.setText("<html><b>" + paramName + ": </b></html>");
+ String paramDesc = parentPrintname.getParamDescription(paramPosition);
+ if (paramDesc == null) {
+ subtermDescLabel.setText("");
+ } else {
+ subtermDescLabel.setText("<html>" + paramDesc + "</html>");
+ }
+ }
+ statusLabel.setText(and.node.getType());
+ }
+ }
+ }
+ //also set the old selectionPath since we know that we do know,
+ //that the selectionChanged event is bogus.
+ myTreePanel.oldSelection = selectionPath;
+ myTreePanel.tree.setSelectionPath(selectionPath);
+ myTreePanel.tree.scrollPathToVisible(selectionPath);
+ //show the selected as the 'selected' one in the JTree
+ myTreePanel.tree.makeVisible(selectionPath);
+ gui2.toFront();
+ }
+
+
+ /**
+ * Removes anything but the "new" from the new category menu
+ */
+ private void resetNewCategoryMenu() {
+ //remove everything except "New"
+ while (1< newCategoryMenu.getItemCount())
+ newCategoryMenu.removeItemAt(1);
+ }
+
+
+ /**
+ * Pops up a window for input of the wanted data and asks ic
+ * afterwards, if the data has the right format.
+ * Then gives that to GF.
+ * TODO Is called from RefinementMenu, but uses display. Where to put?
+ * @param ic the InputCommand that specifies the wanted format/type
+ */
+ protected void executeInputCommand(InputCommand ic) {
+ String s = (String)JOptionPane.showInputDialog(
+ this,
+ ic.getTitleText(),
+ ic.getTitleText(),
+ JOptionPane.QUESTION_MESSAGE,
+ null,
+ null,
+ "");
+ StringBuffer reason = new StringBuffer();
+ Object value = ic.validate(s, reason);
+ if (value != null) {
+ send("[t] g "+value);
+ if (logger.isLoggable(Level.FINER)) {
+ logger.finer("sending string " + value);
+ }
+ } else {
+ this.display.addToStages("\n" + reason.toString(), "<p>" + reason.toString() + "</p>");
+ display(true, false, false);
+ }
+ }
+
+
+
+ /**
+ * Handles the showing of the popup menu and the parse field
+ * @param e the MouseEvent, that caused the call of this function
+ */
+ protected void maybeShowPopup(MouseEvent e) {
+ //int i=outputVector.size()-1;
+ // right click:
+ if (e.isPopupTrigger()) {
+ if (popUpLogger.isLoggable(Level.FINER)) {
+ popUpLogger.finer("changing pop-up menu2!");
+ }
+ JPopupMenu popup2 = refinementMenu.producePopup();
+ popup2.show(e.getComponent(), e.getX(), e.getY());
+ }
+ // middle click
+ if (e.getButton() == MouseEvent.BUTTON2) {
+ // selection Exists:
+ if (popUpLogger.isLoggable(Level.FINER)) {
+ popUpLogger.finer(e.getX() + " " + e.getY());
+ }
+ String selectedText;
+
+ if (currentNode.isMeta()) {
+ // we do not want the ?3 to be in parseField, that disturbs
+ selectedText = "";
+ } else {
+ final String language;
+ //put together the currently focused text
+ if (e.getComponent() instanceof JTextComponent) {
+ JTextComponent jtc = (JTextComponent)e.getComponent();
+ int pos = jtc.viewToModel(e.getPoint());
+ final boolean htmlClicked = (jtc instanceof JTextPane);
+ language = linearization.getLanguageForPos(pos, htmlClicked);
+ } else {
+ language = "Abstract";
+ }
+ selectedText = linearization.getSelectedLinearization(language, focusPosition);
+
+ }
+ //compute the size of parseField
+ if (selectedText.length()<5)
+// if (treeCbMenuItem.isSelected())
+// parseField.setBounds(e.getX()+(int)Math.round(tree.getBounds().getWidth()), e.getY()+80, 400, 40);
+// else
+ parseField.setBounds(e.getX(), e.getY()+80, 400, 40);
+ else
+// if (treeCbMenuItem.isSelected())
+// parseField.setBounds(e.getX()+(int)Math.round(tree.getBounds().getWidth()), e.getY()+80, selectedText.length()*20, 40);
+// else
+ parseField.setBounds(e.getX(), e.getY()+80, selectedText.length()*20, 40);
+ getLayeredPane().add(parseField, new Integer(1), 0);
+ parseField.setText(selectedText);
+ parseField.requestFocusInWindow();
+ }
+ }
+
+ /**
+ * Adds toHmsg to the [hmsg] part of command, if that is present.
+ * If not, prepends toHmsg in square brackets to command
+ * @param command The command for GF
+ * @param toHmsg the text, that should occur inside [] before the command
+ * @return the updated command (s.a.)
+ */
+ private static String addToHmsg(String command, String toHmsg) {
+ command = command.trim();
+ if (command.startsWith("[")) {
+ command = "[" + toHmsg + command.substring(1);
+ } else {
+ command = "[" + toHmsg + "] " + command;
+ }
+ return command;
+ }
+
+ /**
+ * pop-up menu (adapted from DynamicTree2):
+ * @author janna
+ */
+ class PopupListener extends MouseAdapter {
+ public void mousePressed(MouseEvent e) {
+ // int selStart = tree.getRowForLocation(e.getX(), e.getY());
+ // output.setSelectionRow(selStart);
+ if (popUpLogger.isLoggable(Level.FINER)) {
+ popUpLogger.finer("mouse pressed2: "+linearizationArea.getSelectionStart()+" "+linearizationArea.getSelectionEnd());
+ }
+ maybeShowPopup(e);
+ }
+
+ public void mouseReleased(MouseEvent e) {
+ //nothing to be done here
+ }
+ }
+
+ /**
+ * Encapsulates the opening of terms or linearizations to a file.
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class OpenAction extends AbstractAction {
+ public OpenAction() {
+ super("Open Text", null);
+ putValue(SHORT_DESCRIPTION, "Opens abstract syntax trees or linearizations for the current grammar");
+ putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_O));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_O, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ if (saveFc.getChoosableFileFilters().length<2)
+ saveFc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = saveFc.showOpenDialog(GFEditor2.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ resetNewCategoryMenu();
+ langMenuModel.resetLanguages();
+
+ File file = saveFc.getSelectedFile();
+ // opening the file for editing :
+ if (logger.isLoggable(Level.FINER)) logger.finer("opening: "+ file.getPath().replace('\\', File.separatorChar));
+ if (saveTypeGroup.getSelection().getActionCommand().equals("term")) {
+ if (logger.isLoggable(Level.FINER)) logger.finer(" opening as a term ");
+ send("[nt] open "+ file.getPath().replace('\\', File.separatorChar));
+ }
+ else {
+ if (logger.isLoggable(Level.FINER)) logger.finer(" opening as a linearization ");
+ send("[nt] openstring "+ file.getPath().replace('\\', File.separatorChar));
+ }
+
+ fileString ="";
+ grammar.setText("No Topic ");
+ }
+ }
+ }
+
+ /**
+ * Encapsulates the saving of terms or linearizations to a file.
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class SaveAction extends AbstractAction {
+ public SaveAction() {
+ super("Save As", null);
+ putValue(SHORT_DESCRIPTION, "Saves either the current linearizations or the AST");
+ putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_S));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_S, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ if (saveFc.getChoosableFileFilters().length<2)
+ saveFc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = saveFc.showSaveDialog(GFEditor2.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = saveFc.getSelectedFile();
+ if (logger.isLoggable(Level.FINER)) logger.finer("saving as " + file);
+ final String abstractLin = linearization.getLinearizations().get("Abstract").toString();
+
+ if (saveTypeGroup.getSelection().getActionCommand().equals("term")) {
+ // saving as a term
+ writeOutput(removeMetavariableNumbers(abstractLin), file.getPath());
+ } else {
+ // saving as a linearization:
+ /** collects the show linearizations */
+ StringBuffer text = new StringBuffer();
+ /** if sth. at all is shown already*/
+ boolean sthAtAll = false;
+ for (Iterator it = linearization.getLinearizations().keySet().iterator(); it.hasNext();) {
+ Object key = it.next();
+ if (!key.equals("Abstract")) {
+ if (sthAtAll) {
+ text.append("\n\n");
+ }
+ text.append(linearization.getLinearizations().get(key));
+ sthAtAll = true;
+ }
+ }
+ if (sthAtAll) {
+ writeOutput(text.toString(), file.getPath());
+ if (logger.isLoggable(Level.FINER)) logger.finer(file + " saved.");
+ } else {
+ if (logger.isLoggable(Level.FINER)) logger.warning("no concrete language shown, saving abstract");
+ writeOutput(removeMetavariableNumbers(abstractLin), file.getPath());
+ if (logger.isLoggable(Level.FINER)) logger.finer(file + " saved.");
+ }
+ }
+ }
+
+ }
+ }
+
+ /**
+ * Encapsulates adding new languages for the current abstract grammar.
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class ImportAction extends AbstractAction {
+ public ImportAction() {
+ super("Add", null);
+ putValue(SHORT_DESCRIPTION, "add another concrete language for the current abstract grammar");
+ putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_A));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_A, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ //add another language (Add...)
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc.showOpenDialog(GFEditor2.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ File file = fc.getSelectedFile();
+
+ resetNewCategoryMenu();
+ langMenuModel.resetLanguages();
+ // importing a new language :
+ if (logger.isLoggable(Level.FINER)) logger.finer("importing: "+ file.getPath().replace('\\','/'));
+ fileString ="";
+ //TODO does that load paths in UNIX-notation under windows?
+ send("i "+ file.getPath().replace('\\',File.separatorChar), false, 1);
+ processGfinit();
+ processGfedit();
+ }
+ }
+
+ }
+
+ /**
+ * Encapsulates starting over with a new grammar.
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class NewTopicAction extends AbstractAction {
+ public NewTopicAction() {
+ super("New Grammar", null);
+ putValue(SHORT_DESCRIPTION, "dismiss current editing and load a new grammar");
+ putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_N));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_N, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ if (fc.getChoosableFileFilters().length<2)
+ fc.addChoosableFileFilter(new GrammarFilter());
+ int returnVal = fc.showOpenDialog(GFEditor2.this);
+ if (returnVal == JFileChooser.APPROVE_OPTION) {
+ int n = JOptionPane.showConfirmDialog(GFEditor2.this,
+ "This will dismiss the previous editing. Would you like to continue?",
+ "Starting a new topic", JOptionPane.YES_NO_OPTION);
+ if (n == JOptionPane.YES_OPTION){
+ File file = fc.getSelectedFile();
+ // importing a new grammar :
+ newObject = false;
+ statusLabel.setText(status);
+ subtermDescLabel.setText("");
+ subtermNameLabel.setText("");
+ refinementMenu.reset();
+ tree.resetTree();
+ resetNewCategoryMenu();
+ langMenuModel.resetLanguages();
+ selectedMenuLanguage = "Abstract";
+ rbMenuItemShort.setSelected(true);
+ rbMenuItemUnTyped.setSelected(true);
+ typedMenuItems = false;
+
+ fileString="";
+ grammar.setText("No Topic ");
+ display.resetLin();
+ display(true, true, false);
+ undoStack.clear();
+ send(" e "+ file.getPath().replace('\\',File.separatorChar), false, 1);
+ processInit(null, false);
+ processGfedit();
+ resetPrintnames(true);
+ }
+ }
+ }
+
+ }
+
+ /**
+ * Encapsulates starting over without loading new grammars
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class ResetAction extends AbstractAction {
+ public ResetAction() {
+ super("Reset", null);
+ putValue(SHORT_DESCRIPTION, "discard everything including the loaded grammars");
+ putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_R));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_R, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ newObject = false;
+ statusLabel.setText(status);
+ subtermDescLabel.setText("");
+ subtermNameLabel.setText("");
+ refinementMenu.reset();
+ tree.resetTree();
+ langMenuModel.resetLanguages();
+ resetNewCategoryMenu();
+ selectedMenuLanguage = "Abstract";
+
+ rbMenuItemShort.setSelected(true);
+ rbMenuItemUnTyped.setSelected(true);
+ typedMenuItems = false;
+
+ fileString="";
+ grammar.setText("No Topic ");
+ undoStack.clear();
+ send("e", false, 1);
+ processGfinit();
+ }
+
+ }
+
+ /**
+ * Encapsulates exiting the program
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class QuitAction extends AbstractAction {
+ public QuitAction() {
+ super("Quit", null);
+ putValue(SHORT_DESCRIPTION, "exit the editor");
+ putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_Q));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_Q, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ endProgram();
+ }
+
+ }
+
+ /**
+ * Encapsulates the random command for GF
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class RandomAction extends AbstractAction {
+ public RandomAction() {
+ super("Random", null);
+ putValue(SHORT_DESCRIPTION, "build a random AST from the current cursor position");
+ //putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_M));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_M, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ send("[t] a");
+ }
+
+ }
+
+ /**
+ * Encapsulates the undo command for GF
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class UndoAction extends AbstractAction {
+ public UndoAction() {
+ super("Undo", null);
+ putValue(SHORT_DESCRIPTION, "undo the last command");
+ //putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_U));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_U, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ int undoSteps = 1;
+ if (!undoStack.empty()) {
+ undoSteps = ((Integer)undoStack.pop()).intValue();
+ }
+ send("[t] u " + undoSteps, true, 0);
+ }
+ }
+
+ /**
+ * Encapsulates alpha command for GF
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class AlphaAction extends AbstractAction {
+ public AlphaAction() {
+ super("Alpha", null);
+ putValue(SHORT_DESCRIPTION, "Performing alpha-conversion, rename bound variables");
+ //putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_P));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_P, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ String s = JOptionPane.showInputDialog("Type string:", alphaInput);
+ if (s!=null) {
+ alphaInput = s;
+ send("[t] x "+s);
+ }
+ }
+
+ }
+
+ /**
+ * Encapsulates the input dialog and sending of arbitrary commands to GF
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class GfCommandAction extends AbstractAction {
+ public GfCommandAction() {
+ super("GF command", null);
+ putValue(SHORT_DESCRIPTION, "send a command to GF");
+ //putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_G));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_G, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ String s = JOptionPane.showInputDialog("Command:", commandInput);
+ if (s!=null) {
+ commandInput = s;
+ s = addToHmsg(s, "t");
+ if (logger.isLoggable(Level.FINER)) logger.finer("sending: "+ s);
+ send(s);
+ }
+ }
+ }
+
+ /**
+ * Encapsulates the showing of the read dialog
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class ReadAction extends AbstractAction {
+ public ReadAction() {
+ super("Read", null);
+ putValue(SHORT_DESCRIPTION, "Refining with term or linearization from typed string or file");
+ //putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_E));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_E, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ readDialog.show();
+ }
+
+ }
+
+ /**
+ * Encapsulates the splitting of the main window
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class SplitAction extends AbstractAction {
+ public SplitAction() {
+ super("Split Windows", null);
+ putValue(SHORT_DESCRIPTION, "Splits the refinement menu into its own window");
+ putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_L));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_L, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ coverPanel.remove(centerPanel);
+ centerPanel2.add(middlePanelUp, BorderLayout.SOUTH);
+ if (((JCheckBoxMenuItem)viewMenu.getItem(0)).isSelected()) {
+ centerPanel2.add(treePanel, BorderLayout.CENTER);
+ }
+ else {
+ centerPanel2.add(outputPanelUp, BorderLayout.CENTER);
+ }
+ coverPanel.add(centerPanel2, BorderLayout.CENTER);
+ gui2.getContentPane().add(refinementMenu.getRefinementListsContainer());
+ gui2.setVisible(true);
+ pack();
+ repaint();
+ }
+
+ }
+
+ /**
+ * Encapsulates the combining of the main window
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class CombineAction extends AbstractAction {
+ public CombineAction() {
+ super("One Window", null);
+ putValue(SHORT_DESCRIPTION, "Refinement menu and linearization areas in one window");
+ putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_W));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_W, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ coverPanel.remove(centerPanel2);
+ middlePanel.add(middlePanelUp, BorderLayout.NORTH);
+ if (((JCheckBoxMenuItem)viewMenu.getItem(0)).isSelected()) { gui2.setVisible(false);
+ centerPanel.setLeftComponent(treePanel);
+ }
+ else {
+ centerPanel.setLeftComponent(outputPanelUp);
+ gui2.setVisible(false);
+ }
+ coverPanel.add(centerPanel, BorderLayout.CENTER);
+ centerPanelDown.add(refinementMenu.getRefinementListsContainer(), BorderLayout.CENTER);
+ //centerPanelDown.add(refinementMenu.refinementSubcatPanel, BorderLayout.EAST);
+ pack();
+ repaint();
+ }
+
+ }
+
+ /**
+ * Starts a run on the AST to hunt down open subtyping witnesses
+ * Is not local in initializeGUI because jswat cannot have active breakpoints in such a class, whyever.
+ * @author daniels
+ */
+ class SubtypeAction extends AbstractAction {
+ public SubtypeAction() {
+ super("Close Subtypes", null);
+ putValue(SHORT_DESCRIPTION, "try to automatically refine Subtype relations");
+ //putValue(MNEMONIC_KEY, new Integer(KeyEvent.VK_U));
+ putValue(ACCELERATOR_KEY, KeyStroke.getKeyStroke(KeyEvent.VK_T, ActionEvent.CTRL_MASK));
+ }
+
+ public void actionPerformed(ActionEvent e) {
+ String resetCommand;
+ int usteps ;
+ if (focusPosition != null) {
+ //go back to where we come from
+ resetCommand = "[t] mp " + focusPosition.position;
+ usteps = 1;
+ } else {
+ resetCommand = "[t] gf";
+ usteps = 0;
+ }
+ SubtypingProber sp = new SubtypingProber(gfCapsule);
+ int undos = sp.checkSubtyping();
+ send(resetCommand , true, undos + usteps);
+ }
+ }
+
+
+
+ /**
+ * Takes care, which classes are present and which states they have.
+ * @author daniels
+ */
+ class LangMenuModel implements LanguageManager{
+ Logger menuLogger = Logger.getLogger("de.uka.ilkd.key.ocl.gf.GFEditor2.MenuModel");
+ /**
+ * Just a mutable tuple of language name and whether this language
+ * is displayed or not.
+ */
+ class LangActiveTuple {
+ String lang;
+ boolean active;
+ public LangActiveTuple(String lang, boolean active) {
+ this.lang = lang;
+ this.active = active;
+ }
+ public String toString() {
+ return lang + " : " + active;
+ }
+ }
+
+ private Vector languages = new Vector();
+ /** the group containing RadioButtons for the language the menus
+ * should have
+ */
+ private ButtonGroup languageGroup = new ButtonGroup();
+
+ void updateMenus() {
+ for (Iterator it = this.languages.iterator(); it.hasNext(); ) {
+ LangActiveTuple lat = (LangActiveTuple)it.next();
+ boolean alreadyPresent = false;
+ // language already in the list of available languages?
+ for (int i=0; i<langMenu.getItemCount()-2;i++)
+ if ((langMenu.getItem(i) != null) && langMenu.getItem(i).getText().equals(lat.lang)) {
+ alreadyPresent = true;
+ break;
+ }
+ if (!alreadyPresent) {
+ //add item to the language list:
+ JCheckBoxMenuItem cbMenuItem = new JCheckBoxMenuItem(lat.lang);
+ if (menuLogger.isLoggable(Level.FINER)) menuLogger.finer("menu item: " + lat.lang);
+ cbMenuItem.setSelected(lat.active);
+ cbMenuItem.setActionCommand("lang");
+ cbMenuItem.addActionListener(this.langDisplayListener);
+ langMenu.insert(cbMenuItem, langMenu.getItemCount()-2);
+
+ JRadioButtonMenuItem rbMenuItem = new JRadioButtonMenuItem(lat.lang);
+ rbMenuItem.setActionCommand(lat.lang);
+ rbMenuItem.addActionListener(this.menuLanguageListener);
+ languageGroup.add(rbMenuItem);
+ if (lat.lang.equals(selectedMenuLanguage)) {
+ if (menuLogger.isLoggable(Level.FINER)) {
+ menuLogger.finer("Selecting " + selectedMenuLanguage);
+ }
+ rbMenuItem.setSelected(true);
+ }
+ mlMenu.add(rbMenuItem);
+
+ }
+ }
+ //stolen from fontEverywhere
+ setSubmenuFont(langMenu, font, false);
+ setSubmenuFont(mlMenu, font, false);
+ }
+
+ /**
+ * Sets language myLang to myActive.
+ * Does nothing, if myLang is not already there.
+ * @param myLang The name of the language
+ * @param myActive whether the language is displayed or not
+ */
+ void setActive(String myLang, boolean myActive) {
+ boolean alreadyThere = false;
+ for (Iterator it = this.languages.iterator(); it.hasNext(); ) {
+ LangActiveTuple current = (LangActiveTuple)it.next();
+ if (current.lang.equals(myLang)) {
+ current.active = myActive;
+ alreadyThere = true;
+ }
+ }
+ if (!alreadyThere) {
+ menuLogger.warning(myLang + " not yet known");
+ }
+ }
+
+ /**
+ * Checks if myLang is already present, and if not,
+ * adds it. In that case, myActive is ignored.
+ * @param myLang The name of the language
+ * @param myActive whether the language is displayed or not
+ */
+ public void add(String myLang, boolean myActive) {
+ boolean alreadyThere = false;
+ for (Iterator it = this.languages.iterator(); it.hasNext(); ) {
+ LangActiveTuple current = (LangActiveTuple)it.next();
+ if (current.lang.equals(myLang)) {
+ alreadyThere = true;
+ }
+ }
+ if (!alreadyThere) {
+ if (menuLogger.isLoggable(Level.FINER)) {
+ menuLogger.finer(myLang + " added");
+ }
+ LangActiveTuple lat = new LangActiveTuple(myLang, myActive);
+ this.languages.add(lat);
+ }
+ updateMenus();
+ }
+
+ /**
+ * @param myLang The language in question
+ * @return true iff the language is present and set to active,
+ * false otherwise.
+ */
+ public boolean isLangActive(String myLang) {
+ for (Iterator it = this.languages.iterator(); it.hasNext(); ) {
+ LangActiveTuple current = (LangActiveTuple)it.next();
+ if (current.lang.equals(myLang)) {
+ return current.active;
+ }
+ }
+ return false;
+ }
+
+ /**
+ * initializes a virgin languages menu
+ */
+ public LangMenuModel() {
+ resetLanguages();
+ }
+
+
+ /**
+ * Resets the Languages menu so that it only contains a seperator and the Add button.
+ * Resets the shown menu languages.
+ * Resets the CheckBoxes that display the available languages.
+ */
+ void resetLanguages() {
+ langMenu.removeAll();
+ langMenu.addSeparator();
+ JMenuItem fileMenuItem = new JMenuItem(new ImportAction());
+ langMenu.add(fileMenuItem);
+
+ mlMenu.removeAll();
+ this.languageGroup = new ButtonGroup();
+ this.languages = new Vector();
+ updateMenus();
+ }
+
+
+ /**
+ * Listens to the language menu RadioButtons and sends the
+ * menu language changing commands suiting to the respective
+ * button to GF.
+ * Operates on selectedMenuLanguage from GFEditor2.
+ */
+ private ActionListener menuLanguageListener = new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ final String action = e.getActionCommand();
+ // must be a menu language
+ selectedMenuLanguage = action;
+ final String sendLang;
+ if (action.equals("Abstract")) {
+ sendLang = "Abs";
+ } else {
+ sendLang = action;
+ }
+ send("ml " + sendLang);
+ resetPrintnames(true);
+
+ return;
+ }
+ };
+
+ /**
+ * listens to the CheckBoxes in the Language menu and switches the
+ * correspondend languages on or off when the user clicks on them
+ */
+ private ActionListener langDisplayListener = new ActionListener() {
+ public void actionPerformed(ActionEvent e) {
+ if (newObject) {
+ //clear display of text and HTML
+ display.resetLin();
+ display(true, false, true);
+ formLin();
+ }
+ final String lang = ((JCheckBoxMenuItem)e.getSource()).getText();
+ if (((JCheckBoxMenuItem)e.getSource()).isSelected()){
+ if (menuLogger.isLoggable(Level.FINER)) {
+ menuLogger.finer("turning on language '" + lang + "'");
+ }
+ setActive(lang, true);
+ send("on " + lang);
+ }
+ else{
+ if (menuLogger.isLoggable(Level.FINER)) {
+ menuLogger.finer("turning off language '" + lang + "'");
+ }
+ setActive(lang, false);
+ send("off " + lang);
+ }
+ return;
+ }
+ };
+ }
+}
diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GfAstNode.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GfAstNode.java new file mode 100644 index 000000000..8912d0778 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GfAstNode.java @@ -0,0 +1,121 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +/** + * @author daniels + * This Class represents a parsed node in the GF AST. + * It knows about types, bound variables, funs. + * But nothing about printnames. That's what AstNodeData is for. + */ +class GfAstNode { + /** + * contains the types of the bound variables in the order of their occurence + */ + protected final String[] boundTypes; + /** + * contains the names of the bound variables in the order of their occurence + */ + protected final String[] boundNames; + /** + * The type of this AST node + */ + private final String type; + /** + * @return The type of this AST node + */ + protected String getType() { + return type; + } + /** + * the fun represented in this AST node + */ + private final String fun; + + /** + * @return the fun represented in this AST node. + * Can be a metavariable like "?1" + */ + protected String getFun() { + return fun; + } + + /** + * @return true iff the node is a metavariable, i.e. open and not + * yet refined. + */ + protected boolean isMeta() { + return fun.startsWith("?"); + } + /** + * the line that was used to build this node + */ + private final String line; + /** + * @return the line that was used to build this node + */ + protected String getLine() { + return line; + } + + /** + * The constraint attached to this node + */ + public final String constraint; + + /** + * feed this constructor the line that appears in the GF AST and + * it will get chopped at the right points. + * @param line The line from GF without the * in the beginning. + */ + protected GfAstNode(final String line) { + this.line = line.trim(); + final int index = this.line.lastIndexOf(" : "); + String typeString = this.line.substring(index + 3); + final int constraintIndex = typeString.indexOf(" {"); + if (constraintIndex > -1) { + this.constraint = typeString.substring(constraintIndex + 1).trim(); + this.type = typeString.substring(0, constraintIndex).trim(); + } else { + this.constraint = ""; + this.type = typeString; + } + String myFun = this.line.substring(0, index); + if (myFun.startsWith("\\(")) { + final int end = myFun.lastIndexOf(") -> "); + String boundPart = myFun.substring(2, end); + String[] bounds = boundPart.split("\\)\\s*\\,\\s*\\("); + this.boundNames = new String[bounds.length]; + this.boundTypes = new String[bounds.length]; + for (int i = 0; i < bounds.length;i++) { + //System.out.print("+" + bounds[i] + "-"); + int colon = bounds[i].indexOf(" : "); + this.boundNames[i] = bounds[i].substring(0, colon); + this.boundTypes[i] = bounds[i].substring(colon + 3); + //System.out.println(boundNames[i] + " ;; " + boundTypes[i]); + } + myFun = myFun.substring(end + 5); + } else { + this.boundNames = new String[0]; + this.boundTypes = new String[0]; + } + this.fun = myFun; + } + + public String toString() { + return this.line; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GfCapsule.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GfCapsule.java new file mode 100644 index 000000000..c1d012a02 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GfCapsule.java @@ -0,0 +1,621 @@ +//Copyright (c) Janna Khegai 2004, Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.io.BufferedReader; +import java.io.BufferedWriter; +import java.io.File; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.OutputStreamWriter; +import java.util.Vector; +import java.util.logging.Level; +import java.util.logging.Logger; + +import javax.swing.JFrame; +import javax.swing.JOptionPane; +import javax.swing.ProgressMonitor; + +class GfCapsule { + /** + * XML parsing debug messages + */ + private static Logger xmlLogger = Logger.getLogger(GfCapsule.class.getName() + ".xml"); + /** + * generic logging of this class + */ + private static Logger logger = Logger.getLogger(GfCapsule.class.getName()); + /** + * The output from GF is in here. + * Only the read methods, initializeGF and the prober objects access this. + */ + BufferedReader fromProc; + /** + * Used to leave messages for GF here. + * But <b>only</b> in send and special probers that clean up with undo + * after them (or don't change the state like PrintnameLoader). + */ + BufferedWriter toProc; + + /** + * Starts GF with the given command gfcmd in another process. + * Sets up the reader and writer to that process. + * Does in it self not read anything from GF. + * @param gfcmd The complete command to start GF, including 'gf' itself. + */ + public GfCapsule(String gfcmd){ + try { + Process extProc = Runtime.getRuntime().exec(gfcmd); + InputStreamReader isr = new InputStreamReader( + extProc.getInputStream(),"UTF8"); + this.fromProc = new BufferedReader (isr); + String defaultEncoding = isr.getEncoding(); + if (logger.isLoggable(Level.FINER)) { + logger.finer("encoding "+defaultEncoding); + } + this.toProc = new BufferedWriter(new OutputStreamWriter(extProc.getOutputStream(),"UTF8")); + } catch (IOException e) { + JOptionPane.showMessageDialog(new JFrame(), "Could not start " + gfcmd+ + "\nCheck your $PATH", "Error", + JOptionPane.ERROR_MESSAGE); + throw new RuntimeException("Could not start " + gfcmd+ + "\nCheck your $PATH"); + } + } + + + /** + * Does the actual writing of command to the GF process via STDIN + * @param command exactly the string that is going to be sent + */ + protected void realSend(String command) { + try { + toProc.write(command, 0, command.length()); + toProc.newLine(); + toProc.flush(); + } catch (IOException e) { + System.err.println("Could not write to external process " + e); + } + + } + + /** + * reads the part between >gfinit< and >/gfinit< + * @return the data for the new category menu + */ + protected NewCategoryMenuResult readGfinit() { + try { + //read <hmsg> or <newcat> or <topic> (in case of no grammar loaded) + String readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("12 "+readresult); + //when old grammars are loaded, the first line looks like + //"reading grammar of old format letter.Abs.gfreading old file letter.Abs.gf<gfinit>" + if (readresult.indexOf("<gfinit>") > -1) { + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("12 "+readresult); + } + //no command appendix expected or applicable here, so appendix is discarded + Hmsg hmsg = readHmsg(readresult); + String next = hmsg.lastline; + //no hmsg supported here. Wouldn't be applicable. + //the reading above is to silently ignore it intead of failing. + //formHmsg(hmsg); + + if ((next!=null) && ((next.indexOf("newcat") > -1) + || (next.indexOf("topic") > -1))) { + NewCategoryMenuResult ncmr = readNewMenu(); + return ncmr; + } + + } catch (IOException e) { + System.err.println("Could not read from external process:\n" + e); + } + return null; + } + + /** + * reads the greeting text from GF + * @return S tuple with first = the last read GF line, + * which should be the first loading line + * and second = The greetings string + */ + protected StringTuple readGfGreetings() { + try { + String readresult = ""; + StringBuffer outputStringBuffer = new StringBuffer(); + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("1 "+readresult); + while ((readresult.indexOf("gf")==-1) && (readresult.trim().indexOf("<") < 0)){ + outputStringBuffer.append(readresult).append("\n"); + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("1 "+readresult); + } + return new StringTuple(readresult, outputStringBuffer.toString()); + } catch (IOException e) { + System.err.println("Could not read from external process:\n" + e); + return new StringTuple("", e.getLocalizedMessage()); + } + + } + + /** + * reads the loading and compiling messages from GF + * @param readresult the first loading line + * @param pm to monitor the loading progress. May be null + * @return A tuple with first = the first line from >gfinit< or >gfedit< + * and second = the loading message as pure text + */ + protected StringTuple readGfLoading(String readresult, ProgressMonitor pm) { + try { + // in case nothing has been loaded first, the that has to be done now + if (readresult == null) { + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("1 " + readresult); + } + StringBuffer textPure = new StringBuffer(); + int progress = 5300; + while (!(readresult.indexOf("<gfinit>") > -1 || (readresult.indexOf("<gfmenu>") > -1))){ + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("1 "+readresult); + textPure.append(readresult).append("\n"); + progress += 12; + Utils.tickProgress(pm, progress, null); + } + //when old grammars are loaded, the first line looks like + //"reading grammar of old format letter.Abs.gfreading old file letter.Abs.gf<gfinit>" + //without newlines + final int beginInit = readresult.indexOf("<gfinit>"); + if (beginInit > 0) { + textPure.append(readresult.substring(0, beginInit)).append("\n"); + //that is the expected result + readresult = "<gfinit>"; + } + return new StringTuple(readresult, textPure.toString()); + } catch (IOException e) { + System.err.println("Could not read from external process:\n" + e); + return new StringTuple("", e.getLocalizedMessage()); + } + + } + + + /** + * Reads the <gfedit> part from GF's XML output. + * The different subtags are put into the result + * @param newObj If a new object in the editor has been started. + * If the to-be-read hmsg contains the newObject flag, + * that overwrites this parameter + * @return the read tags, partially halfy parsed, partially raw. + * The way the different form methods expect it. + */ + protected GfeditResult readGfedit(boolean newObj) { + try { + String next = ""; + //read <gfedit> + String readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("11 "+readresult); + //read either <hsmg> or <lineatization> + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("11 "+readresult); + + //hmsg stuff + final Hmsg hmsg = readHmsg(readresult); + next = hmsg.lastline; + + //reading <linearizations> + //seems to be the only line read here + //this is here to give as some sort of catch clause. + while ((next!=null)&&((next.length()==0)||(next.indexOf("<linearizations>")==-1))) { + next = fromProc.readLine(); + if (next!=null){ + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("10 "+next); + } else { + System.exit(0); + } + } + readresult = next; + String lin = readLin(); + final String treeString = readTree(); + final String message = readMessage(); + //read the menu stuff + Vector gfCommandVector; + if (newObj || hmsg.newObject) { + gfCommandVector = readRefinementMenu(); + } else { + while(readresult.indexOf("</menu")==-1) { + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("12 " + readresult); + } + gfCommandVector = null; + } + // "" should occur quite fast, but it has not already been read, + // since the last read line is "</menu>" + for (int i = 0; i < 3 && !readresult.equals(""); i++){ + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("11 " + readresult); + } + //all well, return the read stuff + return new GfeditResult(gfCommandVector, hmsg, lin, message, treeString); + + } catch (IOException e) { + System.err.println("Could not read from external process:\n" + e); + } + //nothing well, return bogus stuff + return new GfeditResult(new Vector(), new Hmsg("", "", false, false, false, false, true), "", "", ""); + + } + + /** + * reads the linearizations in all language. + * seems to expect the first line of the XML structure + * (< lin) already to be read + * Accumulates the GF-output between <linearization> </linearization> tags + */ + protected String readLin(){ + StringBuffer lins = new StringBuffer(); + try { + //read <linearizations> + String readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("7 " + readresult); + lins.append(readresult).append('\n'); + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("6 " + readresult); + while ((readresult != null) && (readresult.indexOf("/linearization") == -1)){ + lins.append(readresult).append('\n'); + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("6 " + readresult); + } + } catch(IOException e){ + System.err.println(e.getMessage()); + e.printStackTrace(); + } + return lins.toString(); + } + + /** + * reads in the tree and calls formTree without start end end tag of tree + * expects the first starting XML tag tree to be already read + * @return the read tags for the tree or null if a read error occurs + */ + protected String readTree(){ + String treeString = ""; + try { + //read <tree> + String readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("6 " + readresult); + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("6 " + readresult); + while (readresult.indexOf("/tree") == -1){ + treeString += readresult + "\n"; + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("6 " + readresult); + } + return treeString; + } catch(IOException e){ + System.err.println(e.getMessage()); + e.printStackTrace(); + return null; + } + } + + /** + * Parses the GF-output between <message> </message> tags + * and returns it. + * @return The read message. + */ + protected String readMessage(){ + String s =""; + try { + // read <message> + String readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("6 " + readresult); + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("7 " + readresult); + while (readresult.indexOf("/message") == -1){ + s += readresult + "\n"; + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("7 " + readresult); + } + return s; + } catch(IOException e){ + System.err.println(e.getLocalizedMessage()); + e.printStackTrace(); + return e.getLocalizedMessage(); + } + } + + /** + * reads the cat entries and puts them into result.menuContent, + * after that reads + * the names of the languages and puts them into the result.languages + * The loaded grammar files are put into result.paths, + * a guessed grammar name into result.grammarName + * Parses the GF-output between <gfinit> tags + */ + protected NewCategoryMenuResult readNewMenu () { + //here the read stuff is sorted into + String grammarName = ""; + final Vector languages = new Vector(); + final Vector menuContent = new Vector(); + final Vector paths = new Vector(); + + boolean more = true; + try { + //read first cat + String readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) { + xmlLogger.finer("2 " + readresult); + } + if (readresult.indexOf("(none)") > -1) { + //no topics present + more = false; + } + + while (more){ + //adds new cat s to the menu + if (readresult.indexOf("topic") == -1) { + final String toAdd = readresult.substring(6); + menuContent.add(toAdd); + } else { + more = false; + } + //read </newcat + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("2 " + readresult); + //read <newcat (normally) + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("3 " + readresult); + if (readresult.indexOf("topic") != -1) { + //no more categories + more = false; + } + //read next cat / topic + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("4 " + readresult); + } + //set topic + grammarName = readresult.substring(4) + " "; + //read </topic> + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("2 " + readresult); + //read <language> + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("3 " + readresult); + //read actual language + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("4 " + readresult); + + //read the languages and select the last non-abstract + more = true; + while (more){ + if ((readresult.indexOf("/gfinit") == -1) + && (readresult.indexOf("lin") == -1)) { + //form lang and Menu menu: + final String langName = readresult.substring(4); + languages.add(langName); + } else { + more = false; + } + // read </language> + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("2 " + readresult); + // read <language> or </gfinit...> + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("3 " + readresult); + if ((readresult.indexOf("/gfinit") != -1) + || (readresult.indexOf("lin") != -1)) { + more = false; + } + // registering the file name: + if (readresult.indexOf("language") != -1) { + String path = readresult.substring(readresult.indexOf('=') + 1, + readresult.indexOf('>')); + path = path.substring(path.lastIndexOf(File.separatorChar) + 1); + if (xmlLogger.isLoggable(Level.FINE)) xmlLogger.fine("language: " + path); + paths.add(path); + } + // in case of finished, read the final "" after </gfinit>, + // otherwise the name of the next language + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("4 " + readresult); + } + } catch(IOException e){ + xmlLogger.warning(e.getMessage()); + } + String[] menuContentArray = Utils.vector2Array(menuContent); + String[] languagesArray = Utils.vector2Array(languages); + String[] pathsArray = Utils.vector2Array(paths); + NewCategoryMenuResult result = new NewCategoryMenuResult(grammarName, menuContentArray, languagesArray, pathsArray); + return result; + } + + /** + * Reads the hmsg part of the XML that is put out from GF. + * Everything in [] given in front of a GF command will be rewritten here. + * This method does nothing when no hmsg part is present. + * + * If a '$' appears in this string, everything that comes after it + * will be in result.second. + * ;; and [] don't work in the [] for the hmsg, + * therfore the following replacements are done: + * %% for ;; + * ( for [ + * ) for ] + * + * If one of the characters c,t,n comes before, the following is done: + * c The output will be cleared before the linearization (TODO: done anyway?) + * t The treeChanged flag will be set to true + * n The newObject flag will be set to true + * p No other probing run should be done (avoid cycles) + * r To prevent the execution of automatically triggered commands to prevent recursion + * + * @param prevreadresult The last line read from GF + * @return first: the last line this method has read; + * second: the string after $, null if that is not present + */ + protected Hmsg readHmsg(String prevreadresult){ + if ((prevreadresult!=null)&&(prevreadresult.indexOf("<hmsg>") > -1)) { + StringBuffer s =new StringBuffer(""); + String commandAppendix = null; + try { + boolean onceAgain = true; + boolean recurse = true; + boolean newObj = false; + boolean treeCh = false; + boolean clear = false; + String readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("7 "+readresult); + while (readresult.indexOf("/hmsg")==-1){ + s.append(readresult).append('\n'); + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("7 "+readresult); + } + int commandAppendixStart = s.indexOf("$"); + if (commandAppendixStart > -1 && commandAppendixStart < s.length() - 1) { //present, but not the last character + commandAppendix = s.substring(commandAppendixStart + 1, s.indexOf("\n")); //two \n trail the hmsg + //;; and [] don't work in the [] for the hmsg + commandAppendix = Utils.replaceAll(commandAppendix, "%%", ";;"); + commandAppendix = Utils.replaceAll(commandAppendix, "(", "["); + commandAppendix = Utils.replaceAll(commandAppendix, ")", "]"); + } else { + commandAppendixStart = s.length(); + } + if (s.indexOf("c") > -1 && s.indexOf("c") < commandAppendixStart) { + //clear output before linearization + clear = true; + } + if (s.indexOf("t") > -1 && s.indexOf("t") < commandAppendixStart) { + //tree has changed + treeCh = true; + } + if (s.indexOf("p") > -1 && s.indexOf("p") < commandAppendixStart) { + //we must not probe again + onceAgain = false; + } + if (s.indexOf("r") > -1 && s.indexOf("r") < commandAppendixStart) { + //we must not probe again + recurse = false; + } + + if (s.indexOf("n") > -1 && s.indexOf("n") < commandAppendixStart) { + //a new object has been created + newObj = true; + } + if (logger.isLoggable(Level.FINE)) { + if (commandAppendix != null) { + logger.fine("command appendix read: '" + commandAppendix + "'"); + } + } + return new Hmsg(readresult, commandAppendix, onceAgain, recurse, newObj, treeCh, clear); + } catch(IOException e){ + System.err.println(e.getMessage()); + e.printStackTrace(); + return new Hmsg("", null, false, true, false, true, false); + } + } else { + return new Hmsg(prevreadresult, null, true, true, false, true, false); + } + } + + /** + * Parses the GF-output between <menu> and </menu> tags + * and puts a StringTuple for each show/send pair into the + * return vector. + * @return A Vector of StringTuple as described above + */ + protected Vector readRefinementMenu (){ + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("list model changing! "); + String s =""; + Vector printnameVector = new Vector(); + Vector commandVector = new Vector(); + Vector gfCommandVector = new Vector(); + try { + //read <menu> + String readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("7 " + readresult); + //read item + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("8 " + readresult); + while (readresult.indexOf("/menu")==-1){ + //read show + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("8 " + readresult); + while (readresult.indexOf("/show") == -1){ + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("9 " + readresult); + if (readresult.indexOf("/show") == -1) { + if (readresult.length()>8) + s += readresult.trim(); + else + s += readresult; + } + } + // if (s.charAt(0)!='d') + // listModel.addElement("Refine " + s); + // else + String showText = s; + printnameVector.addElement(s); + s = ""; + //read /show + //read send + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("8 " + readresult); + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("8 " + readresult); + String myCommand = readresult; + commandVector.add(readresult); + //read /send (discarded) + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("8 " + readresult); + + // read /item + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("8 " + readresult); + readresult = fromProc.readLine(); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("8 " + readresult); + + StringTuple st = new StringTuple(myCommand.trim(), showText); + gfCommandVector.addElement(st); + } + } catch(IOException e){ + System.err.println(e.getMessage()); + e.printStackTrace(); + } + return gfCommandVector; + } + /** + * Reads the output from GF until the ending tag corresponding to the + * given opening tag is read. + * @param opening tag in the format of >gfinit< + */ + protected void skipChild(String opening) { + String closing = (new StringBuffer(opening)).insert(1, '/').toString(); + try { + String nextRead = fromProc.readLine(); + if (logger.isLoggable(Level.FINER)) { + logger.finer("3 " + nextRead); + } + while (!nextRead.trim().equals(closing)) { + nextRead = fromProc.readLine(); + if (logger.isLoggable(Level.FINER)) { + logger.finer("3 " + nextRead); + } + } + } catch (IOException e) { + System.err.println("Could not read from external process:\n" + e); + } + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GfeditResult.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GfeditResult.java new file mode 100644 index 000000000..ccc75ff26 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GfeditResult.java @@ -0,0 +1,61 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.util.Vector; +/** + * Encapsulates the <gfedit> XML tree from GF. + * @author hdaniels + */ +class GfeditResult { + /** + * The fully parsed <hmsg> subtree + */ + final Hmsg hmsg; + /** + * A Vector of StringTuple where first is the command for GF + * and second is the show text + */ + final Vector gfCommands; + /** + * The tree from GF isn't XML anyway, so here it is in all its raw glory + */ + final String treeString; + /** + * if GF had something extra to tell, it can be found here + */ + final String message; + /** + * The XML for the linearizations in all languages + */ + final String linearizations; + /** + * A simple setter constructor + * @param gfCommands A Vector of StringTuple where first is the command for GF + * and second is the show text + * @param hmsg The fully parsed <hmsg> subtree + * @param linearizations The XML for the linearizations in all languages + * @param message the GF message + * @param treeString The tree from GF + */ + public GfeditResult(Vector gfCommands, Hmsg hmsg, String linearizations, String message, String treeString) { + this.gfCommands = gfCommands; + this.hmsg = hmsg; + this.linearizations = linearizations; + this.message = message; + this.treeString = treeString; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GrammarFilter.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GrammarFilter.java new file mode 100644 index 000000000..e8bd59c66 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/GrammarFilter.java @@ -0,0 +1,46 @@ +//Copyright (c) Janna Khegai 2004, Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.io.File; +import javax.swing.filechooser.*; + +public class GrammarFilter extends FileFilter { + + // Accept all directories and all gf, gfcm files. + public boolean accept(File f) { + if (f.isDirectory()) { + return true; + } + + String extension = Utils.getExtension(f); + if (extension != null) { + if (extension.equals(Utils.gf) || + extension.equals(Utils.gfcm)) { + return true; + } else { + return false; + } + } + + return false; + } + + // The description of this filter + public String getDescription() { + return "Just Grammars (*.gf, *.gfcm)"; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Hmsg.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Hmsg.java new file mode 100644 index 000000000..0a640f787 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Hmsg.java @@ -0,0 +1,77 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +/** + * The parsed format of the hmsg, that GF sents, if a command in java mode + * was prefixed with [something]. + * And that something gets parsed and stored in this representation. + * @author daniels + */ +class Hmsg { + /** + * The last read line + */ + String lastline = ""; + /** + * the String that should be appended to all commands of the + * next refinement menu + */ + String appendix = null; + /** + * If the editor shall probe once again for missing subtyping witnesses. + * Unused. + */ + boolean onceAgain = false; + /** + * If false, no commands are executed automatically + * in the next GF reading run + */ + boolean recurse = false; + /** + * if the newObject flag should be set + */ + boolean newObject = false; + /** + * if the command changed the tree, so that it has to be rebuilt + */ + boolean treeChanged = false; + /** + * if the display should be cleared + */ + boolean clear = false; + /** + * A simple setter constructor + * @param lastRead The last read line + * @param appendix the String that should be appended to all commands of the + * next refinement menu + * @param onceAgain + * @param recurse If false, no commands are executed automatically + * in the next GF reading run + * @param newObject if the newObject flag should be set + * @param treeChanged if the command changed the tree, so that it has to be rebuilt + * @param clear if the display should get cleared + */ + public Hmsg(String lastRead, String appendix, boolean onceAgain, boolean recurse, boolean newObject, boolean treeChanged, boolean clear) { + this.lastline = lastRead; + this.appendix = appendix; + this.onceAgain = onceAgain; + this.recurse = recurse; + this.newObject = newObject; + this.treeChanged = treeChanged; + this.clear = clear; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/InputCommand.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/InputCommand.java new file mode 100644 index 000000000..d047b943b --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/InputCommand.java @@ -0,0 +1,141 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; +import java.util.HashSet; + +/** + * @author daniels + * + * This class represents a fake command, i.e. nothing is send to GF here. + * Instead this class acts more like a placeholder for the input dialog. + * This dialog is handled in GFEditor2 when a InputCommand is executed. + * Reason: No GUI stuff in the command. + */ +class InputCommand extends GFCommand { + public static InputCommand intInputCommand = new InputCommand("read in Integer", + "opens a dialog window in which an Integer can be entered", + int.class, + "Please enter an Integer"); + public static InputCommand stringInputCommand = new InputCommand("read in String", + "opens a dialog window in which a String can be entered", + String.class, + "Please enter a String"); + + protected InputCommand(final String description, final String ttt, Class type, final String title) { + this.type = type; + this.tooltipText = ttt; + this.displayText = description; + this.titleText = title; + this.command = type.getName(); + } + + protected Class type; + + /** + * the text that is to be displayed as the title in the input window + */ + protected final String titleText; + /** + * the text that is to be displayed as the title in the input window + */ + public String getTitleText() { + return titleText; + } + + /** + * stores the entered values, so they can be offered to the user + * the next time, in case, he wants them again. + */ + protected final HashSet enteredValues = new HashSet(); + + /** + * the text that is to be displayed as the tooltip + */ + protected final String tooltipText; + /** + * the text that is to be displayed as the tooltip + */ + public String getTooltipText() { + return tooltipText; + } + + /** + * the text that is to be displayed in the refinement lists + */ + protected final String displayText; + /** + * the text that is to be displayed in the refinement lists + */ + public String getDisplayText() { + return displayText; + } + /** + * the subcategory of this command + */ + public String getSubcat() { + return null; + } + + /** + * Checks if the given String can be converted into + * the Type of this InputCommand (int or String). + * If that is possible, the converted object is saved + * in enteredValues for later redisplay for the user. + * @param o The String the user has typed + * @param reason If the entered String is not parseable as the expected + * type, an error message is appended to this StringBuffer, so better + * give an empty one. + * @return an Object whose toString() should send the right + * thing to GF. + * Maybe null, if this "conversion" failed. + */ + protected Object validate(String o, StringBuffer reason) { + Object result = null; + if (type == int.class) { + int i; + try { + i = Integer.parseInt(o); + result = new Integer(i); + } catch (NumberFormatException e) { + reason.append("Input format error: '" + o + "' is no Integer"); + } + } else if (type == String.class) { + if (o != null) { + result = "\"" + o.toString() + "\""; + } + } + if (result != null) { + this.enteredValues.add(result); + } + return result; + } + + /** + * selects the suiting InputCommand for the given full name of a type + * @param typeName at the moment, either int.class.getName() or String.class.getName() + * @return intInputCommand for int, stringInputCommand for String or null otherwise + */ + protected static InputCommand forTypeName(String typeName) { + InputCommand ic = null; + if (typeName.equals(int.class.getName())) { + ic = InputCommand.intInputCommand; + } else if (typeName.equals(String.class.getName())) { + ic = InputCommand.stringInputCommand; + } + return ic; + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/LanguageManager.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/LanguageManager.java new file mode 100644 index 000000000..39e3e6fb1 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/LanguageManager.java @@ -0,0 +1,39 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +/** + * Sadly, this class is a hack. + * It serves as the pointer type to an inner class of GFEditor2. + * Two of its methods are needed outside after refactoring. + * @author daniels + * + */ +interface LanguageManager { + /** + * @param myLang The language in question + * @return true iff the language is present and set to active, + * false otherwise. + */ + public boolean isLangActive(String myLang); + /** + * Checks if myLang is already present, and if not, + * adds it. In that case, myActive is ignored. + * @param myLang The name of the language + * @param myActive whether the language is displayed or not + */ + public void add(String myLang, boolean myActive); +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/LinPosition.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/LinPosition.java new file mode 100644 index 000000000..cf2963210 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/LinPosition.java @@ -0,0 +1,157 @@ +//Copyright (c) Janna Khegai 2004, Hans-Joachim Daniels 2005
+//
+//This program is free software; you can redistribute it and/or modify
+//it under the terms of the GNU General Public License as published by
+//the Free Software Foundation; either version 2 of the License, or
+//(at your option) any later version.
+//
+//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. See the
+//GNU General Public License for more details.
+//
+//You can either finde the file LICENSE or LICENSE.TXT in the source
+//distribution or in the .jar file of this application
+
+package de.uka.ilkd.key.ocl.gf;
+
+/**
+ * represents a position in the AST in Haskell notation together
+ * with a flag that indicates whether at least one constraint does not hold or
+ * if all hold (correct/incorrect).
+ * Class is immutable.
+ */
+class LinPosition {
+ /**
+ * a position in the AST in Haskell notation
+ */
+ final public String position;
+
+ /**
+ * true means green, false means red (janna guesses)
+ */
+ final public boolean correctPosition;
+
+ /**
+ * creates a LinPosition
+ * @param p the position in the AST in Haskell notation like [0,1,2]
+ * @param cor false iff there are violated constraints
+ */
+ LinPosition(String p, boolean cor) {
+ position = p;
+ correctPosition = cor;
+ }
+
+ /**
+ * Creates a position string in Haskell notation for the argument
+ * number nr of this node.
+ * @param nr The number of the wanted argument
+ * @return the position string for the nrth child
+ */
+ public String childPosition(int nr) {
+ return calculateChildPosition(this.position, nr);
+ }
+
+ /**
+ * Creates a position string in Haskell notation for the argument
+ * number nr for the position pos
+ * @param pos The position of the to be parent
+ * @param nr The number of the wanted argument
+ * @return the position string for the nrth child of pos
+ */
+ protected static String calculateChildPosition(String pos, int nr) {
+ if ("[]".equals(pos)) {
+ return "[" + nr + "]";
+ } else {
+ return pos.trim().substring(0, pos.length() - 1) + "," + nr + "]";
+ }
+ }
+
+ /**
+ * Creates a position string in Haskell notation for the argument
+ * number nr for the position pos' parent, i.e. brethren number nr.
+ * Example: calculateBrethrenPosition("[0,0,1]", 3).equals("[0,0,3]")
+ * @param pos The position of a brethren of the wanted
+ * @param nr The number of the wanted brethren
+ * @return the position string for the nrth brother of pos
+ */
+ protected static String calculateBrethrenPosition(String pos, int nr) {
+ if ("[]".equals(pos)) {
+ return "[]"; //no brethren possible here
+ } else if (pos.lastIndexOf(',') == -1) {
+ return "[" + nr + "]"; //one below top
+ } else {
+ final String newPos = pos.substring(0, pos.lastIndexOf(',') + 1) + nr + "]";
+ return newPos;
+ }
+
+ }
+
+ /**
+ * compares two position strings and returns true, if superPosition is
+ * a prefix of subPosition, that is, if subPosition is in a subtree of
+ * superPosition
+ * @param superPosition the position String in Haskell notation
+ * ([0,1,0,4]) of the to-be super-branch of subPosition
+ * @param subPosition the position String in Haskell notation
+ * ([0,1,0,4]) of the to-be (grand-)child-branch of superPosition
+ * @return true iff superPosition denotes an ancestor of subPosition
+ */
+ public static boolean isSubtreePosition(final LinPosition superPosition, final LinPosition subPosition) {
+ if (superPosition == null || subPosition == null) {
+ return false;
+ }
+ String superPos = superPosition.position;
+ String subPos = subPosition.position;
+ if (superPos.length() < 2 || subPos.length() < 2 ) {
+ return false;
+ }
+ superPos = superPos.substring(1, superPos.length() - 1);
+ subPos = subPos.substring(1, subPos.length() - 1);
+ boolean result = subPos.startsWith(superPos);
+ return result;
+ }
+
+ /**
+ * Returns the biggest position of first and second.
+ * Each word in the linearization area has the corresponding
+ * position in the tree. The position-notion is taken from
+ * GF-Haskell, where empty position ("[]")
+ * represents tree-root, "[0]" represents first child of the root,
+ * "[0,0]" represents the first grandchild of the root etc.
+ * So comparePositions("[0]","[0,0]")="[0]"
+ */
+ public static String maxPosition(String first, String second) {
+ String common ="[]";
+ int i = 1;
+ while ((i<Math.min(first.length()-1,second.length()-1))&&(first.substring(0,i+1).equals(second.substring(0,i+1)))) {
+ common=first.substring(0,i+1);
+ i+=2;
+ }
+ if (common.charAt(common.length()-1)==']') {
+ return common;
+ } else {
+ return common+"]";
+ }
+ }
+
+ /**
+ * @return The Haskell position string for the parent of this position.
+ * If self is already the top node, [] is returned.
+ */
+ public String parentPosition() {
+ if (this.position.equals("[]")) {
+ return this.position;
+ } else if (this.position.lastIndexOf(',') == -1) {
+ return "[]"; //one below top
+ } else {
+ final String newPos = this.position.substring(0, this.position.lastIndexOf(',')) + "]";
+ return newPos;
+ }
+ }
+
+ public String toString() {
+ return position + (correctPosition ? " correct" : " incorrect");
+ }
+}
+
diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Linearization.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Linearization.java new file mode 100644 index 000000000..5ff78202b --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Linearization.java @@ -0,0 +1,760 @@ +//Copyright (c) Janna Khegai 2004, Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.util.HashMap; +import java.util.HashSet; +import java.util.Iterator; +import java.util.Vector; +import java.util.logging.Level; +import java.util.logging.Logger; + +/** + * Encapsulates everything that has to do with the linearization. + * It is parsed here, and also the indices for click-in for pure text and HTML + * are managed here. They get calculated in GfCapsule. + * The result can be directly displayed, and this class has methods to translate + * the indices back to the respective tree positions. + * @author daniels + */ +class Linearization { + /** + * linearization marking debug messages + */ + protected static Logger logger = Logger.getLogger(Linearization.class.getName()); + + /** + * contains all the linearization pieces as HtmlMarkedArea + * Needed to know to which node in the AST a word in the linHtmlPane + * area belongs. + */ + private Vector htmlOutputVector = new Vector(); + /** + * the GF-output between <linearization> </linearization> tags is stored here. + * Must be saved in case the displayed languages are changed. + * Only written in readLin + */ + private String linearization = ""; + /** + * stack for storing the current position: + * When displaying, we start with the root of the AST. + * Whenever we start to display a node, it is pushed, and when it is completely displayed, we pop it. + * Only LinPositions are stored in here + * local in formLin? + * */ + private Vector currentPosition = new Vector(); + + /** + * Must be the same Display as GFEditor2 uses + */ + private Display display; + /** + * to collect the linearization strings + */ + private HashMap linearizations = new HashMap(); + + + + /** + * Initializes this object and binds it to the given Display + * @param display The display, that the editor uses + */ + public Linearization(Display display) { + this.display = display; + } + + /** + * @return Returns the linearizations. + */ + HashMap getLinearizations() { + return linearizations; + } + + /** + * @param linearization The linearization to set. + */ + void setLinearization(String linearization) { + this.linearization = linearization; + } + + /** + * resets the output mechanism. + */ + void reset() { + htmlOutputVector = new Vector(); + } + + /** + * Returns the widest position (see comments to comparePositions) + * covered in the string from begin to end in the + * linearization area. + * @param begin The index in htmlOutputVector of the first MarkedArea, that is possibly the max + * @param end The index in htmlOutputVector of the last MarkedArea, that is possibly the max + * @return the position in GF Haskell notation (hdaniels guesses) + */ + private String findMax(int begin, int end) { + String max = (((MarkedArea)this.htmlOutputVector.elementAt(begin)).position).position; + for (int i = begin+1; i <= end; i++) + max = LinPosition.maxPosition(max,(((MarkedArea)this.htmlOutputVector.elementAt(i)).position).position); + return max; + } + + /** + * Appends the string restString to display. + * It parses the subtree tags and registers them. + * The focus tag is expected to be replaced by subtree. + * @param restString string to append, with tags in it. + * @param clickable if true, the text is appended and the subtree tags are + * parsed. If false, the text is appended, but the subtree tags are ignored. + * @param doDisplay true iff the output is to be displayed. + * Implies, if false, that clickable is treated as false. + * @param language the current linearization language + */ + private String appendMarked(String restString, final boolean clickable, boolean doDisplay, String language) { + String appendedPureText = ""; + if (restString.length()>0) { + /** + * the length of what is already displayed of the linearization. + * Alternatively: What has been processed in restString since + * subtreeBegin + */ + int currentLength = 0; + /** position of <subtree */ + int subtreeBegin; + /** position of </subtree */ + int subtreeEnd; + + if (clickable && doDisplay) { + subtreeBegin = Utils.indexOfNotEscaped(restString, "<subtree"); + subtreeEnd = Utils.indexOfNotEscaped(restString, "</subtree"); + // cutting subtree-tags: + while ((subtreeEnd>-1)||(subtreeBegin>-1)) { + /** + * length of the portion that is to be displayed + * in the current run of appendMarked. + * For HTML this would have to be calculated + * in another way. + */ + final int newLength; + + if ((subtreeEnd==-1)||((subtreeBegin<subtreeEnd)&&(subtreeBegin>-1))) { + final int subtreeTagEnd = Utils.indexOfNotEscaped(restString, ">",subtreeBegin); + final int nextOpeningTagBegin = Utils.indexOfNotEscaped(restString, "<", subtreeTagEnd); + + //getting position: + final int posStringBegin = Utils.indexOfNotEscaped(restString, "[",subtreeBegin); + final int posStringEnd = Utils.indexOfNotEscaped(restString, "]",subtreeBegin); + final LinPosition position = new LinPosition(restString.substring(posStringBegin,posStringEnd+1), + restString.substring(subtreeBegin,subtreeTagEnd).indexOf("incorrect")==-1); + + // is something before the tag? + // is the case in the first run + if (subtreeBegin-currentLength>1) { + if (logger.isLoggable(Level.FINER)) { + logger.finer("SOMETHING BEFORE THE TAG"); + } + if (this.currentPosition.size()>0) + newLength = register(currentLength, subtreeBegin, (LinPosition)this.currentPosition.elementAt(this.currentPosition.size()-1), restString, language); + else + newLength = register(currentLength, subtreeBegin, new LinPosition("[]", + restString.substring(subtreeBegin,subtreeTagEnd).indexOf("incorrect")==-1), restString, language); + } else { // nothing before the tag: + //the case in the beginning + if (logger.isLoggable(Level.FINER)) { + logger.finer("NOTHING BEFORE THE TAG"); + } + if (nextOpeningTagBegin>0) { + newLength = register(subtreeTagEnd+2, nextOpeningTagBegin, position, restString, language); + } else { + newLength = register(subtreeTagEnd+2, restString.length(), position, restString, language); + } + restString = removeSubTreeTag(restString,subtreeBegin, subtreeTagEnd+1); + } + currentLength += newLength ; + } else { + // something before the </subtree> tag: + if (subtreeEnd-currentLength>1) { + if (logger.isLoggable(Level.FINER)) { + logger.finer("SOMETHING BEFORE THE </subtree> TAG"); + } + if (this.currentPosition.size()>0) + newLength = register(currentLength, subtreeEnd, (LinPosition)this.currentPosition.elementAt(this.currentPosition.size()-1), restString, language); + else + newLength = register(currentLength, subtreeEnd, new LinPosition("[]", + restString.substring(subtreeBegin,subtreeEnd).indexOf("incorrect")==-1), restString, language); + currentLength += newLength ; + } + // nothing before the tag: + else + // punctuation after the </subtree> tag: + if (restString.substring(subtreeEnd+10,subtreeEnd+11).trim().length()>0) + { + if (logger.isLoggable(Level.FINER)) { + logger.finer("PUNCTUATION AFTER THE </subtree> TAG" + + "/n" + "STRING: " + restString); + } + //cutting the tag first!: + if (subtreeEnd>0) { + restString = removeSubTreeTag(restString,subtreeEnd-1, subtreeEnd+9); + } else { + restString = removeSubTreeTag(restString,subtreeEnd, subtreeEnd+9); + } + if (logger.isLoggable(Level.FINER)) { + logger.finer("STRING after cutting the </subtree> tag: "+restString); + } + // cutting the space in the last registered component: + if (this.htmlOutputVector.size()>0) { + ((MarkedArea)this.htmlOutputVector.elementAt(this.htmlOutputVector.size()-1)).end -=1; + if (currentLength>0) { + currentLength -=1; + } + } + if (logger.isLoggable(Level.FINER)) { + logger.finer("currentLength: " + currentLength); + } + // register the punctuation: + if (this.currentPosition.size()>0) { + newLength = register(currentLength, currentLength+2, (LinPosition)this.currentPosition.elementAt(this.currentPosition.size()-1), restString, language); + } else { + newLength = register(currentLength, currentLength+2, new LinPosition("[]", + true), restString, language); + } + currentLength += newLength ; + } else { + // just cutting the </subtree> tag: + restString = removeSubTreeTag(restString,subtreeEnd, subtreeEnd+10); + } + } + subtreeEnd = Utils.indexOfNotEscaped(restString, "</subtree"); + subtreeBegin = Utils.indexOfNotEscaped(restString, "<subtree"); + // if (debug2) + // System.out.println("/subtree index: "+l2 + "<subtree"+l); + if (logger.isLoggable(Level.FINER)) { + logger.finer("<-POSITION: "+subtreeBegin+" CURRLENGTH: "+currentLength + + "\n STRING: "+restString.substring(currentLength)); + } + } //while + } else { //no focus, no selection enabled (why ever) + //that means, that all subtree tags are removed here. + if (logger.isLoggable(Level.FINER)) { + logger.finer("NO SELECTION IN THE TEXT TO BE APPENDED!"); + } + //cutting tags from previous focuses if any: + int r = Utils.indexOfNotEscaped(restString, "</subtree>"); + while (r>-1) { + // check if punktualtion marks like . ! ? are at the end of a sentence: + if (restString.charAt(r+10)==' ') + restString = restString.substring(0,r)+restString.substring(r+11); + else + restString = restString.substring(0,r)+restString.substring(r+10); + r = Utils.indexOfNotEscaped(restString, "</subtree>"); + } + r = Utils.indexOfNotEscaped(restString, "<subtree"); + while (r>-1) { + int t = Utils.indexOfNotEscaped(restString, ">", r); + if (t<restString.length()-2) + restString = restString.substring(0,r)+restString.substring(t+2); + else + restString = restString.substring(0,r); + r = Utils.indexOfNotEscaped(restString, "<subtree"); + } + } + // appending: + restString = unescapeTextFromGF(restString); + if (logger.isLoggable(Level.FINER)) { + logger.finer(restString); + } + appendedPureText = restString.replaceAll("&-","\n "); + //display the text if not already done in case of clickable + if (!clickable && doDisplay) { + // the text has only been pruned from markup, but still needs + // to be displayed + this.display.addToStages(appendedPureText, appendedPureText); + } + } // else: nothing to append + return appendedPureText; + } + + /** + * Replaces a number of escaped characters by an unescaped version + * of the same length + * @param string The String with '\' as the escape character + * @return the same String, but with escaped characters removed + * + */ + static String unescapeTextFromGF(String string) { + final String more = "\\"+">"; + final String less = "\\"+"<"; + //%% by daniels, linearization output will be changed drastically + //(or probably will), so for now some hacks for -> and >= + string = Utils.replaceAll(string, "-" + more, "-> "); + string = Utils.replaceAll(string, "-" + more,"-> "); + string = Utils.replaceAll(string, more," >"); + string = Utils.replaceAll(string, less," <"); + //an escaped \ becomes a single \ + string = Utils.replaceAll(string, "\\\\"," \\"); + return string; + } + + + + /** + * The substring from start to end in workingString, together with + * position is saved as a MarkedArea in this.htmlOutputVector. + * The information from where to where the to be created MarkedArea + * extends, is calculated in this method. + * @param start The position of the first character in workingString + * of the part, that is to be registered. + * @param end The position of the last character in workingString + * of the part, that is to be registered. + * @param position the position in the tree that corresponds to + * the to be registered text + * @param workingString the String from which the displayed + * characters are taken from + * @param language the current linearization language + * @return newLength, the difference between end and start + */ + private int register(int start, int end, LinPosition position, String workingString, String language) { + /** + * the length of the piece of text that is to be appended now + */ + final int newLength = end-start; + // the tag has some words to register: + if (newLength>0) { + final String stringToAppend = workingString.substring(start,end); + //if (stringToAppend.trim().length()>0) { + + //get oldLength and add the new text + String toAdd = unescapeTextFromGF(stringToAppend); + final MarkedArea hma = this.display.addAsMarked(toAdd, position, language); + this.htmlOutputVector.add(hma); + if (logger.isLoggable(Level.FINER)) { + logger.finer("HTML added : " + hma); + } + } //some words to register + return newLength; + } + + /** + * removing subtree-tag in the interval start-end + * and updating the coordinates after that + * basically part of appendMarked + * No subtree is removed, just the tag. + * @param s The String in which the subtree tag should be removed + * @param start position in restString + * @param end position in restString + * @return the String without the subtree-tags in the given interval + */ + private String removeSubTreeTag (final String s, final int start, final int end) { + String restString = s; + if (logger.isLoggable(Level.FINER)) { + logger.finer("removing: "+ start +" to "+ end); + } + int difference =end-start+1; + int positionStart, positionEnd; + if (difference>20) { + positionStart = Utils.indexOfNotEscaped(restString, "[", start); + positionEnd = Utils.indexOfNotEscaped(restString, "]", start); + + currentPosition.addElement(new LinPosition( + restString.substring(positionStart, positionEnd+1), + restString.substring(start,end).indexOf("incorrect")==-1)); + } else if (currentPosition.size()>0) { + currentPosition.removeElementAt(currentPosition.size()-1); + } + if (start>0) { + restString = restString.substring(0,start)+restString.substring(end+1); + } else{ + restString = restString.substring(end+1); + } + return restString; + } + + /** + * Goes through the list of MarkedAreas and creates MarkedAreaHighlightingStatus + * objects for them, which contain fields for incorrect constraints + * and if they belong to the selected subtree. + * @param focusPosition The AST position of the selected node + * @return a Vector of MarkedAreaHighlightingStatus + */ + Vector calculateHighlights(LinPosition focusPosition) { + Vector result = new Vector(); + final HashSet incorrectMA = new HashSet(); + for (int i = 0; i<htmlOutputVector.size(); i++) { + final MarkedArea ma = (MarkedArea)this.htmlOutputVector.elementAt(i); + //check, if and how ma should be highlighted + boolean incorrect = false; + boolean focused = false; + if (logger.isLoggable(Level.FINER)) { + logger.finer("Highlighting: " + ma); + } + if (!ma.position.correctPosition) { + incorrectMA.add(ma); + incorrect = true; + } else { + //This could be quadratic, but normally on very + //few nodes constraints are introduced, so + //incorrectMA should not contain many elements. + MarkedArea incMA; + for (Iterator it = incorrectMA.iterator(); !incorrect && it.hasNext();) { + incMA = (MarkedArea)it.next(); + if (LinPosition.isSubtreePosition(incMA.position, ma.position)) { + incorrect = true; + } + } + } + if (LinPosition.isSubtreePosition(focusPosition, ma.position)) { + focused = true; + } + MarkedAreaHighlightingStatus mahs = new MarkedAreaHighlightingStatus(focused, incorrect, ma); + result.add(mahs); + } + return result; + } + + /** + * Parses the linearization XML and calls outputAppend + * @param langMan The LangMenuModel, but that is an inner class and only + * the methods in the Interface LanguageManager are used here. + */ + void parseLin(LanguageManager langMan) { + linearizations.clear(); + boolean firstLin=true; + //read first line like ' <lin lang=Abstract>' + String readResult = linearization.substring(0,linearization.indexOf('\n')); + //the rest of the linearizations + String lin = linearization.substring(linearization.indexOf('\n')+1); + //extract the language from readResult + int ind = Utils.indexOfNotEscaped(readResult, "="); + int ind2 = Utils.indexOfNotEscaped(readResult, ">"); + /** The language of the linearization */ + String language = readResult.substring(ind+1,ind2); + //the first direct linearization + readResult = lin.substring(0,lin.indexOf("</lin>")); + //the rest + lin = lin.substring(lin.indexOf("</lin>")); + while (readResult.length()>1) { + langMan.add(language,true); + // selected? + boolean visible = langMan.isLangActive(language); + if (visible && !firstLin) { + // appending sth. linearizationArea + this.display.addToStages("\n************\n", "<br><hr><br>"); + } + if (logger.isLoggable(Level.FINER)) { + logger.finer("linearization for the language: "+readResult); + } + + // change the focus tag into a subtree tag. + // focus handling now happens in GFEditor2::formTree + String readLin = readResult; + readLin = Utils.replaceNotEscaped(readLin, "<focus", "<subtree"); + readLin = Utils.replaceNotEscaped(readLin, "</focus", "</subtree"); + + final boolean isAbstract = "Abstract".equals(language); + // now do appending and registering + String linResult = appendMarked(readLin + '\n', !isAbstract, visible, language); + + if (visible) { + firstLin = false; + } + linearizations.put(language, linResult); + // read </lin> + lin = lin.substring(lin.indexOf('\n')+1); + // read lin or 'end' + if (lin.length()<1) { + break; + } + + readResult = lin.substring(0,lin.indexOf('\n')); + lin = lin.substring(lin.indexOf('\n')+1); + if (readResult.indexOf("<lin ")!=-1){ + //extract the language from readResult + ind = readResult.indexOf('='); + ind2 = readResult.indexOf('>'); + language = readResult.substring(ind+1,ind2); + readResult = lin.substring(0,lin.indexOf("</lin>")); + lin = lin.substring(lin.indexOf("</lin>")); + } + } + } + + /** + * + * @param language The concrete language of choice + * @return The linearization of the subtree starting with the currently + * selected node in the given language. + */ + String getSelectedLinearization(final String language, final LinPosition focusPosition) { + StringBuffer sel = new StringBuffer(); + for (int i = 0; i<htmlOutputVector.size(); i++) { + final MarkedArea ma = (MarkedArea)htmlOutputVector.elementAt(i); + if (language.equals(ma.language) && LinPosition.isSubtreePosition(focusPosition, ma.position)) { + sel.append(ma.words); + } + } + return sel.toString(); + } + + /** + * Takes the index of a caret position in the linearization area + * and returns the language of the clicked linearization. + * GF lists the different concrete languages one after the other, + * and this method looks at the linearization snipplets to get + * the language. + * If somehow no language can be found out, 'Abstract' is returned + * @param pos The index of the caret position + * @param htmlClicked If the HTML JTextPane has been clicked, + * false for the JTextArea + * @return the name of the concrete grammar (language) or Abstract + * (see above). + */ + String getLanguageForPos(int pos, final boolean htmlClicked) { + final String language; + MarkedArea ma = null; + if (htmlClicked) { + //HTML + for (int i = 0; i < htmlOutputVector.size(); i++) { + if ((pos >= ((MarkedArea)htmlOutputVector.get(i)).htmlBegin) && (pos <= ((MarkedArea)htmlOutputVector.get(i)).htmlEnd)) { + ma = (MarkedArea)htmlOutputVector.get(i); + break; + } + } + } else { + //assumably pure text + for (int i = 0; i < htmlOutputVector.size(); i++) { + if ((pos >= ((MarkedArea)htmlOutputVector.get(i)).begin) && (pos <= ((MarkedArea)htmlOutputVector.get(i)).end)) { + ma = (MarkedArea)htmlOutputVector.get(i); + break; + } + } + + } + if (ma != null && ma.language != null) { + language = ma.language; + } else { + language = "Abstract"; + } + return language; + } + + /** + * The user has either just clicked in the linearization area, + * which means start == end, or he has selected a text, so that + * start < end. + * This method figures out the smallest subtree whose linearization + * completely encompasses the area from start to end. + * This method is for the HTML linearization area. + * @param start The index of the caret position at the begin of the selection + * @param end The index of the caret position at the end of the selection + * @return The 'root' of the subtree described above + */ + String markedAreaForPosHtml(int start, int end) { + if (htmlOutputVector.isEmpty()) { + return null; + } + String position = null; //the result + String jPosition ="", iPosition=""; + MarkedArea jElement = null; + MarkedArea iElement = null; + int j = 0; + int i = htmlOutputVector.size()-1; + + if (logger.isLoggable(Level.FINER)) + for (int k=0; k < htmlOutputVector.size(); k++) { + logger.finer("element: "+k+" begin "+((MarkedArea)htmlOutputVector.elementAt(k)).htmlBegin+" " + + "\n-> end: "+((MarkedArea)htmlOutputVector.elementAt(k)).htmlEnd+" " + + "\n-> position: "+(((MarkedArea)htmlOutputVector.elementAt(k)).position).position+" " + + "\n-> words: "+((MarkedArea)htmlOutputVector.elementAt(k)).words); + } + // localizing end: + while ((j < htmlOutputVector.size()) && (((MarkedArea)htmlOutputVector.elementAt(j)).htmlEnd < end)) { + j++; + } + // localising start: + while ((i >= 0) && (((MarkedArea)htmlOutputVector.elementAt(i)).htmlBegin > start)) { + i--; + } + if (logger.isLoggable(Level.FINER)) { + logger.finer("i: "+i+" j: "+j); + } + if ((j < htmlOutputVector.size())) { + jElement = (MarkedArea)htmlOutputVector.elementAt(j); + jPosition = jElement.position.position; + // less & before: + if (i == -1) { // less: + if (end>=jElement.htmlBegin) { + iElement = (MarkedArea)htmlOutputVector.elementAt(0); + iPosition = iElement.position.position; + if (logger.isLoggable(Level.FINER)) { + logger.finer("Less: "+jPosition+" and "+iPosition); + } + position = findMax(0,j); + if (logger.isLoggable(Level.FINER)) { + logger.finer("SELECTEDTEXT: "+position+"\n"); + } + } else { // before: + if (logger.isLoggable(Level.FINER)) { + logger.finer("BEFORE vector of size: "+htmlOutputVector.size()); + } + } + } else { // just: + iElement = (MarkedArea)htmlOutputVector.elementAt(i); + iPosition = iElement.position.position; + if (logger.isLoggable(Level.FINER)) { + logger.finer("SELECTED TEXT Just: "+iPosition +" and "+jPosition+"\n"); + } + position = findMax(i,j); + if (logger.isLoggable(Level.FINER)) { + logger.finer("SELECTEDTEXT: "+position+"\n"); + } + } + } else if (i>=0) { // more && after: + iElement = (MarkedArea)htmlOutputVector.elementAt(i); + iPosition = iElement.position.position; + // more + if (start<=iElement.htmlEnd) { + jElement = (MarkedArea)htmlOutputVector.elementAt(htmlOutputVector.size()-1); + jPosition = jElement.position.position; + if (logger.isLoggable(Level.FINER)) { + logger.finer("MORE: "+iPosition+ " and "+jPosition); + } + position = findMax(i,htmlOutputVector.size()-1); + if (logger.isLoggable(Level.FINER)) { + logger.finer("SELECTEDTEXT: "+position+"\n"); + } + // after: + } else if (logger.isLoggable(Level.FINER)) { + logger.finer("AFTER vector of size: "+htmlOutputVector.size()); + } + } else { // bigger: + iElement = (MarkedArea)htmlOutputVector.elementAt(0); + iPosition = iElement.position.position; + jElement = (MarkedArea)htmlOutputVector.elementAt(htmlOutputVector.size()-1); + jPosition = jElement.position.position; + if (logger.isLoggable(Level.FINER)) { + logger.finer("BIGGER: "+iPosition +" and "+jPosition+"\n" + + "\n-> SELECTEDTEXT: []\n"); + } + position = "[]"; + } + return position; + } + + /** + * The user has either just clicked in the linearization area, + * which means start == end, or he has selected a text, so that + * start < end. + * This method figures out the smallest subtree whose linearization + * completely encompasses the area from start to end. + * This method is for the pure text linearization area. + * @param start The index of the caret position at the begin of the selection + * @param end The index of the caret position at the end of the selection + * @return The 'root' of the subtree described above + */ + String markedAreaForPosPureText(int start, int end) { + if (htmlOutputVector.isEmpty()) { + return null; + } + //the result + String position = null; + //variables for confining the searched MarkedArea from + //start and end (somehow ...) + int j = 0; + int i = htmlOutputVector.size() - 1; + String jPosition ="", iPosition=""; + MarkedArea jElement = null; + MarkedArea iElement = null; + + if (logger.isLoggable(Level.FINER)) + for (int k = 0; k < htmlOutputVector.size(); k++) { + logger.finer("element: " + k + " begin " + ((MarkedArea)htmlOutputVector.elementAt(k)).begin + " " + + "\n-> end: " + ((MarkedArea)htmlOutputVector.elementAt(k)).end+" " + + "\n-> position: " + (((MarkedArea)htmlOutputVector.elementAt(k)).position).position+" " + + "\n-> words: " + ((MarkedArea)htmlOutputVector.elementAt(k)).words); + } + // localizing end: + while ((j < htmlOutputVector.size()) && (((MarkedArea)htmlOutputVector.elementAt(j)).end < end)) { + j++; + } + // localising start: + while ((i >= 0) && (((MarkedArea)htmlOutputVector.elementAt(i)).begin > start)) + i--; + if (logger.isLoggable(Level.FINER)) { + logger.finer("i: " + i + " j: " + j); + } + if ((j < htmlOutputVector.size())) { + jElement = (MarkedArea)htmlOutputVector.elementAt(j); + jPosition = jElement.position.position; + // less & before: + if (i==-1) { // less: + if (end>=jElement.begin) { + iElement = (MarkedArea)htmlOutputVector.elementAt(0); + iPosition = iElement.position.position; + if (logger.isLoggable(Level.FINER)) { + logger.finer("Less: "+jPosition+" and "+iPosition); + } + position = findMax(0,j); + if (logger.isLoggable(Level.FINER)) { + logger.finer("SELECTEDTEXT: "+position+"\n"); + } + } else if (logger.isLoggable(Level.FINER)) { // before: + logger.finer("BEFORE vector of size: " + htmlOutputVector.size()); + } + } else { // just: + iElement = (MarkedArea)htmlOutputVector.elementAt(i); + iPosition = iElement.position.position; + if (logger.isLoggable(Level.FINER)) { + logger.finer("SELECTED TEXT Just: "+iPosition +" and "+jPosition+"\n"); + } + position = findMax(i,j); + if (logger.isLoggable(Level.FINER)) { + logger.finer("SELECTEDTEXT: "+position+"\n"); + } + } + } else if (i>=0) { // more && after: + iElement = (MarkedArea)htmlOutputVector.elementAt(i); + iPosition = iElement.position.position; + // more + if (start<=iElement.end) { + jElement = (MarkedArea)htmlOutputVector.elementAt(htmlOutputVector.size() - 1); + jPosition = jElement.position.position; + if (logger.isLoggable(Level.FINER)) { + logger.finer("MORE: "+iPosition+ " and "+jPosition); + } + position = findMax(i, htmlOutputVector.size()-1); + if (logger.isLoggable(Level.FINER)) { + logger.finer("SELECTEDTEXT: "+position+"\n"); + } + } else if (logger.isLoggable(Level.FINER)) { // after: + logger.finer("AFTER vector of size: " + htmlOutputVector.size()); + } + } else { + // bigger: + iElement = (MarkedArea)htmlOutputVector.elementAt(0); + iPosition = iElement.position.position; + jElement = (MarkedArea)htmlOutputVector.elementAt(htmlOutputVector.size()-1); + jPosition = jElement.position.position; + if (logger.isLoggable(Level.FINER)) { + logger.finer("BIGGER: "+iPosition +" and "+jPosition+"\n" + + "\n-> SELECTEDTEXT: []\n"); + } + position = "[]"; + } + return position; + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/LinkCommand.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/LinkCommand.java new file mode 100644 index 000000000..fb12c79b7 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/LinkCommand.java @@ -0,0 +1,85 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +/** + * @author daniels + * This class represents a link to a subcategory submenu. + * When it is encountered as the executed command, the corresponding + * menu gets opened. + */ +public class LinkCommand extends GFCommand { + + /** + * Since LinkCommand is not a real command, that is sent to GF, + * most fields are given dummy values here. + * The subcat is assigned its full display name and tooltip + * @param subcat The subcategory of the menu behind this command + * @param manager The PrintnameManager, that can map subcat to its + * full name + */ + public LinkCommand(final String subcat, final PrintnameManager manager) { + this.command = subcat; + this.newSubcat = false; + this.commandType = Printname.SUBCAT; + this.argument = -1; + this.funName = null; + this.printname = null; + + String dtext; + String ttext; + String fullname = manager.getFullname(subcat); + if (fullname == null) { + dtext = getSubcat(); + ttext = "open submenu " + getSubcat(); + } else { + ttext = Printname.htmlPrepend(Printname.extractTooltipText(fullname), "<i>open submenu</i> <br> "); + dtext = Printname.extractDisplayText(fullname); + } + this.tooltipText = ttext; + this.displayText = dtext; + + } + + /** + * the text that is to be displayed as the tooltip + */ + protected final String tooltipText; + /** + * the text that is to be displayed as the tooltip + */ + public String getTooltipText() { + return tooltipText; + } + + /** + * the text that is to be displayed in the refinement lists + */ + protected final String displayText; + /** + * the text that is to be displayed in the refinement lists + */ + public String getDisplayText() { + return displayText; + } + /** + * the subcategory of this command + */ + public String getSubcat() { + return this.command; + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/MarkedArea.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/MarkedArea.java new file mode 100644 index 000000000..0f4422978 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/MarkedArea.java @@ -0,0 +1,84 @@ +//Copyright (c) Janna Khegai 2004, Hans-Joachim Daniels 2005
+//
+//This program is free software; you can redistribute it and/or modify
+//it under the terms of the GNU General Public License as published by
+//the Free Software Foundation; either version 2 of the License, or
+//(at your option) any later version.
+//
+//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. See the
+//GNU General Public License for more details.
+//
+//You can either finde the file LICENSE or LICENSE.TXT in the source
+//distribution or in the .jar file of this application
+
+package de.uka.ilkd.key.ocl.gf;
+
+/**
+ * Stores quasi a piece of the linearization area, that has a word, a beginning
+ * and an end in the linearization area and a position in the AST. It is used
+ * for clicking in the text
+ *
+ * @author janna, daniels
+ */
+class MarkedArea {
+ /**
+ * The starting position of the stored words
+ */
+ final public int begin;
+ /**
+ * The ending position of the stored words.
+ * Not final because of some punctuation issue daniels
+ * does not understand
+ */
+ public int end;
+ /**
+ * The position in the AST
+ */
+ final public LinPosition position;
+ /**
+ * The actual text of this area
+ */
+ final public String words;
+ /**
+ * the concrete grammar (or better, its linearization)
+ * this MarkedArea belongs to
+ */
+ final public String language;
+
+ /**
+ * the start index in the HTML area
+ */
+ final public int htmlBegin;
+ /**
+ * the end index in the HTML area
+ */
+ final public int htmlEnd;
+
+ /**
+ * A stand-alone constuctor which takes all values as arguments
+ * @param begin The starting position of the stored words
+ * @param end The ending position of the stored words
+ * @param position The position in the AST
+ * @param words The actual text of this area
+ * @param htmlBegin the start index in the HTML area
+ * @param htmlEnd the end index in the HTML area
+ * @param language the language of the current linearization
+ */
+ public MarkedArea(int begin, int end, LinPosition position, String words, int htmlBegin, int htmlEnd, String language) {
+ this.begin = begin;
+ this.end = end;
+ this.position = position;
+ this.words = words;
+ this.language = language;
+ this.htmlBegin = htmlBegin;
+ this.htmlEnd = htmlEnd;
+ }
+
+
+ public String toString() {
+ return begin + " - " + end + " : " + position + " = '" + words + "' ; HTML: " + htmlBegin + " - " + htmlEnd;
+ }
+}
+
diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/MarkedAreaHighlightingStatus.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/MarkedAreaHighlightingStatus.java new file mode 100644 index 000000000..f2c712a75 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/MarkedAreaHighlightingStatus.java @@ -0,0 +1,48 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +/** + * Stores a MarkedArea together with some status fields, which tell + * how it should get highlighted. + * No direct highlighting stuff in here, that's done in GFEditor2 + * @author daniels + */ +class MarkedAreaHighlightingStatus { + /** + * The MarkedArea, which contains the highlighting information + */ + final MarkedArea ma; + /** + * whether this MarkedArea is a subnode of the currently focused node + */ + final boolean focused; + /** + * whether this MarkedArea has (inherited) a GF constraint + */ + final boolean incorrect; + /** + * Initializes this immutable record class + * @param focused whether this MarkedArea is a subnode of the currently focused node + * @param incorrect whether this MarkedArea has (inherited) a GF constraint + * @param ma The MarkedArea, which contains the highlighting information + */ + public MarkedAreaHighlightingStatus(boolean focused, boolean incorrect, MarkedArea ma) { + this.focused = focused; + this.incorrect = incorrect; + this.ma = ma; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/NewCategoryMenuResult.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/NewCategoryMenuResult.java new file mode 100644 index 000000000..44880a00a --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/NewCategoryMenuResult.java @@ -0,0 +1,57 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +/** + * GF sends the new menu as XML. + * After this has been parsed by GfCapsule, it is sent in this representation + * to GFEditor2. + * @author daniels + * + */ +class NewCategoryMenuResult { + /** + * The actual entries of the newMenu + */ + final String[] menuContent; + /** + * The languages, that GF sent + */ + final String[] languages; + /** + * the constituents of the import path? + */ + final String[] paths; + /** + * the name of the abstract grammar, also called topic + */ + final String grammarName; + + /** + * Just sets the attributes of this class + * @param grammarName the name of the abstract grammar, also called topic + * @param menuContent The actual entries of the newMenu + * @param languages The languages, that GF sent + * @param paths the constituents of the import path? + */ + public NewCategoryMenuResult(String grammarName, String[] menuContent, String[] languages, String paths[]) { + this.grammarName = grammarName; + this.menuContent = menuContent; + this.languages = languages; + this.paths = paths; + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/NoLineBreakFormatter.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/NoLineBreakFormatter.java new file mode 100644 index 000000000..f241acb69 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/NoLineBreakFormatter.java @@ -0,0 +1,23 @@ +package de.uka.ilkd.key.ocl.gf; + +import java.util.logging.Formatter; +import java.util.logging.LogRecord; + +/** + * @author daniels + * A simple Formatter class, that does not introduce linebreaks, so that + * continous lines can be read under each other. + */ +public class NoLineBreakFormatter extends Formatter { + + /** + * @see java.util.logging.Formatter#format(java.util.logging.LogRecord) + */ + public String format(LogRecord record) { + final String shortLoggerName = record.getLoggerName().substring(record.getLoggerName().lastIndexOf('.') + 1); + return record.getLevel() + " : " + + shortLoggerName + " " + + record.getSourceMethodName() + " -:- " + + record.getMessage() + "\n"; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Printname.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Printname.java new file mode 100644 index 000000000..68feb6dd9 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Printname.java @@ -0,0 +1,569 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.util.Hashtable; +import java.util.Vector; +import java.util.logging.*; + +/** + * @author daniels + * + * A Printname allows easy access for all the information that is crammed + * into a printname in the GF grammars. + * This information consists of (in this order!) + * The tooltip text which is started with \\$ + * The subcategory which is started with \\% + * The longer explanation for the subcategory which directly follows the + * subcategory and is put into parantheses + * The parameter descriptions, which start with \\#name and is followed + * by their actual description. + * HTML can be used inside the descriptions and the tooltip text + */ +class Printname { + private static Logger subcatLogger = Logger.getLogger(Printname.class.getName()); + + /** + * delete is always the same and only consists of one letter, therefore static. + */ + public static final Printname delete = new Printname("d", "delete current sub-tree", false); + /** + * The ac command i always the same, therefore static + */ + public static final Printname addclip = new Printname("ac", "add to clipboard\\$<html>adds the current subtree to the clipboard.<br>It is offered in the refinement menu if the expected type fits to the one of the current sub-tree.</html>", false); + + /** + * @param arg The number of the argument, + * that will take the place of the selected fun + * @return a Printname for the 'ph arg' command + */ + public static Printname peelHead(int arg) { + final String cmd = "ph " + arg; + final String show = "peel head " + arg + "\\$removes this fun and moves its " + (arg + 1) + ". argument at its place instead"; + return new Printname(cmd, show, true); + } + + /** + * the type of the fun behind that printname (if applicable) + */ + protected final String type; + + /** + * If the command type will already + * be present in the display name and does not need to be added. + */ + protected final boolean funPresent; + /** + * The character that is the borderline between the text that + * is to be displayed in the JList and the ToolTip text + */ + public final static String TT_START = "\\$"; + /** + * the string that is followed by the sub-category shorthand + * in the refinement menu + */ + public final static String SUBCAT = "\\%"; + /** + * The string that is followed by a new parameter to the GF function + */ + public final static String PARAM = "\\#"; + /** + * If that follows "\#" in the parameter descriptions, then do an + * auto-coerce when this param is meta and selected + */ + public final static String AUTO_COERCE = "!"; + + /** + * the name of the fun that is used in this command + */ + protected final String fun; + + /** + * the printname of this function + */ + protected final String printname; + + /** + * to cache the printname, once it is constructed + */ + protected String displayedPrintname = null; + /** + * the name of the module the fun belongs to + * null means that the function is saved without module information, + * "" means that a GF command is represented + */ + protected final String module; + /** + * the name of the module the fun belongs to + * null means that the function is saved without module information, + * "" means that a GF command is represented + */ + public String getModule() { + return module; + } + + + /** the qualified function name, not needed yet */ + /* + public String getFunQualified() { + if (module != null && !module.equals("")) { + return module + "." + fun; + } else { + return fun; + } + } + */ + + /** + * the subcategory of this command + */ + protected final String subcat; + /** + * the subcategory of this command + */ + public String getSubcat() { + return subcat; + } + + /** + * The hashmap for the names of the sub categories, + * with the shortname starting with '%' as the key. + * It is important that all Printnames of one session share the same + * instance of Hashtable here. + * This field is not static because there can be several instances of + * the editor that shouldn't interfere. + */ + protected final Hashtable subcatNameHashtable; + + /** + * contains the names of the paramters of this function (String). + * Parallel with paramTexts + */ + protected final Vector paramNames = new Vector(); + + /** + * fetches the name of the nth parameter + * @param n the number of the wanted paramter + * @return the corresponding name, null if not found + */ + public String getParamName(int n) { + String name = null; + try { + name = (String)this.paramNames.get(n); + } catch (ArrayIndexOutOfBoundsException e) { + subcatLogger.fine(e.getLocalizedMessage()); + } + return name; + } + /** + * contains the descriptions of the paramters of this function (String). + * Parallel with paramNames + */ + protected final Vector paramTexts = new Vector(); + + /** + * tells, whether the nth parameter should be auto-coerced + * @param n the number of the parameter in question + * @return whether the nth parameter should be auto-coerced + */ + public boolean getParamAutoCoerce(int n) { + boolean result = false; + try { + result = ((Boolean)this.paramAutoCoerce.get(n)).booleanValue(); + } catch (ArrayIndexOutOfBoundsException e) { + subcatLogger.fine(e.getLocalizedMessage()); + } + return result; + } + + /** + * stores for the parameters whether they should be auto-coerced or not. + * parallel with paramNames + */ + protected final Vector paramAutoCoerce = new Vector(); + + /** + * Creates a Printname for a normal GF function + * @param myFun the function name + * @param myPrintname the printname given for this function + * @param myFullnames the Hashtable for the full names for the category + * names for the shortnames like \\%PREDEF + * @param type The type of this fun. + * If null, it won't be displayed in the refinement menu. + */ + public Printname(String myFun, String myPrintname, Hashtable myFullnames, String type) { + myFun = myFun.trim(); + myPrintname = myPrintname.trim(); + this.printname = myPrintname; + this.subcatNameHashtable = myFullnames; + this.type = type; + if (myFullnames == null) { + //if the menu language is abstract, no fullnames are loaded + //and the fun will be in the used showname + this.funPresent = true; + } else { + this.funPresent = false; + } + + //parse the fun name + { + int index = myFun.indexOf('.'); + if (index > -1) { + //a valid fun name must not be empty + this.fun = myFun.substring(index + 1); + this.module = myFun.substring(0, index); + } else { + this.fun = myFun; + this.module = null; + } + } + + //parse the parameters and cut that part + { + int index = Utils.indexOfNotEscaped(myPrintname, PARAM); + if (index > -1) { + String paramPart = myPrintname.substring(index); + String splitString; + //split takes a regexp as an argument. So we have to escape the '\' again. + if (PARAM.startsWith("\\")) { + splitString = "\\" + PARAM; + } else { + splitString = PARAM; + } + String[] params = paramPart.split(splitString); + //don't use the first split part, since it's empty + for (int i = 1; i < params.length; i++) { + String current = params[i]; + boolean autocoerce = false; + if (AUTO_COERCE.equals(current.substring(0,1))) { + autocoerce = true; + //cut the ! + current = current.substring(1); + } + int nameEnd = current.indexOf(' '); + int nameEnd2 = Utils.indexOfNotEscaped(current, PARAM); + if (nameEnd == -1) { + nameEnd = current.length(); + } + String name = current.substring(0, nameEnd); + String description; + if (nameEnd < current.length() - 1) { + description = current.substring(nameEnd + 1).trim(); + } else { + description = ""; + } + this.paramNames.addElement(name); + this.paramTexts.addElement(description); + this.paramAutoCoerce.addElement(new Boolean(autocoerce)); + } + myPrintname = myPrintname.substring(0, index); + } + } + + + //extract the subcategory part and cut that part + { + int index = Utils.indexOfNotEscaped(myPrintname, SUBCAT); + if (index > -1) { + String subcatPart = myPrintname.substring(index); + myPrintname = myPrintname.substring(0, index); + int indFull = subcatPart.indexOf('{'); + if (indFull > -1) { + int indFullEnd = subcatPart.indexOf('}', indFull + 1); + if (indFullEnd == -1) { + indFullEnd = subcatPart.length(); + } + String fullName = subcatPart.substring(indFull + 1, indFullEnd); + this.subcat = subcatPart.substring(0, indFull).trim(); + this.subcatNameHashtable.put(this.subcat, fullName); + if (subcatLogger.isLoggable(Level.FINER)) { + subcatLogger.finer("new fullname '" + fullName + "' for category (shortname) '" + this.subcat + "'"); + } + } else { + subcat = subcatPart.trim(); + } + + } else { + this.subcat = null; + } + } + } + + /** + * a constructor for GF command that don't represent functions, + * like d, ph, ac + * @param command the GF command + * @param explanation an explanatory text what this command does + * @param funPresent If explanation already contains the fun. + * If true, the fun won't be printed in the refinement menu. + */ + protected Printname(String command, String explanation, boolean funPresent) { + this.fun = command; + this.subcatNameHashtable = null; + this.subcat = null; + this.module = ""; + this.printname = explanation; + this.type = null; + this.funPresent = funPresent; + } + + /** + * Special constructor for bound variables. + * These printnames don't get saved since they don't always exist and + * also consist of quite few information. + * @param bound The name of the bound variable + */ + public Printname(String bound) { + this.fun = bound; + this.subcatNameHashtable = null; + this.subcat = null; + this.module = null; + this.printname = bound; + this.type = null; + this.funPresent = false; + } + + /** + * the text that is to be displayed in the refinement lists + */ + public String getDisplayText() { + String result; + result = extractDisplayText(this.printname); + return result; + } + + /** + * the text that is to be displayed as the tooltip. + * Will always be enclosed in <html> </html> tags. + */ + public String getTooltipText() { + if (this.displayedPrintname != null) { + return this.displayedPrintname; + } else { + String result; + result = extractTooltipText(this.printname); + if (this.paramNames.size() > 0) { + String params = htmlifyParams(); + //will result in <html> wrapping + result = htmlAppend(result, params); + } else { + //wrap in <html> by force + result = htmlAppend(result, ""); + } + this.displayedPrintname = result; + return result; + } + } + + /** + * extracts the part of the body of the printname that is the tooltip + * @param myPrintname the body of the printname + * @return the tooltip + */ + public static String extractTooltipText(String myPrintname) { + //if the description part of the fun has no \\$ to denote a tooltip, + //but the subcat description has one, than we must take extra + //caution + final int indTT = Utils.indexOfNotEscaped(myPrintname, TT_START); + final int indSC = Utils.indexOfNotEscaped(myPrintname, SUBCAT); + int ind; + if ((indSC > -1) && (indSC < indTT)) { + ind = -1; + } else { + ind = indTT; + } + String result; + if (ind > -1) { + result = myPrintname.substring(ind + TT_START.length()); + } else { + result = myPrintname; + } + ind = Utils.indexOfNotEscaped(result, SUBCAT); + if (ind > -1) { + result = result.substring(0, ind); + } + ind = Utils.indexOfNotEscaped(result, PARAM); + if (ind > -1) { + result = result.substring(0, ind); + } + return result; + } + + /** + * extracts the part of the body of the printname that is the + * text entry for the JList + * @param myPrintname the body of the printname + * @return the one-line description of this Printname's fun + */ + public static String extractDisplayText(String myPrintname) { + String result; + int ind = Utils.indexOfNotEscaped(myPrintname, TT_START); + if (ind > -1) { + result = myPrintname.substring(0, ind); + } else { + result = myPrintname; + } + ind = Utils.indexOfNotEscaped(result, SUBCAT); + if (ind > -1) { + result = result.substring(0, ind); + } + ind = Utils.indexOfNotEscaped(result, PARAM); + if (ind > -1) { + result = result.substring(0, ind); + } + + return result; + } + + /** + * Appends the given string insertion to original and + * returns the result. If original is already HTML, the appended + * text will get right before the </html> tag. + * If original is no HTML, it will be enclosed in <html> + * @param original The String that is to come before insertion + * @param insertion the String to be appended + * @return the aforementioned result. + */ + public static String htmlAppend(String original, String insertion) { + StringBuffer result; + if (original != null) { + result = new StringBuffer(original); + } else { + result = new StringBuffer(); + } + int htmlindex = result.indexOf("</html>"); + + if (htmlindex > -1) { + result.insert(htmlindex, insertion); + } else { + result.insert(0,"<html>").append(insertion).append("</html>"); + } + return result.toString(); + + } + + /** + * Prepends the given string insertion to original and + * returns the result. If original is already HTML, the appended + * text will get right after the <html> tag. + * If original is no HTML, it will be enclosed in <html> + * @param original The String that is to come after insertion + * @param insertion the String to be appended + * @return the aforementioned result. + */ + public static String htmlPrepend(String original, String insertion) { + StringBuffer result = new StringBuffer(original); + int htmlindex = result.indexOf("<html>"); + + if (htmlindex > -1) { + result.insert(htmlindex, insertion); + } else { + result.insert(0,insertion).insert(0,"<html>").append("</html>"); + } + return result.toString(); + + } + + /** + * wraps a single parameter with explanatory text + * into <dt> and <dd> tags + * @param which the number of the parameter + * @return the resulting String, "" if the wanted parameter + * is not stored (illegal index) + */ + protected String htmlifyParam(int which) { + try { + String result = "<dt>" + this.paramNames.get(which) + "</dt>" + + "<dd>" + this.paramTexts.get(which) + "</dd>"; + return result; + } catch (ArrayIndexOutOfBoundsException e) { + subcatLogger.fine(e.getLocalizedMessage()); + return ""; + } + + } + + /** + * wraps a single parameter together with its explanatory text into + * a HTML definition list (<dl> tags). + * Also the result is wrapped in <html> tags. + * @param which the number of the parameter + * @return the resulting definition list, null if the param is not found. + */ + public String htmlifySingleParam(int which) { + String text = htmlifyParam(which); + if (text.equals("")) { + return null; + } + String result = "<html><dl>" + text + "</dl></html>"; + return result; + } + /** + * looks up the description for parameter number 'which' and returns it. + * Returns null, if no parameter description is present. + * @param which The number of the parameter + * @return s.a. + */ + public String getParamDescription(int which) { + return (String)paramTexts.get(which); + } + + /** + * wraps all parameters together with their explanatory text into + * a HTML definition list (<dl> tags). + * No <html> tags are wrapped around here, that is sth. the caller + * has to do! + * @return the resulting definition list, "" if which is larger than + * the amount of stored params + */ + public String htmlifyParams() { + if (this.paramNames.size() == 0) { + return ""; + } + StringBuffer result = new StringBuffer("<h4>Parameters:</h4><dl>"); + for (int i = 0; i < this.paramNames.size(); i++) { + result.append(htmlifyParam(i)); + } + result.append("</dl>"); + return result.toString(); + } + + /** + * a testing method that is not called from KeY. + * Probably things like this should be automated via JUnit ... + * @param args not used + */ + public static void main(String[] args) { + String SandS = "boolean 'and' for sentences$true iff both of the two given sentences is equivalent to true%BOOL#alpha the first of the two and-conjoined sentences#beta the second of the and-conjoined sentences"; + String FandS = "andS"; + Hashtable ht = new Hashtable(); + Printname pn = new Printname(FandS, SandS, ht, null); + System.out.println(pn); + for (int i = 0; i < pn.paramNames.size(); i++) { + System.out.println(pn.htmlifySingleParam(i)); + } + System.out.println(pn.getTooltipText()); + SandS = "boolean 'and' for sentences$true iff both of the two given sentences is equivalent to true%BOOL"; + FandS = "andS"; + pn = new Printname(FandS, SandS, ht, null); + System.out.println("*" + pn.getTooltipText()); + } + + public String toString() { + return getDisplayText() + " \n " + getTooltipText() + " (" + this.paramNames.size() + ")"; + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/PrintnameLoader.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/PrintnameLoader.java new file mode 100644 index 000000000..2cf5e9daa --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/PrintnameLoader.java @@ -0,0 +1,112 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.io.IOException; +import java.util.Hashtable; +import java.util.logging.*; +/** + * @author daniels + * asks GF to print all available printnames, parses that list and generates + * the suiting Printname objects. + */ +public class PrintnameLoader extends AbstractProber { + private final static Logger nogger = Logger.getLogger(Printname.class.getName()); + /** + * The PrintnameManager on which the read Printnames + * will be registered with their fun name. + */ + private final PrintnameManager printnameManager; + /** + * Here, the funs with their types get stored + */ + private final Hashtable funTypes = new Hashtable(); + /** + * if the Printnames should have their type appended to their display names + */ + private final boolean loadTypes; + /** + * an initializing constructor, does nothing except setting fields + * @param gfCapsule the read/write encapsulation of GF + * @param pm The PrintnameManager on which the read Printnames + * will be registered with their fun name. + * @param withTypes true iff the Printnames should have their type + * appended to their display names + */ + public PrintnameLoader(GfCapsule gfCapsule, PrintnameManager pm, boolean withTypes) { + super(gfCapsule); + this.printnameManager = pm; + this.loadTypes = withTypes; + } + + /** + * Reads the tree child of the XML from beginning to end. + * Sets autocompleted to false, if the focus position is open. + */ + protected void readMessage() { + try { + String result = gfCapsule.fromProc.readLine(); + if (nogger.isLoggable(Level.FINER)) { + nogger.finer("1 " + result); + } + //first read line is <message>, but this one gets filtered out in the next line + while (result.indexOf("/message")==-1){ + result = result.trim(); + if (result.startsWith("printname fun ")) { + //unescape backslashes. Probably there are more + result = Linearization.unescapeTextFromGF(result); + this.printnameManager.addNewPrintnameLine(result, this.funTypes); + } + + result = gfCapsule.fromProc.readLine(); + if (nogger.isLoggable(Level.FINER)) { + nogger.finer("1 " + result); + } + } + if (nogger.isLoggable(Level.FINER)) { + nogger.finer("finished loading printnames"); + } + } catch(IOException e){ + System.err.println(e.getMessage()); + e.printStackTrace(); + } + + } + + /** + * asks GF to print a list of all available printnames and + * calls the registered PrintnameManager to register those. + * @param lang The module for which the grammars should be printed. + * If lang is "" or null, the last read grammar module is used. + */ + protected void readPrintnames(String lang) { + //before, we want the types to be read. + if (this.loadTypes) { + TypesLoader tl = new TypesLoader(gfCapsule, this.funTypes); + tl.readTypes(); + } + //prints the printnames of the last loaded grammar, + String sendString = "gf pg -printer=printnames"; + if (lang != null && !("".equals(lang))) { + sendString = sendString + " -lang=" + lang; + } + nogger.fine("collecting printnames :" + sendString); + send(sendString); + readGfedit(); + } + + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/PrintnameManager.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/PrintnameManager.java new file mode 100644 index 000000000..685dcf000 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/PrintnameManager.java @@ -0,0 +1,174 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; +import java.util.Hashtable; +import java.util.logging.*; + +/** + * @author daniels + * + * An object of this class manages a bunch of printlines which is comprised of + * storage and retrieval. Also giving the subcategory shortnames their long + * counterpart is done here. + */ +class PrintnameManager { + /** + * This constructor is a bit of a hack. + * It puts the \%SELF subcat into this.printnames. + * This subcat does not appear in the grammars and thus is + * introduced here. If it is defined there although, this + * definition is used. So it does not hurt. + */ + public PrintnameManager() { + this.subcatNames.put(SELF_SUBCAT, "properties of self\\$shortcuts to the properties of self, that have a fitting type"); + } + + /** + * The name of the subcat, that is used for the easy property access + * of self. + */ + static final String SELF_SUBCAT = "\\%SELF"; + + private static Logger logger = Logger.getLogger(Printname.class.getName()); + + protected final static String frontMatter = "printname fun "; + + /** + * The hashmap for the names of the sub categories, + * with the shortname starting with '%' as the key. + * It is important that all Printnames of one session share the same + * instance of Hashtable here. + * This field is not static because there can be several instances of + * the editor that shouldn't interfere. + */ + protected final Hashtable subcatNames = new Hashtable(); + + /** + * contains all the Printnames with the fun names as keys + */ + protected final Hashtable printnames = new Hashtable(); + + /** + * processes a line from the "gf pg -printer=printnames" command + * @param line the read line from GF + * Should look like + * printname fun neq = "<>," ++ ("parametrized" ++ ("disequality$to" ++ ("compare" ++ ("two" ++ ("instances" ++ ("on" ++ ("a" ++ ("specific" ++ "type%COMP")))))))) + * and needs to get like + * printname fun neq = "<>, parametrized disequality$to compare two instances on a specific type%COMP" + * @param funTypes contains funs, mapped to their types + */ + public void addNewPrintnameLine(String line, Hashtable funTypes) { + line = removePluses(line); + + //remove "printname fun " (the frontMatter) + final int index = line.indexOf(frontMatter); + line = line.substring(index + frontMatter.length()).trim(); + + //extract fun name + final int endFun = line.indexOf(' '); + final String fun = line.substring(0, endFun); + final String type = (String)funTypes.get(fun); + //extract printname + String printname = line.substring(line.indexOf('"') + 1, line.lastIndexOf('"')); + + addNewPrintname(fun, printname, type); + } + + /** + * The printname printer of pg spits out no String, but a wrapping of + * small Strings conjoined with ++ which includes lots of parantheses. + * @param line The GF line from pg -printer=printnames + * @return a String representing the actual printname without the clutter + */ + protected static String removePluses(String line) { + line = line.replaceAll("\"\\)*\\s*\\+\\+\\s*\\(*\""," "); + int index = line.lastIndexOf('"'); + line = line.substring(0, index + 1); + return line; + } + + + /** + * Constructs the actual printname and puts it into printnames + * @param myFun the GF abstract fun name + * @param myPrintname the printname given by GF + */ + protected void addNewPrintname(String myFun, String myPrintname, String type) { + if (logger.isLoggable(Level.FINER)) { + logger.finer("addNewPrintname, myFun = '" + myFun + "' , myPrintname = '" + myPrintname + "'"); + } + Printname printname = new Printname(myFun, myPrintname, this.subcatNames, type); + if (logger.isLoggable(Level.FINER)) { + logger.finer("printname = '" + printname + "'"); + } + this.printnames.put(myFun, printname); + } + + /** + * looks for the Printname corresponding to the given fun. + * If the fun is qualified with a module and no Printname + * is found with module, another lookup without the module part + * is made. + * @param myFun the GF abstract fun name (with or without qualification) + * @return the corresponding Printname iff that one exists, null otherwise + */ + public Printname getPrintname(String myFun) { + Printname result = null; + if (this.printnames.containsKey(myFun)) { + result = (Printname)this.printnames.get(myFun); + } else { + int index = myFun.indexOf('.'); + if (index > -1) { + //a valid fun name must not be empty + String fun = myFun.substring(index + 1); + if (printnames.containsKey(fun)) { + result = (Printname)this.printnames.get(fun); + } + } + } + if (result == null) { + //?n indicates that myFun is a metavariable of GF, + // which does not occur in the refinement menu. + // if that is not wanted, don't call this method! + if (!myFun.startsWith("?")) { + logger.fine("no printname for '" + myFun + "', pretend that it is a bound variable"); + return new Printname(myFun); + } + } + return result; + } + + /** + * looks up the full name for the subcategory name shortname. + * This is the %SOMETHING from the printname. + * @param shortname The subcat name which should get expanded + * @return the corresponding full name, maybe null! + */ + public String getFullname(String shortname) { + String result = (String)this.subcatNames.get(shortname); + return result; + } + + public static void main(String[] args) { + String a = "printname fun stringLiteral = \"arbitrary\" ++ (\"String$click\" ++ (\"read\" ++ (\"and\" ++ (\"enter\" ++ (\"the\" ++ (\"String\" ++ (\"in\" ++ (\"the\" ++ (\"dialog\" ++ (\"TODO%STRING(String\" ++ \"operations)\"))))))))))"; + System.out.println(a); + System.out.println(removePluses(a)); + a = "printname fun count = \"count\" ++ (\"the\" ++ (\"occurances\" ++ (\"of\" ++ (\"an\" ++ (\"object\" ++ (\"in\" ++ (\"the\" ++ \"collection.\")))))))++ (\"%COLL\" ++ (\"#collElemType\" ++ (\"The\" ++ (\"official\" ++ (\"element\" ++ (\"type\" ++ (\"of\" ++ (\"<i>coll</i>.<br>That\" ++ (\"is,\" ++ (\"the\" ++ (\"parameter\" ++ (\"type\" ++ (\"of\" ++ \"<i>coll</i>\")))))))))))++ (\"#set\" ++ (\"The\" ++ (\"Set\" ++ (\"in\" ++ (\"which\" ++ (\"occurances\" ++ (\"of\" ++ (\"<i>elem</i>\" ++ (\"are\" ++ (\"to\" ++ (\"be\" ++ \"counted.\")))))))))) ++ (\"#elem\" ++ (\"The\" ++ (\"instance\" ++ (\"of\" ++ (\"which\" ++ (\"the\" ++ (\"occurances\" ++ (\"in\" ++ (\"<i>coll</i>\" ++ (\"are\" ++ \"counted.\")))))))))))))"; + System.out.println(a); + System.out.println(removePluses(a)); + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ReadDialog.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ReadDialog.java new file mode 100644 index 000000000..3a0ea34f4 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ReadDialog.java @@ -0,0 +1,200 @@ +//Copyright (c) Janna Khegai 2004, Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.awt.BorderLayout; +import java.awt.Dimension; +import java.awt.Font; +import java.awt.GridLayout; +import java.awt.event.ActionEvent; +import java.awt.event.ActionListener; +import java.io.File; + +import javax.swing.ButtonGroup; +import javax.swing.JButton; +import javax.swing.JDialog; +import javax.swing.JFileChooser; +import javax.swing.JLabel; +import javax.swing.JPanel; +import javax.swing.JRadioButton; +import javax.swing.JTextField; + +import java.util.logging.*; + +/** + * Takes care of reading in Strings that are to be parsed and terms. + * @author daniels + * + */ +class ReadDialog implements ActionListener{ + /** XML parsing debug messages */ + private static Logger xmlLogger = Logger.getLogger(GFEditor2.class.getName() + "_XML"); + /** The window to which this class belongs */ + private final GFEditor2 owner; + /** is the main thing of this class */ + private final JDialog readDialog; + /** main area of the Read dialog (content pane)*/ + private final JPanel inputPanel = new JPanel(); + /** OK, Cancel, Browse in the Read dialog */ + private final JPanel inputPanel2 = new JPanel(); + /** in the Read dialog the OK button */ + private final JButton ok = new JButton("OK"); + /** in the Read dialog the Cancel button */ + private final JButton cancel = new JButton("Cancel"); + /** in the Read dialog the Browse button */ + private final JButton browse = new JButton("Browse..."); + /** groups inputField and inputLabel */ + private final JPanel inputPanel3 = new JPanel(); + /** for 'Read' to get the input */ + private final JTextField inputField = new JTextField(); + /** "Read: " */ + private final JLabel inputLabel = new JLabel("Read: "); + /** the radio group in the Read dialog to select Term or String */ + private final ButtonGroup readGroup = new ButtonGroup(); + /** to select to input a Term in the Read dialog */ + private final JRadioButton termReadButton = new JRadioButton("Term"); + /** to select to input a String in the Read dialog */ + private final JRadioButton stringReadButton = new JRadioButton("String"); + /** used for new Topic, Import and Browse (readDialog) */ + private final JFileChooser fc = new JFileChooser("./"); + /** + * if a user sends a custom command to GF, he might want to do this + * again with the same command. + * Therefore it is saved. + */ + private String parseInput = ""; + /** + * if the user enters a term, he perhaps wants to input the same text again. + * Therefore it is saved. + */ + private String termInput = ""; + + /** + * creates a modal dialog + * @param owner The parent for which this dialog shall be modal. + */ + protected ReadDialog(GFEditor2 owner) { + this.owner = owner; + readDialog= new JDialog(owner, "Input", true); + readDialog.setLocationRelativeTo(owner); + readDialog.getContentPane().add(inputPanel); + readDialog.setSize(480,135); + + termReadButton.setActionCommand("term"); + stringReadButton.setSelected(true); + stringReadButton.setActionCommand("lin"); + // Group the radio buttons. + readGroup.add(stringReadButton); + readGroup.add(termReadButton); + JPanel readButtonPanel = new JPanel(); + readButtonPanel.setLayout(new GridLayout(3,1)); + readButtonPanel.setPreferredSize(new Dimension(70, 70)); + readButtonPanel.add(new JLabel("Format:")); + readButtonPanel.add(stringReadButton); + readButtonPanel.add(termReadButton); + inputPanel.setLayout(new BorderLayout(10,10)); + inputPanel3.setLayout(new GridLayout(2,1,5,5)); + inputPanel3.add(inputLabel); + inputPanel3.add(inputField); + ok.addActionListener(this); + browse.addActionListener(this); + cancel.addActionListener(this); + inputField.setPreferredSize(new Dimension(300,23)); + inputPanel.add(inputPanel3, BorderLayout.CENTER); + inputPanel.add(new JLabel(" "), BorderLayout.WEST); + inputPanel.add(readButtonPanel, BorderLayout.EAST); + inputPanel.add(inputPanel2, BorderLayout.SOUTH); + inputPanel2.add(ok); + inputPanel2.add(cancel); + inputPanel2.add(browse); + } + + /** + * Shows this modal dialog. + * The previous input text will be there again. + * + */ + protected void show() { + if (stringReadButton.isSelected()) { + inputField.setText(this.parseInput); + } else { + inputField.setText(this.termInput); + } + this.readDialog.setVisible(true); + } + + /** + * Sets the font of all GUI elements to font + * @param font + */ + protected void setFont(Font font) { + ok.setFont(font); + cancel.setFont(font); + inputLabel.setFont(font); + browse.setFont(font); + termReadButton.setFont(font); + stringReadButton.setFont(font); + } + + /** + * the ActionListener method that does the user interaction + */ + public void actionPerformed(ActionEvent ae) { + Object obj = ae.getSource(); + + if ( obj == cancel ) { + readDialog.setVisible(false); + } + + if ( obj == browse ) { + if (fc.getChoosableFileFilters().length<2) + fc.addChoosableFileFilter(new GrammarFilter()); + int returnVal = fc.showOpenDialog(owner); + if (returnVal == JFileChooser.APPROVE_OPTION) { + File file = fc.getSelectedFile(); + inputField.setText(file.getPath().replace('\\','/')); + } + } + + if ( obj == ok ) { + if (termReadButton.isSelected()) { + termInput = inputField.getText(); + if (termInput.indexOf(File.separatorChar)==-1){ + owner.send("[t] g "+termInput); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("sending term string"); + } else { + owner.send("[t] tfile "+termInput); + if (xmlLogger.isLoggable(Level.FINER)) { + xmlLogger.finer("sending file term: "+termInput); + } + } + } else { //String selected + parseInput = inputField.getText(); + if (parseInput.indexOf(File.separatorChar)==-1){ + owner.send("[t] p "+parseInput); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("sending parse string: "+parseInput); + } + else { + owner.send("[t] pfile "+parseInput); + if (xmlLogger.isLoggable(Level.FINER)) xmlLogger.finer("sending file parse string: "+parseInput); + } + } + readDialog.setVisible(false); + } + + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RealCommand.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RealCommand.java new file mode 100644 index 000000000..8d9b4f3f8 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RealCommand.java @@ -0,0 +1,255 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.util.HashSet; +import java.util.HashMap; +import java.util.logging.*; + +/** + * @author daniels + * This class represents a command, that is sent to GF. + * TODO Refactor the chain command stuff out of this class and make it a subclass + */ +class RealCommand extends GFCommand { + + /** + * maps shorthands to fullnames + */ + private final static HashMap fullnames = new HashMap(); + + private final static Logger logger = Logger.getLogger(Printname.class.getName()); + + /** + * The number of undo steps that is needed to undo this fun call + */ + public final int undoSteps; + + /** + * The text that GF sent to describe the command + */ + protected final String showText; + + protected final String subcat; + + /** + * Creates a Command that stands for a GF command, no link command + * sets all the attributes of this semi-immutable class. + * @param myCommand the actual GF command + * @param processedSubcats + * @param manager maps funs to previously read Printnames. + * Thus needs to be the same object. + * @param myShowText The text GF prints in the show part of the XML + * which should be the command followed by the printname + * @param mlAbstract is true, iff the menu language is set to Abstract + * Then no preloaded printnames are used. + * @param toAppend will be appended to the command, that is sent to GF. + * Normally, toAppend will be the empty String "". + * But it can be a chain command's second part. + * It will not be shown to the user. + */ + public RealCommand(final String myCommand, final HashSet processedSubcats, final PrintnameManager manager, final String myShowText, final boolean mlAbstract, final String toAppend) { + this(myCommand, processedSubcats, manager, myShowText, mlAbstract, toAppend, 1, null, null); + } + + /** + * Creates a Command that stands for a GF command, no link command + * sets all the attributes of this semi-immutable class. + * @param myCommand the actual GF command + * @param processedSubcats + * @param manager maps funs to previously read Printnames. + * Thus needs to be the same object. + * @param myShowText The text GF prints in the show part of the XML + * which should be the command followed by the printname + * @param mlAbstract is true, iff the menu language is set to Abstract + * Then no preloaded printnames are used. + * @param toAppend will be appended to the command, that is sent to GF. + * Normally, toAppend will be the empty String "". + * But it can be a chain command's second part. + * It will not be shown to the user. + * @param undoSteps The number of undo steps that is needed to undo this fun call + * @param printnameFun If the fun, that selects the printname, should not be read from + * myCommand. For single commands, this is the only fun. For chain command, the last is + * taken. With this parameter, this behaviour can be overwritten + * @param subcat Normally, every fun has its own Printname, which has a fixed + * category. Sometimes, for the properies of self for example, + * this should be overwritten. If null, the subcat from the printname is used. + */ + public RealCommand(final String myCommand, final HashSet processedSubcats, final PrintnameManager manager, final String myShowText, final boolean mlAbstract, String toAppend, int undoSteps, String printnameFun, String subcat) { + if (fullnames.isEmpty()) { + fullnames.put("w", "wrap"); + fullnames.put("r", "refine"); + fullnames.put("ch", "change head"); + fullnames.put("rc", "refine from history:"); + fullnames.put("ph", "peel head"); + } + if (logger.isLoggable(Level.FINEST)) { + logger.finest("new RealCommand: " + myCommand); + } + //if we have a ChainCommand, but undoSteps is just 1, count the undoSteps. + if ((undoSteps == 1) && (myCommand.indexOf(";;") > -1)) { + int occ = Utils.countOccurances(Utils.removeQuotations(myCommand), ";;") + 1; + this.undoSteps = occ; + } else { + this.undoSteps = undoSteps; + } + this.command = myCommand.trim(); + this.showText = myShowText; + this.subcat = subcat; + + //handle chain commands. + //Only the last command counts for the printname selection + final String lastCommand; + if (this.undoSteps > 1) { + //TODO: sth. like refine " f ;;d" ;; mp [2] will break here. + final int chainIndex = this.command.lastIndexOf(";;"); + lastCommand = this.command.substring(chainIndex + 2).trim(); + } else { + lastCommand = this.command; + } + + //extract command type + int ind = lastCommand.indexOf(' '); + if (ind > -1) { + this.commandType = lastCommand.substring(0, ind); + } else { + this.commandType = lastCommand; + } + + //extract the argument position for wrapping commands and cut that part + if (this.commandType.equals("w") || this.commandType.equals("ph")) { + int beforeNumber = lastCommand.lastIndexOf(' '); + int protoarg; + try { + String argumentAsString = lastCommand.substring(beforeNumber + 1); + protoarg = Integer.parseInt(argumentAsString); + } catch (Exception e) { + protoarg = -1; + } + this.argument = protoarg; + } else { + this.argument = -1; + } + + //extract the fun of the GF command + if (this.commandType.equals("w")) { + int beforePos = lastCommand.indexOf(' '); + int afterPos = lastCommand.lastIndexOf(' '); + if (beforePos > -1 && afterPos > beforePos) { + this.funName = lastCommand.substring(beforePos + 1, afterPos); + } else { + this.funName = null; + } + } else { + int beforePos = lastCommand.indexOf(' '); + if (beforePos > -1) { + this.funName = lastCommand.substring(beforePos + 1); + } else { + this.funName = null; + } + } + + //get corresponding Printname + if (this.commandType.equals("d")) { + this.printname = Printname.delete; + } else if (this.commandType.equals("ac")) { + this.printname = Printname.addclip; + } else if (this.commandType.equals("rc")) { + String subtree = this.showText.substring(3); + this.printname = new Printname(this.getCommand(), subtree + "\\$paste the previously copied subtree here<br>" + subtree, false); + } else if (this.commandType.equals("ph")) { + this.printname = Printname.peelHead(this.argument); + } else if (mlAbstract) { + //create a new Printname + this.printname = new Printname(funName, myShowText, null, null); + } else { //standard case + if (printnameFun == null) { + this.printname = manager.getPrintname(funName); + } else { + //overwrite mode. Until now, only for properties of self. + this.printname = manager.getPrintname(printnameFun); + } + } + + if (this.getSubcat() != null) { + if (processedSubcats.contains(this.getSubcat())) { + newSubcat = false; + } else { + newSubcat = true; + processedSubcats.add(this.getSubcat()); + } + } else { + newSubcat = false; + } + + //now append toAppend before it is too late. + //Only now, since it must not interfere with the things above. + if (toAppend != null) { + this.command += toAppend; + } + } + + /** + * the text that is to be displayed in the refinement lists + */ + public String getDisplayText() { + String result = ""; + if (this.printname.funPresent) { + result = this.printname.getDisplayText(); + } else { + if (fullnames.containsKey(this.commandType)) { + result = fullnames.get(this.commandType) + " '"; + } + result = result + this.printname.getDisplayText(); + if (fullnames.containsKey(this.commandType)) { + result = result + "'"; + } + } + if (this.commandType.equals("w")) { + String insertion = " as argument " + (this.argument + 1); + result = result + insertion; + } + if (this.printname.type != null) { + result = result + " : " + this.printname.type; + } + return result; + } + + /** + * the text that is to be displayed as the tooltip + */ + public String getTooltipText() { + String result; + result = this.printname.getTooltipText(); + if (this.commandType.equals("w")) { + String insertion = "<br>The selected sub-tree will be the " + (this.argument + 1) + ". argument of this refinement."; + result = Printname.htmlAppend(result, insertion); + } + return result; + } + + /** + * returns the subcat of this command + */ + public String getSubcat() { + if (this.subcat == null) { + return this.printname.getSubcat(); + } else { + //special case, only for properties of self so far + return this.subcat; + } + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinedAstNodeData.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinedAstNodeData.java new file mode 100644 index 000000000..bfd526593 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinedAstNodeData.java @@ -0,0 +1,68 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; +import java.util.logging.*; +/** + * @author daniels + * An object of this class represents a line in the GF abstract syntax tree + * in the graphical form. Well, not really, but how this line appears there + * and what its tooltip is is stored here. + * RefinedAstNodeData has its tooltip from the function it represents, not + * from its parent node. + */ +class RefinedAstNodeData extends AstNodeData { + + protected final Printname printname; + + /** + * all we have to know about an already refined node is its Printname + * and the GF line representing it + * @param pname the suiting Printname, may be null if the line could + * not be parsed + * @param node the GfAstNode for the current line + * @param pos The position in the GF AST of this node in Haskell notation + * @param selected if this is the selected node in the GF AST + * @param constraint A constraint from a parent node, that also + * applies for this node. + */ + public RefinedAstNodeData(Printname pname, GfAstNode node, String pos, boolean selected, String constraint) { + super(node, pos, selected, constraint); + this.printname = pname; + if (logger.isLoggable(Level.FINEST)) { + logger.finest(this.toString() + " - " + position); + } + } + + /** + * @return the printname associated with this object + */ + public Printname getPrintname() { + return this.printname; + } + + /** + * @return displays the tooltip of the registered Printname, + * which may be null + */ + public String getParamTooltip() { + if (getPrintname() != null) { + return getPrintname().getTooltipText(); + } else { + return null; + } + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinementMenu.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinementMenu.java new file mode 100644 index 000000000..46e4a2443 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinementMenu.java @@ -0,0 +1,518 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this applicationpackage de.uka.ilkd.key.ocl.gf; + +package de.uka.ilkd.key.ocl.gf; + +import java.awt.Color; +import java.awt.Font; +import java.awt.event.ActionEvent; +import java.awt.event.ActionListener; +import java.awt.event.KeyEvent; +import java.awt.event.KeyListener; +import java.awt.event.MouseAdapter; +import java.awt.event.MouseEvent; +import java.awt.event.MouseListener; +import java.util.Collections; +import java.util.HashSet; +import java.util.Hashtable; +import java.util.Iterator; +import java.util.Vector; +import java.util.logging.Level; +import java.util.logging.Logger; + +import javax.swing.DefaultListModel; +import javax.swing.JList; +import javax.swing.JMenu; +import javax.swing.JMenuItem; +import javax.swing.JPopupMenu; +import javax.swing.JScrollPane; +import javax.swing.JSplitPane; +import javax.swing.ListSelectionModel; + +/** + * Takes care of managing the commands, that GF sent, + * including subcategories and their menus. + * Manages the graphical lists. To display them, they are reachable + * via getRefinementListsContainer(). + * @author hdaniels + */ +class RefinementMenu { + /** + * logs things like selections and key events + */ + private static Logger logger = Logger.getLogger(RefinementMenu.class.getName()); + + /** + * the editor of which this menu is part of + */ + final private GFEditor2 editor; + /** + * the content of the refinementMenu + */ + public DefaultListModel listModel= new DefaultListModel(); + /** + * The list of current refinement options + */ + private JList refinementList = new JList(this.listModel); + /** + * to store the Vectors which contain the display names for the + * ListModel for refinementSubcatList for the different + * subcategory menus. + * The key is the shortname String, the value the Vector with the + * display Strings + */ + private Hashtable subcatListModelHashtable = new Hashtable(); + /** + * this ListModel gets refilled every time a %WHATEVER command, + * which stands for a shortname for a subcategory of commands + * in the ListModel of refinementList, is selected there + */ + private DefaultListModel refinementSubcatListModel = new DefaultListModel(); + /** + * The list of current refinement options in the subcategory menu + */ + private JList refinementSubcatList = new JList(this.refinementSubcatListModel); + /** + * the scrollpane containing the refinement subcategory + */ + private JScrollPane refinementSubcatPanel = new JScrollPane(this.refinementSubcatList); + /** + * store what the shorthand name for the current subcat is + */ + private String whichSubcat; + /** + * stores the two refinement JLists + */ + private JSplitPane refinementListsContainer; + /** + * the scrollpane containing the refinements + */ + private JScrollPane refinementPanel = new JScrollPane(this.refinementList); + /** + * here the GFCommand objects are stored + */ + private Vector gfcommands = new Vector(); + /** + * The cached popup menu containing the same stuff as the refinement list + */ + public JPopupMenu popup2 = new JPopupMenu(); + + /** + * Creates the panels for the refinement (subcat) menu + * @param editor the editor, that the refinement menu is part of + */ + protected RefinementMenu(GFEditor2 editor) { + this.editor = editor; + refinementListsContainer = new JSplitPane(JSplitPane.HORIZONTAL_SPLIT,refinementPanel, refinementSubcatPanel); + refinementList.setSelectionMode(ListSelectionModel.SINGLE_SELECTION); + + final MouseListener mlRefinementList = new MouseAdapter() { + public void mouseClicked(MouseEvent e) { + refinementList.setSelectionBackground(refinementSubcatList.getSelectionBackground()); + boolean doubleClick = (e.getClickCount() == 2); + listAction(refinementList, refinementList.locationToIndex(e.getPoint()), doubleClick); + } + }; + refinementList.addMouseListener(mlRefinementList); + refinementList.addKeyListener(new KeyListener() { + /** Handle the key pressed event for the refinement list. */ + public void keyPressed(KeyEvent e) { + int keyCode = e.getKeyCode(); + if (logger.isLoggable(Level.FINER)) { + logger.finer("Key pressed: " + e.toString()); + } + + int index = refinementList.getSelectedIndex(); + if (index == -1) { + //nothing selected, so nothing to be seen here, please move along + } else if (keyCode == KeyEvent.VK_ENTER) { + listAction(refinementList, refinementList.getSelectedIndex(), true); + } else if (keyCode == KeyEvent.VK_DOWN && index < listModel.getSize() - 1) { + listAction(refinementList, index + 1, false); + } else if (keyCode == KeyEvent.VK_UP && index > 0) { + listAction(refinementList, index - 1, false); + } else if (keyCode == KeyEvent.VK_RIGHT) { + if (refinementSubcatList.getModel().getSize() > 0) { + refinementSubcatList.requestFocusInWindow(); + refinementSubcatList.setSelectedIndex(0); + refinementList.setSelectionBackground(Color.GRAY); + } + } + } + + /** + * Handle the key typed event. + * We are not really interested in typed characters, thus empty + */ + public void keyTyped(KeyEvent e) { + //needed for KeyListener, but not used + } + + /** Handle the key released event. */ + public void keyReleased(KeyEvent e) { + //needed for KeyListener, but not used + } + }); + + refinementSubcatList.setSelectionMode(ListSelectionModel.SINGLE_SELECTION); + + final MouseListener mlRefinementSubcatList = new MouseAdapter() { + public void mouseClicked(MouseEvent e) { + boolean doubleClick = (e.getClickCount() == 2); + listAction(refinementSubcatList, refinementSubcatList.locationToIndex(e.getPoint()), doubleClick); + refinementList.setSelectionBackground(Color.GRAY); + } + }; + refinementSubcatList.addMouseListener(mlRefinementSubcatList); + refinementSubcatList.addKeyListener(new KeyListener() { + /** Handle the key pressed event. */ + public void keyPressed(KeyEvent e) { + int keyCode = e.getKeyCode(); + if (logger.isLoggable(Level.FINER)) { + logger.finer("Key pressed: " + e.toString()); + } + if (keyCode == KeyEvent.VK_ENTER) { + listAction(refinementSubcatList, refinementSubcatList.getSelectedIndex(), true); + } else if (keyCode == KeyEvent.VK_LEFT) { + refinementList.requestFocusInWindow(); + refinementSubcatList.clearSelection(); + refinementList.setSelectionBackground(refinementSubcatList.getSelectionBackground()); + } + } + + /** + * Handle the key typed event. + * We are not really interested in typed characters, thus empty + */ + public void keyTyped(KeyEvent e) { + //needed for KeyListener, but not used + } + + /** Handle the key released event. */ + public void keyReleased(KeyEvent e) { + //needed for KeyListener, but not used + } + }); + refinementList.setToolTipText("The list of current refinement options"); + refinementList.setCellRenderer(new ToolTipCellRenderer()); + refinementSubcatList.setToolTipText("The list of current refinement options"); + refinementSubcatList.setCellRenderer(new ToolTipCellRenderer()); + + } + + /** + * @return Returns the refinementListsContainer, + * which will contain both JLists. + */ + protected JSplitPane getRefinementListsContainer() { + return refinementListsContainer; + } + + /** + * handling the event of choosing the action at index from the list. + * That is either giving commands to GF or displaying the subcat menus + * @param list The list that generated this action + * @param index the index of the selected element in list + * @param doubleClick true iff a command should be sent to GF, + * false if only a new subcat menu should be opened. + */ + private void listAction(JList list, int index, boolean doubleClick) { + if (index == -1) { + if (logger.isLoggable(Level.FINER)) logger.finer("no selection"); + } else { + Object o; + if (list == refinementList) { + o = listModel.elementAt(index); + } else { + if (whichSubcat == null) { + //this is probably the case when no fitting properties of self + //are available and only a string is displayed in the submenu. + //clicking that string should do exactly nothing. + return; + } + Vector cmdvector = (Vector)this.subcatListModelHashtable.get(this.whichSubcat); + o = (cmdvector.get(index)); + } + GFCommand command = null; + if (o instanceof GFCommand) { + command = (GFCommand)o; + } else { + return; + } + if (command instanceof SelfPropertiesCommand) { + SelfPropertiesCommand spc = (SelfPropertiesCommand)command; + Vector selfs = spc.produceSubmenu(); + if (selfs.size() == 0) { + listModel.remove(index); + refinementSubcatListModel.clear(); + refinementSubcatListModel.addElement("No properties fit here"); + return; + } else { + this.subcatListModelHashtable.put(command.getSubcat(), selfs); + listModel.remove(index); + LinkCommand newLink = new LinkCommand(PrintnameManager.SELF_SUBCAT, editor.getPrintnameManager()); + listModel.add(index, newLink); + command = newLink; + } + } + if (command instanceof LinkCommand) { //includes SelfPropertiesCommand, which is intended + this.whichSubcat = command.getSubcat(); + refinementSubcatListModel.clear(); + Vector currentCommands = (Vector)this.subcatListModelHashtable.get(this.whichSubcat); + for (Iterator it = currentCommands.iterator(); it.hasNext();) { + this.refinementSubcatListModel.addElement(it.next()); + } + } else if (doubleClick && command instanceof InputCommand) { + InputCommand ic = (InputCommand)command; + editor.executeInputCommand(ic); + + } else if (doubleClick){ + refinementSubcatListModel.clear(); + if (command instanceof RealCommand) { + editor.send("[t] " + command.getCommand(), true, ((RealCommand)command).undoSteps); + } else { + //that shouldn't be the case ... + editor.send("[t] " + command.getCommand()); + } + } else if (list == refinementList){ + refinementSubcatListModel.clear(); + } + } + } + /** + * Produces the popup menu that represents the current refinements. + * An alternative to the refinement list. + * @return s.a. + */ + protected JPopupMenu producePopup() { + if (popup2.getComponentCount() > 0) { + return popup2; + } + for (int i = 0; i < this.listModel.size(); i++) { + GFCommand gfcmd = (GFCommand)this.listModel.get(i); + if (gfcmd instanceof LinkCommand) { + LinkCommand lc = (LinkCommand)gfcmd; + Vector subcatMenu = (Vector)this.subcatListModelHashtable.get(lc.getSubcat()); + JMenu tempMenu = new JMenu(lc.getDisplayText()); + tempMenu.setToolTipText(lc.getTooltipText()); + tempMenu.setFont(popup2.getFont()); + JMenuItem tempMenuItem; + for (Iterator it = subcatMenu.iterator(); it.hasNext();) { + GFCommand subgfcmd = (GFCommand)it.next(); + tempMenuItem = menuForCommand(subgfcmd); + if (tempMenuItem != null) { + tempMenu.add(tempMenuItem); + } + } + popup2.add(tempMenu); + } else { + JMenuItem tempMenu = menuForCommand(gfcmd); + if (tempMenu != null) { + popup2.add(tempMenu); + } + } + } + return popup2; + } + + /** + * takes a GFCommand and "transforms" it in a JMenuItem. + * These JMenuItems have their own listeners that take care of + * doing what is right ... + * @param gfcmd a RealCommand or an InputCommand + * (LinkCommand is ignored and produces null as the result) + * @return either the correspondend JMenuItem or null. + */ + private JMenuItem menuForCommand(GFCommand gfcmd) { + JMenuItem tempMenu = null; + if (gfcmd instanceof RealCommand){ + tempMenu = new JMenuItem(gfcmd.getDisplayText()); + tempMenu.setFont(popup2.getFont()); + tempMenu.setActionCommand(gfcmd.getCommand()); + tempMenu.setToolTipText(gfcmd.getTooltipText()); + tempMenu.addActionListener(new ActionListener() { + public void actionPerformed(ActionEvent ae) { + JMenuItem mi = (JMenuItem)ae.getSource(); + refinementSubcatListModel.clear(); + String command = "[t] " + mi.getActionCommand(); + editor.send(command); + } + }); + } else if (gfcmd instanceof InputCommand) { + tempMenu = new JMenuItem(gfcmd.getDisplayText()); + tempMenu.setFont(popup2.getFont()); + tempMenu.setActionCommand(gfcmd.getCommand()); + tempMenu.setToolTipText(gfcmd.getTooltipText()); + tempMenu.addActionListener(new ActionListener() { + public void actionPerformed(ActionEvent ae) { + JMenuItem mi = (JMenuItem)ae.getSource(); + String command = mi.getActionCommand(); + InputCommand ic = InputCommand.forTypeName(command); + if (ic != null) { + editor.executeInputCommand(ic); + } + } + }); + + } + return tempMenu; + } + /** + * Takes the StringTuples in gfCommandVector, creates the RealCommand + * objects for them. + * Goes through this list and groups the RealCommands + * according to their subcategory tag (which starts with %) + * If there is a "(" afterwards, everything until the before last + * character in the printname will be used as the display name + * for this subcategory. If this displayname is defined a second time, + * it will get overwritten. + * Sorting is also done here. + * Adding additional special commands like InputCommand happens here too. + * @param gfCommandVector contains all RealCommands, that are available + * at the moment + * @param toAppend will be appended to every command, that is sent to GF. + * Normally, toAppend will be the empty String "". + * But it can be a chain command's second part. + * @param isAbstract If the selected menu language is abstract or not + * @param easyAttributes if true, attributes of self will be added. + * @param focusPosition The current position of the focus in the AST. + * Needed for easy access to properties of self. + * @param gfCapsule The read/write encapsulation of the GF process. + * Needed for easy access to properties of self. + */ + protected void formRefinementMenu(final Vector gfCommandVector, final String toAppend, GfAstNode currentNode, final boolean isAbstract, boolean easyAttributes, LinPosition focusPosition, GfCapsule gfCapsule) { + this.listModel.clear(); + this.refinementSubcatListModel.clear(); + this.gfcommands.clear(); + this.subcatListModelHashtable.clear(); + this.whichSubcat = null; + this.popup2.removeAll(); + Vector prelListModel = new Vector(); + /** to keep track of subcats and their names */ + HashSet processedSubcats = new HashSet(); + //at the moment, we don't know yet, which subcats are + //nearly empty + for (Iterator it = gfCommandVector.iterator(); it.hasNext();) { + final StringTuple st = (StringTuple)it.next(); + GFCommand gfcommand; + if (st instanceof ChainCommandTuple) { + ChainCommandTuple cct = (ChainCommandTuple)st; + gfcommand = new RealCommand(st.first, processedSubcats, editor.getPrintnameManager(), st.second, isAbstract, toAppend, cct.undoSteps, cct.fun, cct.subcat); + } else { + gfcommand = new RealCommand(st.first, processedSubcats, editor.getPrintnameManager(), st.second, isAbstract, toAppend); + } + if ((!editor.isGroupSubcat()) || (gfcommand.getSubcat() == null)) { + prelListModel.addElement(gfcommand); + } else { + //put stuff in the correct Vector for the refinementSubcatListModel + Vector lm; + if (subcatListModelHashtable.containsKey(gfcommand.getSubcat())) { + lm = (Vector)this.subcatListModelHashtable.get(gfcommand.getSubcat()); + } else { + lm = new Vector(); + this.subcatListModelHashtable.put(gfcommand.getSubcat(), lm); + } + lm.addElement(gfcommand); + if (gfcommand.isNewSubcat()) { + GFCommand linkCmd = new LinkCommand(gfcommand.getSubcat(), editor.getPrintnameManager()); + prelListModel.addElement(linkCmd); + } + } + } + + //so we remove empty subcats now and replace them by their RealCommand + for (int i = 0; i < prelListModel.size(); i++) { + if (prelListModel.get(i) instanceof LinkCommand) { + LinkCommand lc = (LinkCommand) prelListModel.get(i); + Vector subcatMenu = (Vector)this.subcatListModelHashtable.get(lc.getSubcat()); + if (subcatMenu.size() == 1) { + RealCommand rc = (RealCommand)subcatMenu.get(0); + prelListModel.set(i, rc); + } + } + } + + + // Some types invite special treatment, like Int and String + // which can be read from the user. + if (currentNode.isMeta()) { + InputCommand usedInputCommand = null; + if (currentNode.getType().equals("Int")) { + usedInputCommand = InputCommand.intInputCommand; + prelListModel.addElement(usedInputCommand); + } if (currentNode.getType().equals("String")) { + usedInputCommand = InputCommand.stringInputCommand; + prelListModel.addElement(usedInputCommand); + } + if (usedInputCommand != null) { + for (Iterator it = usedInputCommand.enteredValues.iterator(); it.hasNext();) { + Object o = it.next(); + //for GF it seems to make no difference, + //if we use 'g' or 'r' as the command to send + //Int and String. 'r' is already supported + //by RealCommand, so I chose that. + RealCommand rc = new RealCommand("r " + o, processedSubcats, editor.getPrintnameManager(), "r " + o, isAbstract, toAppend); + prelListModel.addElement(rc); + } + } + } + + //add the special entry for the properties of self + if (easyAttributes) { + final SelfPropertiesCommand spc = new SelfPropertiesCommand(editor.getPrintnameManager(), gfCapsule, focusPosition, isAbstract, toAppend, processedSubcats); + prelListModel.add(spc); + } + + //now sort the preliminary listmodels + if (editor.isSortRefinements()) { + Collections.sort(prelListModel); + for (Iterator it = subcatListModelHashtable.values().iterator(); it.hasNext();) { + Vector slm = (Vector)it.next(); + Collections.sort(slm); + } + } + //now fill this.listModel + for (Iterator it = prelListModel.iterator(); it.hasNext();) { + Object next = it.next(); + this.listModel.addElement(next); + } + //select the first command in the refinement menu, if available + if (this.listModel.size() > 0) { + this.refinementList.setSelectedIndex(0); + } else { + this.refinementList.setSelectedIndex(-1); + } + this.refinementList.setSelectionBackground(refinementSubcatList.getSelectionBackground()); + } + + /** + * Requests the focus for the refinement list + */ + protected void requestFocus() { + refinementList.requestFocusInWindow(); + } + + /** + * clears the list model + */ + protected void reset() { + listModel.clear(); + } + + /** + * Applies newFont to the visible elements + * @param newFont The new font, what else? + */ + protected void setFont(Font newFont) { + refinementList.setFont(newFont); + refinementSubcatList.setFont(newFont); + popup2.setFont(newFont); + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinementMenuCollector.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinementMenuCollector.java new file mode 100644 index 000000000..4d7df9dac --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinementMenuCollector.java @@ -0,0 +1,51 @@ +package de.uka.ilkd.key.ocl.gf; + +import java.util.Vector; + +/** + * Asks GF the Vector of RefinementMenu entries. + * + * This class can be reused. + * @author daniels + */ +class RefinementMenuCollector extends AbstractProber { + /** + * here the result of this run is saved + */ + Vector refinementMenuContent = null; + /** + * Standard fill-in-the-parameters constructor + * @param gfCapsule The reader/writer to GF + */ + public RefinementMenuCollector(GfCapsule gfCapsule) { + super(gfCapsule); + } + + /** + * Asks GF (the same GF as the one editor has) to execute a command + * and returns the read refinement menu that is offered then. + * Uses the readRefinementMenu method from GFEditor2 which does not + * change any global variable besides GF itself. So that is safe. + * + * Note: This method does not do undo automatically, since it is + * intended to run several times in a row, so the u should be part of + * next command. + * @param command The command that is sent to GF. Should contain a mp + * to make sure that the command at the right position in the AST + * is read + * @return a Vector of StringTuple like readRefinementMenu does it. + */ + public Vector readRefinementMenu(String command) { + send(command); + readGfedit(); + return this.refinementMenuContent; + } + + /** + * parses the refinement menu part and stores it in this.refinementMenuContent + */ + protected void readMenu() { + this.refinementMenuContent = gfCapsule.readRefinementMenu(); + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinementMenuTransformer.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinementMenuTransformer.java new file mode 100644 index 000000000..ba1263db8 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/RefinementMenuTransformer.java @@ -0,0 +1,223 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.util.HashSet; +import java.util.Iterator; +import java.util.Vector; +import java.util.logging.Level; +import java.util.logging.Logger; + +/** + * This class is completely static and cannot be instantiated. + * @see #transformRefinementMenu(de.uka.ilkd.key.ocl.gf.TreeAnalysisResult, java.util.Vector, de.uka.ilkd.key.ocl.gf.GfCapsule) + * @author hdaniels + */ +class RefinementMenuTransformer { + /** + * if things are added to or removed from the refinement menu + */ + protected static Logger logger = Logger.getLogger(RefinementMenuTransformer.class.getName()); + + private RefinementMenuTransformer() { + //A private constructor enforces the noninstantiability + //of "RefinementMenuTransformer". + //(See item 3 of "Effective Java".) + } + + /** + * Depending on tar, the refinement menu given in raw form in oldMenu + * is transformed. + * That includes: + * - adding properties of self + * - producing a reduced version for subtyping below a coerce + * where only Instances of subtypes are listed + * - probes, if self and result are really applicable + * - changes the delete command, when an unrefined Instance + * argument of coerce is clicked on, to first delete the + * whole coerce to avoid sticking with wrong type arguments. + * @param tar TreeAnalyser has decided what to do here. That is followed. + * @param oldMenu The original content of the refinement menu. + * Is a Vector of StringTuple + * @param gfCapsule The encapsulation of GF regarding read/write access + * @return The refinement menu in its new form + */ + protected static Vector transformRefinementMenu(TreeAnalysisResult tar, Vector oldMenu, GfCapsule gfCapsule) { + //now do fill (or partially empty) the offered commands list + final Vector usedCommandVector; + if (tar.reduceCoerce) { + //is only true if switched on globally. + //And if conditions are right. + usedCommandVector = produceReducedCoerceRefinementMenu(tar.focusPosition.position, gfCapsule); + } else { + usedCommandVector = oldMenu; + } + if (tar.deleteAlsoAbove) { + String newPos = tar.focusPosition.parentPosition(); + StringTuple newDelete = new StringTuple("mp " + newPos + " ;; d", "delete current subtree\\$also delete the encompassing coercion "); + exchangeCommand(usedCommandVector, "d", newDelete); + } + if (tar.probeSelfResult) { + probeCompletability(usedCommandVector, tar.focusPosition, gfCapsule); + } + if (tar.easyAttributes && !tar.reduceCoerce) { + addSelfProperties(usedCommandVector, tar.focusPosition, gfCapsule); + } + return usedCommandVector; + } + + /** + * Looks at the subtyping witness of the same coerce as currentPos + * and collects the possible refinements for all offered subtypes. + * It assumes that argument 0 of coerce is automatically filled in. + * + * This method is surely <b>slow</b> since a lot of calls to GF is made + * here. + * @param currentPos musst point to a child of a coerce. + * @param gfCapsule The encapsulation of GF regarding read/write access + * @return a Vector of StringTuple as readRefinementMenu does. + * This Vector can be fed into formRefinementMenu. + */ + private static Vector produceReducedCoerceRefinementMenu(String currentPos, GfCapsule gfCapsule) { + final HashSet commands = new HashSet(); + RefinementMenuCollector rmc = new RefinementMenuCollector(gfCapsule); + //move to the subtype witness argument + final String collectSubtypesCommand = "mp " + LinPosition.calculateBrethrenPosition(currentPos, 2); + Vector possibleSubtypes = rmc.readRefinementMenu(collectSubtypesCommand); + String undoString = ""; + final String undoTemplate = "u 2 ;; "; + for (Iterator it = possibleSubtypes.iterator(); it.hasNext(); ) { + StringTuple nextCommand = (StringTuple)it.next(); +// if (!nextCommand.first.trim().startsWith("r")) { +// //no ac, d, rc or whatever wanted here. Only refine. +// continue; +// } + final String collectRefinementsCommand = undoString + nextCommand.first + " ;; mp " + currentPos; + undoString = undoTemplate; //for all following runs we want an undo before it + Vector nextRefinements = rmc.readRefinementMenu(collectRefinementsCommand); + commands.addAll(nextRefinements); + } + final String cleanupCommand = "u 3"; //undo the last command and also the first mp + rmc.readRefinementMenu(cleanupCommand); //no harm done here, collector won't get reused + Vector result = new Vector(commands); + return result; + } + + /** + * checks if result and self make sense in the current context. + * if not, they are removed from oldMenu + * @param oldMenu A Vector of StringTuple that represents the + * commands for the refinement menu + * @param focusPos The current position in the AST + * @param gfCapsule The encapsulation of GF regarding read/write access + */ + private static void probeCompletability(Vector oldMenu, LinPosition focusPos, GfCapsule gfCapsule) { + /** + * self and result both take two arguments. + * The first is the type, which is fixed + * if the second argument is refineable. + * Important is the second. + * This only is refineable for the real type of self/result + */ + if (focusPos == null) { + //sadly, we can't do much + return; + } + final String childPos = focusPos.childPosition(1); + final SelfResultProber cp = new SelfResultProber(gfCapsule); + for (int i = 0; i < oldMenu.size(); i++) { + String cmd = ((StringTuple)oldMenu.elementAt(i)).first; + if ((cmd != null) && ((cmd.indexOf("r core.self") > -1) || (cmd.indexOf("r core.result") > -1))) { + //the first mp is necessary for the second of self/result. + //without, GF will jump to a stupid position + String newCommand = "mp " + focusPos.position + " ;; " + cmd + " ;; mp " + childPos; + if (!cp.isAutoCompletable(newCommand, 3)) { + oldMenu.remove(i); + i -=1; + } + } + } + } + + /** + * Probes for the properties of self, that could be filled in at + * the current focus position. + * If it finds any, these are added to oldMenu + * This method will add all offered commands to the refinement menu, + * not only for suiting subtypes due to speed reasons. + * @param oldMenu A Vector of StringTuple. The menu with the commands + * and show texts as given by GF. Gets modified. + * @param focusPos The position of the GF focus in the AST + * @param gfCapsule The encapsulation of GF regarding read/write access + */ + private static void addSelfProperties(Vector oldMenu, LinPosition focusPos, GfCapsule gfCapsule) { + //solve in between to avoid some typing errors by closing some type arguments + final String probeCommand = "r core.implPropCall ;; mp " + focusPos.childPosition(2) + " ;; r core.self ;; solve ;; mp " + focusPos.childPosition(3); + final String deleteAppendix = " ;; d"; + final RefinementMenuCollector rmc = new RefinementMenuCollector(gfCapsule); + Vector futureRefinements = rmc.readRefinementMenu(probeCommand + deleteAppendix); + final int undos = 5; + final boolean singleRefinement; + if (futureRefinements.size() == 1) { + singleRefinement = true; + } else { + singleRefinement = false; + } + final String cleanupCommand = "u " + undos; + rmc.readRefinementMenu(cleanupCommand); //no harm done here + for (Iterator it = futureRefinements.iterator(); it.hasNext();) { + StringTuple st = (StringTuple)it.next(); + if (st.first.startsWith("r")) { //is a refinement, no ac or d + String newCommand; + //add the command that came before + final int cmdUndos; + if (singleRefinement) { + //that is an exceptional case, but might happen. + //Here we don't have to refine the final property + //at all, since GF does that automatically + newCommand = probeCommand + " ;; c solve"; + cmdUndos = 5; + } else { + //here the 'd' is not needed, since we know, + //that nothing is refined automatically + newCommand = probeCommand + " ;; " + st.first + " ;; c solve"; + cmdUndos = 6; + } + // now extract the fun of the property + String fun = st.first.substring(1).trim(); + ChainCommandTuple cct = new ChainCommandTuple(newCommand, st.second, fun, PrintnameManager.SELF_SUBCAT, cmdUndos); + if (logger.isLoggable(Level.FINER)) { + logger.finer("added " + cct); + } + oldMenu.add(cct); + } + } + } + + /** + * Goes through oldMenu and if it finds a command in there, where + * first.equals(oldCommand), this command is replaced by newCommand. + * oldMenu's content thus gets modified. + * @param oldMenu a Vector of StringTuple + * @param oldCommand a GF command string (what is sent, not the show text) + * @param newCommand a StringTuple representing what could be a pait from GF + */ + private static void exchangeCommand(Vector oldMenu, String oldCommand, StringTuple newCommand) { + for (int i = 0; i < oldMenu.size(); i++) { + StringTuple next = (StringTuple)oldMenu.get(i); + if (next.first.equals(oldCommand)) { + oldMenu.remove(i); + oldMenu.insertElementAt(newCommand, i); + } + } + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/SelfPropertiesCommand.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/SelfPropertiesCommand.java new file mode 100644 index 000000000..60ee86c64 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/SelfPropertiesCommand.java @@ -0,0 +1,175 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this applicationpackage de.uka.ilkd.key.ocl.gf; + +package de.uka.ilkd.key.ocl.gf; +import java.util.Collections; +import java.util.HashSet; +import java.util.Iterator; +import java.util.Vector; +import java.util.logging.Level; +import java.util.logging.Logger; + +/** + * This class is an unclean hack. + * The whole refinement menu architecture expected, that everything is probed, + * when the refinement menu is getting created. + * But for getting only subtype correct properties of self needs a number of + * calls to GF, which could be deferred to not make things slower than they + * already are. + * This deferred probing is done in this class. + * @author daniels + * + */ +class SelfPropertiesCommand extends LinkCommand { + private final static Logger logger = Logger.getLogger(SelfPropertiesCommand.class.getName()); + private final GfCapsule gfCapsule; + private final LinPosition focusPos; + private final String toAppend; + private final boolean isAbstract; + private final HashSet processedSubcats; + private final PrintnameManager printnameManager; + + /** + * A simple setter constructor, no calculation done here. + * @param manager The printname manager, that knows, how the properties + * of self should be listed in the refinement menu + * @param gfCapsule The reader/writer abstraction from GF + * @param focusPos The position of the GF focus + * @param isAbstract if Abstract is the current menu language + * @param toAppend If something should be appended to the command + * @param processedSubcats Here, the subcat for self is put into + */ + public SelfPropertiesCommand(final PrintnameManager manager, GfCapsule gfCapsule, LinPosition focusPos, boolean isAbstract, String toAppend, HashSet processedSubcats) { + super(PrintnameManager.SELF_SUBCAT, manager); + this.gfCapsule = gfCapsule; + this.printnameManager = manager; + this.focusPos = focusPos; + this.processedSubcats = processedSubcats; + this.toAppend = toAppend; + this.isAbstract = isAbstract; + } + + /** + * @return a Vector of RealCommand containing the suitable properties + * of self at the current focus position. + * Subtyping is taken into account, so only properties with a subtype + * of the supertype of the coerce above (at other places this method + * is not applicable) show up in this menu. + * The method used is similiar to the one for Instances below a coerce. + */ + Vector produceSubmenu() { + logger.fine("SelfPropertiesCommand asked to produce a menu"); + //HashSet to prevent duplicates + final HashSet commands = new HashSet(); + RefinementMenuCollector rmc = new RefinementMenuCollector(gfCapsule); + //move to the subtype witness argument + final String collectSubtypesCommand = "mp " + LinPosition.calculateBrethrenPosition(focusPos.position, 2); + final Vector possibleSubtypes = rmc.readRefinementMenu(collectSubtypesCommand); + String undoString = ""; + int undos = 0; + //for the case, that there is only one possible refinement at all + //which gets automatically filled in + final StringBuffer singleReplacement = new StringBuffer(); + //loop through the offered Subtype refinements + for (Iterator it = possibleSubtypes.iterator(); it.hasNext(); ) { + StringTuple nextCommand = (StringTuple)it.next(); + if (!nextCommand.first.trim().startsWith("r")) { + //no ac, d, rc or whatever wanted here. Only refine. + continue; + } + final String commandPrefix = undoString + nextCommand.first + " ;; mp " + focusPos.position + " ;; "; + logger.finer("commandPrefix: " + commandPrefix); + Vector futureRefinements = new Vector(); + undos = addSelfProperties(futureRefinements, commandPrefix, singleReplacement); + undos += 2; // to undo commandPrefix + undoString = "u " + undos + " ;; "; //for all following runs we want an undo before it +// Vector nextRefinements = rmc.readRefinementMenu(collectRefinementsCommand); + commands.addAll(futureRefinements); + } + final String cleanupCommand = "u " + (undos + 1); //undo the last command and also the first mp + rmc.readRefinementMenu(cleanupCommand); //no harm done here, collector won't get reused + Vector result = new Vector(); + for (Iterator it = commands.iterator(); it.hasNext();) { + StringTuple st = (StringTuple)it.next(); + if ((commands.size() == 1) && (st instanceof ChainCommandTuple)) { + //the case when only one property is available at all. + //Then this will automatically be selected + //To compensate for that, singleRefinement is used. + //This will be just one refinement, otherwise, we + //wouldn't be in this branch. + //This refinement does not contain the actual r + //command and therefore needs one undo step less + ChainCommandTuple cct = (ChainCommandTuple)st; + st = new ChainCommandTuple(singleReplacement.toString(), cct.second, cct.fun, cct.subcat, cct.undoSteps - 1); + } + GFCommand gfcommand; + if (st instanceof ChainCommandTuple) { + ChainCommandTuple cct = (ChainCommandTuple)st; + gfcommand = new RealCommand(st.first, processedSubcats, printnameManager, st.second, isAbstract, toAppend, cct.undoSteps, cct.fun, cct.subcat); + } else { + gfcommand = new RealCommand(st.first, processedSubcats, printnameManager, st.second, isAbstract, toAppend); + } + result.add(gfcommand); + } + Collections.sort(result); + return result; + } + + /** + * Probes for the properties of self, that could be filled in at + * the current focus position. + * If it finds any, these are added to result. + * @param result The Vector, that will get filled with the collected + * chain commands + * @param commandPrefix The prefix, that is to be prepended to the + * probing command. Used for refining with a Subtype witness and a + * mp to the Instance position, where this method expects to start. + * @param singleReplacement This is a hack for cases, when GF refines + * an refinement automatically. If that happens only for one subtype, + * then GF would fill that in automatically even when the supertype is + * open. Therefore, it must be omitted in the actual command. + * But this situation can only be checked after all subtypes have been + * probed. + * @return the number of undo steps needed to undo the probing command + * (without prefix, that is handled by the caller) + */ + private int addSelfProperties(final Vector result, final String commandPrefix, final StringBuffer singleReplacement) { + //solve in between to avoid some typing errors by closing some type arguments + final String probeCommand = "r core.implPropCall ;; mp " + focusPos.childPosition(2) + " ;; r core.self ;; solve ;; mp " + focusPos.childPosition(3); + final String deleteAppendix = " ;; d"; + final RefinementMenuCollector rmc = new RefinementMenuCollector(gfCapsule); + final String actualProbeCommand = commandPrefix + probeCommand + deleteAppendix; + logger.finer("&&& actual probe command:: " + actualProbeCommand); + Vector futureRefinements = rmc.readRefinementMenu(actualProbeCommand); + final int undos = 5; + for (Iterator it = futureRefinements.iterator(); it.hasNext();) { + StringTuple st = (StringTuple)it.next(); + if (st.first.startsWith("r")) { //is a refinement, no ac or d + String newCommand; + //add the command that came before + final int cmdUndos; + if (futureRefinements.size() == 1) { + //the case, when only one property is defined in the grammar: + singleReplacement.append(probeCommand + " ;; c solve"); + } + newCommand = probeCommand + " ;; " + st.first + " ;; c solve"; + cmdUndos = 6; + // now extract the fun of the property + String fun = st.first.substring(1).trim(); + ChainCommandTuple cct = new ChainCommandTuple(newCommand, st.second, fun, PrintnameManager.SELF_SUBCAT, cmdUndos); + if (logger.isLoggable(Level.FINE)) { + logger.finer("added " + cct); + } + result.add(cct); + } + } + return undos; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/SelfResultProber.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/SelfResultProber.java new file mode 100644 index 000000000..664a9d918 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/SelfResultProber.java @@ -0,0 +1,84 @@ +package de.uka.ilkd.key.ocl.gf; + +import java.util.logging.*; + +/** + * asks GF if the given commands leads to a situation, where + * something could be filled in automatically. + * This class is meant for self and result. + * @author daniels + */ +class SelfResultProber extends AbstractProber { + /** + * This field is true in the beginning of each run, and + * set to false, if the focus position when checking is found + * to be open. + */ + protected boolean autocompleted = true; + + protected static Logger nogger = Logger.getLogger(SelfResultProber.class.getName()); + /** + * A constructor which sets some fields + * @param gfCapsule The encapsulation of the running GF process + */ + public SelfResultProber(GfCapsule gfCapsule) { + super(gfCapsule); + } + + /** + * asks GF if the given commands leads to a situation, where + * something could be filled in automatically. + * This function is meant for self and result. + * IMPORTANT: Must be called <b>after</b> </gfedit> + * when no other method reads sth. from GF. + * It uses the same GF as everything else, since it tests if + * sth. is possible there. + * @param gfCommand the command to be tested. + * One has to chain a mp command to make GF go to the right place afterwards + * @param chainCount The number of chained commands in gfCommand. + * So many undos are done to clean up afterwards. + * @return true iff sth. could be filled in automatically + */ + public boolean isAutoCompletable(String gfCommand, int chainCount) { + this.autocompleted = true; + send(gfCommand); + readGfedit(); + final boolean result = this.autocompleted; + this.autocompleted = true; + //clean up and undo + send("u " + chainCount); + readAndIgnore(); + if (nogger.isLoggable(Level.FINE)) { + nogger.fine(result + " is the result for: '" + gfCommand +"'"); + } + return result; + } + + /** + * Reads the tree child of the XML from beginning to end. + * Sets autocompleted to false, if the focus position is open. + */ + protected void readTree() { + String treeString = gfCapsule.readTree(); + String[] treeArray = treeString.split("\\n"); + for (int i = 0; i < treeArray.length; i++) { + String result = treeArray[i].trim(); + if (result.startsWith("*")) { + result = result.substring(1).trim(); + if (result.startsWith("?")) { + //the normal case, focus position open + this.autocompleted = false; + } else if ((i >= 6) //that we could be at the instance argument at all + && (treeArray[i - 6].indexOf("coerce") > -1) //we are below a coerce + && (treeArray[i - 3].trim().startsWith("?")) //the Subtype argument is not filled in + // The super argument cannot be OclAnyC or even unrefined, because then this + // method wouldn't have been called. Thus, the Subtype argument is unique. + ){ + //we are below a coerce, but self would have a non-suiting subtype + this.autocompleted = false; + } + } + + } + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/StringTuple.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/StringTuple.java new file mode 100644 index 000000000..67f4326e1 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/StringTuple.java @@ -0,0 +1,54 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +/** + * Small tuple class for two Strings. + * The main use is grouping command and showname for GF commands before + * they are processed. + * This class is mutable. + * Equality is bound to the first argument. + * @author daniels + */ +class StringTuple { + String first; + String second; + + /** + * Just sets both values. + * @param f Well, the first String + * @param s Well, the second String + * (if it is used at all) + */ + public StringTuple(String f, String s) { + this.first = f; + this.second = s; + } + + public int hashCode() { + return this.first.hashCode(); + } + public boolean equals(Object o) { + if (o instanceof StringTuple) { + return this.first.equals(((StringTuple)o).first); + } else { + return false; + } + } + public String toString() { + return this.first; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/SubtypingProber.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/SubtypingProber.java new file mode 100644 index 000000000..9ff3c4f92 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/SubtypingProber.java @@ -0,0 +1,107 @@ +package de.uka.ilkd.key.ocl.gf; + +import java.util.logging.Logger; +import java.util.*; + +/** + * This class goes through the tree and tries to close all open Subtype lines. + * + * Makes heavy use of instance fields instead of parameters and return values. + * I justify that with the rather small size of this class. + * Because of this this class has to be reinitialized for each run. + * @author daniels + */ +class SubtypingProber extends RefinementMenuCollector { + private static Logger nogger = Logger.getLogger(SubtypingProber.class.getName()); + /** + * how many undos are needed to clean up behind this probing + */ + protected int undoSteps = 0; + /** + * the GF AST line by line + */ + protected String[] treeArray = new String[0]; + /** + * the pointer to the line, that has been read last + */ + protected int currentLine; + + /** + * Standard fill-in-the-parameters constructor + * @param gfCapsule The encapsulation of GF + */ + public SubtypingProber(GfCapsule gfCapsule) { + super(gfCapsule); + this.currentLine = 0; + } + + /** + * stores the read GF AST in treeArray + */ + protected void readTree() { + String treeString = gfCapsule.readTree(); + this.treeArray = treeString.split("\\n"); + } + + /** + * looks at the refinement menu for node number lineNumber in the AST + * and if there is only one refinement command offered, does + * execute this. + * @param lineNumber + */ + protected void checkLine(int lineNumber) { + String command = "mp [] ;; > " + lineNumber; + this.undoSteps += 2; + send(command); + readGfedit(); + Vector commands = new Vector(); + for (Iterator it = this.refinementMenuContent.iterator(); it.hasNext(); ) { + StringTuple next = (StringTuple)it.next(); + if (next.first.startsWith("r")) { + commands.add(next); + } + } + if (commands.size() == 0) { + //nothing can be done + nogger.fine("no refinement for '" + this.treeArray[lineNumber] + "'"); + } else if (commands.size() == 1) { + StringTuple nextCommand = (StringTuple)commands.lastElement(); + nogger.fine("one refinement for '" + this.treeArray[lineNumber] + "'"); + send(nextCommand.first); + this.undoSteps += 1; + // now new things are in the state, + // but since we assume that nothing above lineNumber changes, + // that is wanted. + readGfedit(); + } else { + nogger.fine(commands.size() + " refinements for '" + this.treeArray[lineNumber] + "'"); + } + } + + /** + * Asks GF for the AST and tries to hunt down all unrefined + * Subtype witnesses. + * @return the number of undo steps this run needed + */ + public int checkSubtyping() { + //solve to try to eliminate many unrefined places + send("c solve ;; mp []"); //focus at the top where '*' does not disturb + readGfedit(); + this.undoSteps += 2; + for (int i = 3; i < this.treeArray.length; i++) { + //the condition gets rechecked every run, and length will only grow + //We start at 3 since the witness is the third argument of coerce, + //before nothing can happen + //(sth. like "n core.Subtype" does not count! + //(starting with new category Subtype) ) + if (this.treeArray[i].indexOf(": Subtype") > -1) { + if (!this.treeArray[i - 2].startsWith("?") //both Class arguments refined + && !this.treeArray[i - 1].startsWith("?")) { + checkLine(i); + } + } + } + nogger.fine(this.undoSteps + " individual commands sent"); + return this.undoSteps; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ToolTipCellRenderer.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ToolTipCellRenderer.java new file mode 100644 index 000000000..b05aeeb87 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/ToolTipCellRenderer.java @@ -0,0 +1,71 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.awt.Component; +import javax.swing.JLabel; +import javax.swing.JList; +import javax.swing.ListCellRenderer; + +/** + * A cell renderer, that returns JLables, that put everything after the first + * '$' character into their tooltip + * @author daniels + */ +public class ToolTipCellRenderer extends JLabel implements ListCellRenderer { + + /** + * Returns a JLabel with a tooltip, which is given by the GFCommand + * @param list Well, the list this cell belongs to + * @param value value to display + * @param index cell index + * @param isSelected is the cell selected + * @param cellHasFocus the list and the cell have the focus + * @return a suiting JLabel + */ + public Component getListCellRendererComponent(JList list, Object value, int index, boolean isSelected, boolean cellHasFocus) { + if (isSelected) { + setBackground(list.getSelectionBackground()); + setForeground(list.getSelectionForeground()); + } + else { + setBackground(list.getBackground()); + setForeground(list.getForeground()); + } + setEnabled(list.isEnabled()); + setFont(list.getFont()); + setOpaque(true); + + + if (value == null) { + setText("Null-Value!!! Something went terribly wrong here!"); + } else if (value instanceof GFCommand){ + GFCommand gfc = (GFCommand)value; + String disText = gfc.getDisplayText(); + if (gfc instanceof LinkCommand) { + //italic font could be an alternative + disText = "-> " + disText; + } + setText(disText); + setToolTipText(gfc.getTooltipText()); + } else { + setText(value.toString()); + setToolTipText("Strange thing of class '" + value.getClass() + "'"); + } + return this; + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/TreeAnalyser.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/TreeAnalyser.java new file mode 100644 index 000000000..5edf2a16b --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/TreeAnalyser.java @@ -0,0 +1,387 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.util.Enumeration; +import java.util.logging.Level; +import java.util.logging.Logger; + +import javax.swing.tree.DefaultMutableTreeNode; + +/** + * Goes through the AST and: + * Labels node according to the following: + * hidden, if they are a coerce without a constraint + * colored, if they are a coerce with a constraint + * Saves a reference to the currently selected node + * Finds out + * if attributes of self should be given an easy access, + * if the refinement menu below a coerce should be reduces, + * if it should be probed, if self and result are superfluous + * in the refinement menu. + * if a coerce should be introduced automatically. + * Takes a tree and hides the nodes labelled as hidden in another stage. + * @author hdaniels + */ +class TreeAnalyser { + /** + * debug stuff for the tree + */ + private static Logger treeLogger = Logger.getLogger(TreeAnalyser.class.getName()); + /** + * dealing with coerce, when it is inserted and so on + */ + private static Logger coerceLogger = Logger.getLogger(TreeAnalyser.class.getName() + ".coerce"); + + /** + * if coerce should get hidden, if all their arguments are refined + */ + private boolean hideCoerce; + /** + * if coerce should always be hidden, + */ + private boolean hideCoerceAggressive; + /** + * if the refinement menu should get condensed at all + */ + private boolean coerceReduceRM; + /** + * if coerce should get introduced automatically at all + */ + private boolean autoCoerce; + /** + * if result and self should be shown always + */ + private boolean showSelfResult; + /** + * if properties of self should be probed for + */ + private boolean easyAttributes; + /** + * If coerces whith both Class arguments + */ + private boolean highlightSubtypingErrors; + + /** + * @param autoCoerce if coerce should get introduced automatically at all + * @param coerceReduceRM if the refinement menu should get condensed at all + * @param easyAttributes if properties of self should be probed for + * @param hideCoerce if coerce should get hidden, if all their arguments are refined + * @param hideCoerceAggressive if coerce should always be hidden, + * unless there is a GF constraint + * @param highlightSubtypingErrors If coerces whith both Class arguments + * refined, but not with the Subtype argument should get marked + * @param showSelfResult if result and self should be shown always + */ + public TreeAnalyser(boolean autoCoerce, boolean coerceReduceRM, boolean easyAttributes, boolean hideCoerce, boolean hideCoerceAggressive, boolean highlightSubtypingErrors, boolean showSelfResult) { + this.autoCoerce = autoCoerce; + this.coerceReduceRM = coerceReduceRM; + this.easyAttributes = easyAttributes; + this.hideCoerce = hideCoerce; + this.hideCoerceAggressive = hideCoerceAggressive; + this.highlightSubtypingErrors = highlightSubtypingErrors; + this.showSelfResult = showSelfResult; + } + + + /** + * Takes the rootNode of the AST and does some small analysis on it: + * Check for missing Subtype witnesses, + * check if the Instance menu of a Coerce can be reduced + * @param topNode The root or top node of the AST + * @return an object that contains the result of this analysis. + * Currently this applies only to the selected node. + * @see TreeAnalysisResult + */ + TreeAnalysisResult analyseTree(DefaultMutableTreeNode topNode) { + //just the initial values + String resultCommand = null; + int resultUndoSteps = -1; + boolean resultReduceCoerce = false; + boolean resultProbeSelfResult = false; + boolean resultDeleteAlsoAbove = false; + boolean resultEasyAttributes = false; + TreeAnalysisResult tar = new TreeAnalysisResult(resultCommand, resultUndoSteps, resultReduceCoerce, resultProbeSelfResult, resultDeleteAlsoAbove, resultEasyAttributes, null, null); + + //doing it depth first, because we have to know the subtypingStatus + //of the children of coerce before we analyze coerce itself + for (Enumeration e = topNode.depthFirstEnumeration() ; e.hasMoreElements() ;) { + DefaultMutableTreeNode currNode = (DefaultMutableTreeNode)e.nextElement(); + analyseTreeNode(currNode, tar); + } + AstNodeData and = (AstNodeData)tar.selectedNode.getUserObject(); + if ((and.showInstead != -1) && (tar.command == null)) { + //if the current node is hidden, move up in the tree, + //until a visible node is found + DefaultMutableTreeNode tn = (DefaultMutableTreeNode)tar.selectedNode.getParent(); + AstNodeData dand = null; + while (tn != null) { + dand = (AstNodeData)tn.getUserObject(); + if (dand.showInstead == -1) { + //found a visible node + break; + } + tn = (DefaultMutableTreeNode)tn.getParent(); + } + if (dand != null) { + tar.command = "[tr] mp " + dand.position; + tar.undoSteps = 1; + } //otherwise give up, can only occur, if coerce is the top node. + //And for that, one would have to do a "n Instance" first, + //which GF does not even offer. + } + return tar; + } + + /** + * Takes the rootNode of the AST and does some small analysis on it: + * Check for missing Subtype witnesses, + * check if the Instance menu of a Coerce can be reduced + * @param nodeToCheck The node that is to be analysed + * @param tar The result, that gets modified + * @see TreeAnalysisResult + */ + private void analyseTreeNode(DefaultMutableTreeNode nodeToCheck, TreeAnalysisResult tar) { + AstNodeData and = (AstNodeData)nodeToCheck.getUserObject(); + DefaultMutableTreeNode parent = (DefaultMutableTreeNode)nodeToCheck.getParent(); + Printname parentPrintname = null; + if ((parent != null) && (parent.getUserObject() != null) && (parent.getUserObject() instanceof AstNodeData)) { + AstNodeData parentAnd = (AstNodeData)parent.getUserObject(); + parentPrintname = parentAnd.getPrintname(); + } + + if (and.selected) { + tar.selectedNode = nodeToCheck; + tar.currentNode = and.node; + //set the focusPosition to a preliminary value + tar.focusPosition = new LinPosition(and.position, true); + //rather check too much for null + if (this.autoCoerce + && (and.node != null) + && and.node.isMeta() + && (parent != null) + && (parent.getUserObject() != null) + && (and.node.getType() != null) + && (and.node.getType().startsWith("Instance"))) { + //check, if a coerce is needed + GfAstNode parentNode = ((AstNodeData)parent.getUserObject()).node; + if (parentPrintname.getParamAutoCoerce(parent.getIndex(nodeToCheck))) { + coerceLogger.fine("Coerceable fun found: " + and.node + " + " + parentNode); + //refine with coerce. Do not allow another GF run, so [r] + tar.command = "[tr] r core.coerce ;; mp " + LinPosition.calculateChildPosition(and.position, 3); + tar.undoSteps = 2; //move there is also sth. to be undone + } else if ((parentNode.getFun().indexOf("coerce") > -1) + //to avoid getting stuck below a coerce with wrong type arguments + //the coerce above is deleted and rerefined. + + //coerce below a coerce is never done automatically, so the else if is justified, + //meaning, that introduced a coerce, we do not have to delete it right a away + && parent.getParent() != null + && (parent.getParent() instanceof DefaultMutableTreeNode)) { + DefaultMutableTreeNode grandParent = (DefaultMutableTreeNode)parent.getParent(); + if (grandParent != null) { + AstNodeData grandParentAnd = (AstNodeData)grandParent.getUserObject(); + Printname grandParentPrintname = grandParentAnd.getPrintname(); + + if (grandParentPrintname.getParamAutoCoerce(grandParent.getIndex(parent))) { + coerceLogger.fine("Auto-Coerce to be un- and redone: " + + and.node + " + " + parentNode + + " -- " + tar.focusPosition.position); + tar.command = "[tr] mp " + tar.focusPosition.parentPosition() + + " ;; d ;; mp " + tar.focusPosition.parentPosition() + + " ;; r core.coerce ;; mp " + tar.focusPosition.position; + tar.undoSteps = 6; + } + } + } + } + + if (coerceReduceRM + && (and.node != null) + && (and.node.getType() != null) + && (parent != null) + && (parent.getUserObject() != null) + && (((AstNodeData)parent.getUserObject()).getPrintname() != null) + && (((AstNodeData)parent.getUserObject()).getPrintname().fun.endsWith("coerce")) + && (and.node.getType().startsWith("Instance")) //if coerce, than we are the Instance argument + && (((DefaultMutableTreeNode)(parent.getChildAt(2))).getUserObject() != null) + && (parent.getChildAt(2) != null) + && ((AstNodeData)((DefaultMutableTreeNode)(parent.getChildAt(2))).getUserObject()).node.isMeta()) { + AstNodeData superTypeAnd = ((AstNodeData)((DefaultMutableTreeNode)(parent.getChildAt(1))).getUserObject()); + if (!superTypeAnd.node.isMeta() && (superTypeAnd.node.getFun().indexOf("OclAnyC") == -1)) { + //in these cases, everything goes. No sense in dozends of expensive GF runs then. + tar.reduceCoerce = true; + } + coerceLogger.fine("candidate for coerce reduction found: " + and.node + " + " + parent); + } + + if (showSelfResult + && (and.node != null) + && (and.node.getType() != null) + && (and.node.getType().startsWith("Instance")) + && (tar.reduceCoerce //not everything is allowed here + // if not below a coerce (covered above) and no constraints + || (and.node.getType().indexOf("{") == -1)) + ){ + //if there are constraints present, there is no point in probing, since + //then either no or every instance is offered. + //We do not have to probe then. + tar.probeSelfResult = true; + } + + if (easyAttributes + && (and.node != null) + && (and.node.getType() != null) + && (and.node.isMeta()) + && (and.node.getType().startsWith("Instance")) + ) { + //not much to check here + tar.easyAttributes = true; + } + } + + //check for subtyping errors + if (highlightSubtypingErrors + && (and.node != null) + && (and.node.getType() != null) + && (parent != null) + && (and.node.isMeta()) //otherwise GF would complain + && (and.node.getType().startsWith("Subtype")) //if coerce, than we are the Subtype argument + ) { + AstNodeData subtypeAnd = (AstNodeData)(((DefaultMutableTreeNode)(parent.getChildAt(0))).getUserObject()); + AstNodeData supertypeAnd = (AstNodeData)(((DefaultMutableTreeNode)(parent.getChildAt(1))).getUserObject()); + if ((subtypeAnd != null) && (supertypeAnd != null)) { + if (!supertypeAnd.node.isMeta() && !subtypeAnd.node.isMeta()) { + //if one of them is meta, then the situation is not fixed yet, + //so don't complain. + and.subtypingStatus = false; + } + } + } + //hide coerce if possible + //if coere is completely filled in (all children not meta), + //it will be replaced by child 3. + if (hideCoerce + && (and.node != null) + && (and.node.getType() != null) + && (and.node.getFun().endsWith("coerce")) + ) { + /** + * if true, then something is unfinished or constrained. + * So don't hide that node. + */ + boolean metaChild = false; + //check if constraints hold for this node + if ((and.constraint != null) && (and.constraint.length() > 0)) { + //some constraint holds here. + //We must not shroud a possible source for that. + metaChild = true; + } + //This search will only be run once for each coerce: + for (int i = 0; i < 3 && !metaChild; i++) { + //This is for the more complicated collection + //subtyping witnesses. + //we do a depthFirst search to find meta nodes. + //If they exist, we know that we shouldn't hide this node. + for (Enumeration e = ((DefaultMutableTreeNode)nodeToCheck.getChildAt(i)).depthFirstEnumeration() ; e.hasMoreElements() ;) { + DefaultMutableTreeNode currNode = (DefaultMutableTreeNode)e.nextElement(); + AstNodeData dand = (AstNodeData)currNode.getUserObject(); + if (!dand.subtypingStatus + //hideCoerceAggressive means that just incomplete type arguments are no reason to not hide the node + //only subtypingStatus is one because then surely there is an error + || (!hideCoerceAggressive && dand.node.isMeta())) { + metaChild = true; + break; //no need to go further + } + } + if (metaChild) { + break; + } + } + //For the Instance argument, we do not have do to a deep search + AstNodeData childAnd = (AstNodeData)(((DefaultMutableTreeNode)(nodeToCheck.getChildAt(3))).getUserObject()); + if (!hideCoerceAggressive && childAnd.node.isMeta()) { + //see reasons for hideCoerceAggressive above + metaChild = true; + } + + if (!metaChild) { + and.showInstead = 3; + //now label the type nodes as hidden + for (int i = 0; i < 3 && !metaChild; i++) { + //This is for the more complicated collection + //subtyping witnesses. + for (Enumeration e = ((DefaultMutableTreeNode)nodeToCheck.getChildAt(i)).depthFirstEnumeration() ; e.hasMoreElements() ;) { + DefaultMutableTreeNode currNode = (DefaultMutableTreeNode)e.nextElement(); + AstNodeData dand = (AstNodeData)currNode.getUserObject(); + dand.showInstead = -2; // tag for hidden without replacement + } + } + + } + + //if we are at a coerce above the selected Instance node, + //we want to mark that, so that the d command can be modified + if ((and.node != null) + && (and.node.getFun().endsWith("coerce")) + && (and.showInstead > -1) //only hidden coerce + && (((AstNodeData)((DefaultMutableTreeNode)nodeToCheck.getChildAt(3)).getUserObject()).selected) + ) { + tar.deleteAlsoAbove = true; + } + } + } + /** + * Removes nodes from the tree that has topNode as its root. + * Affected are nodes in which the field showInstead in their + * AstNodeData is greater than -1 + * @param topNode The root of the tree from which nodes should + * be removed. + * @return The root of the transformed tree. + * This might not be topNode, since that node might as well be + * removed. + */ + protected static DefaultMutableTreeNode transformTree(DefaultMutableTreeNode topNode) { + DefaultMutableTreeNode nextNode = topNode; + while (nextNode != null) { + AstNodeData and = (AstNodeData)nextNode.getUserObject(); + if (and.showInstead > -1) { + DefaultMutableTreeNode parent = (DefaultMutableTreeNode)nextNode.getParent(); + if (parent == null) { + topNode = (DefaultMutableTreeNode)nextNode.getChildAt(and.showInstead); + if (treeLogger.isLoggable(Level.FINE)) { + //yeah, I know, variable naming is messed up here because of the assignment above + treeLogger.fine("hiding topNode ###" + nextNode + "###, showing instead ###" + topNode + "###"); + } + nextNode = topNode; + } else { + final int index = parent.getIndex(nextNode); + parent.remove(index); + DefaultMutableTreeNode instead = (DefaultMutableTreeNode)nextNode.getChildAt(and.showInstead); + parent.insert(instead, index); + if (treeLogger.isLoggable(Level.FINE)) { + treeLogger.fine("hiding node ###" + nextNode + "###, showing instead ###" + instead + "###"); + } + nextNode = instead; + } + } else { + nextNode = nextNode.getNextNode(); + } + } + return topNode; + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/TreeAnalysisResult.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/TreeAnalysisResult.java new file mode 100644 index 000000000..1bcae3421 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/TreeAnalysisResult.java @@ -0,0 +1,92 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import javax.swing.tree.DefaultMutableTreeNode; + +/** + * A class to store the result of the tree analysis done in formTree + * @author daniels + */ +class TreeAnalysisResult { + /** + * The command, that is to be executed next automatically + */ + String command; + /** + * the number of undo steps needed to undo command + */ + int undoSteps; + /** + * reduceCoerce Whether the mechanism to produce a reduced + * refinement menu for coerce's 4th argument should kick in or not. + */ + boolean reduceCoerce; + /** + * If the editor should ask GF if self an result are applicable here or not + */ + boolean probeSelfResult; + /** + * If we at the the Instance Argument of a hidden + * coerce, we mark that (to change the d command) + */ + boolean deleteAlsoAbove; + /** + * if the attributes of self should be added to the refinement menu. + */ + boolean easyAttributes; + DefaultMutableTreeNode selectedNode = null; + /** + * The currently selected node + */ + GfAstNode currentNode; + /** + * Where the cursor in GF is. + * Correct is not yet known and thus always true. + */ + LinPosition focusPosition; + + /** + * Just sets both values. + * @param command The command, that is to be executed next automatically + * @param undoSteps the number of undo steps needed to undo command + * @param reduceCoerce Whether the mechanism to produce a reduced + * refinement menu for coerce's 4th argument should kick in or not. + * @param probeSelfResult If the editor should ask GF if self an result + * are applicable here or not + * @param deleteAlsoAbove If we at the the Instance Argument of a hidden + * coerce, we mark that (to change the d command) + * @param easyAttributes if the attributes of self should be added to the + * refinement menu. + * @param currentNode The currently selected node + * @param focusPosition Where the cursor in GF is. + * Correct is not yet known and thus always true. + */ + public TreeAnalysisResult(String command, int undoSteps, boolean reduceCoerce, boolean probeSelfResult, boolean deleteAlsoAbove, boolean easyAttributes, GfAstNode currentNode, LinPosition focusPosition) { + this.command = command; + this.undoSteps = undoSteps; + this.reduceCoerce = reduceCoerce; + this.probeSelfResult = probeSelfResult; + this.deleteAlsoAbove = deleteAlsoAbove; + this.currentNode = currentNode; + this.easyAttributes = easyAttributes; + this.focusPosition = focusPosition; + } + + public String toString() { + return this.command + "|" + this.reduceCoerce + "|" + this.undoSteps + "|" + this.probeSelfResult; + } +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/TypesLoader.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/TypesLoader.java new file mode 100644 index 000000000..5cf5c4bd5 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/TypesLoader.java @@ -0,0 +1,120 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.io.IOException; +import java.util.Hashtable; +import java.util.logging.*; + +/** + * @author daniels + * If the entries of the refinement menu should have to appear there with + * type information appended to them, then the printnames have to get this + * knowledge at the time of their creation. + * When the entries are displayed, the display text line of GF is *not* looked + * at. And even if it would be, it would mess up the architecture, that the + * printnames, and only they, are responsible for their linearization. + * Appending their type later on would break that architecture. + * So they have to be prepared. + */ +public class TypesLoader extends AbstractProber { + /** + * The hash in which the funs as keys and + * types as values get saved. Both are Strings. + */ + protected final Hashtable hashtable; + private static Logger nogger = Logger.getLogger(TypesLoader.class.getName()); + /** + * @param gfCapsule the read/write encapsulation of the running GF + * @param myHashMap The hash in which the funs as keys and + * types as values get saved. Both are Strings. + */ + public TypesLoader(GfCapsule gfCapsule, Hashtable myHashMap) { + super(gfCapsule); + this.hashtable = myHashMap; + } + + /** + * Reads the tree child of the XML from beginning to end. + * Sets autocompleted to false, if the focus position is open. + */ + protected void readMessage() { + try { + String result = gfCapsule.fromProc.readLine(); + if (nogger.isLoggable(Level.FINER)) { + nogger.finer("7 " + result); + } + //first read line is <message>, but this one gets filtered out in the next line + while (result.indexOf("/message")==-1){ + result = result.trim(); + if (result.startsWith("fun ")) { + //unescape backslashes. Probably there are more + readType(result); + } + + result = gfCapsule.fromProc.readLine(); + if (nogger.isLoggable(Level.FINER)) { + nogger.finer("7 " + result); + } + } + if (nogger.isLoggable(Level.FINER)) { + nogger.finer("finished loading printnames"); + } + } catch(IOException e){ + System.err.println(e.getMessage()); + e.printStackTrace(); + } + + } + + /** + * asks GF to print a list of all available printnames and + * calls the registered PrintnameManager to register those. + */ + public void readTypes() { + //prints the last loaded grammar, + String sendString = "gf pg"; + if (nogger.isLoggable(Level.FINE)) { + nogger.fine("collecting types :" + sendString); + } + send(sendString); + readGfedit(); + } + + /** + * Reads a fun line from pg and puts it into hashMap with the fun + * as the key and the type as the value + * @param line One line which describes the signature of a fun + */ + private void readType(String line) { + final int funStartIndex = 4; //length of "fun " + final String fun = line.substring(funStartIndex, line.indexOf(" : ")); + final int typeStartIndex = line.indexOf(" : ") + 3; + final int typeEndIndex = line.lastIndexOf(" = "); + try { + final String type = line.substring(typeStartIndex, typeEndIndex); + this.hashtable.put(fun, type); + } catch (StringIndexOutOfBoundsException e) { + System.err.println("line: '" + line + "'"); + System.err.println("fun: '" + fun + "'"); + System.err.println("typeStartIndex: " + typeStartIndex); + System.err.println("typeEndIndex: " + typeEndIndex); + + System.err.println(e.getLocalizedMessage()); + } + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/UnrefinedAstNodeData.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/UnrefinedAstNodeData.java new file mode 100644 index 000000000..0c12fc0fb --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/UnrefinedAstNodeData.java @@ -0,0 +1,64 @@ +//Copyright (c) Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + +package de.uka.ilkd.key.ocl.gf; + +import java.util.logging.*; + +/** + * @author daniels + * + * represents an open, unrefined node in the AST. + * It knows, how it is called and described (tooltip). + */ +public class UnrefinedAstNodeData extends AstNodeData { + /** + * The tooltip that this node as a parameter should get + */ + protected final String paramTooltip; + + /** + * For a child we have to know its name, its type and the tooltip + * @param pTooltip The tooltip that this node as a parameter should get + * @param node The GfAstNode for the current AST node, for which + * this AstNodeData is the data for. + * @param pos The position in the GF AST of this node in Haskell notation + * @param selected if this is the selected node in the GF AST + * @param constraint A constraint from a parent node, that also + * applies for this node. + */ + public UnrefinedAstNodeData(String pTooltip, GfAstNode node, String pos, boolean selected, String constraint) { + super(node, pos, selected, constraint); + this.paramTooltip = pTooltip; + if (logger.isLoggable(Level.FINEST)) { + logger.finest(this.toString() + " - " + position); + } + } + /** + * @return no refinement, no printname, thus null + */ + public Printname getPrintname() { + return null; + } + + /** + * @return the parameter tooltip that this node has as a child + * of its parent (who gave it to it depending on its position) + */ + public String getParamTooltip() { + return this.paramTooltip; + } + +} diff --git a/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Utils.java b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Utils.java new file mode 100644 index 000000000..076cc2308 --- /dev/null +++ b/src/JavaGUI2/de/uka/ilkd/key/ocl/gf/Utils.java @@ -0,0 +1,243 @@ +//Copyright (c) Kristofer Johanisson 2005, Hans-Joachim Daniels 2005 +// +//This program is free software; you can redistribute it and/or modify +//it under the terms of the GNU General Public License as published by +//the Free Software Foundation; either version 2 of the License, or +//(at your option) any later version. +// +//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. See the +//GNU General Public License for more details. +// +//You can either finde the file LICENSE or LICENSE.TXT in the source +//distribution or in the .jar file of this application + + +package de.uka.ilkd.key.ocl.gf; + + +import java.io.File; +import java.util.logging.*; +import javax.swing.ProgressMonitor; +import java.util.Vector; + +/** + * consists of a bunch of static methods, mostly for String + * @author daniels + * + */ +public class Utils { + private static Logger timeLogger = Logger.getLogger(Utils.class.getName() + ".timer"); + private static Logger deleteLogger = Logger.getLogger(Utils.class.getName() + ".delete"); + private static Logger stringLogger = Logger.getLogger(Utils.class.getName() + ".string"); + + private Utils() { + //non-instantiability enforced + } + + public static final String gf = "gf"; + public static final String gfcm = "gfcm"; + + /** + * Get the extension of a file. + */ + public static String getExtension(File f) { + String ext = null; + String s = f.getName(); + int i = s.lastIndexOf('.'); + + if (i > 0 && i < s.length() - 1) { + ext = s.substring(i+1).toLowerCase(); + } + return ext; + } + /** + * Sets the progress on the given ProgressMonitor and logs the current time. + * @param pm the monitor which is to be updated. If null, only logging is done + * @param progress The progress in absolute ticks + * @param note The note that is to be displayed above the progress monitor + */ + public static void tickProgress(ProgressMonitor pm, int progress, String note) { + if (note != null) { + if (timeLogger.isLoggable(Level.FINER)) { + timeLogger.finer(System.currentTimeMillis() + " : " + note); + } + } + if (pm == null) { + return; + } + pm.setProgress(progress); + if (note != null) { + pm.setNote(note); + } + } + + /** + * schedules all Eng, OCL and Ger grammar files for deletion. + * @param grammarsDir The directory where those files are + */ + public static void cleanupFromUMLTypes(String grammarsDir) { + String[] endings = {"Eng.gf", "Eng.gfc", "Ger.gf", "Ger.gfc", "OCL.gf", "OCL.gfc", ".gf", ".gfc"}; + for (int i = 0; i < endings.length; i++) { + String filename = grammarsDir + File.separator + GFEditor2.modelModulName + endings[i]; + File file = new File(filename); + file.deleteOnExit(); + if (deleteLogger.isLoggable(Level.FINER)) { + deleteLogger.fine("scheduled for deletion: " + filename); + } + } + File file = new File(grammarsDir); + file.deleteOnExit(); + file = file.getParentFile(); + file.deleteOnExit(); + } + + /** + * Searches for the first occurace not escaped with '\' of toBeFound in s. + * Works like String::indexOf otherwise + * @param s the String to search in + * @param toBeFound the String to search for + * @return the index of toBeFound, -1 if not found (or only escaped) + */ + public static int indexOfNotEscaped(String s, String toBeFound) { + return indexOfNotEscaped(s, toBeFound, 0); + } + + /** + * Searches for the first occurace not escaped with '\' of toBeFound in s. + * Works like String::indexOf otherwise + * @param s the String to search in + * @param toBeFound the String to search for + * @param startIndex the index in s, from which the search starts + * @return the index of toBeFound, -1 if not found (or only escaped) + */ + public static int indexOfNotEscaped(String s, String toBeFound, int startIndex) { + for (int from = startIndex; from < s.length();) { + int i = s.indexOf(toBeFound, from); + if (i <= 0) { + //-1 is not found at all, 0 can't have a '\' before + return i; + } else if (s.charAt(i-1) != '\\') { + return i; + } else { + from = i + 1; + } + } + return -1; + } + + /** + * a simple replaceAll replacement, that uses NO regexps + * and thus needs no freaking amount of backslashes + * @param original The String in which the replacements should take place + * @param toReplace the String literal that is to be replaced + * @param replacement the replacement string + * @return original, but with replacements + */ + public static String replaceAll(String original, String toReplace, String replacement) { + StringBuffer sb = new StringBuffer(original); + for (int i = sb.indexOf(toReplace); i >= 0; i = sb.indexOf(toReplace, i + replacement.length())) { + sb.replace(i, i + toReplace.length(), replacement); + } + return sb.toString(); + } + + /** + * Removes all parts, that are inside "quotation marks" from s. + * Assumes no nesting of those, like in Java. + * " escaped with \ like \" do not count as quotation marks + * @param s The String, that possibly contains quotations + * @return a String described above, s without quotations. + */ + public static String removeQuotations(String s) { + if (s.indexOf('"') == -1) { + return s; + } + for (int begin = indexOfNotEscaped(s, "\""); begin > -1 ; begin = indexOfNotEscaped(s, "\"", begin)) {//yes, I want an unescaped '"'! + int end = indexOfNotEscaped(s, "\"", begin + 1); + if (end > -1) { + s = s.substring(0, begin) + s.substring(end + 1); + } else { + stringLogger.info("Strange String given: '" + s + "'"); + s = s.substring(0, begin); + } + } + return s; + } + + /** + * counts the occurances of toSearch in s + * @param s The String in which the search shall take place + * @param toSearch The String that should be counted + * @return the number of occurances, 0 if s is null + */ + public static int countOccurances(String s, String toSearch) { + if (s == null) { + return 0; + } + int result = 0; + for (int i = s.indexOf(toSearch); i > -1; i = s.indexOf(toSearch, i)) { + result++; + i += toSearch.length(); + } + return result; + } + + /** + * Takes an arbitrary Vector and executes toString on each element and + * puts these into a String[] of the same size as the Vector + * @param strings A Vector of Object, preferably String + * @return The Vector as a String[] + */ + public static String[] vector2Array(Vector strings) { + String[] result = new String[strings.size()]; + for (int i = 0; i < strings.size(); i++) { + result[i] = strings.get(i).toString(); + } + return result; + } + /** + * just replace sequences of spaces with one space + * @param s The string to be compacted + * @return the compacted result + */ + static String compactSpaces(String s) { + String localResult = new String(); + boolean spaceIncluded = false; + + for (int i = 0; i < s.length(); i++) { + char c = s.charAt(i); + if (c != ' ') { // include all non-spaces + localResult += String.valueOf(c); + spaceIncluded = false; + } else {// we have a space + if (!spaceIncluded) { + localResult += " "; + spaceIncluded = true; + } // else just skip + } + } + return localResult; + } + /** + * Replaces all occurances of toBeReplaced, that are not escaped by '\' + * with replacement + * @param working the String in which substrings should be replaced + * @param toBeReplaced The substring, that should be replaced by replacement + * @param replacement well, the replacement string + * @return The String with the replaced parts + */ + public static String replaceNotEscaped(String working, String toBeReplaced, String replacement) { + StringBuffer w = new StringBuffer(working); + for (int i = w.indexOf(toBeReplaced); i > -1 && i < w.length(); i = w.indexOf(toBeReplaced, i)) { + if (i == 0 || w.charAt(i - 1) != '\\') { + w.replace(i, i + toBeReplaced.length(), replacement); + i += replacement.length(); + } else { + i += 1; + } + } + return w.toString(); + } +} diff --git a/src/JavaGUI2/gf-icon.gif b/src/JavaGUI2/gf-icon.gif Binary files differnew file mode 100644 index 000000000..5e8863d76 --- /dev/null +++ b/src/JavaGUI2/gf-icon.gif diff --git a/src/JavaGUI2/jargs-1.0.jar b/src/JavaGUI2/jargs-1.0.jar Binary files differnew file mode 100644 index 000000000..cdbc80bb3 --- /dev/null +++ b/src/JavaGUI2/jargs-1.0.jar diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 000000000..08de81434 --- /dev/null +++ b/src/Makefile @@ -0,0 +1,320 @@ +include config.mk + + +GHMAKE=$(GHC) --make +GHCXMAKE=ghcxmake +GHCFLAGS+= -fglasgow-exts +GHCOPTFLAGS=-O2 +GHCFUDFLAG= +JAVAFLAGS=-target 1.4 -source 1.4 +GFEDITOR=JavaGUI2 + +DIST_DIR=GF-$(PACKAGE_VERSION) +NOT_IN_DIST= \ + grammars \ + download \ + doc/release2.html \ + src/tools/AlphaConvGF.hs + +BIN_DIST_DIR=$(DIST_DIR)-$(host) + +GRAMMAR_PACKAGE_VERSION=$(shell date +%Y%m%d) +GRAMMAR_DIST_DIR=gf-grammars-$(GRAMMAR_PACKAGE_VERSION) + +MSI_FILE=gf-$(subst .,_,$(PACKAGE_VERSION)).msi + +GF_DATA_DIR=$(datadir)/GF-$(PACKAGE_VERSION) +GF_LIB_DIR=$(GF_DATA_DIR)/lib + +EMBED = GF/Embed/TemplateApp + +# use the temporary binary file name 'gf-bin' to not clash with directory 'GF' +# on case insensitive file systems (such as FAT) +GF_EXE=gf3$(EXEEXT) +GF_EXE_TMP=gf-bin$(EXEEXT) +GF_DOC_EXE=gfdoc$(EXEEXT) +GF3_EXE=gf3$(EXEEXT) +TESTGF3_EXE=testgf3$(EXEEXT) + + +ifeq ("$(READLINE)","readline") + GHCFLAGS += -package readline -DUSE_READLINE +endif + +ifneq ("$(CPPFLAGS)","") + GHCFLAGS += $(addprefix -optP, $(CPPFLAGS)) +endif + +ifneq ("$(LDFLAGS)","") + GHCFLAGS += $(addprefix -optl, $(LDFLAGS)) +endif + +ifeq ("$(INTERRUPT)","yes") + GHCFLAGS += -DUSE_INTERRUPT +endif + +ifeq ("$(ATK)","yes") + GHCFLAGS += -DUSE_ATK +endif + +ifeq ("$(ENABLE_JAVA)", "yes") + BUILD_JAR=jar +else + BUILD_JAR= +endif + +.PHONY: all unix jar tags gfdoc windows install install-gf \ + lib temp install-gfdoc install-editor \ + today help clean windows-msi dist + +all: unix gfdoc $(BUILD_JAR) lib + +static: GHCFLAGS += -optl-static +static: unix + + +gf: unix + +unix: today opt + +windows: unix + +temp: today noopt + + + +build: + $(GHMAKE) $(GHCFLAGS) GF.hs -o $(GF_EXE_TMP) + strip $(GF_EXE_TMP) + mv $(GF_EXE_TMP) ../bin/$(GF_EXE) + +opt: GHCFLAGS += $(GHCOPTFLAGS) +opt: build + +embed: GHCFLAGS += $(GHCOPTFLAGS) +embed: + $(GHMAKE) $(GHCFLAGS) $(EMBED) -o $(EMBED) + strip $(EMBED) + +noopt: build + +ghci: ghci-nofud + +fud: + $(GHCXMAKE) $(GHCFLAGS) $(GHCFUDFLAG) GF.hs -o fgf + strip fgf + mv fgf ../bin/ + +gft: + $(GHMAKE) $(GHCFLAGS) -itranslate translate/GFT.hs -o gft-bin + strip gft-bin + mv gft-bin ../bin/gft + +api: + $(GHMAKE) $(GHCFLAGS) $(GHCOPTFLAGS) GF/API.hs + +shell: + $(GHMAKE) $(GHCFLAGS) $(GHCOPTFLAGS) GF/Shell.hs + +clean: + find . '(' -name '*~' -o -name '*.hi' -o -name '*.ghi' -o -name '*.o' ')' -exec rm -f '{}' ';' + -rm -f JavaGUI/*.class + -rm -f $(GFEDITOR)/de/uka/ilkd/key/ocl/gf/*.class + -rm -f gf.wixobj + -rm -f ../bin/$(GF_EXE) + $(MAKE) -C tools/c clean + $(MAKE) -C ../lib/c clean + -rm -f ../bin/gfcc2c + +distclean: clean + -rm -f JavaGUI/gf-java.jar jgf + -rm -f $(GFEDITOR)/gfeditor.jar jgf + -rm -f tools/$(GF_DOC_EXE) + -rm -f config.status config.mk config.log + -rm -f *.tgz *.zip + -rm -rf $(DIST_DIR) $(BIN_DIST_DIR) + -rm -rf gf.wxs *.msi + +ghci-nofud: + $(GHCI) $(GHCFLAGS) + +today: + echo 'module Paths_gf (version, getDataDir) where' > Paths_gf.hs + echo 'import Data.Version' >> Paths_gf.hs + echo '{-# NOINLINE version #-}' >> Paths_gf.hs + echo 'version :: Version' >> Paths_gf.hs + echo 'version = Version {versionBranch = [3,0], versionTags = ["alpha"]}' >> Paths_gf.hs + echo 'getDataDir = return $(GF_DATA_DIR) :: IO FilePath' >> Paths_gf.hs + +javac: + $(JAVAC) $(JAVAFLAGS) -classpath $(GFEDITOR)/jargs-1.0.jar $(GFEDITOR)/de/uka/ilkd/key/ocl/gf/*.java + $(JAVAC) $(JAVAFLAGS) JavaGUI/*.java + +jar: javac + cd JavaGUI; $(JAR) -cmf manifest.txt gf-java.jar *.class ; cd .. + cd $(GFEDITOR) ; rm -rf jarcontents ; mkdir jarcontents ; cp -r de ManifestMain.txt ../../LICENSE LICENCE_jargs gf-icon.gif jarcontents ; cat jargs-1.0.jar | (cd jarcontents; jar -x jargs) ; cd jarcontents ; $(JAR) -cmf ManifestMain.txt ../gfeditor.jar de/uka/ilkd/key/ocl/gf/*.class jargs LICENSE LICENCE_jargs gf-icon.gif ; cd .. ; cd .. + +showflags: + @echo $(GHCFLAGS) + +# added by peb: +tracing: GHCFLAGS += -DTRACING +tracing: temp + +ghci-trace: GHCFLAGS += -DTRACING +ghci-trace: ghci + +#touch-files: +# rm -f GF/System/Tracing.{hi,o} +# touch GF/System/Tracing.hs + +# profiling +prof: GHCOPTFLAGS += -prof -auto-all -auto-dicts +prof: all + +tags: + find GF Transfer -name '*.hs' | xargs hasktags + +# +# Help file +# + +tools/MkHelpFile: tools/MkHelpFile.hs + $(GHMAKE) -o $@ $^ + +help: GF/Shell/HelpFile.hs + +GF/Shell/HelpFile.hs: tools/MkHelpFile HelpFile + tools/MkHelpFile + +# +# Tools +# + +gfdoc: tools/$(GF_DOC_EXE) + +tools/$(GF_DOC_EXE): tools/GFDoc.hs + $(GHMAKE) $(GHCOPTFLAGS) -o $@ $^ + +gfc: gf3 + cp -f gfc ../bin/ + chmod a+x ../bin/gfc + +gfi: gf3 + +gf3: + $(GHMAKE) $(GHCOPTFLAGS) $(GHCFLAGS) -o gf3 GF.hs + strip $(GF3_EXE) + mv $(GF3_EXE) ../bin/ + +testgf3: + $(GHMAKE) $(GHCOPTFLAGS) -o testgf3 GF/Devel/TestGF3.hs + strip $(TESTGF3_EXE) + mv $(TESTGF3_EXE) ../bin/ + +gfcc2c: + $(MAKE) -C tools/c + $(MAKE) -C ../lib/c + mv tools/c/gfcc2c ../bin + +# +# Resource grammars +# + +lib: + $(MAKE) -C ../lib/resource clean new + +# +# Distribution +# + +dist: + -rm -rf $(DIST_DIR) + darcs dist --dist-name=$(DIST_DIR) + tar -zxf ../$(DIST_DIR).tar.gz + rm ../$(DIST_DIR).tar.gz + cd $(DIST_DIR)/src && perl -pi -e "s/^AC_INIT\(\[GF\],\[[^\]]*\]/AC_INIT([GF],[$(PACKAGE_VERSION)]/" configure.ac + cd $(DIST_DIR)/src && autoconf && rm -rf autom4te.cache +# cd $(DIST_DIR)/grammars && sh mkLib.sh + cd $(DIST_DIR) && rm -rf $(NOT_IN_DIST) + $(TAR) -zcf $(DIST_DIR).tgz $(DIST_DIR) + rm -rf $(DIST_DIR) + +snapshot: PACKAGE_VERSION=$(shell date +%Y%m%d) +snapshot: DIST_DIR=GF-$(PACKAGE_VERSION) +snapshot: dist + +rpm: dist + rpmbuild -ta $(DIST_DIR).tgz + + +binary-dist: + rm -rf $(BIN_DIST_DIR) + mkdir $(BIN_DIST_DIR) + mkdir $(BIN_DIST_DIR)/lib + ./configure --host="$(host)" --build="$(build)" + $(MAKE) all + $(INSTALL) ../bin/$(GF_EXE) tools/$(GF_DOC_EXE) $(BIN_DIST_DIR) + $(INSTALL) -m 0644 JavaGUI/gf-java.jar $(BIN_DIST_DIR) + $(INSTALL) -m 0644 $(GFEDITOR)/gfeditor.jar $(BIN_DIST_DIR) + $(INSTALL) configure config.guess config.sub install-sh $(BIN_DIST_DIR) + $(INSTALL) -m 0644 config.mk.in jgf.in gfeditor.in $(BIN_DIST_DIR) + $(INSTALL) -m 0644 ../README ../LICENSE $(BIN_DIST_DIR) + $(INSTALL) -m 0644 INSTALL.binary $(BIN_DIST_DIR)/INSTALL + $(INSTALL) -m 0644 Makefile.binary $(BIN_DIST_DIR)/Makefile + $(MAKE) lib + $(TAR) -C $(BIN_DIST_DIR)/lib -zxf ../lib/compiled.tgz + $(TAR) -zcf GF-$(PACKAGE_VERSION)-$(host).tgz $(BIN_DIST_DIR) + rm -rf $(BIN_DIST_DIR) + +grammar-dist: + -rm -rf $(GRAMMAR_DIST_DIR) + mkdir $(GRAMMAR_DIST_DIR) + cp -r ../_darcs/current/{lib,examples} $(GRAMMAR_DIST_DIR) + $(MAKE) GF_LIB_PATH=.. -C $(GRAMMAR_DIST_DIR)/lib/resource-1.0 show-path prelude present alltenses mathematical api multimodal langs + $(TAR) -zcf $(GRAMMAR_DIST_DIR).tgz $(GRAMMAR_DIST_DIR) + rm -rf $(GRAMMAR_DIST_DIR) + +gf.wxs: config.status gf.wxs.in + ./config.status --file=$@ + +windows-msi: gf.wxs + candle -nologo gf.wxs + light -nologo -o $(MSI_FILE) gf.wixobj + +# +# Installation +# + +install: install-gf install-gfdoc install-lib install-editor + +install-gf: + $(INSTALL) -d $(bindir) + $(INSTALL) ../bin/$(GF_EXE) $(bindir) + +install-gf3: + $(INSTALL) -d $(bindir) + $(INSTALL) ../bin/$(GF3_EXE) $(bindir) + $(INSTALL) ../bin/gfc $(bindir) + +install-gfdoc: + $(INSTALL) -d $(bindir) + $(INSTALL) tools/$(GF_DOC_EXE) $(bindir) + +install-lib: + $(INSTALL) -d $(GF_LIB_DIR) + $(TAR) -C $(GF_LIB_DIR) -zxf ../lib/compiled.tgz + +install-editor: + $(INSTALL) -d $(GF_DATA_DIR) + $(INSTALL) jgf $(bindir) + $(INSTALL) -m 0644 JavaGUI/gf-java.jar $(GF_DATA_DIR) + $(INSTALL) gfeditor $(bindir) + $(INSTALL) -m 0644 $(GFEDITOR)/gfeditor.jar $(GF_DATA_DIR) + +install-java: + -rm -f ../bin/JavaGUI + ln -s ../src/JavaGUI ../bin + @echo "PLEASE set GFHOME and GF_LIB_PATH in your environment" + -rm -f ../bin/$(GFEDITOR) + ln -s ../src/$(GFEDITOR) ../bin diff --git a/src/Makefile.binary b/src/Makefile.binary new file mode 100644 index 000000000..ab52185fd --- /dev/null +++ b/src/Makefile.binary @@ -0,0 +1,23 @@ +include config.mk + +GF_DATA_DIR=$(datadir)/GF-$(PACKAGE_VERSION) +GF_LIB_DIR=$(GF_DATA_DIR)/lib + +.PHONY: install uninstall + +install: + $(INSTALL) -d $(bindir) + $(INSTALL) gf$(EXEEXT) gfdoc$(EXEEXT) jgf gfeditor $(bindir) + $(INSTALL) -d $(GF_DATA_DIR) + $(INSTALL) -m 0644 gf-java.jar $(GF_DATA_DIR) + $(INSTALL) -m 0644 gfeditor.jar $(GF_DATA_DIR) + cp -r lib $(GF_DATA_DIR) + +uninstall: + -rm -f $(bindir)/gf$(EXEEXT) $(bindir)/gfdoc$(EXEEXT) $(bindir)/jgf $(bindir)/gfeditor + -rm -f $(GF_DATA_DIR)/gf-java.jar + -rm -f $(GF_DATA_DIR)/gfeditor.jar + -rm -f $GF_LIB_DIR)/*/*.gf{c,r,cm} + -rmdir $(GF_LIB_DIR)/* + -rmdir $(GF_LIB_DIR) + -rmdir $(GF_DATA_DIR) diff --git a/src/PGF.hs b/src/PGF.hs new file mode 100644 index 000000000..8add3d1d8 --- /dev/null +++ b/src/PGF.hs @@ -0,0 +1,224 @@ +------------------------------------------------- +-- | +-- Module : PGF +-- Maintainer : Aarne Ranta +-- Stability : stable +-- Portability : portable +-- +-- This module is an Application Programming Interface to +-- load and interpret grammars compiled in Portable Grammar Format (PGF). +-- The PGF format is produced as a final output from the GF compiler. +-- The API is meant to be used for embedding GF grammars in Haskell +-- programs. +------------------------------------------------- + +module PGF( + -- * PGF + PGF, + readPGF, + + -- * Identifiers + -- ** CId + CId, mkCId, prCId, + + -- ** Language + Language, languages, abstractName, + + -- ** Category + Category, categories, startCat, + + -- * Expressions + -- ** Tree + Tree(..), Literal(..), + showTree, readTree, + + -- ** Expr + Expr(..), Equation(..), + showExpr, readExpr, + + -- * Operations + -- ** Linearization + linearize, linearizeAllLang, linearizeAll, + + -- ** Parsing + parse, parseAllLang, parseAll, + + -- ** Evaluation + tree2expr, expr2tree, + + -- ** Word Completion (Incremental Parsing) + Incremental.ParseState, + initState, Incremental.nextState, Incremental.getCompletions, extractExps, + + -- ** Generation + generateRandom, generateAll, generateAllDepth + ) where + +import PGF.CId +import PGF.Linearize +import PGF.Generate +import PGF.Macros +import PGF.Data +import PGF.Expr +import PGF.Raw.Convert +import PGF.Raw.Parse +import PGF.Raw.Print (printTree) +import PGF.Parsing.FCFG +import qualified PGF.Parsing.FCFG.Incremental as Incremental +import GF.Text.UTF8 + +import GF.Data.ErrM + +import qualified Data.Map as Map +import System.Random (newStdGen) + +--------------------------------------------------- +-- Interface +--------------------------------------------------- + +-- | This is just a string with the language name. +-- A language name is the identifier that you write in the +-- top concrete or abstract module in GF after the +-- concrete/abstract keyword. Example: +-- +-- > abstract Lang = ... +-- > concrete LangEng of Lang = ... +type Language = String + +-- | This is just a string with the category name. +-- The categories are defined in the abstract syntax +-- with the \'cat\' keyword. +type Category = String + +-- | Reads file in Portable Grammar Format and produces +-- 'PGF' structure. The file is usually produced with: +-- +-- > $ gfc --make <grammar file name> +readPGF :: FilePath -> IO PGF + +-- | Linearizes given expression as string in the language +linearize :: PGF -> Language -> Tree -> String + +-- | Tries to parse the given string in the specified language +-- and to produce abstract syntax expression. An empty +-- list is returned if the parsing is not successful. The list may also +-- contain more than one element if the grammar is ambiguous. +parse :: PGF -> Language -> Category -> String -> [Tree] + +-- | The same as 'linearizeAllLang' but does not return +-- the language. +linearizeAll :: PGF -> Tree -> [String] + +-- | Linearizes given expression as string in all languages +-- available in the grammar. +linearizeAllLang :: PGF -> Tree -> [(Language,String)] + +-- | The same as 'parseAllLang' but does not return +-- the language. +parseAll :: PGF -> Category -> String -> [[Tree]] + +-- | Tries to parse the given string with every language +-- available in the grammar and to produce abstract syntax +-- expression. The returned list contains pairs of language +-- and list of possible expressions. Only those languages +-- for which at least one parsing is possible are listed. +-- More than one abstract syntax expressions are possible +-- if the grammar is ambiguous. +parseAllLang :: PGF -> Category -> String -> [(Language,[Tree])] + +-- | Creates an initial parsing state for a given language and +-- startup category. +initState :: PGF -> Language -> Category -> Incremental.ParseState + +-- | This function extracts the list of all completed parse trees +-- that spans the whole input consumed so far. The trees are also +-- limited by the category specified, which is usually +-- the same as the startup category. +extractExps :: Incremental.ParseState -> Category -> [Tree] + +-- | The same as 'generateAllDepth' but does not limit +-- the depth in the generation. +generateAll :: PGF -> Category -> [Tree] + +-- | Generates an infinite list of random abstract syntax expressions. +-- This is usefull for tree bank generation which after that can be used +-- for grammar testing. +generateRandom :: PGF -> Category -> IO [Tree] + +-- | Generates an exhaustive possibly infinite list of +-- abstract syntax expressions. A depth can be specified +-- to limit the search space. +generateAllDepth :: PGF -> Category -> Maybe Int -> [Tree] + +-- | List of all languages available in the given grammar. +languages :: PGF -> [Language] + +-- | The abstract language name is the name of the top-level +-- abstract module +abstractName :: PGF -> Language + +-- | List of all categories defined in the given grammar. +categories :: PGF -> [Category] + +-- | The start category is defined in the grammar with +-- the \'startcat\' flag. This is usually the sentence category +-- but it is not necessary. Despite that there is a start category +-- defined you can parse with any category. The start category +-- definition is just for convenience. +startCat :: PGF -> Category + +--------------------------------------------------- +-- Implementation +--------------------------------------------------- + +readPGF f = do + s <- readFile f + g <- parseGrammar s + return $! toPGF g + +linearize pgf lang = concat . take 1 . PGF.Linearize.linearizes pgf (mkCId lang) + +parse pgf lang cat s = + case Map.lookup (mkCId lang) (concretes pgf) of + Just cnc -> case parser cnc of + Just pinfo -> if Map.lookup (mkCId "erasing") (cflags cnc) == Just "on" + then Incremental.parse pinfo (mkCId cat) (words s) + else case parseFCFG "bottomup" pinfo (mkCId cat) (words s) of + Ok x -> x + Bad s -> error s + Nothing -> error ("No parser built fo language: " ++ lang) + Nothing -> error ("Unknown language: " ++ lang) + +linearizeAll mgr = map snd . linearizeAllLang mgr +linearizeAllLang mgr t = + [(lang,PGF.linearize mgr lang t) | lang <- languages mgr] + +parseAll mgr cat = map snd . parseAllLang mgr cat + +parseAllLang mgr cat s = + [(lang,ts) | lang <- languages mgr, let ts = parse mgr lang cat s, not (null ts)] + +initState pgf lang cat = + case lookParser pgf langCId of + Just pinfo -> Incremental.initState pinfo catCId + _ -> error ("Unknown language: " ++ lang) + where + langCId = mkCId lang + catCId = mkCId cat + +extractExps state cat = Incremental.extractExps state (mkCId cat) + +generateRandom pgf cat = do + gen <- newStdGen + return $ genRandom gen pgf (mkCId cat) + +generateAll pgf cat = generate pgf (mkCId cat) Nothing +generateAllDepth pgf cat = generate pgf (mkCId cat) + +abstractName pgf = prCId (absname pgf) + +languages pgf = [prCId l | l <- cncnames pgf] + +categories pgf = [prCId c | c <- Map.keys (cats (abstract pgf))] + +startCat pgf = lookStartCat pgf diff --git a/src/PGF/BuildParser.hs b/src/PGF/BuildParser.hs new file mode 100644 index 000000000..9dfab3130 --- /dev/null +++ b/src/PGF/BuildParser.hs @@ -0,0 +1,64 @@ +--------------------------------------------------------------------- +-- | +-- Maintainer : Krasimir Angelov +-- Stability : (stable) +-- Portability : (portable) +-- +-- FCFG parsing, parser information +----------------------------------------------------------------------------- + +module PGF.BuildParser where + +import GF.Data.SortedList +import GF.Data.Assoc +import PGF.CId +import PGF.Data +import PGF.Parsing.FCFG.Utilities + +import Data.Array +import Data.Maybe +import qualified Data.Map as Map +import qualified Data.Set as Set +import Debug.Trace + + +------------------------------------------------------------ +-- parser information + +getLeftCornerTok (FRule _ _ _ _ lins) + | inRange (bounds syms) 0 = case syms ! 0 of + FSymTok tok -> [tok] + _ -> [] + | otherwise = [] + where + syms = lins ! 0 + +getLeftCornerCat (FRule _ _ args _ lins) + | inRange (bounds syms) 0 = case syms ! 0 of + FSymCat _ d -> [args !! d] + _ -> [] + | otherwise = [] + where + syms = lins ! 0 + +buildParserInfo :: FGrammar -> ParserInfo +buildParserInfo (grammar,startup) = -- trace (unlines [prt (x,Set.toList set) | (x,set) <- Map.toList leftcornFilter]) $ + ParserInfo { allRules = allrules + , topdownRules = topdownrules + -- , emptyRules = emptyrules + , epsilonRules = epsilonrules + , leftcornerCats = leftcorncats + , leftcornerTokens = leftcorntoks + , grammarCats = grammarcats + , grammarToks = grammartoks + , startupCats = startup + } + + where allrules = listArray (0,length grammar-1) grammar + topdownrules = accumAssoc id [(cat, ruleid) | (ruleid, FRule _ _ _ cat _) <- assocs allrules] + epsilonrules = [ ruleid | (ruleid, FRule _ _ _ _ lins) <- assocs allrules, + not (inRange (bounds (lins ! 0)) 0) ] + leftcorncats = accumAssoc id [ (cat, ruleid) | (ruleid, rule) <- assocs allrules, cat <- getLeftCornerCat rule ] + leftcorntoks = accumAssoc id [ (tok, ruleid) | (ruleid, rule) <- assocs allrules, tok <- getLeftCornerTok rule ] + grammarcats = aElems topdownrules + grammartoks = nubsort [t | (FRule _ _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin] diff --git a/src/PGF/CId.hs b/src/PGF/CId.hs new file mode 100644 index 000000000..161529308 --- /dev/null +++ b/src/PGF/CId.hs @@ -0,0 +1,18 @@ +module PGF.CId (CId(..), wildCId, mkCId, prCId) where + +import Data.ByteString.Char8 as BS + +-- | An abstract data type that represents +-- function identifier in PGF. +newtype CId = CId BS.ByteString deriving (Eq,Ord,Show) + +wildCId :: CId +wildCId = CId (BS.singleton '_') + +-- | Creates a new identifier from 'String' +mkCId :: String -> CId +mkCId s = CId (BS.pack s) + +-- | Renders the identifier as 'String' +prCId :: CId -> String +prCId (CId x) = BS.unpack x diff --git a/src/PGF/Check.hs b/src/PGF/Check.hs new file mode 100644 index 000000000..f66b9189d --- /dev/null +++ b/src/PGF/Check.hs @@ -0,0 +1,171 @@ +module PGF.Check (checkPGF) where + +import PGF.CId +import PGF.Data +import PGF.Macros +import GF.Data.ErrM + +import qualified Data.Map as Map +import Control.Monad +import Debug.Trace + +checkPGF :: PGF -> Err (PGF,Bool) +checkPGF pgf = do + (cs,bs) <- mapM (checkConcrete pgf) + (Map.assocs (concretes pgf)) >>= return . unzip + return (pgf {concretes = Map.fromAscList cs}, and bs) + + +-- errors are non-fatal; replace with 'fail' to change this +msg s = trace s (return ()) + +andMapM :: Monad m => (a -> m Bool) -> [a] -> m Bool +andMapM f xs = mapM f xs >>= return . and + +labelBoolErr :: String -> Err (x,Bool) -> Err (x,Bool) +labelBoolErr ms iob = do + (x,b) <- iob + if b then return (x,b) else (msg ms >> return (x,b)) + + +checkConcrete :: PGF -> (CId,Concr) -> Err ((CId,Concr),Bool) +checkConcrete pgf (lang,cnc) = + labelBoolErr ("happened in language " ++ prCId lang) $ do + (rs,bs) <- mapM checkl (Map.assocs (lins cnc)) >>= return . unzip + return ((lang,cnc{lins = Map.fromAscList rs}),and bs) + where + checkl = checkLin pgf lang + +checkLin :: PGF -> CId -> (CId,Term) -> Err ((CId,Term),Bool) +checkLin pgf lang (f,t) = + labelBoolErr ("happened in function " ++ prCId f) $ do + (t',b) <- checkTerm (lintype pgf lang f) t --- $ inline pgf lang t + return ((f,t'),b) + +inferTerm :: [CType] -> Term -> Err (Term,CType) +inferTerm args trm = case trm of + K _ -> returnt str + C i -> returnt $ ints i + V i -> do + testErr (i < length args) ("too large index " ++ show i) + returnt $ args !! i + S ts -> do + (ts',tys) <- mapM infer ts >>= return . unzip + let tys' = filter (/=str) tys + testErr (null 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 + return $ (R ts',tuple tys) + P t u -> do + (t',tt) <- infer t + (u',tu) <- infer u + case tt of + R tys -> case tu of + R vs -> infer $ foldl P t' [P u' (C i) | i <- [0 .. length vs - 1]] + --- R [v] -> infer $ P t v + --- R (v:vs) -> infer $ P (head tys) (R vs) + + C i -> do + testErr (i < length 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 " ++ show trm) + return (P t' u', typ) -- table: types must be same + _ -> Bad $ "projection from " ++ show t ++ " : " ++ show tt + FV [] -> returnt tm0 ---- + FV (t:ts) -> do + (t',ty) <- infer t + (ts',tys) <- mapM infer ts >>= return . unzip + 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 " ++ show trm) + where + returnt ty = return (trm,ty) + infer = inferTerm args + +checkTerm :: LinType -> Term -> Err (Term,Bool) +checkTerm (args,val) trm = case inferTerm args trm of + Ok (t,ty) -> if eqType ty val + then return (t,True) + else do + msg ("term: " ++ show trm ++ + "\nexpected type: " ++ show val ++ + "\ninferred type: " ++ show ty) + return (t,False) + Bad s -> do + msg s + return (trm,False) + +eqType :: CType -> CType -> Bool +eqType inf exp = case (inf,exp) of + (C k, C n) -> k <= n -- only run-time corr. + (R rs,R ts) -> length rs == length ts && and [eqType r t | (r,t) <- zip rs ts] + (TM _, _) -> True ---- for variants [] ; not safe + _ -> inf == exp + +-- should be in a generic module, but not in the run-time DataGFCC + +type CType = Term +type LinType = ([CType],CType) + +tuple :: [CType] -> CType +tuple = R + +ints :: Int -> CType +ints = C + +str :: CType +str = S [] + +lintype :: PGF -> CId -> CId -> LinType +lintype pgf lang fun = case typeSkeleton (lookType pgf fun) of + (cs,c) -> (map vlinc cs, linc c) ---- HOAS + where + linc = lookLincat pgf lang + vlinc (0,c) = linc c + vlinc (i,c) = case linc c of + R ts -> R (ts ++ replicate i str) + +inline :: PGF -> CId -> Term -> Term +inline pgf lang t = case t of + F c -> inl $ look c + _ -> composSafeOp inl t + where + inl = inline pgf lang + look = lookLin pgf lang + +composOp :: Monad m => (Term -> m Term) -> Term -> m Term +composOp f trm = case trm of + R ts -> liftM R $ mapM f ts + S ts -> liftM S $ mapM f ts + FV ts -> liftM FV $ mapM f ts + P t u -> liftM2 P (f t) (f u) + W s t -> liftM (W s) $ f t + _ -> return trm + +composSafeOp :: (Term -> Term) -> Term -> Term +composSafeOp f = maybe undefined id . composOp (return . f) + +-- from GF.Data.Oper + +maybeErr :: String -> Maybe a -> Err a +maybeErr s = maybe (Bad s) Ok + +testErr :: Bool -> String -> Err () +testErr cond msg = if cond then return () else Bad msg + +errVal :: a -> Err a -> a +errVal a = err (const a) id + +errIn :: String -> Err a -> Err a +errIn msg = err (\s -> Bad (s ++ "\nOCCURRED IN\n" ++ msg)) return + +err :: (String -> b) -> (a -> b) -> Err a -> b +err d f e = case e of + Ok a -> f a + Bad s -> d s diff --git a/src/PGF/Data.hs b/src/PGF/Data.hs new file mode 100644 index 000000000..3f9aaa6ab --- /dev/null +++ b/src/PGF/Data.hs @@ -0,0 +1,201 @@ +module PGF.Data where + +import PGF.CId +import GF.Text.UTF8 +import GF.Data.Assoc + +import qualified Data.Map as Map +import Data.List +import Data.Array + +-- internal datatypes for PGF + +-- | An abstract data type representing multilingual grammar +-- in Portable Grammar Format. +data PGF = PGF { + absname :: CId , + cncnames :: [CId] , + gflags :: Map.Map CId String, -- value of a global flag + abstract :: Abstr , + concretes :: Map.Map CId Concr + } + +data Abstr = Abstr { + aflags :: Map.Map CId String, -- value of a flag + funs :: Map.Map CId (Type,Expr), -- type and def of a fun + cats :: Map.Map CId [Hypo], -- context of a cat + catfuns :: Map.Map CId [CId] -- funs to a cat (redundant, for fast lookup) + } + +data Concr = Concr { + cflags :: Map.Map CId String, -- value of a flag + lins :: Map.Map CId Term, -- lin of a fun + opers :: Map.Map CId Term, -- oper generated by subex elim + lincats :: Map.Map CId Term, -- lin type of a cat + lindefs :: Map.Map CId Term, -- lin default of a cat + printnames :: Map.Map CId Term, -- printname of a cat or a fun + paramlincats :: Map.Map CId Term, -- lin type of cat, with printable param names + parser :: Maybe ParserInfo -- parser + } + +data Type = + DTyp [Hypo] CId [Expr] + deriving (Eq,Ord,Show) + +data Literal = + LStr String -- ^ string constant + | LInt Integer -- ^ integer constant + | LFlt Double -- ^ floating point constant + deriving (Eq,Ord,Show) + +-- | The tree is an evaluated expression in the abstract syntax +-- of the grammar. The type is especially restricted to not +-- allow unapplied lambda abstractions. The tree is used directly +-- from the linearizer and is produced directly from the parser. +data Tree = + Abs [CId] Tree -- ^ lambda abstraction. The list of variables is non-empty + | Var CId -- ^ variable + | Fun CId [Tree] -- ^ function application + | Lit Literal -- ^ literal + | Meta Int -- ^ meta variable + deriving (Show, Eq, Ord) + +-- | An expression represents a potentially unevaluated expression +-- in the abstract syntax of the grammar. It can be evaluated with +-- the 'expr2tree' function and then linearized or it can be used +-- directly in the dependent types. +data Expr = + EAbs CId Expr -- ^ lambda abstraction + | EApp Expr Expr -- ^ application + | ELit Literal -- ^ literal + | EMeta Int -- ^ meta variable + | EVar CId -- ^ variable or function reference + | EEq [Equation] -- ^ lambda function defined as a set of equations with pattern matching + deriving (Eq,Ord,Show) + +data Term = + R [Term] + | P Term Term + | S [Term] + | K Tokn + | V Int + | C Int + | F CId + | FV [Term] + | W String Term + | TM String + deriving (Eq,Ord,Show) + +data Tokn = + KS String + | KP [String] [Alternative] + deriving (Eq,Ord,Show) + +data Alternative = + Alt [String] [String] + deriving (Eq,Ord,Show) + +data Hypo = + Hyp CId Type + deriving (Eq,Ord,Show) + +-- | The equation is used to define lambda function as a sequence +-- of equations with pattern matching. The list of 'Expr' represents +-- the patterns and the second 'Expr' is the function body for this +-- equation. +data Equation = + Equ [Expr] Expr + deriving (Eq,Ord,Show) + + +type FToken = String +type FCat = Int +type FIndex = Int +data FSymbol + = FSymCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int + | FSymTok FToken +type Profile = [Int] +type FPointPos = Int +type FGrammar = ([FRule], Map.Map CId [FCat]) +data FRule = FRule CId [Profile] [FCat] FCat (Array FIndex (Array FPointPos FSymbol)) + +type RuleId = Int + +data ParserInfo + = ParserInfo { allRules :: Array RuleId FRule + , topdownRules :: Assoc FCat [RuleId] + -- ^ used in 'GF.Parsing.MCFG.Active' (Earley): + -- , emptyRules :: [RuleId] + , epsilonRules :: [RuleId] + -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury): + , leftcornerCats :: Assoc FCat [RuleId] + , leftcornerTokens :: Assoc FToken [RuleId] + -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury): + , grammarCats :: [FCat] + , grammarToks :: [FToken] + , startupCats :: Map.Map CId [FCat] + } + + +fcatString, fcatInt, fcatFloat, fcatVar :: Int +fcatString = (-1) +fcatInt = (-2) +fcatFloat = (-3) +fcatVar = (-4) + + +-- print statistics + +statGFCC :: PGF -> String +statGFCC pgf = unlines [ + "Abstract\t" ++ prCId (absname pgf), + "Concretes\t" ++ unwords (map prCId (cncnames pgf)), + "Categories\t" ++ unwords (map prCId (Map.keys (cats (abstract pgf)))) + ] + +-- merge two GFCCs; fails is differens absnames; priority to second arg + +unionPGF :: PGF -> PGF -> PGF +unionPGF one two = case absname one of + n | n == wildCId -> two -- extending empty grammar + | n == absname two -> one { -- extending grammar with same abstract + concretes = Map.union (concretes two) (concretes one), + cncnames = union (cncnames two) (cncnames one) + } + _ -> one -- abstracts don't match ---- print error msg + +emptyPGF :: PGF +emptyPGF = PGF { + absname = wildCId, + cncnames = [] , + gflags = Map.empty, + abstract = error "empty grammar, no abstract", + concretes = Map.empty + } + +-- encode idenfifiers and strings in UTF8 + +utf8GFCC :: PGF -> PGF +utf8GFCC pgf = pgf { + concretes = Map.map u8concr (concretes pgf) + } + where + u8concr cnc = cnc { + lins = Map.map u8term (lins cnc), + opers = Map.map u8term (opers cnc) + } + u8term = convertStringsInTerm encodeUTF8 + +---- TODO: convert identifiers and flags + +convertStringsInTerm conv t = case t of + K (KS s) -> K (KS (conv s)) + W s r -> W (conv s) (convs r) + R ts -> R $ map convs ts + S ts -> S $ map convs ts + FV ts -> FV $ map convs ts + P u v -> P (convs u) (convs v) + _ -> t + where + convs = convertStringsInTerm conv + diff --git a/src/PGF/Expr.hs b/src/PGF/Expr.hs new file mode 100644 index 000000000..51a076d36 --- /dev/null +++ b/src/PGF/Expr.hs @@ -0,0 +1,203 @@ +module PGF.Expr(readTree, showTree, pTree, ppTree,
+ readExpr, showExpr, pExpr, ppExpr,
+
+ tree2expr, expr2tree,
+
+ -- needed in the typechecker
+ Value(..), Env, eval,
+
+ -- helpers
+ pIdent,pStr
+ ) where
+
+import PGF.CId
+import PGF.Data
+
+import Data.Char
+import Data.Maybe
+import Control.Monad
+import qualified Text.PrettyPrint as PP
+import qualified Text.ParserCombinators.ReadP as RP
+import qualified Data.Map as Map
+
+
+-- | parses 'String' as an expression
+readTree :: String -> Maybe Tree
+readTree s = case [x | (x,cs) <- RP.readP_to_S (pTree False) s, all isSpace cs] of
+ [x] -> Just x
+ _ -> Nothing
+
+-- | renders expression as 'String'
+showTree :: Tree -> String
+showTree = PP.render . ppTree 0
+
+-- | parses 'String' as an expression
+readExpr :: String -> Maybe Expr
+readExpr s = case [x | (x,cs) <- RP.readP_to_S pExpr s, all isSpace cs] of
+ [x] -> Just x
+ _ -> Nothing
+
+-- | renders expression as 'String'
+showExpr :: Expr -> String
+showExpr = PP.render . ppExpr 0
+
+
+-----------------------------------------------------
+-- Parsing
+-----------------------------------------------------
+
+pTrees :: RP.ReadP [Tree]
+pTrees = liftM2 (:) (pTree True) pTrees RP.<++ (RP.skipSpaces >> return [])
+
+pTree :: Bool -> RP.ReadP Tree
+pTree isNested = RP.skipSpaces >> (pParen RP.<++ pAbs RP.<++ pApp RP.<++ fmap Lit pLit RP.<++ pMeta)
+ where
+ pParen = RP.between (RP.char '(') (RP.char ')') (pTree False)
+ pAbs = do xs <- RP.between (RP.char '\\') (RP.skipSpaces >> RP.string "->") (RP.sepBy1 (RP.skipSpaces >> pCId) (RP.skipSpaces >> RP.char ','))
+ t <- pTree False
+ return (Abs xs t)
+ pApp = do f <- pCId
+ ts <- (if isNested then return [] else pTrees)
+ return (Fun f ts)
+ pMeta = do RP.char '?'
+ n <- fmap read (RP.munch1 isDigit)
+ return (Meta n)
+
+pExpr :: RP.ReadP Expr
+pExpr = RP.skipSpaces >> (pAbs RP.<++ pTerm RP.<++ pEqs)
+ where
+ pTerm = fmap (foldl1 EApp) (RP.sepBy1 pFactor RP.skipSpaces)
+
+ pFactor = fmap EVar pCId
+ RP.<++ fmap ELit pLit
+ RP.<++ pMeta
+ RP.<++ RP.between (RP.char '(') (RP.char ')') pExpr
+
+ pAbs = do xs <- RP.between (RP.char '\\') (RP.skipSpaces >> RP.string "->") (RP.sepBy1 (RP.skipSpaces >> pCId) (RP.skipSpaces >> RP.char ','))
+ e <- pExpr
+ return (foldr EAbs e xs)
+
+ pMeta = do RP.char '?'
+ n <- fmap read (RP.munch1 isDigit)
+ return (EMeta n)
+
+ pEqs = fmap EEq $
+ RP.between (RP.skipSpaces >> RP.char '{')
+ (RP.skipSpaces >> RP.char '}')
+ (RP.sepBy1 (RP.skipSpaces >> pEq)
+ (RP.skipSpaces >> RP.string ";"))
+
+ pEq = do pats <- (RP.sepBy1 pExpr RP.skipSpaces)
+ RP.skipSpaces >> RP.string "=>"
+ e <- pExpr
+ return (Equ pats e)
+
+pLit :: RP.ReadP Literal
+pLit = pNum RP.<++ liftM LStr pStr
+
+pNum = do x <- RP.munch1 isDigit
+ ((RP.char '.' >> RP.munch1 isDigit >>= \y -> return (LFlt (read (x++"."++y))))
+ RP.<++
+ (return (LInt (read x))))
+
+pStr = RP.char '"' >> (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"'))
+ where
+ pEsc = RP.char '\\' >> RP.get
+
+pCId = fmap mkCId pIdent
+
+pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
+ where
+ isIdentFirst c = c == '_' || isLetter c
+ isIdentRest c = c == '_' || c == '\'' || isAlphaNum c
+
+
+-----------------------------------------------------
+-- Printing
+-----------------------------------------------------
+
+ppTree d (Abs xs t) = ppParens (d > 0) (PP.char '\\' PP.<>
+ PP.hsep (PP.punctuate PP.comma (map (PP.text . prCId) xs)) PP.<+>
+ PP.text "->" PP.<+>
+ ppTree 0 t)
+ppTree d (Fun f []) = PP.text (prCId f)
+ppTree d (Fun f ts) = ppParens (d > 0) (PP.text (prCId f) PP.<+> PP.hsep (map (ppTree 1) ts))
+ppTree d (Lit l) = ppLit l
+ppTree d (Meta n) = PP.char '?' PP.<> PP.int n
+ppTree d (Var id) = PP.text (prCId id)
+
+
+ppExpr d (EAbs x e) = let (xs,e1) = getVars (EAbs x e)
+ in ppParens (d > 0) (PP.char '\\' PP.<>
+ PP.hsep (PP.punctuate PP.comma (map (PP.text . prCId) xs)) PP.<+>
+ PP.text "->" PP.<+>
+ ppExpr 0 e1)
+ where
+ getVars (EAbs x e) = let (xs,e1) = getVars e in (x:xs,e1)
+ getVars e = ([],e)
+ppExpr d (EApp e1 e2) = ppParens (d > 1) ((ppExpr 1 e1) PP.<+> (ppExpr 2 e2))
+ppExpr d (ELit l) = ppLit l
+ppExpr d (EMeta n) = PP.char '?' PP.<+> PP.int n
+ppExpr d (EVar f) = PP.text (prCId f)
+ppExpr d (EEq eqs) = PP.braces (PP.sep (PP.punctuate PP.semi (map ppEquation eqs)))
+
+ppEquation (Equ pats e) = PP.hsep (map (ppExpr 2) pats) PP.<+> PP.text "=>" PP.<+> ppExpr 0 e
+
+ppLit (LStr s) = PP.text (show s)
+ppLit (LInt n) = PP.integer n
+ppLit (LFlt d) = PP.double d
+
+ppParens True = PP.parens
+ppParens False = id
+
+
+-----------------------------------------------------
+-- Evaluation
+-----------------------------------------------------
+
+-- | Converts a tree to expression.
+tree2expr :: Tree -> Expr
+tree2expr (Fun x ts) = foldl EApp (EVar x) (map tree2expr ts)
+tree2expr (Lit l) = ELit l
+tree2expr (Meta n) = EMeta n
+tree2expr (Abs xs t) = foldr EAbs (tree2expr t) xs
+tree2expr (Var x) = EVar x
+
+-- | Converts an expression to tree. If the expression
+-- contains unevaluated applications they will be applied.
+expr2tree :: Expr -> Tree
+expr2tree e = value2tree (eval Map.empty e) [] []
+ where
+ value2tree (VApp v1 v2) xs ts = value2tree v1 xs (value2tree v2 [] []:ts)
+ value2tree (VVar x) xs ts = ret xs (fun xs x ts)
+ value2tree (VMeta n) xs [] = ret xs (Meta n)
+ value2tree (VLit l) xs [] = ret xs (Lit l)
+ value2tree (VClosure env (EAbs x e)) xs [] = value2tree (eval (Map.insert x (VVar x) env) e) (x:xs) []
+
+ fun xs x ts
+ | x `elem` xs = Var x
+ | otherwise = Fun x ts
+
+ ret [] t = t
+ ret xs t = Abs (reverse xs) t
+
+data Value
+ = VGen Int
+ | VApp Value Value
+ | VVar CId
+ | VMeta Int
+ | VLit Literal
+ | VClosure Env Expr
+
+type Env = Map.Map CId Value
+
+eval :: Env -> Expr -> Value
+eval env (EVar x) = fromMaybe (VVar x) (Map.lookup x env)
+eval env (EApp e1 e2) = apply (eval env e1) (eval env e2)
+eval env (EAbs x e) = VClosure env (EAbs x e)
+eval env (EMeta k) = VMeta k
+eval env (ELit l) = VLit l
+
+apply :: Value -> Value -> Value
+apply (VClosure env (EAbs x e)) v = eval (Map.insert x v env) e
+apply v0 v = VApp v0 v
diff --git a/src/PGF/Generate.hs b/src/PGF/Generate.hs new file mode 100644 index 000000000..64ca4d5f5 --- /dev/null +++ b/src/PGF/Generate.hs @@ -0,0 +1,70 @@ +module PGF.Generate where + +import PGF.CId +import PGF.Data +import PGF.Macros + +import qualified Data.Map as M +import System.Random + +-- generate an infinite list of trees exhaustively +generate :: PGF -> CId -> Maybe Int -> [Tree] +generate pgf cat dp = concatMap (\i -> gener i cat) depths + where + gener 0 c = [Fun f [] | (f, ([],_)) <- fns c] + gener i c = [ + tr | + (f, (cs,_)) <- fns c, + let alts = map (gener (i-1)) cs, + ts <- combinations alts, + let tr = Fun f ts, + depth tr >= i + ] + fns c = [(f,catSkeleton ty) | (f,ty) <- functionsToCat pgf c] + depths = maybe [0 ..] (\d -> [0..d]) dp + +-- generate an infinite list of trees randomly +genRandom :: StdGen -> PGF -> CId -> [Tree] +genRandom gen pgf cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where + + timeout = 47 -- give up + + genTrees ds0 cat = + let (ds,ds2) = splitAt (timeout+1) ds0 -- for time out, else ds + (t,k) = genTree ds cat + in (if k>timeout then id else (t:)) + (genTrees ds2 cat) -- else (drop k ds) + + genTree rs = gett rs where + gett ds cid | cid == mkCId "String" = (Lit (LStr "foo"), 1) + gett ds cid | cid == mkCId "Int" = (Lit (LInt 12345), 1) + gett [] _ = (Lit (LStr "TIMEOUT"), 1) ---- + gett ds cat = case fns cat of + [] -> (Meta 0,1) + fs -> let + d:ds2 = ds + (f,args) = getf d fs + (ts,k) = getts ds2 args + in (Fun f ts, k+1) + getf d fs = let lg = (length fs) in + fs !! (floor (d * fromIntegral lg)) + getts ds cats = case cats of + c:cs -> let + (t, k) = gett ds c + (ts,ks) = getts (drop k ds) cs + in (t:ts, k + ks) + _ -> ([],0) + + fns cat = [(f,(fst (catSkeleton ty))) | (f,ty) <- functionsToCat pgf cat] + + +{- +-- brute-force parsing method; only returns the first result +-- note: you cannot throw away rules with unknown words from the grammar +-- because it is not known which field in each rule may match the input + +searchParse :: Int -> PGF -> CId -> [String] -> [Exp] +searchParse i pgf cat ws = [t | t <- gen, s <- lins t, words s == ws] where + gen = take i $ generate pgf cat + lins t = [linearize pgf lang t | lang <- cncnames pgf] +-} diff --git a/src/PGF/Linearize.hs b/src/PGF/Linearize.hs new file mode 100644 index 000000000..5bc40438f --- /dev/null +++ b/src/PGF/Linearize.hs @@ -0,0 +1,99 @@ +module PGF.Linearize (linearizes,realize,realizes,linTree) where + +import PGF.CId +import PGF.Data +import PGF.Macros + +import qualified Data.Map as Map +import Data.List + +import Debug.Trace + +-- linearization and computation of concrete PGF Terms + +linearizes :: PGF -> CId -> Tree -> [String] +linearizes pgf lang = realizes . linTree pgf lang + +realize :: Term -> String +realize = concat . take 1 . realizes + +realizes :: Term -> [String] +realizes = map (unwords . untokn) . realizest + +realizest :: Term -> [[Tokn]] +realizest trm = case trm of + R ts -> realizest (ts !! 0) + S ss -> map concat $ combinations $ map realizest ss + K t -> [[t]] + W s t -> [[KS (s ++ r)] | [KS r] <- realizest t] + FV ts -> concatMap realizest ts + TM s -> [[KS s]] + _ -> [[KS $ "REALIZE_ERROR " ++ show trm]] ---- debug + +untokn :: [Tokn] -> [String] +untokn ts = case ts of + KP d _ : [] -> d + KP d vs : ws -> let ss@(s:_) = untokn ws in sel d vs s ++ ss + KS s : ws -> s : untokn ws + [] -> [] + where + sel d vs w = case [v | Alt v cs <- vs, any (\c -> isPrefixOf c w) cs] of + v:_ -> v + _ -> d + +linTree :: PGF -> CId -> Tree -> Term +linTree pgf lang = lin + where + lin (Abs xs e ) = case lin e of + R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs) + TM s -> R $ (TM s) : (Data.List.map (kks . prCId) xs) + lin (Fun fun es) = comp (map lin es) $ look fun + lin (Lit (LStr s)) = R [kks (show s)] -- quoted + lin (Lit (LInt i)) = R [kks (show i)] + lin (Lit (LFlt d)) = R [kks (show d)] + lin (Var x) = TM (prCId x) + lin (Meta i) = TM (show i) + + comp = compute pgf lang + look = lookLin pgf lang + + +compute :: PGF -> CId -> [Term] -> Term -> Term +compute pgf lang args = comp where + comp trm = case trm of + P r p -> proj (comp r) (comp p) + W s t -> W s (comp t) + R ts -> R $ map comp ts + V i -> idx args i -- already computed + F c -> comp $ look c -- not computed (if contains argvar) + FV ts -> FV $ map comp ts + S ts -> S $ filter (/= S []) $ map comp ts + _ -> trm + + look = lookOper pgf lang + + idx xs i = if i > length xs - 1 + then trace + ("too large " ++ show i ++ " for\n" ++ unlines (map show xs) ++ "\n") tm0 + else xs !! i + + proj r p = case (r,p) of + (_, FV ts) -> FV $ map (proj r) ts + (FV ts, _ ) -> FV $ map (\t -> proj t p) ts + (W s t, _) -> kks (s ++ getString (proj t p)) + _ -> comp $ getField r (getIndex p) + + getString t = case t of + K (KS s) -> s + _ -> error ("ERROR in grammar compiler: string from "++ show t) "ERR" + + getIndex t = case t of + C i -> i + TM _ -> 0 -- default value for parameter + _ -> trace ("ERROR in grammar compiler: index from " ++ show t) 666 + + getField t i = case t of + R rs -> idx rs i + TM s -> TM s + _ -> error ("ERROR in grammar compiler: field from " ++ show t) t + diff --git a/src/PGF/Macros.hs b/src/PGF/Macros.hs new file mode 100644 index 000000000..bb5e8188b --- /dev/null +++ b/src/PGF/Macros.hs @@ -0,0 +1,139 @@ +module PGF.Macros where + +import PGF.CId +import PGF.Data +import Control.Monad +import qualified Data.Map as Map +import qualified Data.Array as Array +import Data.Maybe +import Data.List + +-- operations for manipulating PGF grammars and objects + +lookLin :: PGF -> CId -> CId -> Term +lookLin pgf lang fun = + lookMap tm0 fun $ lins $ lookMap (error "no lang") lang $ concretes pgf + +lookOper :: PGF -> CId -> CId -> Term +lookOper pgf lang fun = + lookMap tm0 fun $ opers $ lookMap (error "no lang") lang $ concretes pgf + +lookLincat :: PGF -> CId -> CId -> Term +lookLincat pgf lang fun = + lookMap tm0 fun $ lincats $ lookMap (error "no lang") lang $ concretes pgf + +lookParamLincat :: PGF -> CId -> CId -> Term +lookParamLincat pgf lang fun = + lookMap tm0 fun $ paramlincats $ lookMap (error "no lang") lang $ concretes pgf + +lookPrintName :: PGF -> CId -> CId -> Term +lookPrintName pgf lang fun = + lookMap tm0 fun $ printnames $ lookMap (error "no lang") lang $ concretes pgf + +lookType :: PGF -> CId -> Type +lookType pgf f = + fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf)) + +lookValCat :: PGF -> CId -> CId +lookValCat pgf = valCat . lookType pgf + +lookParser :: PGF -> CId -> Maybe ParserInfo +lookParser pgf lang = Map.lookup lang (concretes pgf) >>= parser + +lookFCFG :: PGF -> CId -> Maybe FGrammar +lookFCFG pgf lang = fmap toFGrammar $ lookParser pgf lang + where + toFGrammar :: ParserInfo -> FGrammar + toFGrammar pinfo = (Array.elems (allRules pinfo), startupCats pinfo) + +lookStartCat :: PGF -> String +lookStartCat pgf = fromMaybe "S" $ msum $ Data.List.map (Map.lookup (mkCId "startcat")) + [gflags pgf, aflags (abstract pgf)] + +lookGlobalFlag :: PGF -> CId -> String +lookGlobalFlag pgf f = + lookMap "?" f (gflags pgf) + +lookAbsFlag :: PGF -> CId -> String +lookAbsFlag pgf f = + lookMap "?" f (aflags (abstract pgf)) + +lookConcr :: PGF -> CId -> Concr +lookConcr pgf cnc = + lookMap (error $ "Missing concrete syntax: " ++ prCId cnc) cnc $ concretes pgf + +lookConcrFlag :: PGF -> CId -> CId -> Maybe String +lookConcrFlag pgf lang f = Map.lookup f $ cflags $ lookConcr pgf lang + +functionsToCat :: PGF -> CId -> [(CId,Type)] +functionsToCat pgf cat = + [(f,ty) | f <- fs, Just (ty,_) <- [Map.lookup f $ funs $ abstract pgf]] + where + fs = lookMap [] cat $ catfuns $ abstract pgf + +missingLins :: PGF -> CId -> [CId] +missingLins pgf lang = [c | c <- fs, not (hasl c)] where + fs = Map.keys $ funs $ abstract pgf + hasl = hasLin pgf lang + +hasLin :: PGF -> CId -> CId -> Bool +hasLin pgf lang f = Map.member f $ lins $ lookConcr pgf lang + +restrictPGF :: (CId -> Bool) -> PGF -> PGF +restrictPGF cond pgf = pgf { + abstract = abstr { + funs = restrict $ funs $ abstr, + cats = restrict $ cats $ abstr + } + } ---- restrict concrs also, might be needed + where + restrict = Map.filterWithKey (\c _ -> cond c) + abstr = abstract pgf + +depth :: Tree -> Int +depth (Abs _ t) = depth t +depth (Fun _ ts) = maximum (0:map depth ts) + 1 +depth _ = 1 + +cftype :: [CId] -> CId -> Type +cftype args val = DTyp [Hyp wildCId (cftype [] arg) | arg <- args] val [] + +catSkeleton :: Type -> ([CId],CId) +catSkeleton ty = case ty of + DTyp hyps val _ -> ([valCat ty | Hyp _ ty <- hyps],val) + +typeSkeleton :: Type -> ([(Int,CId)],CId) +typeSkeleton ty = case ty of + DTyp hyps val _ -> ([(contextLength ty, valCat ty) | Hyp _ ty <- hyps],val) + +valCat :: Type -> CId +valCat ty = case ty of + DTyp _ val _ -> val + +contextLength :: Type -> Int +contextLength ty = case ty of + DTyp hyps _ _ -> length hyps + +primNotion :: Expr +primNotion = EEq [] + +term0 :: CId -> Term +term0 = TM . prCId + +tm0 :: Term +tm0 = TM "?" + +kks :: String -> Term +kks = K . KS + +-- lookup with default value +lookMap :: (Show i, Ord i) => a -> i -> Map.Map i a -> a +lookMap d c m = fromMaybe d $ Map.lookup c m + +--- from Operations +combinations :: [[a]] -> [[a]] +combinations t = case t of + [] -> [[]] + aa:uu -> [a:u | a <- aa, u <- combinations uu] + + diff --git a/src/PGF/Morphology.hs b/src/PGF/Morphology.hs new file mode 100644 index 000000000..2eb793d73 --- /dev/null +++ b/src/PGF/Morphology.hs @@ -0,0 +1,32 @@ +module PGF.Morphology where + +import PGF.ShowLinearize (collectWords) +import PGF.Data +import PGF.CId + +import qualified Data.Map as Map +import Data.List (intersperse) + +-- these 4 definitions depend on the datastructure used + +type Morpho = Map.Map String [(Lemma,Analysis)] + +lookupMorpho :: Morpho -> String -> [(Lemma,Analysis)] +lookupMorpho mo s = maybe noAnalysis id $ Map.lookup s mo + +buildMorpho :: PGF -> CId -> Morpho +buildMorpho pgf = Map.fromListWith (++) . collectWords pgf + +prFullFormLexicon :: Morpho -> String +prFullFormLexicon mo = + unlines [w ++ " : " ++ prMorphoAnalysis ts | (w,ts) <- Map.assocs mo] + +prMorphoAnalysis :: [(Lemma,Analysis)] -> String +prMorphoAnalysis lps = unlines [l ++ " " ++ p | (l,p) <- lps] + +type Lemma = String +type Analysis = String + +noAnalysis :: [(Lemma,Analysis)] +noAnalysis = [] + diff --git a/src/PGF/Parsing/FCFG.hs b/src/PGF/Parsing/FCFG.hs new file mode 100644 index 000000000..4ca6a956a --- /dev/null +++ b/src/PGF/Parsing/FCFG.hs @@ -0,0 +1,40 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : Krasimir Angelov +-- Stability : (stable) +-- Portability : (portable) +-- +-- FCFG parsing +----------------------------------------------------------------------------- + +module PGF.Parsing.FCFG + (buildParserInfo,ParserInfo,parseFCFG) where + +import GF.Data.ErrM +import GF.Data.Assoc +import GF.Data.SortedList + +import PGF.CId +import PGF.Data +import PGF.Macros +import PGF.BuildParser +import PGF.Parsing.FCFG.Utilities +import qualified PGF.Parsing.FCFG.Active as Active +import qualified PGF.Parsing.FCFG.Incremental as Incremental + +import qualified Data.Map as Map + +---------------------------------------------------------------------- +-- parsing + +-- main parsing function + +parseFCFG :: String -- ^ parsing strategy + -> ParserInfo -- ^ compiled grammar (fcfg) + -> CId -- ^ starting category + -> [String] -- ^ input tokens + -> Err [Tree] -- ^ resulting GF terms +parseFCFG "bottomup" pinfo start toks = return $ Active.parse "b" pinfo start toks +parseFCFG "topdown" pinfo start toks = return $ Active.parse "t" pinfo start toks +parseFCFG "incremental" pinfo start toks = return $ Incremental.parse pinfo start toks +parseFCFG strat pinfo start toks = fail $ "FCFG parsing strategy not defined: " ++ strat diff --git a/src/PGF/Parsing/FCFG/Active.hs b/src/PGF/Parsing/FCFG/Active.hs new file mode 100644 index 000000000..4386bfdd1 --- /dev/null +++ b/src/PGF/Parsing/FCFG/Active.hs @@ -0,0 +1,189 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : Krasimir Angelov +-- Stability : (stable) +-- Portability : (portable) +-- +-- MCFG parsing, the active algorithm +----------------------------------------------------------------------------- + +module PGF.Parsing.FCFG.Active (parse) where + +import GF.Data.Assoc +import GF.Data.SortedList +import GF.Data.Utilities +import qualified GF.Data.MultiMap as MM + +import PGF.CId +import PGF.Data +import PGF.Parsing.FCFG.Utilities + +import Control.Monad (guard) + +import qualified Data.List as List +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Array + +---------------------------------------------------------------------- +-- * parsing + +makeFinalEdge cat 0 0 = (cat, [EmptyRange]) +makeFinalEdge cat i j = (cat, [makeRange i j]) + +-- | the list of categories = possible starting categories +parse :: String -> ParserInfo -> CId -> [FToken] -> [Tree] +parse strategy pinfo start toks = nubsort $ filteredForests >>= forest2trees + where + inTokens = input toks + starts = Map.findWithDefault [] start (startupCats pinfo) + schart = xchart2syntaxchart chart pinfo + (i,j) = inputBounds inTokens + finalEdges = [makeFinalEdge cat i j | cat <- starts] + forests = chart2forests schart (const False) finalEdges + filteredForests = forests >>= applyProfileToForest + + chart = process strategy pinfo inTokens axioms emptyXChart + axioms | isBU strategy = literals pinfo inTokens ++ initialBU pinfo inTokens + | isTD strategy = literals pinfo inTokens ++ initialTD pinfo starts inTokens + +isBU s = s=="b" +isTD s = s=="t" + +-- used in prediction +emptyChildren :: RuleId -> ParserInfo -> SyntaxNode RuleId RangeRec +emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) []) + where + FRule _ _ rhs _ _ = allRules pinfo ! ruleid + +process :: String -> ParserInfo -> Input FToken -> [(FCat,Item)] -> XChart FCat -> XChart FCat +process strategy pinfo toks [] chart = chart +process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks items $! univRule c item chart + where + univRule cat item@(Active found rng lbl ppos node@(SNode ruleid recs)) chart + | inRange (bounds lin) ppos = + case lin ! ppos of + FSymCat r d -> let c = args !! d + in case recs !! d of + [] -> case insertXChart chart item c of + Nothing -> chart + Just chart -> let items = do item@(Final found' _) <- lookupXChartFinal chart c + rng <- concatRange rng (found' !! r) + return (c, Active found rng lbl (ppos+1) (SNode ruleid (updateNth (const found') d recs))) + ++ + do guard (isTD strategy) + ruleid <- topdownRules pinfo ? c + return (c, Active [] EmptyRange 0 0 (emptyChildren ruleid pinfo)) + in process strategy pinfo toks items chart + found' -> let items = do rng <- concatRange rng (found' !! r) + return (c, Active found rng lbl (ppos+1) node) + in process strategy pinfo toks items chart + FSymTok tok -> let items = do t_rng <- inputToken toks ? tok + rng' <- concatRange rng t_rng + return (cat, Active found rng' lbl (ppos+1) node) + in process strategy pinfo toks items chart + | otherwise = + if inRange (bounds lins) (lbl+1) + then univRule cat (Active (rng:found) EmptyRange (lbl+1) 0 node) chart + else univRule cat (Final (reverse (rng:found)) node) chart + where + (FRule _ _ args cat lins) = allRules pinfo ! ruleid + lin = lins ! lbl + univRule cat item@(Final found' node) chart = + case insertXChart chart item cat of + Nothing -> chart + Just chart -> let items = do (Active found rng l ppos node@(SNode ruleid _)) <- lookupXChartAct chart cat + let FRule _ _ args _ lins = allRules pinfo ! ruleid + FSymCat r d = lins ! l ! ppos + rng <- concatRange rng (found' !! r) + return (args !! d, Active found rng l (ppos+1) (updateChildren node d found')) + ++ + do guard (isBU strategy) + ruleid <- leftcornerCats pinfo ? cat + let FRule _ _ args _ lins = allRules pinfo ! ruleid + FSymCat r d = lins ! 0 ! 0 + return (args !! d, Active [] (found' !! r) 0 1 (updateChildren (emptyChildren ruleid pinfo) d found')) + + updateChildren :: SyntaxNode RuleId RangeRec -> Int -> RangeRec -> SyntaxNode RuleId RangeRec + updateChildren (SNode ruleid recs) i rec = SNode ruleid $! updateNth (const rec) i recs + in process strategy pinfo toks items chart + +---------------------------------------------------------------------- +-- * XChart + +data Item + = Active RangeRec + Range + {-# UNPACK #-} !FIndex + {-# UNPACK #-} !FPointPos + (SyntaxNode RuleId RangeRec) + | Final RangeRec (SyntaxNode RuleId RangeRec) + deriving (Eq, Ord) + +data XChart c = XChart !(MM.MultiMap c Item) !(MM.MultiMap c Item) + +emptyXChart :: Ord c => XChart c +emptyXChart = XChart MM.empty MM.empty + +insertXChart (XChart actives finals) item@(Active _ _ _ _ _) c = + case MM.insert' c item actives of + Nothing -> Nothing + Just actives -> Just (XChart actives finals) + +insertXChart (XChart actives finals) item@(Final _ _) c = + case MM.insert' c item finals of + Nothing -> Nothing + Just finals -> Just (XChart actives finals) + +lookupXChartAct (XChart actives finals) c = actives MM.! c +lookupXChartFinal (XChart actives finals) c = finals MM.! c + +xchart2syntaxchart :: XChart FCat -> ParserInfo -> SyntaxChart (CId,[Profile]) (FCat,RangeRec) +xchart2syntaxchart (XChart actives finals) pinfo = + accumAssoc groupSyntaxNodes $ + [ case node of + SNode ruleid rrecs -> let FRule fun prof rhs cat _ = allRules pinfo ! ruleid + in ((cat,found), SNode (fun,prof) (zip rhs rrecs)) + SString s -> ((cat,found), SString s) + SInt n -> ((cat,found), SInt n) + SFloat f -> ((cat,found), SFloat f) + | (cat, Final found node) <- MM.toList finals + ] + +literals :: ParserInfo -> Input FToken -> [(FCat,Item)] +literals pinfo toks = + [let (c,node) = lexer t in (c,Final [rng] node) | (t,rngs) <- aAssocs (inputToken toks), rng <- rngs, not (t `elem` grammarToks pinfo)] + where + lexer t = + case reads t of + [(n,"")] -> (fcatInt, SInt (n::Integer)) + _ -> case reads t of + [(f,"")] -> (fcatFloat, SFloat (f::Double)) + _ -> (fcatString,SString t) + + +---------------------------------------------------------------------- +-- Earley -- + +-- called with all starting categories +initialTD :: ParserInfo -> [FCat] -> Input FToken -> [(FCat,Item)] +initialTD pinfo starts toks = + do cat <- starts + ruleid <- topdownRules pinfo ? cat + return (cat,Active [] (Range 0 0) 0 0 (emptyChildren ruleid pinfo)) + + +---------------------------------------------------------------------- +-- Kilbury -- + +initialBU :: ParserInfo -> Input FToken -> [(FCat,Item)] +initialBU pinfo toks = + do (tok,rngs) <- aAssocs (inputToken toks) + ruleid <- leftcornerTokens pinfo ? tok + let FRule _ _ _ cat _ = allRules pinfo ! ruleid + rng <- rngs + return (cat,Active [] rng 0 1 (emptyChildren ruleid pinfo)) + ++ + do ruleid <- epsilonRules pinfo + let FRule _ _ _ cat _ = allRules pinfo ! ruleid + return (cat,Active [] EmptyRange 0 0 (emptyChildren ruleid pinfo)) diff --git a/src/PGF/Parsing/FCFG/Incremental.hs b/src/PGF/Parsing/FCFG/Incremental.hs new file mode 100644 index 000000000..fff5f0212 --- /dev/null +++ b/src/PGF/Parsing/FCFG/Incremental.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE BangPatterns #-}
+module PGF.Parsing.FCFG.Incremental
+ ( ParseState
+ , initState
+ , nextState
+ , getCompletions
+ , extractExps
+ , parse
+ ) where
+
+import Data.Array
+import Data.Array.Base (unsafeAt)
+import Data.List (isPrefixOf, foldl')
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as Map
+import qualified Data.IntMap as IntMap
+import qualified Data.Set as Set
+import Control.Monad
+
+import GF.Data.Assoc
+import GF.Data.SortedList
+import qualified GF.Data.MultiMap as MM
+import PGF.CId
+import PGF.Data
+import PGF.Parsing.FCFG.Utilities
+import Debug.Trace
+
+parse :: ParserInfo -> CId -> [FToken] -> [Tree]
+parse pinfo start toks = extractExps (foldl' nextState (initState pinfo start) toks) start
+
+initState :: ParserInfo -> CId -> ParseState
+initState pinfo start =
+ let items = do
+ c <- Map.findWithDefault [] start (startupCats pinfo)
+ ruleid <- topdownRules pinfo ? c
+ let (FRule fn _ args cat lins) = allRules pinfo ! ruleid
+ lbl <- indices lins
+ return (Active 0 lbl 0 ruleid args cat)
+
+ forest = IntMap.fromListWith Set.union [(cat, Set.singleton (Passive ruleid args)) | (ruleid, FRule _ _ args cat _) <- assocs (allRules pinfo)]
+
+ max_fid = case IntMap.maxViewWithKey forest of
+ Just ((fid,_), _) -> fid+1
+ Nothing -> 0
+
+ in State pinfo
+ (Chart MM.empty [] Map.empty forest max_fid 0)
+ (Set.fromList items)
+
+-- | From the current state and the next token
+-- 'nextState' computes a new state where the token
+-- is consumed and the current position shifted by one.
+nextState :: ParseState -> String -> ParseState
+nextState (State pinfo chart items) t =
+ let (items1,chart1) = process add (allRules pinfo) (Set.toList items) (Set.empty,chart)
+ chart2 = chart1{ active =MM.empty
+ , actives=active chart1 : actives chart1
+ , passive=Map.empty
+ , offset =offset chart1+1
+ }
+ in State pinfo chart2 items1
+ where
+ add tok item set
+ | tok == t = Set.insert item set
+ | otherwise = set
+
+-- | If the next token is not known but only its prefix (possible empty prefix)
+-- then the 'getCompletions' function can be used to calculate the possible
+-- next words and the consequent states. This is used for word completions in
+-- the GF interpreter.
+getCompletions :: ParseState -> String -> Map.Map String ParseState
+getCompletions (State pinfo chart items) w =
+ let (map',chart1) = process add (allRules pinfo) (Set.toList items) (MM.empty,chart)
+ chart2 = chart1{ active =MM.empty
+ , actives=active chart1 : actives chart1
+ , passive=Map.empty
+ , offset =offset chart1+1
+ }
+ in fmap (State pinfo chart2) map'
+ where
+ add tok item map
+ | isPrefixOf w tok = fromMaybe map (MM.insert' tok item map)
+ | otherwise = map
+
+extractExps :: ParseState -> CId -> [Tree]
+extractExps (State pinfo chart items) start = exps
+ where
+ (_,st) = process (\_ _ -> id) (allRules pinfo) (Set.toList items) ((),chart)
+
+ exps = nubsort $ do
+ c <- Map.findWithDefault [] start (startupCats pinfo)
+ ruleid <- topdownRules pinfo ? c
+ let (FRule fn _ args cat lins) = allRules pinfo ! ruleid
+ lbl <- indices lins
+ fid <- Map.lookup (PK c lbl 0) (passive st)
+ go Set.empty fid
+
+ go rec fid
+ | Set.member fid rec = mzero
+ | otherwise = do set <- IntMap.lookup fid (forest st)
+ Passive ruleid args <- Set.toList set
+ let (FRule fn _ _ cat lins) = allRules pinfo ! ruleid
+ if fn == wildCId
+ then go (Set.insert fid rec) (head args)
+ else do args <- mapM (go (Set.insert fid rec)) args
+ return (Fun fn args)
+
+process fn !rules [] acc_chart = acc_chart
+process fn !rules (item:items) acc_chart = univRule item acc_chart
+ where
+ univRule (Active j lbl ppos ruleid args fid0) acc_chart@(acc,chart)
+ | inRange (bounds lin) ppos =
+ case unsafeAt lin ppos of
+ FSymCat r d -> let !fid = args !! d
+ in case MM.insert' (AK fid r) item (active chart) of
+ Nothing -> process fn rules items $ acc_chart
+ Just actCat -> (case Map.lookup (PK fid r k) (passive chart) of
+ Nothing -> id
+ Just id -> process fn rules [Active j lbl (ppos+1) ruleid (updateAt d id args) fid0]) $
+ (case IntMap.lookup fid (forest chart) of
+ Nothing -> id
+ Just set -> process fn rules (Set.fold (\(Passive ruleid args) -> (:) (Active k r 0 ruleid args fid)) [] set)) $
+ process fn rules items $
+ (acc,chart{active=actCat})
+ FSymTok tok -> process fn rules items $
+ (fn tok (Active j lbl (ppos+1) ruleid args fid0) acc,chart)
+ | otherwise = case Map.lookup (PK fid0 lbl j) (passive chart) of
+ Nothing -> let fid = nextId chart
+ in process fn rules [Active j' lbl (ppos+1) ruleid (updateAt d fid args) fidc
+ | Active j' lbl ppos ruleid args fidc <- ((active chart:actives chart) !! (k-j)) MM.! (AK fid0 lbl),
+ let FSymCat _ d = unsafeAt (rhs ruleid lbl) ppos] $
+ process fn rules items $
+ (acc,chart{passive=Map.insert (PK fid0 lbl j) fid (passive chart)
+ ,forest =IntMap.insert fid (Set.singleton (Passive ruleid args)) (forest chart)
+ ,nextId =nextId chart+1
+ })
+ Just id -> process fn rules items $
+ (acc,chart{forest = IntMap.insertWith Set.union id (Set.singleton (Passive ruleid args)) (forest chart)})
+ where
+ !lin = rhs ruleid lbl
+ !k = offset chart
+
+ rhs ruleid lbl = unsafeAt lins lbl
+ where
+ (FRule _ _ _ cat lins) = unsafeAt rules ruleid
+
+ updateAt :: Int -> a -> [a] -> [a]
+ updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs]
+
+
+data Active
+ = Active {-# UNPACK #-} !Int
+ {-# UNPACK #-} !FIndex
+ {-# UNPACK #-} !FPointPos
+ {-# UNPACK #-} !RuleId
+ [FCat]
+ {-# UNPACK #-} !FCat
+ deriving (Eq,Show,Ord)
+data Passive
+ = Passive {-# UNPACK #-} !RuleId
+ [FCat]
+ deriving (Eq,Ord,Show)
+
+data ActiveKey
+ = AK {-# UNPACK #-} !FCat
+ {-# UNPACK #-} !FIndex
+ deriving (Eq,Ord,Show)
+data PassiveKey
+ = PK {-# UNPACK #-} !FCat
+ {-# UNPACK #-} !FIndex
+ {-# UNPACK #-} !Int
+ deriving (Eq,Ord,Show)
+
+
+-- | An abstract data type whose values represent
+-- the current state in an incremental parser.
+data ParseState = State ParserInfo Chart (Set.Set Active)
+
+data Chart
+ = Chart
+ { active :: MM.MultiMap ActiveKey Active
+ , actives :: [MM.MultiMap ActiveKey Active]
+ , passive :: Map.Map PassiveKey FCat
+ , forest :: IntMap.IntMap (Set.Set Passive)
+ , nextId :: {-# UNPACK #-} !FCat
+ , offset :: {-# UNPACK #-} !Int
+ }
diff --git a/src/PGF/Parsing/FCFG/Utilities.hs b/src/PGF/Parsing/FCFG/Utilities.hs new file mode 100644 index 000000000..4187d0f24 --- /dev/null +++ b/src/PGF/Parsing/FCFG/Utilities.hs @@ -0,0 +1,187 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : PL +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/13 12:40:19 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.6 $ +-- +-- Basic type declarations and functions for grammar formalisms +----------------------------------------------------------------------------- + + +module PGF.Parsing.FCFG.Utilities where + +import Control.Monad +import Data.Array +import Data.List (groupBy) + +import PGF.CId +import PGF.Data +import GF.Data.Assoc +import GF.Data.Utilities (sameLength, foldMerge, splitBy) + + +------------------------------------------------------------ +-- ranges as single pairs + +type RangeRec = [Range] + +data Range = Range {-# UNPACK #-} !Int {-# UNPACK #-} !Int + | EmptyRange + deriving (Eq, Ord) + +makeRange :: Int -> Int -> Range +makeRange = Range + +concatRange :: Range -> Range -> [Range] +concatRange EmptyRange rng = return rng +concatRange rng EmptyRange = return rng +concatRange (Range i j) (Range j' k) = [Range i k | j==j'] + +minRange :: Range -> Int +minRange (Range i j) = i + +maxRange :: Range -> Int +maxRange (Range i j) = j + + +------------------------------------------------------------ +-- * representaions of input tokens + +data Input t = MkInput { inputBounds :: (Int, Int), + inputToken :: Assoc t [Range] + } + +input :: Ord t => [t] -> Input t +input toks = MkInput inBounds inToken + where + inBounds = (0, length toks) + inToken = accumAssoc id [ (tok, makeRange i j) | (i,j,tok) <- zip3 [0..] [1..] toks ] + +inputMany :: Ord t => [[t]] -> Input t +inputMany toks = MkInput inBounds inToken + where + inBounds = (0, length toks) + inToken = accumAssoc id [ (tok, makeRange i j) | (i,j,ts) <- zip3 [0..] [1..] toks, tok <- ts ] + + +------------------------------------------------------------ +-- * representations of syntactical analyses + +-- ** charts as finite maps over edges + +-- | The values of the chart, a list of key-daughters pairs, +-- has unique keys. In essence, it is a map from 'n' to daughters. +-- The daughters should be a set (not necessarily sorted) of rhs's. +type SyntaxChart n e = Assoc e [SyntaxNode n [e]] + +data SyntaxNode n e = SMeta + | SNode n [e] + | SString String + | SInt Integer + | SFloat Double + deriving (Eq,Ord) + +groupSyntaxNodes :: Ord n => [SyntaxNode n e] -> [SyntaxNode n [e]] +groupSyntaxNodes [] = [] +groupSyntaxNodes (SNode n0 es0:xs) = (SNode n0 (es0:ess)) : groupSyntaxNodes xs' + where + (ess,xs') = span xs + + span [] = ([],[]) + span xs@(SNode n es:xs') + | n0 == n = let (ess,xs) = span xs' in (es:ess,xs) + | otherwise = ([],xs) +groupSyntaxNodes (SString s:xs) = (SString s) : groupSyntaxNodes xs +groupSyntaxNodes (SInt n:xs) = (SInt n) : groupSyntaxNodes xs +groupSyntaxNodes (SFloat f:xs) = (SFloat f) : groupSyntaxNodes xs + +-- ** syntax forests + +data SyntaxForest n = FMeta + | FNode n [[SyntaxForest n]] + -- ^ The outer list should be a set (not necessarily sorted) + -- of possible alternatives. Ie. the outer list + -- is a disjunctive node, and the inner lists + -- are (conjunctive) concatenative nodes + | FString String + | FInt Integer + | FFloat Double + deriving (Eq, Ord, Show) + +instance Functor SyntaxForest where + fmap f (FNode n forests) = FNode (f n) $ map (map (fmap f)) forests + fmap _ (FString s) = FString s + fmap _ (FInt n) = FInt n + fmap _ (FFloat f) = FFloat f + fmap _ (FMeta) = FMeta + +forestName :: SyntaxForest n -> Maybe n +forestName (FNode n _) = Just n +forestName _ = Nothing + +unifyManyForests :: (Monad m, Eq n) => [SyntaxForest n] -> m (SyntaxForest n) +unifyManyForests = foldM unifyForests FMeta + +-- | two forests can be unified, if either is 'FMeta', or both have the same parent, +-- and all children can be unified +unifyForests :: (Monad m, Eq n) => SyntaxForest n -> SyntaxForest n -> m (SyntaxForest n) +unifyForests FMeta forest = return forest +unifyForests forest FMeta = return forest +unifyForests (FNode name1 children1) (FNode name2 children2) + | name1 == name2 && not (null children) = return $ FNode name1 children + where children = [ forests | forests1 <- children1, forests2 <- children2, + sameLength forests1 forests2, + forests <- zipWithM unifyForests forests1 forests2 ] +unifyForests (FString s1) (FString s2) + | s1 == s2 = return $ FString s1 +unifyForests (FInt n1) (FInt n2) + | n1 == n2 = return $ FInt n1 +unifyForests (FFloat f1) (FFloat f2) + | f1 == f2 = return $ FFloat f1 +unifyForests _ _ = fail "forest unification failure" + + +-- ** conversions between representations + +chart2forests :: (Ord n, Ord e) => + SyntaxChart n e -- ^ The complete chart + -> (e -> Bool) -- ^ When is an edge 'FMeta'? + -> [e] -- ^ The starting edges + -> [SyntaxForest n] -- ^ The result has unique keys, ie. all 'n' are joined together. + -- In essence, the result is a map from 'n' to forest daughters +chart2forests chart isMeta = concatMap (edge2forests []) + where edge2forests edges edge + | isMeta edge = [FMeta] + | edge `elem` edges = [] + | otherwise = map (item2forest (edge:edges)) $ chart ? edge + item2forest edges (SMeta) = FMeta + item2forest edges (SNode name children) = + FNode name $ children >>= mapM (edge2forests edges) + item2forest edges (SString s) = FString s + item2forest edges (SInt n) = FInt n + item2forest edges (SFloat f) = FFloat f + + +applyProfileToForest :: SyntaxForest (CId,[Profile]) -> [SyntaxForest CId] +applyProfileToForest (FNode (fun,profiles) children) + | fun == wildCId = concat chForests + | otherwise = [ FNode fun chForests | not (null chForests) ] + where chForests = concat [ mapM (unifyManyForests . map (forests !!)) profiles | + forests0 <- children, + forests <- mapM applyProfileToForest forests0 ] +applyProfileToForest (FString s) = [FString s] +applyProfileToForest (FInt n) = [FInt n] +applyProfileToForest (FFloat f) = [FFloat f] +applyProfileToForest (FMeta) = [FMeta] + + +forest2trees :: SyntaxForest CId -> [Tree] +forest2trees (FNode n forests) = map (Fun n) $ forests >>= mapM forest2trees +forest2trees (FString s) = [Lit (LStr s)] +forest2trees (FInt n) = [Lit (LInt n)] +forest2trees (FFloat f) = [Lit (LFlt f)] +forest2trees (FMeta) = [Meta 0] diff --git a/src/PGF/Quiz.hs b/src/PGF/Quiz.hs new file mode 100644 index 000000000..7f5bae201 --- /dev/null +++ b/src/PGF/Quiz.hs @@ -0,0 +1,67 @@ +---------------------------------------------------------------------- +-- | +-- Module : TeachYourself +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/21 16:46:13 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.7 $ +-- +-- translation and morphology quiz. AR 10\/5\/2000 -- 12\/4\/2002 -- 14\/6\/2008 +-------------------------------------------------------------------------------- + +module PGF.Quiz ( + mkQuiz, + translationList, + morphologyList + ) where + +import PGF +import PGF.ShowLinearize + +import GF.Data.Operations +import GF.Infra.UseIO + +import System.Random + +import Data.List (nub) + +-- translation and morphology quiz. AR 10/5/2000 -- 12/4/2002 + +-- generic quiz function + +mkQuiz :: String -> [(String,[String])] -> IO () +mkQuiz msg tts = do + let qas = [ (q, mkAnswer as) | (q,as) <- tts] + teachDialogue qas msg + +translationList :: + PGF -> Language -> Language -> Category -> Int -> IO [(String,[String])] +translationList pgf ig og cat number = do + ts <- generateRandom pgf cat >>= return . take number + return $ map mkOne $ ts + where + mkOne t = (norml (linearize pgf ig t), map (norml . linearize pgf og) (homonyms t)) + homonyms = nub . parse pgf ig cat . linearize pgf ig + +morphologyList :: PGF -> Language -> Category -> Int -> IO [(String,[String])] +morphologyList pgf ig cat number = do + ts <- generateRandom pgf cat >>= return . take (max 1 number) + gen <- newStdGen + let ss = map (tabularLinearize pgf (mkCId ig)) ts + let size = length (head ss) + let forms = take number $ randomRs (0,size-1) gen + return [(head (snd (head pws)) +++ par, ws) | + (pws,i) <- zip ss forms, let (par,ws) = pws !! i] + +-- | compare answer to the list of right answers, increase score and give feedback +mkAnswer :: [String] -> String -> (Integer, String) +mkAnswer as s = if (elem (norml s) as) + then (1,"Yes.") + else (0,"No, not" +++ s ++ ", but" ++++ unlines as) + +norml :: String -> String +norml = unwords . words + diff --git a/src/PGF/Raw/Abstract.hs b/src/PGF/Raw/Abstract.hs new file mode 100644 index 000000000..77d919a2d --- /dev/null +++ b/src/PGF/Raw/Abstract.hs @@ -0,0 +1,14 @@ +module PGF.Raw.Abstract where + +data Grammar = + Grm [RExp] + deriving (Eq,Ord,Show) + +data RExp = + App String [RExp] + | AInt Integer + | AStr String + | AFlt Double + | AMet + deriving (Eq,Ord,Show) + diff --git a/src/PGF/Raw/Convert.hs b/src/PGF/Raw/Convert.hs new file mode 100644 index 000000000..af3708eb5 --- /dev/null +++ b/src/PGF/Raw/Convert.hs @@ -0,0 +1,248 @@ +module PGF.Raw.Convert (toPGF,fromPGF) where + +import PGF.CId +import PGF.Data +import PGF.Raw.Abstract +import PGF.BuildParser (buildParserInfo) +import PGF.Parsing.FCFG.Utilities + +import qualified Data.Array as Array +import qualified Data.Map as Map + +pgfMajorVersion, pgfMinorVersion :: Integer +(pgfMajorVersion, pgfMinorVersion) = (1,0) + +-- convert parsed grammar to internal PGF + +toPGF :: Grammar -> PGF +toPGF (Grm [ + App "pgf" (AInt v1 : AInt v2 : App a []:cs), + App "flags" gfs, + ab@( + App "abstract" [ + App "fun" fs, + App "cat" cts + ]), + App "concrete" ccs + ]) = PGF { + absname = mkCId a, + cncnames = [mkCId c | App c [] <- cs], + gflags = Map.fromAscList [(mkCId f,v) | App f [AStr v] <- gfs], + abstract = + let + aflags = Map.fromAscList [(mkCId f,v) | App f [AStr v] <- gfs] + lfuns = [(mkCId f,(toType typ,toExp def)) | App f [typ, def] <- fs] + funs = Map.fromAscList lfuns + lcats = [(mkCId c, Prelude.map toHypo hyps) | App c hyps <- cts] + cats = Map.fromAscList lcats + catfuns = Map.fromAscList + [(cat,[f | (f, (DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats] + in Abstr aflags funs cats catfuns, + concretes = Map.fromAscList [(mkCId lang, toConcr ts) | App lang ts <- ccs] + } + where + +toConcr :: [RExp] -> Concr +toConcr = foldl add (Concr { + cflags = Map.empty, + lins = Map.empty, + opers = Map.empty, + lincats = Map.empty, + lindefs = Map.empty, + printnames = Map.empty, + paramlincats = Map.empty, + parser = Nothing + }) + where + add :: Concr -> RExp -> Concr + add cnc (App "flags" ts) = cnc { cflags = Map.fromAscList [(mkCId f,v) | App f [AStr v] <- ts] } + add cnc (App "lin" ts) = cnc { lins = mkTermMap ts } + add cnc (App "oper" ts) = cnc { opers = mkTermMap ts } + add cnc (App "lincat" ts) = cnc { lincats = mkTermMap ts } + add cnc (App "lindef" ts) = cnc { lindefs = mkTermMap ts } + add cnc (App "printname" ts) = cnc { printnames = mkTermMap ts } + add cnc (App "param" ts) = cnc { paramlincats = mkTermMap ts } + add cnc (App "parser" ts) = cnc { parser = Just (toPInfo ts) } + +toPInfo :: [RExp] -> ParserInfo +toPInfo [App "rules" rs, App "startupcats" cs] = buildParserInfo (rules, cats) + where + rules = map toFRule rs + cats = Map.fromList [(mkCId c, map expToInt fs) | App c fs <- cs] + + toFRule :: RExp -> FRule + toFRule (App "rule" + [n, + App "cats" (rt:at), + App "R" ls]) = FRule fun prof args res lins + where + (fun,prof) = toFName n + args = map expToInt at + res = expToInt rt + lins = mkArray [mkArray [toSymbol s | s <- l] | App "S" l <- ls] + +toFName :: RExp -> (CId,[Profile]) +toFName (App "_A" [x]) = (wildCId, [[expToInt x]]) +toFName (App f ts) = (mkCId f, map toProfile ts) + where + toProfile :: RExp -> Profile + toProfile AMet = [] + toProfile (App "_A" [t]) = [expToInt t] + toProfile (App "_U" ts) = [expToInt t | App "_A" [t] <- ts] + +toSymbol :: RExp -> FSymbol +toSymbol (App "P" [n,l]) = FSymCat (expToInt l) (expToInt n) +toSymbol (AStr t) = FSymTok t + +toType :: RExp -> Type +toType e = case e of + App cat [App "H" hypos, App "X" exps] -> + DTyp (map toHypo hypos) (mkCId cat) (map toExp exps) + _ -> error $ "type " ++ show e + +toHypo :: RExp -> Hypo +toHypo e = case e of + App x [typ] -> Hyp (mkCId x) (toType typ) + _ -> error $ "hypo " ++ show e + +toExp :: RExp -> Expr +toExp e = case e of + App "Abs" [App x [], exp] -> EAbs (mkCId x) (toExp exp) + App "App" [e1,e2] -> EApp (toExp e1) (toExp e2) + App "Eq" eqs -> EEq [Equ (map toExp ps) (toExp v) | App "E" (v:ps) <- eqs] + App "Var" [App i []] -> EVar (mkCId i) + AMet -> EMeta 0 + AInt i -> ELit (LInt i) + AFlt i -> ELit (LFlt i) + AStr i -> ELit (LStr i) + _ -> error $ "exp " ++ show e + +toTerm :: RExp -> Term +toTerm e = case e of + App "R" es -> R (map toTerm es) + App "S" es -> S (map toTerm es) + App "FV" es -> FV (map toTerm es) + App "P" [e,v] -> P (toTerm e) (toTerm v) + App "W" [AStr s,v] -> W s (toTerm v) + App "A" [AInt i] -> V (fromInteger i) + App f [] -> F (mkCId f) + AInt i -> C (fromInteger i) + AMet -> TM "?" + AStr s -> K (KS s) ---- + _ -> error $ "term " ++ show e + +------------------------------ +--- from internal to parser -- +------------------------------ + +fromPGF :: PGF -> Grammar +fromPGF pgf0 = Grm [ + App "pgf" (AInt pgfMajorVersion:AInt pgfMinorVersion + : App (prCId (absname pgf)) [] : map (flip App [] . prCId) (cncnames pgf)), + App "flags" [App (prCId f) [AStr v] | (f,v) <- Map.toList (gflags pgf `Map.union` aflags apgf)], + App "abstract" [ + App "fun" [App (prCId f) [fromType t,fromExp d] | (f,(t,d)) <- Map.toList (funs apgf)], + App "cat" [App (prCId f) (map fromHypo hs) | (f,hs) <- Map.toList (cats apgf)] + ], + App "concrete" [App (prCId lang) (fromConcrete c) | (lang,c) <- Map.toList (concretes pgf)] + ] + where + pgf = utf8GFCC pgf0 + apgf = abstract pgf + fromConcrete cnc = [ + App "flags" [App (prCId f) [AStr v] | (f,v) <- Map.toList (cflags cnc)], + App "lin" [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (lins cnc)], + App "oper" [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (opers cnc)], + App "lincat" [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (lincats cnc)], + App "lindef" [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (lindefs cnc)], + App "printname" [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (printnames cnc)], + App "param" [App (prCId f) [fromTerm v] | (f,v) <- Map.toList (paramlincats cnc)] + ] ++ maybe [] (\p -> [fromPInfo p]) (parser cnc) + +fromType :: Type -> RExp +fromType e = case e of + DTyp hypos cat exps -> + App (prCId cat) [ + App "H" (map fromHypo hypos), + App "X" (map fromExp exps)] + +fromHypo :: Hypo -> RExp +fromHypo e = case e of + Hyp x typ -> App (prCId x) [fromType typ] + +fromExp :: Expr -> RExp +fromExp e = case e of + EAbs x exp -> App "Abs" [App (prCId x) [], fromExp exp] + EApp e1 e2 -> App "App" [fromExp e1, fromExp e2] + EVar x -> App "Var" [App (prCId x) []] + ELit (LStr s) -> AStr s + ELit (LFlt d) -> AFlt d + ELit (LInt i) -> AInt (toInteger i) + EMeta _ -> AMet ---- + EEq eqs -> + App "Eq" [App "E" (map fromExp (v:ps)) | Equ ps v <- eqs] + +fromTerm :: Term -> RExp +fromTerm e = case e of + R es -> App "R" (map fromTerm es) + S es -> App "S" (map fromTerm es) + FV es -> App "FV" (map fromTerm es) + P e v -> App "P" [fromTerm e, fromTerm v] + W s v -> App "W" [AStr s, fromTerm v] + C i -> AInt (toInteger i) + TM _ -> AMet + F f -> App (prCId f) [] + V i -> App "A" [AInt (toInteger i)] + K (KS s) -> AStr s ---- + K (KP d vs) -> App "FV" (str d : [str v | Alt v _ <- vs]) ---- + where + str v = App "S" (map AStr v) + +-- ** Parsing info + +fromPInfo :: ParserInfo -> RExp +fromPInfo p = App "parser" [ + App "rules" [fromFRule rule | rule <- Array.elems (allRules p)], + App "startupcats" [App (prCId f) (map intToExp cs) | (f,cs) <- Map.toList (startupCats p)] + ] + +fromFRule :: FRule -> RExp +fromFRule (FRule fun prof args res lins) = + App "rule" [fromFName (fun,prof), + App "cats" (intToExp res:map intToExp args), + App "R" [App "S" [fromSymbol s | s <- Array.elems l] | l <- Array.elems lins] + ] + +fromFName :: (CId,[Profile]) -> RExp +fromFName (f,ps) | f == wildCId = fromProfile (head ps) + | otherwise = App (prCId f) (map fromProfile ps) + where + fromProfile :: Profile -> RExp + fromProfile [] = AMet + fromProfile [x] = daughter x + fromProfile args = App "_U" (map daughter args) + + daughter n = App "_A" [intToExp n] + +fromSymbol :: FSymbol -> RExp +fromSymbol (FSymCat l n) = App "P" [intToExp n, intToExp l] +fromSymbol (FSymTok t) = AStr t + +-- ** Utilities + +mkTermMap :: [RExp] -> Map.Map CId Term +mkTermMap ts = Map.fromAscList [(mkCId f,toTerm v) | App f [v] <- ts] + +mkArray :: [a] -> Array.Array Int a +mkArray xs = Array.listArray (0, length xs - 1) xs + +expToInt :: Integral a => RExp -> a +expToInt (App "neg" [AInt i]) = fromIntegral (negate i) +expToInt (AInt i) = fromIntegral i + +expToStr :: RExp -> String +expToStr (AStr s) = s + +intToExp :: Integral a => a -> RExp +intToExp x | x < 0 = App "neg" [AInt (fromIntegral (negate x))] + | otherwise = AInt (fromIntegral x) diff --git a/src/PGF/Raw/Parse.hs b/src/PGF/Raw/Parse.hs new file mode 100644 index 000000000..671183ba4 --- /dev/null +++ b/src/PGF/Raw/Parse.hs @@ -0,0 +1,101 @@ +module PGF.Raw.Parse (parseGrammar) where + +import PGF.CId +import PGF.Raw.Abstract + +import Control.Monad +import Data.Char +import qualified Data.ByteString.Char8 as BS + +parseGrammar :: String -> IO Grammar +parseGrammar s = case runP pGrammar s of + Just (x,"") -> return x + _ -> fail "Parse error" + +pGrammar :: P Grammar +pGrammar = liftM Grm pTerms + +pTerms :: P [RExp] +pTerms = liftM2 (:) (pTerm 1) pTerms <++ (skipSpaces >> return []) + +pTerm :: Int -> P RExp +pTerm n = skipSpaces >> (pParen <++ pApp <++ pNum <++ pStr <++ pMeta) + where pParen = between (char '(') (char ')') (pTerm 0) + pApp = liftM2 App pIdent (if n == 0 then pTerms else return []) + pStr = char '"' >> liftM AStr (manyTill (pEsc <++ get) (char '"')) + pEsc = char '\\' >> get + pNum = do x <- munch1 isDigit + ((char '.' >> munch1 isDigit >>= \y -> return (AFlt (read (x++"."++y)))) + <++ + return (AInt (read x))) + pMeta = char '?' >> return AMet + pIdent = liftM2 (:) (satisfy isIdentFirst) (munch isIdentRest) + isIdentFirst c = c == '_' || isAlpha c + isIdentRest c = c == '_' || c == '\'' || isAlphaNum c + +-- Parser combinators with only left-biased choice + +newtype P a = P { runP :: String -> Maybe (a,String) } + +instance Monad P where + return x = P (\ts -> Just (x,ts)) + P p >>= f = P (\ts -> p ts >>= \ (x,ts') -> runP (f x) ts') + fail _ = pfail + +instance MonadPlus P where + mzero = pfail + mplus = (<++) + + +get :: P Char +get = P (\ts -> case ts of + [] -> Nothing + c:cs -> Just (c,cs)) + +look :: P String +look = P (\ts -> Just (ts,ts)) + +(<++) :: P a -> P a -> P a +P p <++ P q = P (\ts -> p ts `mplus` q ts) + +pfail :: P a +pfail = P (\ts -> Nothing) + +satisfy :: (Char -> Bool) -> P Char +satisfy p = do c <- get + if p c then return c else pfail + +char :: Char -> P Char +char c = satisfy (c==) + +string :: String -> P String +string this = look >>= scan this + where + scan [] _ = return this + scan (x:xs) (y:ys) | x == y = get >> scan xs ys + scan _ _ = pfail + +skipSpaces :: P () +skipSpaces = look >>= skip + where + skip (c:s) | isSpace c = get >> skip s + skip _ = return () + +manyTill :: P a -> P end -> P [a] +manyTill p end = scan + where scan = (end >> return []) <++ liftM2 (:) p scan + +munch :: (Char -> Bool) -> P String +munch p = munch1 p <++ return [] + +munch1 :: (Char -> Bool) -> P String +munch1 p = liftM2 (:) (satisfy p) (munch p) + +choice :: [P a] -> P a +choice = msum + +between :: P open -> P close -> P a -> P a +between open close p = do open + x <- p + close + return x diff --git a/src/PGF/Raw/Print.hs b/src/PGF/Raw/Print.hs new file mode 100644 index 000000000..d34adbc2b --- /dev/null +++ b/src/PGF/Raw/Print.hs @@ -0,0 +1,35 @@ +module PGF.Raw.Print (printTree) where + +import PGF.CId +import PGF.Raw.Abstract + +import Data.List (intersperse) +import Numeric (showFFloat) +import qualified Data.ByteString.Char8 as BS + +printTree :: Grammar -> String +printTree g = prGrammar g "" + +prGrammar :: Grammar -> ShowS +prGrammar (Grm xs) = prRExpList xs + +prRExp :: Int -> RExp -> ShowS +prRExp _ (App x []) = showString x +prRExp n (App x xs) = p (showString x . showChar ' ' . prRExpList xs) + where p s = if n == 0 then s else showChar '(' . s . showChar ')' +prRExp _ (AInt x) = shows x +prRExp _ (AStr x) = showChar '"' . concatS (map mkEsc x) . showChar '"' +prRExp _ (AFlt x) = showFFloat Nothing x +prRExp _ AMet = showChar '?' + +mkEsc :: Char -> ShowS +mkEsc s = case s of + '"' -> showString "\\\"" + '\\' -> showString "\\\\" + _ -> showChar s + +prRExpList :: [RExp] -> ShowS +prRExpList = concatS . intersperse (showChar ' ') . map (prRExp 1) + +concatS :: [ShowS] -> ShowS +concatS = foldr (.) id diff --git a/src/PGF/ShowLinearize.hs b/src/PGF/ShowLinearize.hs new file mode 100644 index 000000000..663264d63 --- /dev/null +++ b/src/PGF/ShowLinearize.hs @@ -0,0 +1,105 @@ +module PGF.ShowLinearize ( + collectWords, + tableLinearize, + recordLinearize, + termLinearize, + tabularLinearize, + allLinearize + ) where + +import PGF.CId +import PGF.Data +import PGF.Macros +import PGF.Linearize + +import GF.Data.Operations +import Data.List +import qualified Data.Map as Map + +-- printing linearizations in different ways with source parameters + +-- internal representation, only used internally in this module +data Record = + RR [(String,Record)] + | RT [(String,Record)] + | RFV [Record] + | RS String + | RCon String + +prRecord :: Record -> String +prRecord = prr where + prr t = case t of + RR fs -> concat $ + "{" : + (intersperse ";" (map (\ (l,v) -> unwords [l,"=", prr v]) fs)) ++ ["}"] + RT fs -> concat $ + "table {" : + (intersperse ";" (map (\ (l,v) -> unwords [l,"=>",prr v]) fs)) ++ ["}"] + RFV ts -> concat $ + "variants {" : (intersperse ";" (map prr ts)) ++ ["}"] + RS s -> prQuotedString s + RCon s -> s + +-- uses the encoding of record types in PGF.paramlincat +mkRecord :: Term -> Term -> Record +mkRecord typ trm = case (typ,trm) of + (_, FV ts) -> RFV $ map (mkRecord typ) ts + (R rs, R ts) -> RR [(str lab, mkRecord ty t) | (P lab ty, t) <- zip rs ts] + (S [FV ps,ty],R ts) -> RT [(str par, mkRecord ty t) | (par, t) <- zip ps ts] + (_,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 $ str trm + _ -> RS $ show trm ---- printTree trm + where + str = realize + +-- show all branches, without labels and params +allLinearize :: (String -> String) -> PGF -> CId -> Tree -> String +allLinearize unlex pgf lang = concat . map (unlex . pr) . tabularLinearize pgf lang where + pr (p,vs) = unlines vs + +-- show all branches, with labels and params +tableLinearize :: (String -> String) -> PGF -> CId -> Tree -> String +tableLinearize unlex pgf lang = unlines . map pr . tabularLinearize pgf lang where + pr (p,vs) = p +++ ":" +++ unwords (intersperse "|" (map unlex vs)) + +-- create a table from labels+params to variants +tabularLinearize :: PGF -> CId -> Tree -> [(String,[String])] +tabularLinearize pgf lang = branches . recLinearize pgf lang where + branches r = case r of + RR fs -> [( b,s) | (lab,t) <- fs, (b,s) <- branches t] + RT fs -> [(lab +++ b,s) | (lab,t) <- fs, (b,s) <- branches t] + RFV rs -> [([], ss) | (_,ss) <- concatMap branches rs] + RS s -> [([], [s])] + RCon _ -> [] + +-- show record in GF-source-like syntax +recordLinearize :: PGF -> CId -> Tree -> String +recordLinearize pgf lang = prRecord . recLinearize pgf lang + +-- create a GF-like record, forming the basis of all functions above +recLinearize :: PGF -> CId -> Tree -> Record +recLinearize pgf lang tree = mkRecord typ $ linTree pgf lang tree where + typ = case tree of + Fun f _ -> lookParamLincat pgf lang $ valCat $ lookType pgf f + +-- show PGF term +termLinearize :: PGF -> CId -> Tree -> String +termLinearize pgf lang = show . linTree pgf lang + + +-- for Morphology: word, lemma, tags +collectWords :: PGF -> CId -> [(String, [(String,String)])] +collectWords pgf lang = + concatMap collOne + [(f,c,0) | (f,(DTyp [] c _,_)) <- Map.toList $ funs $ abstract pgf] + where + collOne (f,c,i) = + fromRec f [prCId c] (recLinearize pgf lang (Fun f (replicate i (Meta 888)))) + fromRec f v r = case r of + RR rs -> concat [fromRec f v t | (_,t) <- rs] + RT rs -> concat [fromRec f (p:v) t | (p,t) <- rs] + RFV rs -> concatMap (fromRec f v) rs + RS s -> [(s,[(prCId f,unwords (reverse v))])] + RCon c -> [] ---- inherent + diff --git a/src/PGF/VisualizeTree.hs b/src/PGF/VisualizeTree.hs new file mode 100644 index 000000000..0219dcbde --- /dev/null +++ b/src/PGF/VisualizeTree.hs @@ -0,0 +1,48 @@ +---------------------------------------------------------------------- +-- | +-- Module : VisualizeTree +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: +-- > CVS $Author: +-- > CVS $Revision: +-- +-- Print a graph of an abstract syntax tree in Graphviz DOT format +-- Based on BB's VisualizeGrammar +-- FIXME: change this to use GF.Visualization.Graphviz, +-- instead of rolling its own. +----------------------------------------------------------------------------- + +module PGF.VisualizeTree ( visualizeTrees + ) where + +import PGF.CId (prCId) +import PGF.Data +import PGF.Macros (lookValCat) + +visualizeTrees :: PGF -> (Bool,Bool) -> [Tree] -> String +visualizeTrees pgf funscats = unlines . map (prGraph False . tree2graph pgf funscats) + +tree2graph :: PGF -> (Bool,Bool) -> Tree -> [String] +tree2graph pgf (funs,cats) = prf [] where + prf ps t = case t of + Fun cid trees -> + let (nod,lab) = prn ps cid in + (nod ++ " [label = " ++ lab ++ ", style = \"solid\", shape = \"plaintext\"] ;") : + [ pra (j:ps) nod t | (j,t) <- zip [0..] trees] ++ + concat [prf (j:ps) t | (j,t) <- zip [0..] trees] + prn ps cid = + let + fun = if funs then prCId cid else "" + cat = if cats then prCat cid else "" + colon = if funs && cats then " : " else "" + lab = "\"" ++ fun ++ colon ++ cat ++ "\"" + in (show(show (ps :: [Int])),lab) + pra i nod t@(Fun cid _) = nod ++ arr ++ fst (prn i cid) ++ " [style = \"solid\"];" + arr = " -- " -- if digr then " -> " else " -- " + prCat = prCId . lookValCat pgf + +prGraph digr ns = concat $ map (++"\n") $ [graph ++ "{\n"] ++ ns ++ ["}"] where + graph = if digr then "digraph" else "graph" diff --git a/src/PGF/doc/Eng.gf b/src/PGF/doc/Eng.gf new file mode 100644 index 000000000..c64f46313 --- /dev/null +++ b/src/PGF/doc/Eng.gf @@ -0,0 +1,13 @@ +concrete Eng of Ex = { + lincat + S = {s : Str} ; + NP = {s : Str ; n : Num} ; + VP = {s : Num => Str} ; + param + Num = Sg | Pl ; + lin + Pred np vp = {s = np.s ++ vp.s ! np.n} ; + She = {s = "she" ; n = Sg} ; + They = {s = "they" ; n = Pl} ; + Sleep = {s = table {Sg => "sleeps" ; Pl => "sleep"}} ; +} diff --git a/src/PGF/doc/Ex.gf b/src/PGF/doc/Ex.gf new file mode 100644 index 000000000..bd0b03483 --- /dev/null +++ b/src/PGF/doc/Ex.gf @@ -0,0 +1,8 @@ +abstract Ex = { + cat + S ; NP ; VP ; + fun + Pred : NP -> VP -> S ; + She, They : NP ; + Sleep : VP ; +} diff --git a/src/PGF/doc/Swe.gf b/src/PGF/doc/Swe.gf new file mode 100644 index 000000000..1d6672371 --- /dev/null +++ b/src/PGF/doc/Swe.gf @@ -0,0 +1,13 @@ +concrete Swe of Ex = { + lincat + S = {s : Str} ; + NP = {s : Str} ; + VP = {s : Str} ; + param + Num = Sg | Pl ; + lin + Pred np vp = {s = np.s ++ vp.s} ; + She = {s = "hon"} ; + They = {s = "de"} ; + Sleep = {s = "sover"} ; +} diff --git a/src/PGF/doc/Test.gf b/src/PGF/doc/Test.gf new file mode 100644 index 000000000..5cd4c5474 --- /dev/null +++ b/src/PGF/doc/Test.gf @@ -0,0 +1,64 @@ +-- to test GFCC compilation + +flags coding=utf8 ; + +cat S ; NP ; N ; VP ; + +fun Pred : NP -> VP -> S ; +fun Pred2 : NP -> VP -> NP -> S ; +fun Det, Dets : N -> NP ; +fun Mina, Sina, Me, Te : NP ; +fun Raha, Paska, Pallo : N ; +fun Puhua, Munia, Sanoa : VP ; + +param Person = P1 | P2 | P3 ; +param Number = Sg | Pl ; +param Case = Nom | Part ; + +param NForm = NF Number Case ; +param VForm = VF Number Person ; + +lincat N = Noun ; +lincat VP = Verb ; + +oper Noun = {s : NForm => Str} ; +oper Verb = {s : VForm => Str} ; + +lincat NP = {s : Case => Str ; a : {n : Number ; p : Person}} ; + +lin Pred np vp = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p} ; +lin Pred2 np vp ob = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p ++ ob.s ! Part} ; +lin Det no = {s = \\c => no.s ! NF Sg c ; a = {n = Sg ; p = P3}} ; +lin Dets no = {s = \\c => no.s ! NF Pl c ; a = {n = Pl ; p = P3}} ; +lin Mina = {s = table Case ["minä" ; "minua"] ; a = {n = Sg ; p = P1}} ; +lin Te = {s = table Case ["te" ; "teitä"] ; a = {n = Pl ; p = P2}} ; +lin Sina = {s = table Case ["sinä" ; "sinua"] ; a = {n = Sg ; p = P2}} ; +lin Me = {s = table Case ["me" ; "meitä"] ; a = {n = Pl ; p = P1}} ; + +lin Raha = mkN "raha" ; +lin Paska = mkN "paska" ; +lin Pallo = mkN "pallo" ; +lin Puhua = mkV "puhu" ; +lin Munia = mkV "muni" ; +lin Sanoa = mkV "sano" ; + +oper mkN : Str -> Noun = \raha -> { + s = table { + NF Sg Nom => raha ; + NF Sg Part => raha + "a" ; + NF Pl Nom => raha + "t" ; + NF Pl Part => Predef.tk 1 raha + "oja" + } + } ; + +oper mkV : Str -> Verb = \puhu -> { + s = table { + VF Sg P1 => puhu + "n" ; + VF Sg P2 => puhu + "t" ; + VF Sg P3 => puhu + Predef.dp 1 puhu ; + VF Pl P1 => puhu + "mme" ; + VF Pl P2 => puhu + "tte" ; + VF Pl P3 => puhu + "vat" + } + } ; + diff --git a/src/PGF/doc/gfcc.html b/src/PGF/doc/gfcc.html new file mode 100644 index 000000000..8f8c478c0 --- /dev/null +++ b/src/PGF/doc/gfcc.html @@ -0,0 +1,809 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> +<HTML> +<HEAD> +<META NAME="generator" CONTENT="http://txt2tags.sf.net"> +<TITLE>The GFCC Grammar Format</TITLE> +</HEAD><BODY BGCOLOR="white" TEXT="black"> +<P ALIGN="center"><CENTER><H1>The GFCC Grammar Format</H1> +<FONT SIZE="4"> +<I>Aarne Ranta</I><BR> +October 5, 2007 +</FONT></CENTER> + +<P> +Author's address: +<A HREF="http://www.cs.chalmers.se/~aarne"><CODE>http://www.cs.chalmers.se/~aarne</CODE></A> +</P> +<P> +History: +</P> +<UL> +<LI>5 Oct 2007: new, better structured GFCC with full expressive power +<LI>19 Oct: translation of lincats, new figures on C++ +<LI>3 Oct 2006: first version +</UL> + +<H2>What is GFCC</H2> +<P> +GFCC is a low-level format for GF grammars. Its aim is to contain the minimum +that is needed to process GF grammars at runtime. This minimality has three +advantages: +</P> +<UL> +<LI>compact grammar files and run-time objects +<LI>time and space efficient processing +<LI>simple definition of interpreters +</UL> + +<P> +Thus we also want to call GFCC the <B>portable grammar format</B>. +</P> +<P> +The idea is that all embedded GF applications use GFCC. +The GF system would be primarily used as a compiler and as a grammar +development tool. +</P> +<P> +Since GFCC is implemented in BNFC, a parser of the format is readily +available for C, C++, C#, Haskell, Java, and OCaml. Also an XML +representation can be generated in BNFC. A +<A HREF="../">reference implementation</A> +of linearization and some other functions has been written in Haskell. +</P> +<H2>GFCC vs. GFC</H2> +<P> +GFCC is aimed to replace GFC as the run-time grammar format. GFC was designed +to be a run-time format, but also to +support separate compilation of grammars, i.e. +to store the results of compiling +individual GF modules. But this means that GFC has to contain extra information, +such as type annotations, which is only needed in compilation and not at +run-time. In particular, the pattern matching syntax and semantics of GFC is +complex and therefore difficult to implement in new platforms. +</P> +<P> +Actually, GFC is planned to be omitted also as the target format of +separate compilation, where plain GF (type annotated and partially evaluated) +will be used instead. GFC provides only marginal advantages as a target format +compared with GF, and it is therefore just extra weight to carry around this +format. +</P> +<P> +The main differences of GFCC compared with GFC (and GF) can be summarized as follows: +</P> +<UL> +<LI>there are no modules, and therefore no qualified names +<LI>a GFCC grammar is multilingual, and consists of a common abstract syntax + together with one concrete syntax per language +<LI>records and tables are replaced by arrays +<LI>record labels and parameter values are replaced by integers +<LI>record projection and table selection are replaced by array indexing +<LI>even though the format does support dependent types and higher-order abstract + syntax, there is no interpreted yet that does this +</UL> + +<P> +Here is an example of a GF grammar, consisting of three modules, +as translated to GFCC. The representations are aligned; thus they do not completely +reflect the order of judgements in GFCC files, which have different orders of +blocks of judgements, and alphabetical sorting. +</P> +<PRE> + grammar Ex(Eng,Swe); + + abstract Ex = { abstract { + cat cat + S ; NP ; VP ; NP[]; S[]; VP[]; + fun fun + Pred : NP -> VP -> S ; Pred=[(($ 0! 1),(($ 1! 0)!($ 0! 0)))]; + She, They : NP ; She=[0,"she"]; + Sleep : VP ; They=[1,"they"]; + Sleep=[["sleeps","sleep"]]; + } } ; + + concrete Eng of Ex = { concrete Eng { + lincat lincat + S = {s : Str} ; S=[()]; + NP = {s : Str ; n : Num} ; NP=[1,()]; + VP = {s : Num => Str} ; VP=[[(),()]]; + param + Num = Sg | Pl ; + lin lin + Pred np vp = { Pred=[(($ 0! 1),(($ 1! 0)!($ 0! 0)))]; + s = np.s ++ vp.s ! np.n} ; + She = {s = "she" ; n = Sg} ; She=[0,"she"]; + They = {s = "they" ; n = Pl} ; They = [1, "they"]; + Sleep = {s = table { Sleep=[["sleeps","sleep"]]; + Sg => "sleeps" ; + Pl => "sleep" + } + } ; + } } ; + + concrete Swe of Ex = { concrete Swe { + lincat lincat + S = {s : Str} ; S=[()]; + NP = {s : Str} ; NP=[()]; + VP = {s : Str} ; VP=[()]; + param + Num = Sg | Pl ; + lin lin + Pred np vp = { Pred = [(($0!0),($1!0))]; + s = np.s ++ vp.s} ; + She = {s = "hon"} ; She = ["hon"]; + They = {s = "de"} ; They = ["de"]; + Sleep = {s = "sover"} ; Sleep = ["sover"]; + } } ; +</PRE> +<P></P> +<H2>The syntax of GFCC files</H2> +<P> +The complete BNFC grammar, from which +the rules in this section are taken, is in the file +<A HREF="../DataGFCC.cf"><CODE>GF/GFCC/GFCC.cf</CODE></A>. +</P> +<H3>Top level</H3> +<P> +A grammar has a header telling the name of the abstract syntax +(often specifying an application domain), and the names of +the concrete languages. The abstract syntax and the concrete +syntaxes themselves follow. +</P> +<PRE> + Grm. Grammar ::= + "grammar" CId "(" [CId] ")" ";" + Abstract ";" + [Concrete] ; + + Abs. Abstract ::= + "abstract" "{" + "flags" [Flag] + "fun" [FunDef] + "cat" [CatDef] + "}" ; + + Cnc. Concrete ::= + "concrete" CId "{" + "flags" [Flag] + "lin" [LinDef] + "oper" [LinDef] + "lincat" [LinDef] + "lindef" [LinDef] + "printname" [LinDef] + "}" ; +</PRE> +<P> +This syntax organizes each module to a sequence of <B>fields</B>, such +as flags, linearizations, operations, linearization types, etc. +It is envisaged that particular applications can ignore some +of the fields, typically so that earlier fields are more +important than later ones. +</P> +<P> +The judgement forms have the following syntax. +</P> +<PRE> + Flg. Flag ::= CId "=" String ; + Cat. CatDef ::= CId "[" [Hypo] "]" ; + Fun. FunDef ::= CId ":" Type "=" Exp ; + Lin. LinDef ::= CId "=" Term ; +</PRE> +<P> +For the run-time system, the reference implementation in Haskell +uses a structure that gives efficient look-up: +</P> +<PRE> + data GFCC = GFCC { + absname :: CId , + cncnames :: [CId] , + abstract :: Abstr , + concretes :: Map CId Concr + } + + data Abstr = Abstr { + aflags :: Map CId String, -- value of a flag + funs :: Map CId (Type,Exp), -- type and def of a fun + cats :: Map CId [Hypo], -- context of a cat + catfuns :: Map CId [CId] -- funs yielding a cat (redundant, for fast lookup) + } + + data Concr = Concr { + flags :: Map CId String, -- value of a flag + lins :: Map CId Term, -- lin of a fun + opers :: Map CId Term, -- oper generated by subex elim + lincats :: Map CId Term, -- lin type of a cat + lindefs :: Map CId Term, -- lin default of a cat + printnames :: Map CId Term -- printname of a cat or a fun + } +</PRE> +<P> +These definitions are from <A HREF="../DataGFCC.hs"><CODE>GF/GFCC/DataGFCC.hs</CODE></A>. +</P> +<P> +Identifiers (<CODE>CId</CODE>) are like <CODE>Ident</CODE> in GF, except that +the compiler produces constants prefixed with <CODE>_</CODE> in +the common subterm elimination optimization. +</P> +<PRE> + token CId (('_' | letter) (letter | digit | '\'' | '_')*) ; +</PRE> +<P></P> +<H3>Abstract syntax</H3> +<P> +Types are first-order function types built from argument type +contexts and value types. +category symbols. Syntax trees (<CODE>Exp</CODE>) are +rose trees with nodes consisting of a head (<CODE>Atom</CODE>) and +bound variables (<CODE>CId</CODE>). +</P> +<PRE> + DTyp. Type ::= "[" [Hypo] "]" CId [Exp] ; + DTr. Exp ::= "[" "(" [CId] ")" Atom [Exp] "]" ; + Hyp. Hypo ::= CId ":" Type ; +</PRE> +<P> +The head Atom is either a function +constant, a bound variable, or a metavariable, or a string, integer, or float +literal. +</P> +<PRE> + AC. Atom ::= CId ; + AS. Atom ::= String ; + AI. Atom ::= Integer ; + AF. Atom ::= Double ; + AM. Atom ::= "?" Integer ; +</PRE> +<P> +The context-free types and trees of the "old GFCC" are special +cases, which can be defined as follows: +</P> +<PRE> + Typ. Type ::= [CId] "->" CId + Typ args val = DTyp [Hyp (CId "_") arg | arg <- args] val + + Tr. Exp ::= "(" CId [Exp] ")" + Tr fun exps = DTr [] fun exps +</PRE> +<P> +To store semantic (<CODE>def</CODE>) definitions by cases, the following expression +form is provided, but it is only meaningful in the last field of a function +declaration in an abstract syntax: +</P> +<PRE> + EEq. Exp ::= "{" [Equation] "}" ; + Equ. Equation ::= [Exp] "->" Exp ; +</PRE> +<P> +Notice that expressions are used to encode patterns. Primitive notions +(the default semantics in GF) are encoded as empty sets of equations +(<CODE>[]</CODE>). For a constructor (canonical form) of a category <CODE>C</CODE>, we +aim to use the encoding as the application <CODE>(_constr C)</CODE>. +</P> +<H3>Concrete syntax</H3> +<P> +Linearization terms (<CODE>Term</CODE>) are built as follows. +Constructor names are shown to make the later code +examples readable. +</P> +<PRE> + R. Term ::= "[" [Term] "]" ; -- array (record/table) + P. Term ::= "(" Term "!" Term ")" ; -- access to field (projection/selection) + S. Term ::= "(" [Term] ")" ; -- concatenated sequence + K. Term ::= Tokn ; -- token + V. Term ::= "$" Integer ; -- argument (subtree) + C. Term ::= Integer ; -- array index (label/parameter value) + FV. Term ::= "[|" [Term] "|]" ; -- free variation + TM. Term ::= "?" ; -- linearization of metavariable +</PRE> +<P> +Tokens are strings or (maybe obsolescent) prefix-dependent +variant lists. +</P> +<PRE> + KS. Tokn ::= String ; + KP. Tokn ::= "[" "pre" [String] "[" [Variant] "]" "]" ; + Var. Variant ::= [String] "/" [String] ; +</PRE> +<P> +Two special forms of terms are introduced by the compiler +as optimizations. They can in principle be eliminated, but +their presence makes grammars much more compact. Their semantics +will be explained in a later section. +</P> +<PRE> + F. Term ::= CId ; -- global constant + W. Term ::= "(" String "+" Term ")" ; -- prefix + suffix table +</PRE> +<P> +There is also a deprecated form of "record parameter alias", +</P> +<PRE> + RP. Term ::= "(" Term "@" Term ")"; -- DEPRECATED +</PRE> +<P> +which will be removed when the migration to new GFCC is complete. +</P> +<H2>The semantics of concrete syntax terms</H2> +<P> +The code in this section is from <A HREF="../Linearize.hs"><CODE>GF/GFCC/Linearize.hs</CODE></A>. +</P> +<H3>Linearization and realization</H3> +<P> +The linearization algorithm is essentially the same as in +GFC: a tree is linearized by evaluating its linearization term +in the environment of the linearizations of the subtrees. +Literal atoms are linearized in the obvious way. +The function also needs to know the language (i.e. concrete syntax) +in which linearization is performed. +</P> +<PRE> + linExp :: GFCC -> CId -> Exp -> Term + linExp gfcc lang tree@(DTr _ at trees) = case at of + AC fun -> comp (Prelude.map lin trees) $ look fun + AS s -> R [kks (show s)] -- quoted + AI i -> R [kks (show i)] + AF d -> R [kks (show d)] + AM -> TM + where + lin = linExp gfcc lang + comp = compute gfcc lang + look = lookLin gfcc lang +</PRE> +<P> +TODO: bindings must be supported. +</P> +<P> +The result of linearization is usually a record, which is realized as +a string using the following algorithm. +</P> +<PRE> + realize :: Term -> String + realize trm = case trm of + R (t:_) -> realize t + S ss -> unwords $ Prelude.map realize ss + K (KS s) -> s + K (KP s _) -> unwords s ---- prefix choice TODO + W s t -> s ++ realize t + FV (t:_) -> realize t + TM -> "?" +</PRE> +<P> +Notice that realization always picks the first field of a record. +If a linearization type has more than one field, the first field +does not necessarily contain the desired string. +Also notice that the order of record fields in GFCC is not necessarily +the same as in GF source. +</P> +<H3>Term evaluation</H3> +<P> +Evaluation follows call-by-value order, with two environments +needed: +</P> +<UL> +<LI>the grammar (a concrete syntax) to give the global constants +<LI>an array of terms to give the subtree linearizations +</UL> + +<P> +The code is presented in one-level pattern matching, to +enable reimplementations in languages that do not permit +deep patterns (such as Java and C++). +</P> +<PRE> + compute :: GFCC -> CId -> [Term] -> Term -> Term + compute gfcc lang args = comp where + comp trm = case trm of + P r p -> proj (comp r) (comp p) + W s t -> W s (comp t) + R ts -> R $ Prelude.map comp ts + V i -> idx args (fromInteger i) -- already computed + F c -> comp $ look c -- not computed (if contains V) + FV ts -> FV $ Prelude.map comp ts + S ts -> S $ Prelude.filter (/= S []) $ Prelude.map comp ts + _ -> trm + + look = lookOper gfcc lang + + idx xs i = xs !! i + + proj r p = case (r,p) of + (_, FV ts) -> FV $ Prelude.map (proj r) ts + (W s t, _) -> kks (s ++ getString (proj t p)) + _ -> comp $ getField r (getIndex p) + + getString t = case t of + K (KS s) -> s + _ -> trace ("ERROR in grammar compiler: string from "++ show t) "ERR" + + getIndex t = case t of + C i -> fromInteger i + RP p _ -> getIndex p + TM -> 0 -- default value for parameter + _ -> trace ("ERROR in grammar compiler: index from " ++ show t) 0 + + getField t i = case t of + R rs -> idx rs i + RP _ r -> getField r i + TM -> TM + _ -> trace ("ERROR in grammar compiler: field from " ++ show t) t +</PRE> +<P></P> +<H3>The special term constructors</H3> +<P> +The three forms introduced by the compiler may a need special +explanation. +</P> +<P> +Global constants +</P> +<PRE> + Term ::= CId ; +</PRE> +<P> +are shorthands for complex terms. They are produced by the +compiler by (iterated) <B>common subexpression elimination</B>. +They are often more powerful than hand-devised code sharing in the source +code. They could be computed off-line by replacing each identifier by +its definition. +</P> +<P> +<B>Prefix-suffix tables</B> +</P> +<PRE> + Term ::= "(" String "+" Term ")" ; +</PRE> +<P> +represent tables of word forms divided to the longest common prefix +and its array of suffixes. In the example grammar above, we have +</P> +<PRE> + Sleep = [("sleep" + ["s",""])] +</PRE> +<P> +which in fact is equal to the array of full forms +</P> +<PRE> + ["sleeps", "sleep"] +</PRE> +<P> +The power of this construction comes from the fact that suffix sets +tend to be repeated in a language, and can therefore be collected +by common subexpression elimination. It is this technique that +explains the used syntax rather than the more accurate +</P> +<PRE> + "(" String "+" [String] ")" +</PRE> +<P> +since we want the suffix part to be a <CODE>Term</CODE> for the optimization to +take effect. +</P> +<H2>Compiling to GFCC</H2> +<P> +Compilation to GFCC is performed by the GF grammar compiler, and +GFCC interpreters need not know what it does. For grammar writers, +however, it might be interesting to know what happens to the grammars +in the process. +</P> +<P> +The compilation phases are the following +</P> +<OL> +<LI>type check and partially evaluate GF source +<LI>create a symbol table mapping the GF parameter and record types to + fixed-size arrays, and parameter values and record labels to integers +<LI>traverse the linearization rules replacing parameters and labels by integers +<LI>reorganize the created GF grammar so that it has just one abstract syntax + and one concrete syntax per language +<LI>TODO: apply UTF8 encoding to the grammar, if not yet applied (this is told by the + <CODE>coding</CODE> flag) +<LI>translate the GF grammar object to a GFCC grammar object, using a simple + compositional mapping +<LI>perform the word-suffix optimization on GFCC linearization terms +<LI>perform subexpression elimination on each concrete syntax module +<LI>print out the GFCC code +</OL> + +<H3>Problems in GFCC compilation</H3> +<P> +Two major problems had to be solved in compiling GF to GFCC: +</P> +<UL> +<LI>consistent order of tables and records, to permit the array translation +<LI>run-time variables in complex parameter values. +</UL> + +<P> +The current implementation is still experimental and may fail +to generate correct code. Any errors remaining are likely to be +related to the two problems just mentioned. +</P> +<P> +The order problem is solved in slightly different ways for tables and records. +In both cases, <B>eta expansion</B> is used to establish a +canonical order. Tables are ordered by applying the preorder induced +by <CODE>param</CODE> definitions. Records are ordered by sorting them by labels. +This means that +e.g. the <CODE>s</CODE> field will in general no longer appear as the first +field, even if it does so in the GF source code. But relying on the +order of fields in a labelled record would be misplaced anyway. +</P> +<P> +The canonical form of records is further complicated by lock fields, +i.e. dummy fields of form <CODE>lock_C = <></CODE>, which are added to grammar +libraries to force intensionality of linearization types. The problem +is that the absence of a lock field only generates a warning, not +an error. Therefore a GF grammar can contain objects of the same +type with and without a lock field. This problem was solved in GFCC +generation by just removing all lock fields (defined as fields whose +type is the empty record type). This has the further advantage of +(slightly) reducing the grammar size. More importantly, it is safe +to remove lock fields, because they are never used in computation, +and because intensional types are only needed in grammars reused +as libraries, not in grammars used at runtime. +</P> +<P> +While the order problem is rather bureaucratic in nature, run-time +variables are an interesting problem. They arise in the presence +of complex parameter values, created by argument-taking constructors +and parameter records. To give an example, consider the GF parameter +type system +</P> +<PRE> + Number = Sg | Pl ; + Person = P1 | P2 | P3 ; + Agr = Ag Number Person ; +</PRE> +<P> +The values can be translated to integers in the expected way, +</P> +<PRE> + Sg = 0, Pl = 1 + P1 = 0, P2 = 1, P3 = 2 + Ag Sg P1 = 0, Ag Sg P2 = 1, Ag Sg P3 = 2, + Ag Pl P1 = 3, Ag Pl P2 = 4, Ag Pl P3 = 5 +</PRE> +<P> +However, an argument of <CODE>Agr</CODE> can be a run-time variable, as in +</P> +<PRE> + Ag np.n P3 +</PRE> +<P> +This expression must first be translated to a case expression, +</P> +<PRE> + case np.n of { + 0 => 2 ; + 1 => 5 + } +</PRE> +<P> +which can then be translated to the GFCC term +</P> +<PRE> + ([2,5] ! ($0 ! $1)) +</PRE> +<P> +assuming that the variable <CODE>np</CODE> is the first argument and that its +<CODE>Number</CODE> field is the second in the record. +</P> +<P> +This transformation of course has to be performed recursively, since +there can be several run-time variables in a parameter value: +</P> +<PRE> + Ag np.n np.p +</PRE> +<P> +A similar transformation would be possible to deal with the double +role of parameter records discussed above. Thus the type +</P> +<PRE> + RNP = {n : Number ; p : Person} +</PRE> +<P> +could be uniformly translated into the set <CODE>{0,1,2,3,4,5}</CODE> +as <CODE>Agr</CODE> above. Selections would be simple instances of indexing. +But any projection from the record should be translated into +a case expression, +</P> +<PRE> + rnp.n ===> + case rnp of { + 0 => 0 ; + 1 => 0 ; + 2 => 0 ; + 3 => 1 ; + 4 => 1 ; + 5 => 1 + } +</PRE> +<P> +To avoid the code bloat resulting from this, we have chosen to +deal with records by a <B>currying</B> transformation: +</P> +<PRE> + table {n : Number ; p : Person} {... ...} + ===> + table Number {Sg => table Person {...} ; table Person {...}} +</PRE> +<P> +This is performed when GFCC is generated. Selections with +records have to be treated likewise, +</P> +<PRE> + t ! r ===> t ! r.n ! r.p +</PRE> +<P></P> +<H3>The representation of linearization types</H3> +<P> +Linearization types (<CODE>lincat</CODE>) are not needed when generating with +GFCC, but they have been added to enable parser generation directly from +GFCC. The linearization type definitions are shown as a part of the +concrete syntax, by using terms to represent types. Here is the table +showing how different linearization types are encoded. +</P> +<PRE> + P* = max(P) -- parameter type + {r1 : T1 ; ... ; rn : Tn}* = [T1*,...,Tn*] -- record + (P => T)* = [T* ,...,T*] -- table, size(P) cases + Str* = () +</PRE> +<P> +For example, the linearization type <CODE>present/CatEng.NP</CODE> is +translated as follows: +</P> +<PRE> + NP = { + a : { -- 6 = 2*3 values + n : {ParamX.Number} ; -- 2 values + p : {ParamX.Person} -- 3 values + } ; + s : {ResEng.Case} => Str -- 3 values + } + + __NP = [[1,2],[(),(),()]] +</PRE> +<P></P> +<H3>Running the compiler and the GFCC interpreter</H3> +<P> +GFCC generation is a part of the +<A HREF="http://www.cs.chalmers.se/Cs/Research/Language-technology/darcs/GF/doc/darcs.html">developers' version</A> +of GF since September 2006. To invoke the compiler, the flag +<CODE>-printer=gfcc</CODE> to the command +<CODE>pm = print_multi</CODE> is used. It is wise to recompile the grammar from +source, since previously compiled libraries may not obey the canonical +order of records. +Here is an example, performed in +<A HREF="../../../../../examples/bronzeage">example/bronzeage</A>. +</P> +<PRE> + i -src -path=.:prelude:resource-1.0/* -optimize=all_subs BronzeageEng.gf + i -src -path=.:prelude:resource-1.0/* -optimize=all_subs BronzeageGer.gf + strip + pm -printer=gfcc | wf bronze.gfcc +</PRE> +<P> +There is also an experimental batch compiler, which does not use the GFC +format or the record aliases. It can be produced by +</P> +<PRE> + make gfc +</PRE> +<P> +in <CODE>GF/src</CODE>, and invoked by +</P> +<PRE> + gfc --make FILES +</PRE> +<P></P> +<H2>The reference interpreter</H2> +<P> +The reference interpreter written in Haskell consists of the following files: +</P> +<PRE> + -- source file for BNFC + GFCC.cf -- labelled BNF grammar of gfcc + + -- files generated by BNFC + AbsGFCC.hs -- abstrac syntax datatypes + ErrM.hs -- error monad used internally + LexGFCC.hs -- lexer of gfcc files + ParGFCC.hs -- parser of gfcc files and syntax trees + PrintGFCC.hs -- printer of gfcc files and syntax trees + + -- hand-written files + DataGFCC.hs -- grammar datatype, post-parser grammar creation + Linearize.hs -- linearization and evaluation + Macros.hs -- utilities abstracting away from GFCC datatypes + Generate.hs -- random and exhaustive generation, generate-and-test parsing + API.hs -- functionalities accessible in embedded GF applications + Generate.hs -- random and exhaustive generation + Shell.hs -- main function - a simple command interpreter +</PRE> +<P> +It is included in the +<A HREF="http://www.cs.chalmers.se/Cs/Research/Language-technology/darcs/GF/doc/darcs.html">developers' version</A> +of GF, in the subdirectories <A HREF="../"><CODE>GF/src/GF/GFCC</CODE></A> and +<A HREF="../../Devel"><CODE>GF/src/GF/Devel</CODE></A>. +</P> +<P> +As of September 2007, default parsing in main GF uses GFCC (implemented by Krasimir +Angelov). The interpreter uses the relevant modules +</P> +<PRE> + GF/Conversions/SimpleToFCFG.hs -- generate parser from GFCC + GF/Parsing/FCFG.hs -- run the parser +</PRE> +<P></P> +<P> +To compile the interpreter, type +</P> +<PRE> + make gfcc +</PRE> +<P> +in <CODE>GF/src</CODE>. To run it, type +</P> +<PRE> + ./gfcc <GFCC-file> +</PRE> +<P> +The available commands are +</P> +<UL> +<LI><CODE>gr <Cat> <Int></CODE>: generate a number of random trees in category. + and show their linearizations in all languages +<LI><CODE>grt <Cat> <Int></CODE>: generate a number of random trees in category. + and show the trees and their linearizations in all languages +<LI><CODE>gt <Cat> <Int></CODE>: generate a number of trees in category from smallest, + and show their linearizations in all languages +<LI><CODE>gtt <Cat> <Int></CODE>: generate a number of trees in category from smallest, + and show the trees and their linearizations in all languages +<LI><CODE>p <Lang> <Cat> <String></CODE>: parse a string into a set of trees +<LI><CODE>lin <Tree></CODE>: linearize tree in all languages, also showing full records +<LI><CODE>q</CODE>: terminate the system cleanly +</UL> + +<H2>Embedded formats</H2> +<UL> +<LI>JavaScript: compiler of linearization and abstract syntax +<P></P> +<LI>Haskell: compiler of abstract syntax and interpreter with parsing, + linearization, and generation +<P></P> +<LI>C: compiler of linearization (old GFCC) +<P></P> +<LI>C++: embedded interpreter supporting linearization (old GFCC) +</UL> + +<H2>Some things to do</H2> +<P> +Support for dependent types, higher-order abstract syntax, and +semantic definition in GFCC generation and interpreters. +</P> +<P> +Replacing the entire GF shell by one based on GFCC. +</P> +<P> +Interpreter in Java. +</P> +<P> +Hand-written parsers for GFCC grammars to reduce code size +(and efficiency?) of interpreters. +</P> +<P> +Binary format and/or file compression of GFCC output. +</P> +<P> +Syntax editor based on GFCC. +</P> +<P> +Rewriting of resource libraries in order to exploit the +word-suffix sharing better (depth-one tables, as in FM). +</P> + +<!-- html code generated by txt2tags 2.3 (http://txt2tags.sf.net) --> +<!-- cmdline: txt2tags -thtml gfcc.txt --> +</BODY></HTML> diff --git a/src/PGF/doc/gfcc.txt b/src/PGF/doc/gfcc.txt new file mode 100644 index 000000000..5dcf2fbdc --- /dev/null +++ b/src/PGF/doc/gfcc.txt @@ -0,0 +1,712 @@ +The GFCC Grammar Format +Aarne Ranta +December 14, 2007 + +Author's address: +[``http://www.cs.chalmers.se/~aarne`` http://www.cs.chalmers.se/~aarne] + +% to compile: txt2tags -thtml --toc gfcc.txt + +History: +- 14 Dec 2007: simpler, Lisp-like concrete syntax of GFCC +- 5 Oct 2007: new, better structured GFCC with full expressive power +- 19 Oct: translation of lincats, new figures on C++ +- 3 Oct 2006: first version + + +==What is GFCC== + +GFCC is a low-level format for GF grammars. Its aim is to contain the minimum +that is needed to process GF grammars at runtime. This minimality has three +advantages: +- compact grammar files and run-time objects +- time and space efficient processing +- simple definition of interpreters + + +Thus we also want to call GFCC the **portable grammar format**. + +The idea is that all embedded GF applications use GFCC. +The GF system would be primarily used as a compiler and as a grammar +development tool. + +Since GFCC is implemented in BNFC, a parser of the format is readily +available for C, C++, C#, Haskell, Java, and OCaml. Also an XML +representation can be generated in BNFC. A +[reference implementation ../] +of linearization and some other functions has been written in Haskell. + + +==GFCC vs. GFC== + +GFCC is aimed to replace GFC as the run-time grammar format. GFC was designed +to be a run-time format, but also to +support separate compilation of grammars, i.e. +to store the results of compiling +individual GF modules. But this means that GFC has to contain extra information, +such as type annotations, which is only needed in compilation and not at +run-time. In particular, the pattern matching syntax and semantics of GFC is +complex and therefore difficult to implement in new platforms. + +Actually, GFC is planned to be omitted also as the target format of +separate compilation, where plain GF (type annotated and partially evaluated) +will be used instead. GFC provides only marginal advantages as a target format +compared with GF, and it is therefore just extra weight to carry around this +format. + +The main differences of GFCC compared with GFC (and GF) can be +summarized as follows: +- there are no modules, and therefore no qualified names +- a GFCC grammar is multilingual, and consists of a common abstract syntax + together with one concrete syntax per language +- records and tables are replaced by arrays +- record labels and parameter values are replaced by integers +- record projection and table selection are replaced by array indexing +- even though the format does support dependent types and higher-order abstract + syntax, there is no interpreted yet that does this + + + +Here is an example of a GF grammar, consisting of three modules, +as translated to GFCC. The representations are aligned; +thus they do not completely +reflect the order of judgements in GFCC files, which have different orders of +blocks of judgements, and alphabetical sorting. +``` + grammar Ex(Eng,Swe); + +abstract Ex = { abstract { + cat cat + S ; NP ; VP ; NP[]; S[]; VP[]; + fun fun + Pred : NP -> VP -> S ; Pred=[(($ 0! 1),(($ 1! 0)!($ 0! 0)))]; + She, They : NP ; She=[0,"she"]; + Sleep : VP ; They=[1,"they"]; + Sleep=[["sleeps","sleep"]]; +} } ; + +concrete Eng of Ex = { concrete Eng { + lincat lincat + S = {s : Str} ; S=[()]; + NP = {s : Str ; n : Num} ; NP=[1,()]; + VP = {s : Num => Str} ; VP=[[(),()]]; + param + Num = Sg | Pl ; + lin lin + Pred np vp = { Pred=[(($ 0! 1),(($ 1! 0)!($ 0! 0)))]; + s = np.s ++ vp.s ! np.n} ; + She = {s = "she" ; n = Sg} ; She=[0,"she"]; + They = {s = "they" ; n = Pl} ; They = [1, "they"]; + Sleep = {s = table { Sleep=[["sleeps","sleep"]]; + Sg => "sleeps" ; + Pl => "sleep" + } + } ; +} } ; + +concrete Swe of Ex = { concrete Swe { + lincat lincat + S = {s : Str} ; S=[()]; + NP = {s : Str} ; NP=[()]; + VP = {s : Str} ; VP=[()]; + param + Num = Sg | Pl ; + lin lin + Pred np vp = { Pred = [(($0!0),($1!0))]; + s = np.s ++ vp.s} ; + She = {s = "hon"} ; She = ["hon"]; + They = {s = "de"} ; They = ["de"]; + Sleep = {s = "sover"} ; Sleep = ["sover"]; +} } ; +``` + +==The syntax of GFCC files== + +The complete BNFC grammar, from which +the rules in this section are taken, is in the file +[``GF/GFCC/GFCC.cf`` ../DataGFCC.cf]. + + +===Top level=== + +A grammar has a header telling the name of the abstract syntax +(often specifying an application domain), and the names of +the concrete languages. The abstract syntax and the concrete +syntaxes themselves follow. +``` + Grm. Grammar ::= + "grammar" CId "(" [CId] ")" ";" + Abstract ";" + [Concrete] ; + + Abs. Abstract ::= + "abstract" "{" + "flags" [Flag] + "fun" [FunDef] + "cat" [CatDef] + "}" ; + + Cnc. Concrete ::= + "concrete" CId "{" + "flags" [Flag] + "lin" [LinDef] + "oper" [LinDef] + "lincat" [LinDef] + "lindef" [LinDef] + "printname" [LinDef] + "}" ; +``` +This syntax organizes each module to a sequence of **fields**, such +as flags, linearizations, operations, linearization types, etc. +It is envisaged that particular applications can ignore some +of the fields, typically so that earlier fields are more +important than later ones. + +The judgement forms have the following syntax. +``` + Flg. Flag ::= CId "=" String ; + Cat. CatDef ::= CId "[" [Hypo] "]" ; + Fun. FunDef ::= CId ":" Type "=" Exp ; + Lin. LinDef ::= CId "=" Term ; +``` +For the run-time system, the reference implementation in Haskell +uses a structure that gives efficient look-up: +``` + data GFCC = GFCC { + absname :: CId , + cncnames :: [CId] , + abstract :: Abstr , + concretes :: Map CId Concr + } + + data Abstr = Abstr { + aflags :: Map CId String, -- value of a flag + funs :: Map CId (Type,Exp), -- type and def of a fun + cats :: Map CId [Hypo], -- context of a cat + catfuns :: Map CId [CId] -- funs yielding a cat (redundant, for fast lookup) + } + + data Concr = Concr { + flags :: Map CId String, -- value of a flag + lins :: Map CId Term, -- lin of a fun + opers :: Map CId Term, -- oper generated by subex elim + lincats :: Map CId Term, -- lin type of a cat + lindefs :: Map CId Term, -- lin default of a cat + printnames :: Map CId Term -- printname of a cat or a fun + } +``` +These definitions are from [``GF/GFCC/DataGFCC.hs`` ../DataGFCC.hs]. + +Identifiers (``CId``) are like ``Ident`` in GF, except that +the compiler produces constants prefixed with ``_`` in +the common subterm elimination optimization. +``` + token CId (('_' | letter) (letter | digit | '\'' | '_')*) ; +``` + + +===Abstract syntax=== + +Types are first-order function types built from argument type +contexts and value types. +category symbols. Syntax trees (``Exp``) are +rose trees with nodes consisting of a head (``Atom``) and +bound variables (``CId``). +``` + DTyp. Type ::= "[" [Hypo] "]" CId [Exp] ; + DTr. Exp ::= "[" "(" [CId] ")" Atom [Exp] "]" ; + Hyp. Hypo ::= CId ":" Type ; +``` +The head Atom is either a function +constant, a bound variable, or a metavariable, or a string, integer, or float +literal. +``` + AC. Atom ::= CId ; + AS. Atom ::= String ; + AI. Atom ::= Integer ; + AF. Atom ::= Double ; + AM. Atom ::= "?" Integer ; +``` +The context-free types and trees of the "old GFCC" are special +cases, which can be defined as follows: +``` + Typ. Type ::= [CId] "->" CId + Typ args val = DTyp [Hyp (CId "_") arg | arg <- args] val + + Tr. Exp ::= "(" CId [Exp] ")" + Tr fun exps = DTr [] fun exps +``` +To store semantic (``def``) definitions by cases, the following expression +form is provided, but it is only meaningful in the last field of a function +declaration in an abstract syntax: +``` + EEq. Exp ::= "{" [Equation] "}" ; + Equ. Equation ::= [Exp] "->" Exp ; +``` +Notice that expressions are used to encode patterns. Primitive notions +(the default semantics in GF) are encoded as empty sets of equations +(``[]``). For a constructor (canonical form) of a category ``C``, we +aim to use the encoding as the application ``(_constr C)``. + + + +===Concrete syntax=== + +Linearization terms (``Term``) are built as follows. +Constructor names are shown to make the later code +examples readable. +``` + R. Term ::= "[" [Term] "]" ; -- array (record/table) + P. Term ::= "(" Term "!" Term ")" ; -- access to field (projection/selection) + S. Term ::= "(" [Term] ")" ; -- concatenated sequence + K. Term ::= Tokn ; -- token + V. Term ::= "$" Integer ; -- argument (subtree) + C. Term ::= Integer ; -- array index (label/parameter value) + FV. Term ::= "[|" [Term] "|]" ; -- free variation + TM. Term ::= "?" ; -- linearization of metavariable +``` +Tokens are strings or (maybe obsolescent) prefix-dependent +variant lists. +``` + KS. Tokn ::= String ; + KP. Tokn ::= "[" "pre" [String] "[" [Variant] "]" "]" ; + Var. Variant ::= [String] "/" [String] ; +``` +Two special forms of terms are introduced by the compiler +as optimizations. They can in principle be eliminated, but +their presence makes grammars much more compact. Their semantics +will be explained in a later section. +``` + F. Term ::= CId ; -- global constant + W. Term ::= "(" String "+" Term ")" ; -- prefix + suffix table +``` +There is also a deprecated form of "record parameter alias", +``` + RP. Term ::= "(" Term "@" Term ")"; -- DEPRECATED +``` +which will be removed when the migration to new GFCC is complete. + + + +==The semantics of concrete syntax terms== + +The code in this section is from [``GF/GFCC/Linearize.hs`` ../Linearize.hs]. + + +===Linearization and realization=== + +The linearization algorithm is essentially the same as in +GFC: a tree is linearized by evaluating its linearization term +in the environment of the linearizations of the subtrees. +Literal atoms are linearized in the obvious way. +The function also needs to know the language (i.e. concrete syntax) +in which linearization is performed. +``` + linExp :: GFCC -> CId -> Exp -> Term + linExp gfcc lang tree@(DTr _ at trees) = case at of + AC fun -> comp (Prelude.map lin trees) $ look fun + AS s -> R [kks (show s)] -- quoted + AI i -> R [kks (show i)] + AF d -> R [kks (show d)] + AM -> TM + where + lin = linExp gfcc lang + comp = compute gfcc lang + look = lookLin gfcc lang +``` +TODO: bindings must be supported. + +The result of linearization is usually a record, which is realized as +a string using the following algorithm. +``` + realize :: Term -> String + realize trm = case trm of + R (t:_) -> realize t + S ss -> unwords $ Prelude.map realize ss + K (KS s) -> s + K (KP s _) -> unwords s ---- prefix choice TODO + W s t -> s ++ realize t + FV (t:_) -> realize t + TM -> "?" +``` +Notice that realization always picks the first field of a record. +If a linearization type has more than one field, the first field +does not necessarily contain the desired string. +Also notice that the order of record fields in GFCC is not necessarily +the same as in GF source. + + +===Term evaluation=== + +Evaluation follows call-by-value order, with two environments +needed: +- the grammar (a concrete syntax) to give the global constants +- an array of terms to give the subtree linearizations + + +The code is presented in one-level pattern matching, to +enable reimplementations in languages that do not permit +deep patterns (such as Java and C++). +``` +compute :: GFCC -> CId -> [Term] -> Term -> Term +compute gfcc lang args = comp where + comp trm = case trm of + P r p -> proj (comp r) (comp p) + W s t -> W s (comp t) + R ts -> R $ Prelude.map comp ts + V i -> idx args (fromInteger i) -- already computed + F c -> comp $ look c -- not computed (if contains V) + FV ts -> FV $ Prelude.map comp ts + S ts -> S $ Prelude.filter (/= S []) $ Prelude.map comp ts + _ -> trm + + look = lookOper gfcc lang + + idx xs i = xs !! i + + proj r p = case (r,p) of + (_, FV ts) -> FV $ Prelude.map (proj r) ts + (FV ts, _ ) -> FV $ Prelude.map (\t -> proj t p) ts + (W s t, _) -> kks (s ++ getString (proj t p)) + _ -> comp $ getField r (getIndex p) + + getString t = case t of + K (KS s) -> s + _ -> trace ("ERROR in grammar compiler: string from "++ show t) "ERR" + + getIndex t = case t of + C i -> fromInteger i + RP p _ -> getIndex p + TM -> 0 -- default value for parameter + _ -> trace ("ERROR in grammar compiler: index from " ++ show t) 0 + + getField t i = case t of + R rs -> idx rs i + RP _ r -> getField r i + TM -> TM + _ -> trace ("ERROR in grammar compiler: field from " ++ show t) t +``` + +===The special term constructors=== + +The three forms introduced by the compiler may a need special +explanation. + +Global constants +``` + Term ::= CId ; +``` +are shorthands for complex terms. They are produced by the +compiler by (iterated) **common subexpression elimination**. +They are often more powerful than hand-devised code sharing in the source +code. They could be computed off-line by replacing each identifier by +its definition. + +**Prefix-suffix tables** +``` + Term ::= "(" String "+" Term ")" ; +``` +represent tables of word forms divided to the longest common prefix +and its array of suffixes. In the example grammar above, we have +``` + Sleep = [("sleep" + ["s",""])] +``` +which in fact is equal to the array of full forms +``` + ["sleeps", "sleep"] +``` +The power of this construction comes from the fact that suffix sets +tend to be repeated in a language, and can therefore be collected +by common subexpression elimination. It is this technique that +explains the used syntax rather than the more accurate +``` + "(" String "+" [String] ")" +``` +since we want the suffix part to be a ``Term`` for the optimization to +take effect. + + + +==Compiling to GFCC== + +Compilation to GFCC is performed by the GF grammar compiler, and +GFCC interpreters need not know what it does. For grammar writers, +however, it might be interesting to know what happens to the grammars +in the process. + +The compilation phases are the following ++ type check and partially evaluate GF source ++ create a symbol table mapping the GF parameter and record types to + fixed-size arrays, and parameter values and record labels to integers ++ traverse the linearization rules replacing parameters and labels by integers ++ reorganize the created GF grammar so that it has just one abstract syntax + and one concrete syntax per language ++ TODO: apply UTF8 encoding to the grammar, if not yet applied (this is told by the + ``coding`` flag) ++ translate the GF grammar object to a GFCC grammar object, using a simple + compositional mapping ++ perform the word-suffix optimization on GFCC linearization terms ++ perform subexpression elimination on each concrete syntax module ++ print out the GFCC code + + + + +===Problems in GFCC compilation=== + +Two major problems had to be solved in compiling GF to GFCC: +- consistent order of tables and records, to permit the array translation +- run-time variables in complex parameter values. + + +The current implementation is still experimental and may fail +to generate correct code. Any errors remaining are likely to be +related to the two problems just mentioned. + +The order problem is solved in slightly different ways for tables and records. +In both cases, **eta expansion** is used to establish a +canonical order. Tables are ordered by applying the preorder induced +by ``param`` definitions. Records are ordered by sorting them by labels. +This means that +e.g. the ``s`` field will in general no longer appear as the first +field, even if it does so in the GF source code. But relying on the +order of fields in a labelled record would be misplaced anyway. + +The canonical form of records is further complicated by lock fields, +i.e. dummy fields of form ``lock_C = <>``, which are added to grammar +libraries to force intensionality of linearization types. The problem +is that the absence of a lock field only generates a warning, not +an error. Therefore a GF grammar can contain objects of the same +type with and without a lock field. This problem was solved in GFCC +generation by just removing all lock fields (defined as fields whose +type is the empty record type). This has the further advantage of +(slightly) reducing the grammar size. More importantly, it is safe +to remove lock fields, because they are never used in computation, +and because intensional types are only needed in grammars reused +as libraries, not in grammars used at runtime. + +While the order problem is rather bureaucratic in nature, run-time +variables are an interesting problem. They arise in the presence +of complex parameter values, created by argument-taking constructors +and parameter records. To give an example, consider the GF parameter +type system +``` + Number = Sg | Pl ; + Person = P1 | P2 | P3 ; + Agr = Ag Number Person ; +``` +The values can be translated to integers in the expected way, +``` + Sg = 0, Pl = 1 + P1 = 0, P2 = 1, P3 = 2 + Ag Sg P1 = 0, Ag Sg P2 = 1, Ag Sg P3 = 2, + Ag Pl P1 = 3, Ag Pl P2 = 4, Ag Pl P3 = 5 +``` +However, an argument of ``Agr`` can be a run-time variable, as in +``` + Ag np.n P3 +``` +This expression must first be translated to a case expression, +``` + case np.n of { + 0 => 2 ; + 1 => 5 + } +``` +which can then be translated to the GFCC term +``` + ([2,5] ! ($0 ! $1)) +``` +assuming that the variable ``np`` is the first argument and that its +``Number`` field is the second in the record. + +This transformation of course has to be performed recursively, since +there can be several run-time variables in a parameter value: +``` + Ag np.n np.p +``` +A similar transformation would be possible to deal with the double +role of parameter records discussed above. Thus the type +``` + RNP = {n : Number ; p : Person} +``` +could be uniformly translated into the set ``{0,1,2,3,4,5}`` +as ``Agr`` above. Selections would be simple instances of indexing. +But any projection from the record should be translated into +a case expression, +``` + rnp.n ===> + case rnp of { + 0 => 0 ; + 1 => 0 ; + 2 => 0 ; + 3 => 1 ; + 4 => 1 ; + 5 => 1 + } +``` +To avoid the code bloat resulting from this, we have chosen to +deal with records by a **currying** transformation: +``` + table {n : Number ; p : Person} {... ...} + ===> + table Number {Sg => table Person {...} ; table Person {...}} +``` +This is performed when GFCC is generated. Selections with +records have to be treated likewise, +``` + t ! r ===> t ! r.n ! r.p +``` + + +===The representation of linearization types=== + +Linearization types (``lincat``) are not needed when generating with +GFCC, but they have been added to enable parser generation directly from +GFCC. The linearization type definitions are shown as a part of the +concrete syntax, by using terms to represent types. Here is the table +showing how different linearization types are encoded. +``` + P* = max(P) -- parameter type + {r1 : T1 ; ... ; rn : Tn}* = [T1*,...,Tn*] -- record + (P => T)* = [T* ,...,T*] -- table, size(P) cases + Str* = () +``` +For example, the linearization type ``present/CatEng.NP`` is +translated as follows: +``` + NP = { + a : { -- 6 = 2*3 values + n : {ParamX.Number} ; -- 2 values + p : {ParamX.Person} -- 3 values + } ; + s : {ResEng.Case} => Str -- 3 values + } + + __NP = [[1,2],[(),(),()]] +``` + + + + +===Running the compiler and the GFCC interpreter=== + +GFCC generation is a part of the +[developers' version http://www.cs.chalmers.se/Cs/Research/Language-technology/darcs/GF/doc/darcs.html] +of GF since September 2006. To invoke the compiler, the flag +``-printer=gfcc`` to the command +``pm = print_multi`` is used. It is wise to recompile the grammar from +source, since previously compiled libraries may not obey the canonical +order of records. +Here is an example, performed in +[example/bronzeage ../../../../../examples/bronzeage]. +``` + i -src -path=.:prelude:resource-1.0/* -optimize=all_subs BronzeageEng.gf + i -src -path=.:prelude:resource-1.0/* -optimize=all_subs BronzeageGer.gf + strip + pm -printer=gfcc | wf bronze.gfcc +``` +There is also an experimental batch compiler, which does not use the GFC +format or the record aliases. It can be produced by +``` + make gfc +``` +in ``GF/src``, and invoked by +``` + gfc --make FILES +``` + + + + +==The reference interpreter== + +The reference interpreter written in Haskell consists of the following files: +``` + -- source file for BNFC + GFCC.cf -- labelled BNF grammar of gfcc + + -- files generated by BNFC + AbsGFCC.hs -- abstrac syntax datatypes + ErrM.hs -- error monad used internally + LexGFCC.hs -- lexer of gfcc files + ParGFCC.hs -- parser of gfcc files and syntax trees + PrintGFCC.hs -- printer of gfcc files and syntax trees + + -- hand-written files + DataGFCC.hs -- grammar datatype, post-parser grammar creation + Linearize.hs -- linearization and evaluation + Macros.hs -- utilities abstracting away from GFCC datatypes + Generate.hs -- random and exhaustive generation, generate-and-test parsing + API.hs -- functionalities accessible in embedded GF applications + Generate.hs -- random and exhaustive generation + Shell.hs -- main function - a simple command interpreter +``` +It is included in the +[developers' version http://www.cs.chalmers.se/Cs/Research/Language-technology/darcs/GF/doc/darcs.html] +of GF, in the subdirectories [``GF/src/GF/GFCC`` ../] and +[``GF/src/GF/Devel`` ../../Devel]. + +As of September 2007, default parsing in main GF uses GFCC (implemented by Krasimir +Angelov). The interpreter uses the relevant modules +``` + GF/Conversions/SimpleToFCFG.hs -- generate parser from GFCC + GF/Parsing/FCFG.hs -- run the parser +``` + + +To compile the interpreter, type +``` + make gfcc +``` +in ``GF/src``. To run it, type +``` + ./gfcc <GFCC-file> +``` +The available commands are +- ``gr <Cat> <Int>``: generate a number of random trees in category. + and show their linearizations in all languages +- ``grt <Cat> <Int>``: generate a number of random trees in category. + and show the trees and their linearizations in all languages +- ``gt <Cat> <Int>``: generate a number of trees in category from smallest, + and show their linearizations in all languages +- ``gtt <Cat> <Int>``: generate a number of trees in category from smallest, + and show the trees and their linearizations in all languages +- ``p <Lang> <Cat> <String>``: parse a string into a set of trees +- ``lin <Tree>``: linearize tree in all languages, also showing full records +- ``q``: terminate the system cleanly + + + +==Embedded formats== + +- JavaScript: compiler of linearization and abstract syntax + +- Haskell: compiler of abstract syntax and interpreter with parsing, + linearization, and generation + +- C: compiler of linearization (old GFCC) + +- C++: embedded interpreter supporting linearization (old GFCC) + + + +==Some things to do== + +Support for dependent types, higher-order abstract syntax, and +semantic definition in GFCC generation and interpreters. + +Replacing the entire GF shell by one based on GFCC. + +Interpreter in Java. + +Hand-written parsers for GFCC grammars to reduce code size +(and efficiency?) of interpreters. + +Binary format and/or file compression of GFCC output. + +Syntax editor based on GFCC. + +Rewriting of resource libraries in order to exploit the +word-suffix sharing better (depth-one tables, as in FM). + diff --git a/src/PGF/doc/old-GFCC.cf b/src/PGF/doc/old-GFCC.cf new file mode 100644 index 000000000..65657a259 --- /dev/null +++ b/src/PGF/doc/old-GFCC.cf @@ -0,0 +1,50 @@ +Grm. Grammar ::= Header ";" Abstract ";" [Concrete] ; +Hdr. Header ::= "grammar" CId "(" [CId] ")" ; +Abs. Abstract ::= "abstract" "{" [AbsDef] "}" ; +Cnc. Concrete ::= "concrete" CId "{" [CncDef] "}" ; + +Fun. AbsDef ::= CId ":" Type "=" Exp ; +--AFl. AbsDef ::= "%" CId "=" String ; -- flag +Lin. CncDef ::= CId "=" Term ; +--CFl. CncDef ::= "%" CId "=" String ; -- flag + +Typ. Type ::= [CId] "->" CId ; +Tr. Exp ::= "(" Atom [Exp] ")" ; +AC. Atom ::= CId ; +AS. Atom ::= String ; +AI. Atom ::= Integer ; +AF. Atom ::= Double ; +AM. Atom ::= "?" ; +trA. Exp ::= Atom ; +define trA a = Tr a [] ; + +R. Term ::= "[" [Term] "]" ; -- record/table +P. Term ::= "(" Term "!" Term ")" ; -- projection/selection +S. Term ::= "(" [Term] ")" ; -- sequence with ++ +K. Term ::= Tokn ; -- token +V. Term ::= "$" Integer ; -- argument +C. Term ::= Integer ; -- parameter value/label +F. Term ::= CId ; -- global constant +FV. Term ::= "[|" [Term] "|]" ; -- free variation +W. Term ::= "(" String "+" Term ")" ; -- prefix + suffix table +RP. Term ::= "(" Term "@" Term ")"; -- record parameter alias +TM. Term ::= "?" ; -- lin of metavariable + +L. Term ::= "(" CId "->" Term ")" ; -- lambda abstracted table +BV. Term ::= "#" CId ; -- lambda-bound variable + +KS. Tokn ::= String ; +KP. Tokn ::= "[" "pre" [String] "[" [Variant] "]" "]" ; +Var. Variant ::= [String] "/" [String] ; + + +terminator Concrete ";" ; +terminator AbsDef ";" ; +terminator CncDef ";" ; +separator CId "," ; +separator Term "," ; +terminator Exp "" ; +terminator String "" ; +separator Variant "," ; + +token CId (('_' | letter) (letter | digit | '\'' | '_')*) ; diff --git a/src/PGF/doc/old-gfcc.txt b/src/PGF/doc/old-gfcc.txt new file mode 100644 index 000000000..6ffd9bd64 --- /dev/null +++ b/src/PGF/doc/old-gfcc.txt @@ -0,0 +1,656 @@ +The GFCC Grammar Format +Aarne Ranta +October 19, 2006 + +Author's address: +[``http://www.cs.chalmers.se/~aarne`` http://www.cs.chalmers.se/~aarne] + +% to compile: txt2tags -thtml --toc gfcc.txt + +History: +- 19 Oct: translation of lincats, new figures on C++ +- 3 Oct 2006: first version + + +==What is GFCC== + +GFCC is a low-level format for GF grammars. Its aim is to contain the minimum +that is needed to process GF grammars at runtime. This minimality has three +advantages: +- compact grammar files and run-time objects +- time and space efficient processing +- simple definition of interpreters + + +The idea is that all embedded GF applications are compiled to GFCC. +The GF system would be primarily used as a compiler and as a grammar +development tool. + +Since GFCC is implemented in BNFC, a parser of the format is readily +available for C, C++, Haskell, Java, and OCaml. Also an XML +representation is generated in BNFC. A +[reference implementation ../] +of linearization and some other functions has been written in Haskell. + + +==GFCC vs. GFC== + +GFCC is aimed to replace GFC as the run-time grammar format. GFC was designed +to be a run-time format, but also to +support separate compilation of grammars, i.e. +to store the results of compiling +individual GF modules. But this means that GFC has to contain extra information, +such as type annotations, which is only needed in compilation and not at +run-time. In particular, the pattern matching syntax and semantics of GFC is +complex and therefore difficult to implement in new platforms. + +The main differences of GFCC compared with GFC can be summarized as follows: +- there are no modules, and therefore no qualified names +- a GFCC grammar is multilingual, and consists of a common abstract syntax + together with one concrete syntax per language +- records and tables are replaced by arrays +- record labels and parameter values are replaced by integers +- record projection and table selection are replaced by array indexing +- there is (so far) no support for dependent types or higher-order abstract + syntax (which would be easy to add, but make interpreters much more difficult + to write) + + +Here is an example of a GF grammar, consisting of three modules, +as translated to GFCC. The representations are aligned, with the exceptions +due to the alphabetical sorting of GFCC grammars. +``` + grammar Ex(Eng,Swe); + +abstract Ex = { abstract { + cat + S ; NP ; VP ; + fun + Pred : NP -> VP -> S ; Pred : NP,VP -> S = (Pred); + She, They : NP ; She : -> NP = (She); + Sleep : VP ; Sleep : -> VP = (Sleep); + They : -> NP = (They); +} } ; + +concrete Eng of Ex = { concrete Eng { + lincat + S = {s : Str} ; + NP = {s : Str ; n : Num} ; + VP = {s : Num => Str} ; + param + Num = Sg | Pl ; + lin + Pred np vp = { Pred = [(($0!1),(($1!0)!($0!0)))]; + s = np.s ++ vp.s ! np.n} ; + She = {s = "she" ; n = Sg} ; She = [0, "she"]; + They = {s = "they" ; n = Pl} ; + Sleep = {s = table { Sleep = [("sleep" + ["s",""])]; + Sg => "sleeps" ; + Pl => "sleep" They = [1, "they"]; + } } ; + } ; +} + +concrete Swe of Ex = { concrete Swe { + lincat + S = {s : Str} ; + NP = {s : Str} ; + VP = {s : Str} ; + param + Num = Sg | Pl ; + lin + Pred np vp = { Pred = [(($0!0),($1!0))]; + s = np.s ++ vp.s} ; + She = {s = "hon"} ; She = ["hon"]; + They = {s = "de"} ; They = ["de"]; + Sleep = {s = "sover"} ; Sleep = ["sover"]; +} } ; +``` + +==The syntax of GFCC files== + +===Top level=== + +A grammar has a header telling the name of the abstract syntax +(often specifying an application domain), and the names of +the concrete languages. The abstract syntax and the concrete +syntaxes themselves follow. +``` + Grammar ::= Header ";" Abstract ";" [Concrete] ; + Header ::= "grammar" CId "(" [CId] ")" ; + Abstract ::= "abstract" "{" [AbsDef] "}" ; + Concrete ::= "concrete" CId "{" [CncDef] "}" ; +``` +Abstract syntax judgements give typings and semantic definitions. +Concrete syntax judgements give linearizations. +``` + AbsDef ::= CId ":" Type "=" Exp ; + CncDef ::= CId "=" Term ; +``` +Also flags are possible, local to each "module" (i.e. abstract and concretes). +``` + AbsDef ::= "%" CId "=" String ; + CncDef ::= "%" CId "=" String ; +``` +For the run-time system, the reference implementation in Haskell +uses a structure that gives efficient look-up: +``` + data GFCC = GFCC { + absname :: CId , + cncnames :: [CId] , + abstract :: Abstr , + concretes :: Map CId Concr + } + + data Abstr = Abstr { + funs :: Map CId Type, -- find the type of a fun + cats :: Map CId [CId] -- find the funs giving a cat + } + + type Concr = Map CId Term +``` + + +===Abstract syntax=== + +Types are first-order function types built from +category symbols. Syntax trees (``Exp``) are +rose trees with the head (``Atom``) either a function +constant, a metavariable, or a string, integer, or float +literal. +``` + Type ::= [CId] "->" CId ; + Exp ::= "(" Atom [Exp] ")" ; + Atom ::= CId ; -- function constant + Atom ::= "?" ; -- metavariable + Atom ::= String ; -- string literal + Atom ::= Integer ; -- integer literal + Atom ::= Double ; -- float literal +``` + + +===Concrete syntax=== + +Linearization terms (``Term``) are built as follows. +Constructor names are shown to make the later code +examples readable. +``` + R. Term ::= "[" [Term] "]" ; -- array + P. Term ::= "(" Term "!" Term ")" ; -- access to indexed field + S. Term ::= "(" [Term] ")" ; -- sequence with ++ + K. Term ::= Tokn ; -- token + V. Term ::= "$" Integer ; -- argument + C. Term ::= Integer ; -- array index + FV. Term ::= "[|" [Term] "|]" ; -- free variation + TM. Term ::= "?" ; -- linearization of metavariable +``` +Tokens are strings or (maybe obsolescent) prefix-dependent +variant lists. +``` + KS. Tokn ::= String ; + KP. Tokn ::= "[" "pre" [String] "[" [Variant] "]" "]" ; + Var. Variant ::= [String] "/" [String] ; +``` +Three special forms of terms are introduced by the compiler +as optimizations. They can in principle be eliminated, but +their presence makes grammars much more compact. Their semantics +will be explained in a later section. +``` + F. Term ::= CId ; -- global constant + W. Term ::= "(" String "+" Term ")" ; -- prefix + suffix table + RP. Term ::= "(" Term "@" Term ")"; -- record parameter alias +``` +Identifiers are like ``Ident`` in GF and GFC, except that +the compiler produces constants prefixed with ``_`` in +the common subterm elimination optimization. +``` + token CId (('_' | letter) (letter | digit | '\'' | '_')*) ; +``` + + +==The semantics of concrete syntax terms== + +===Linearization and realization=== + +The linearization algorithm is essentially the same as in +GFC: a tree is linearized by evaluating its linearization term +in the environment of the linearizations of the subtrees. +Literal atoms are linearized in the obvious way. +The function also needs to know the language (i.e. concrete syntax) +in which linearization is performed. +``` + linExp :: GFCC -> CId -> Exp -> Term + linExp mcfg lang tree@(Tr at trees) = case at of + AC fun -> comp (Prelude.map lin trees) $ look fun + AS s -> R [kks (show s)] -- quoted + AI i -> R [kks (show i)] + AF d -> R [kks (show d)] + AM -> TM + where + lin = linExp mcfg lang + comp = compute mcfg lang + look = lookLin mcfg lang +``` +The result of linearization is usually a record, which is realized as +a string using the following algorithm. +``` + realize :: Term -> String + realize trm = case trm of + R (t:_) -> realize t + S ss -> unwords $ Prelude.map realize ss + K (KS s) -> s + K (KP s _) -> unwords s ---- prefix choice TODO + W s t -> s ++ realize t + FV (t:_) -> realize t + TM -> "?" +``` +Since the order of record fields is not necessarily +the same as in GF source, +this realization does not work securely for +categories whose lincats more than one field. + + +===Term evaluation=== + +Evaluation follows call-by-value order, with two environments +needed: +- the grammar (a concrete syntax) to give the global constants +- an array of terms to give the subtree linearizations + + +The code is presented in one-level pattern matching, to +enable reimplementations in languages that do not permit +deep patterns (such as Java and C++). +``` +compute :: GFCC -> CId -> [Term] -> Term -> Term +compute mcfg lang args = comp where + comp trm = case trm of + P r p -> proj (comp r) (comp p) + RP i t -> RP (comp i) (comp t) + W s t -> W s (comp t) + R ts -> R $ Prelude.map comp ts + V i -> idx args (fromInteger i) -- already computed + F c -> comp $ look c -- not computed (if contains V) + FV ts -> FV $ Prelude.map comp ts + S ts -> S $ Prelude.filter (/= S []) $ Prelude.map comp ts + _ -> trm + + look = lookLin mcfg lang + + idx xs i = xs !! i + + proj r p = case (r,p) of + (_, FV ts) -> FV $ Prelude.map (proj r) ts + (W s t, _) -> kks (s ++ getString (proj t p)) + _ -> comp $ getField r (getIndex p) + + getString t = case t of + K (KS s) -> s + _ -> trace ("ERROR in grammar compiler: string from "++ show t) "ERR" + + getIndex t = case t of + C i -> fromInteger i + RP p _ -> getIndex p + TM -> 0 -- default value for parameter + _ -> trace ("ERROR in grammar compiler: index from " ++ show t) 0 + + getField t i = case t of + R rs -> idx rs i + RP _ r -> getField r i + TM -> TM + _ -> trace ("ERROR in grammar compiler: field from " ++ show t) t +``` + +===The special term constructors=== + +The three forms introduced by the compiler may a need special +explanation. + +Global constants +``` + Term ::= CId ; +``` +are shorthands for complex terms. They are produced by the +compiler by (iterated) common subexpression elimination. +They are often more powerful than hand-devised code sharing in the source +code. They could be computed off-line by replacing each identifier by +its definition. + +Prefix-suffix tables +``` + Term ::= "(" String "+" Term ")" ; +``` +represent tables of word forms divided to the longest common prefix +and its array of suffixes. In the example grammar above, we have +``` + Sleep = [("sleep" + ["s",""])] +``` +which in fact is equal to the array of full forms +``` + ["sleeps", "sleep"] +``` +The power of this construction comes from the fact that suffix sets +tend to be repeated in a language, and can therefore be collected +by common subexpression elimination. It is this technique that +explains the used syntax rather than the more accurate +``` + "(" String "+" [String] ")" +``` +since we want the suffix part to be a ``Term`` for the optimization to +take effect. + +The most curious construct of GFCC is the parameter array alias, +``` + Term ::= "(" Term "@" Term ")"; +``` +This form is used as the value of parameter records, such as the type +``` + {n : Number ; p : Person} +``` +The problem with parameter records is their double role. +They can be used like parameter values, as indices in selection, +``` + VP.s ! {n = Sg ; p = P3} +``` +but also as records, from which parameters can be projected: +``` + {n = Sg ; p = P3}.n +``` +Whichever use is selected as primary, a prohibitively complex +case expression must be generated at compilation to GFCC to get the +other use. The adopted +solution is to generate a pair containing both a parameter value index +and an array of indices of record fields. For instance, if we have +``` + param Number = Sg | Pl ; Person = P1 | P2 | P3 ; +``` +we get the encoding +``` + {n = Sg ; p = P3} ---> (2 @ [0,2]) +``` +The GFCC computation rules are essentially +``` + (t ! (i @ _)) = (t ! i) + ((_ @ r) ! j) =(r ! j) +``` + + +==Compiling to GFCC== + +Compilation to GFCC is performed by the GF grammar compiler, and +GFCC interpreters need not know what it does. For grammar writers, +however, it might be interesting to know what happens to the grammars +in the process. + +The compilation phases are the following ++ translate GF source to GFC, as always in GF ++ undo GFC back-end optimizations ++ perform the ``values`` optimization to normalize tables ++ create a symbol table mapping the GFC parameter and record types to + fixed-size arrays, and parameter values and record labels to integers ++ traverse the linearization rules replacing parameters and labels by integers ++ reorganize the created GFC grammar so that it has just one abstract syntax + and one concrete syntax per language ++ apply UTF8 encoding to the grammar, if not yet applied (this is told by the + ``coding`` flag) ++ translate the GFC syntax tree to a GFCC syntax tree, using a simple + compositional mapping ++ perform the word-suffix optimization on GFCC linearization terms ++ perform subexpression elimination on each concrete syntax module ++ print out the GFCC code + + +Notice that a major part of the compilation is done within GFC, so that +GFC-related tasks (such as parser generation) could be performed by +using the old algorithms. + + +===Problems in GFCC compilation=== + +Two major problems had to be solved in compiling GFC to GFCC: +- consistent order of tables and records, to permit the array translation +- run-time variables in complex parameter values. + + +The current implementation is still experimental and may fail +to generate correct code. Any errors remaining are likely to be +related to the two problems just mentioned. + +The order problem is solved in different ways for tables and records. +For tables, the ``values`` optimization of GFC already manages to +maintain a canonical order. But this order can be destroyed by the +``share`` optimization. To make sure that GFCC compilation works properly, +it is safest to recompile the GF grammar by using the ``values`` +optimization flag. + +Records can be canonically ordered by sorting them by labels. +In fact, this was done in connection of the GFCC work as a part +of the GFC generation, to guarantee consistency. This means that +e.g. the ``s`` field will in general no longer appear as the first +field, even if it does so in the GF source code. But relying on the +order of fields in a labelled record would be misplaced anyway. + +The canonical form of records is further complicated by lock fields, +i.e. dummy fields of form ``lock_C = <>``, which are added to grammar +libraries to force intensionality of linearization types. The problem +is that the absence of a lock field only generates a warning, not +an error. Therefore a GFC grammar can contain objects of the same +type with and without a lock field. This problem was solved in GFCC +generation by just removing all lock fields (defined as fields whose +type is the empty record type). This has the further advantage of +(slightly) reducing the grammar size. More importantly, it is safe +to remove lock fields, because they are never used in computation, +and because intensional types are only needed in grammars reused +as libraries, not in grammars used at runtime. + +While the order problem is rather bureaucratic in nature, run-time +variables are an interesting problem. They arise in the presence +of complex parameter values, created by argument-taking constructors +and parameter records. To give an example, consider the GF parameter +type system +``` + Number = Sg | Pl ; + Person = P1 | P2 | P3 ; + Agr = Ag Number Person ; +``` +The values can be translated to integers in the expected way, +``` + Sg = 0, Pl = 1 + P1 = 0, P2 = 1, P3 = 2 + Ag Sg P1 = 0, Ag Sg P2 = 1, Ag Sg P3 = 2, + Ag Pl P1 = 3, Ag Pl P2 = 4, Ag Pl P3 = 5 +``` +However, an argument of ``Agr`` can be a run-time variable, as in +``` + Ag np.n P3 +``` +This expression must first be translated to a case expression, +``` + case np.n of { + 0 => 2 ; + 1 => 5 + } +``` +which can then be translated to the GFCC term +``` + ([2,5] ! ($0 ! $1)) +``` +assuming that the variable ``np`` is the first argument and that its +``Number`` field is the second in the record. + +This transformation of course has to be performed recursively, since +there can be several run-time variables in a parameter value: +``` + Ag np.n np.p +``` +A similar transformation would be possible to deal with the double +role of parameter records discussed above. Thus the type +``` + RNP = {n : Number ; p : Person} +``` +could be uniformly translated into the set ``{0,1,2,3,4,5}`` +as ``Agr`` above. Selections would be simple instances of indexing. +But any projection from the record should be translated into +a case expression, +``` + rnp.n ===> + case rnp of { + 0 => 0 ; + 1 => 0 ; + 2 => 0 ; + 3 => 1 ; + 4 => 1 ; + 5 => 1 + } +``` +To avoid the code bloat resulting from this, we chose the alias representation +which is easy enough to deal with in interpreters. + + +===The representation of linearization types=== + +Linearization types (``lincat``) are not needed when generating with +GFCC, but they have been added to enable parser generation directly from +GFCC. The linearization type definitions are shown as a part of the +concrete syntax, by using terms to represent types. Here is the table +showing how different linearization types are encoded. +``` + P* = size(P) -- parameter type + {_ : I ; __ : R}* = (I* @ R*) -- record of parameters + {r1 : T1 ; ... ; rn : Tn}* = [T1*,...,Tn*] -- other record + (P => T)* = [T* ,...,T*] -- size(P) times + Str* = () +``` +The category symbols are prefixed with two underscores (``__``). +For example, the linearization type ``present/CatEng.NP`` is +translated as follows: +``` + NP = { + a : { -- 6 = 2*3 values + n : {ParamX.Number} ; -- 2 values + p : {ParamX.Person} -- 3 values + } ; + s : {ResEng.Case} => Str -- 3 values + } + + __NP = [(6@[2,3]),[(),(),()]] +``` + + + + +===Running the compiler and the GFCC interpreter=== + +GFCC generation is a part of the +[developers' version http://www.cs.chalmers.se/Cs/Research/Language-technology/darcs/GF/doc/darcs.html] +of GF since September 2006. To invoke the compiler, the flag +``-printer=gfcc`` to the command +``pm = print_multi`` is used. It is wise to recompile the grammar from +source, since previously compiled libraries may not obey the canonical +order of records. To ``strip`` the grammar before +GFCC translation removes unnecessary interface references. +Here is an example, performed in +[example/bronzeage ../../../../../examples/bronzeage]. +``` + i -src -path=.:prelude:resource-1.0/* -optimize=all_subs BronzeageEng.gf + i -src -path=.:prelude:resource-1.0/* -optimize=all_subs BronzeageGer.gf + strip + pm -printer=gfcc | wf bronze.gfcc +``` + + + +==The reference interpreter== + +The reference interpreter written in Haskell consists of the following files: +``` + -- source file for BNFC + GFCC.cf -- labelled BNF grammar of gfcc + + -- files generated by BNFC + AbsGFCC.hs -- abstrac syntax of gfcc + ErrM.hs -- error monad used internally + LexGFCC.hs -- lexer of gfcc files + ParGFCC.hs -- parser of gfcc files and syntax trees + PrintGFCC.hs -- printer of gfcc files and syntax trees + + -- hand-written files + DataGFCC.hs -- post-parser grammar creation, linearization and evaluation + GenGFCC.hs -- random and exhaustive generation, generate-and-test parsing + RunGFCC.hs -- main function - a simple command interpreter +``` +It is included in the +[developers' version http://www.cs.chalmers.se/Cs/Research/Language-technology/darcs/GF/doc/darcs.html] +of GF, in the subdirectory [``GF/src/GF/Canon/GFCC`` ../]. + +To compile the interpreter, type +``` + make gfcc +``` +in ``GF/src``. To run it, type +``` + ./gfcc <GFCC-file> +``` +The available commands are +- ``gr <Cat> <Int>``: generate a number of random trees in category. + and show their linearizations in all languages +- ``grt <Cat> <Int>``: generate a number of random trees in category. + and show the trees and their linearizations in all languages +- ``gt <Cat> <Int>``: generate a number of trees in category from smallest, + and show their linearizations in all languages +- ``gtt <Cat> <Int>``: generate a number of trees in category from smallest, + and show the trees and their linearizations in all languages +- ``p <Int> <Cat> <String>``: "parse", i.e. generate trees until match or + until the given number have been generated +- ``<Tree>``: linearize tree in all languages, also showing full records +- ``quit``: terminate the system cleanly + + +==Interpreter in C++== + +A base-line interpreter in C++ has been started. +Its main functionality is random generation of trees and linearization of them. + +Here are some results from running the different interpreters, compared +to running the same grammar in GF, saved in ``.gfcm`` format. +The grammar contains the English, German, and Norwegian +versions of Bronzeage. The experiment was carried out on +Ubuntu Linux laptop with 1.5 GHz Intel centrino processor. + +|| | GF | gfcc(hs) | gfcc++ | +| program size | 7249k | 803k | 113k +| grammar size | 336k | 119k | 119k +| read grammar | 1150ms | 510ms | 100ms +| generate 222 | 9500ms | 450ms | 800ms +| memory | 21M | 10M | 20M + + + +To summarize: +- going from GF to gfcc is a major win in both code size and efficiency +- going from Haskell to C++ interpreter is not a win yet, because of a space + leak in the C++ version + + + +==Some things to do== + +Interpreter in Java. + +Parsing via MCFG +- the FCFG format can possibly be simplified +- parser grammars should be saved in files to make interpreters easier + + +Hand-written parsers for GFCC grammars to reduce code size +(and efficiency?) of interpreters. + +Binary format and/or file compression of GFCC output. + +Syntax editor based on GFCC. + +Rewriting of resource libraries in order to exploit the +word-suffix sharing better (depth-one tables, as in FM). + + + diff --git a/src/PGF/doc/syntax.txt b/src/PGF/doc/syntax.txt new file mode 100644 index 000000000..db8f7c149 --- /dev/null +++ b/src/PGF/doc/syntax.txt @@ -0,0 +1,180 @@ +GFCC Syntax + + +==Syntax of GFCC files== + +The parser syntax is very simple, as defined in BNF: +``` + Grm. Grammar ::= [RExp] ; + + App. RExp ::= "(" CId [RExp] ")" ; + AId. RExp ::= CId ; + AInt. RExp ::= Integer ; + AStr. RExp ::= String ; + AFlt. RExp ::= Double ; + AMet. RExp ::= "?" ; + + terminator RExp "" ; + + token CId (('_' | letter) (letter | digit | '\'' | '_')*) ; +``` +While a parser and a printer can be generated for many languages +from this grammar by using the BNF Converter, a parser is also +easy to write by hand using recursive descent. + + +==Syntax of well-formed GFCC code== + +Here is a summary of well-formed syntax, +with a comment on the semantics of each construction. +``` + Grammar ::= + ("grammar" CId CId*) -- abstract syntax name and concrete syntax names + "(" "flags" Flag* ")" -- global and abstract flags + "(" "abstract" Abstract ")" -- abstract syntax + "(" "concrete" Concrete* ")" -- concrete syntaxes + + Abstract ::= + "(" "fun" FunDef* ")" -- function definitions + "(" "cat" CatDef* ")" -- category definitions + + Concrete ::= + "(" CId -- language name + "flags" Flag* -- concrete flags + "lin" LinDef* -- linearization rules + "oper" LinDef* -- operations (macros) + "lincat" LinDef* -- linearization type definitions + "lindef" LinDef* -- linearization default definitions + "printname" LinDef* -- printname definitions + "param" LinDef* -- lincats with labels and parameter value names + ")" + + Flag ::= "(" CId String ")" -- flag and value + FunDef ::= "(" CId Type Exp ")" -- function, type, and definition + CatDef ::= "(" CId Hypo* ")" -- category and context + LinDef ::= "(" CId Term ")" -- function and definition + + Type ::= + "(" CId -- value category + "(" "H" Hypo* ")" -- argument context + "(" "X" Exp* ")" ")" -- arguments (of dependent value type) + + Exp ::= + "(" CId -- function + "(" "B" CId* ")" -- bindings + "(" "X" Exp* ")" ")" -- arguments + | CId -- variable + | "?" -- metavariable + | "(" "Eq" Equation* ")" -- group of pattern equations + | Integer -- integer literal (non-negative) + | Float -- floating-point literal (non-negative) + | String -- string literal (in double quotes) + + Hypo ::= "(" CId Type ")" -- variable and type + + Equation ::= "(" "E" Exp Exp* ")" -- value and pattern list + + Term ::= + "(" "R" Term* ")" -- array (record or table) + | "(" "S" Term* ")" -- concatenated sequence + | "(" "FV" Term* ")" -- free variant list + | "(" "P" Term Term ")" -- access to index (projection or selection) + | "(" "W" String Term ")" -- token prefix with suffix list + | "(" "A" Integer ")" -- pointer to subtree + | String -- token (in double quotes) + | Integer -- index in array + | CId -- macro constant + | "?" -- metavariable +``` + + +==GFCC interpreter== + +The first phase in interpreting GFCC is to parse a GFCC file and +build an internal abstract syntax representation, as specified +in the previous section. + +With this representation, linearization can be performed by +a straightforward function from expressions (``Exp``) to terms +(``Term``). All expressions except groups of pattern equations +can be linearized. + +Here is a reference Haskell implementation of linearization: +``` + linExp :: GFCC -> CId -> Exp -> Term + linExp gfcc lang tree@(DTr _ at trees) = case at of + AC fun -> comp (map lin trees) $ look fun + AS s -> R [K (show s)] -- quoted + AI i -> R [K (show i)] + AF d -> R [K (show d)] + AM -> TM + where + lin = linExp gfcc lang + comp = compute gfcc lang + look = lookLin gfcc lang +``` +TODO: bindings must be supported. + +Terms resulting from linearization are evaluated in +call-by-value order, with two environments needed: +- the grammar (a concrete syntax) to give the global constants +- an array of terms to give the subtree linearizations + + +The Haskell implementation works as follows: +``` +compute :: GFCC -> CId -> [Term] -> Term -> Term +compute gfcc lang args = comp where + comp trm = case trm of + P r p -> proj (comp r) (comp p) + W s t -> W s (comp t) + R ts -> R $ map comp ts + V i -> idx args (fromInteger i) -- already computed + F c -> comp $ look c -- not computed (if contains V) + FV ts -> FV $ Prelude.map comp ts + S ts -> S $ Prelude.filter (/= S []) $ Prelude.map comp ts + _ -> trm + + look = lookOper gfcc lang + + idx xs i = xs !! i + + proj r p = case (r,p) of + (_, FV ts) -> FV $ Prelude.map (proj r) ts + (FV ts, _ ) -> FV $ Prelude.map (\t -> proj t p) ts + (W s t, _) -> kks (s ++ getString (proj t p)) + _ -> comp $ getField r (getIndex p) + + getString t = case t of + K (KS s) -> s + _ -> trace ("ERROR in grammar compiler: string from "++ show t) "ERR" + + getIndex t = case t of + C i -> fromInteger i + RP p _ -> getIndex p + TM -> 0 -- default value for parameter + _ -> trace ("ERROR in grammar compiler: index from " ++ show t) 0 + + getField t i = case t of + R rs -> idx rs i + RP _ r -> getField r i + TM -> TM + _ -> trace ("ERROR in grammar compiler: field from " ++ show t) t +``` +The result of linearization is usually a record, which is realized as +a string using the following algorithm. +``` + realize :: Term -> String + realize trm = case trm of + R (t:_) -> realize t + S ss -> unwords $ map realize ss + K s -> s + W s t -> s ++ realize t + FV (t:_) -> realize t -- TODO: all variants + TM -> "?" +``` +Notice that realization always picks the first field of a record. +If a linearization type has more than one field, the first field +does not necessarily contain the desired string. +Also notice that the order of record fields in GFCC is not necessarily +the same as in GF source. diff --git a/src/ReleaseProcedure b/src/ReleaseProcedure new file mode 100644 index 000000000..c04f2a065 --- /dev/null +++ b/src/ReleaseProcedure @@ -0,0 +1,153 @@ +Procedure for making a GF release: + +1. Make sure everything that should be in the release has been + checked in. + +2. Go to the src/ dir. + + $ cd src + +3. Edit configure.ac to set the right version number + (the second argument to the AC_INIT macro). + +4. Edit gf.spec to set the version and release numbers + (change %define version and %define release). + +5. Commit configure.ac and gf.spec: + + $ darcs record -m 'Updated version numbers.' configure.ac gf.spec + +6. Run autoconf to generate configure with the right version number: + + $ autoconf + +7. Go back to the root of the tree. + + $ cd .. + +8. Tag the release. (X_X should be replaced by the version number, with + _ instead of ., e.g. 2_0) + + $ darcs tag -m RELEASE-X_X + +9. Push the changes that you made for the release to the main repo: + + $ darcs push + +10. Build a source package: + + $ cd src + $ ./configure + $ make dist + +11. (Only if releasing a new grammars distribution) + Build a grammar tarball: + + $ cd src + $ ./configure && make grammar-dist + +12. Build an x86/linux RPM (should be done on a Mandrake Linux box): + + Setup for building RPMs (first time only): + + - Make sure that you have the directories neccessary to build + RPMs: + + $ mkdir -p ~/rpm/{BUILD,RPMS/i586,RPMS/noarch,SOURCES,SRPMS,SPECS,tmp} + + - Create ~/.rpmrc with the following contents: + +buildarchtranslate: i386: i586 +buildarchtranslate: i486: i586 +buildarchtranslate: i586: i586 +buildarchtranslate: i686: i586 + + - Create ~/.rpmmacros with the following contents: + +%_topdir %(echo ${HOME}/rpm) +%_tmppath %{_topdir}/tmp + +%packager Your Name <yourusername@cs.chalmers.se> + + Build the RPM: + + $ cd src + $ ./configure && make rpm + +13. Build a generic binary x86/linux package (should be done on a Linux box, + e.g. banded.medic.chalmers.se): + + $ cd src + $ ./configure --host=i386-pc-linux-gnu && make binary-dist + +14. Build a generic binary sparc/solaris package (should be done + on a Solaris box, e.g. remote1.cs.chalmers.se): + + $ cd src + $ ./configure --host=sparc-sun-solaris2 && gmake binary-dist + +15. Build a Mac OS X package (should be done on a Mac OS X box, + e.g. csmisc99.cs.chalmers.se): + + $ cd src + $ ./configure && make binary-dist + + Note that to run GHC-compiled binaries on OS X, you need + a "Haskell Support Framework". This should be available + separately from the GF download page. + + TODO: Use OS X PackageMaker to build a .pkg-file which can + be installed using the standard OS X Installer program. + +16. Build a binary Cygwin package (should be done on a Windows + machine with Cygwin): + + $ cd src + $ ./configure && make binary-dist + +17. Build a Windows MSI package (FIXME: This doesn't work right, + pathnames with backslashes and spaces are not handled + correctly in Windows. We only release a binary tarball + for Cygwin right now.): + + $ cd src + $ ./configure && make all windows-msi + +18. Add new GF package release to SourceForge: + + - https://sourceforge.net/projects/gf-tools + + - Project page -> Admin -> File releases -> Add release (for the + GF package) + + - New release name: X.X (just the version number, e.g. 2.2) + + - Paste in release notes + + - Upload files using anonymous FTP to upload.sourceforge.net + in the incoming directory. + + - Add the files to the release and set the processor + and file type for each file (remember to press + Update/Refresh for each file): + * x86 rpm -> i386/.rpm + * source rpm -> Any/Source .rpm + * x86 binary tarball -> i386/.gz + * sparc binary tarball -> Sparc/.gz + * source package -> Any/Source .gz + +19. Add new GF-editor release. Repeat the steps above, but + with GF-editor: + + - Add files and set properties: + + * editor rpm -> i386/.rpm (not really true, but I haven't + figured out how to make noarch rpms from the same spec as + arch-specific ones) + +20. Mail to gf-tools-users@lists.sourceforge.net + +21. Update website. + +22. Party! + diff --git a/src/Transfer/CompilerAPI.hs b/src/Transfer/CompilerAPI.hs new file mode 100644 index 000000000..38cb58dd0 --- /dev/null +++ b/src/Transfer/CompilerAPI.hs @@ -0,0 +1,75 @@ +module Transfer.CompilerAPI where + +import Transfer.Syntax.Lex +import Transfer.Syntax.Par +import Transfer.Syntax.Print +import Transfer.Syntax.Abs +import Transfer.Syntax.Layout + +import Transfer.ErrM +import Transfer.SyntaxToCore + +import Transfer.PathUtil + +import Data.List +import System.Directory + + +-- | Compile a source module file to a a code file. +compileFile :: [FilePath] -- ^ directories to look for imported modules in + -> FilePath -- ^ source module file + -> IO FilePath -- ^ path to the core file that was written +compileFile path f = do + ds <- loadModule path f + s <- compile ds + writeFile coreFile s + return coreFile + where coreFile = replaceFilenameSuffix f "trc" + +-- | Compile a self-contained list of declarations to a core program. +compile :: Monad m => [Decl] -> m String +compile m = return (printTree $ declsToCore m) + +-- | Load a source module file and all its dependencies. +loadModule :: [FilePath] -- ^ directories to look for imported modules in + -> FilePath -- ^ source module file + -> IO [Decl] +loadModule = loadModule_ [] + where + loadModule_ ms path f = + do + s <- readFile f + Module is ds <- case pModule (myLLexer s) of + Bad e -> fail $ "Parse error in " ++ f ++ ": " ++ e + Ok m -> return m + let load = [ i | Import (Ident i) <- is ] \\ ms + let path' = directoryOf f : path + files <- mapM (findFile path' . (++".tra")) load + dss <- mapM (loadModule_ (load++ms) path) files + return $ concat (dss++[ds]) + +myLLexer :: String -> [Token] +myLLexer = resolveLayout True . myLexer + +-- | Find a file in one of the given directories. +-- Fails if the file was not found. +findFile :: [FilePath] -- ^ directories to look in + -> FilePath -- ^ file name to find + -> IO FilePath +findFile path f = + do + mf <- findFileM path f + case mf of + Nothing -> fail $ f ++ " not found in path: " ++ show path + Just f' -> return f' + +-- | Find a file in one of the given directories. +findFileM :: [FilePath] -- ^ directories to look in + -> FilePath -- ^ file name to find + -> IO (Maybe FilePath) +findFileM [] _ = return Nothing +findFileM (p:ps) f = + do + let f' = p ++ "/" ++ f + e <- doesFileExist f' + if e then return (Just f') else findFileM ps f diff --git a/src/Transfer/Core/Abs.hs b/src/Transfer/Core/Abs.hs new file mode 100644 index 000000000..8306d5b46 --- /dev/null +++ b/src/Transfer/Core/Abs.hs @@ -0,0 +1,267 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} +module Transfer.Core.Abs (Tree(..), Module, Decl, ConsDecl, Pattern, FieldPattern, PatternVariable, Exp, LetDef, Case, FieldType, FieldValue, TMeta, CIdent, composOp, composOpM, composOpM_, composOpMPlus, composOpMonoid, composOpFold, compos, johnMajorEq) where + +import Control.Monad (ap,MonadPlus,msum,mplus,mzero) +import Control.Monad.Identity +import Data.Monoid + +-- Haskell module generated by the BNF converter + +data Module_ +type Module = Tree Module_ +data Decl_ +type Decl = Tree Decl_ +data ConsDecl_ +type ConsDecl = Tree ConsDecl_ +data Pattern_ +type Pattern = Tree Pattern_ +data FieldPattern_ +type FieldPattern = Tree FieldPattern_ +data PatternVariable_ +type PatternVariable = Tree PatternVariable_ +data Exp_ +type Exp = Tree Exp_ +data LetDef_ +type LetDef = Tree LetDef_ +data Case_ +type Case = Tree Case_ +data FieldType_ +type FieldType = Tree FieldType_ +data FieldValue_ +type FieldValue = Tree FieldValue_ +data TMeta_ +type TMeta = Tree TMeta_ +data CIdent_ +type CIdent = Tree CIdent_ + +data Tree :: * -> * where + Module :: [Decl] -> Tree Module_ + DataDecl :: CIdent -> Exp -> [ConsDecl] -> Tree Decl_ + TypeDecl :: CIdent -> Exp -> Tree Decl_ + ValueDecl :: CIdent -> Exp -> Tree Decl_ + ConsDecl :: CIdent -> Exp -> Tree ConsDecl_ + PCons :: CIdent -> [Pattern] -> Tree Pattern_ + PVar :: PatternVariable -> Tree Pattern_ + PRec :: [FieldPattern] -> Tree Pattern_ + PStr :: String -> Tree Pattern_ + PInt :: Integer -> Tree Pattern_ + FieldPattern :: CIdent -> Pattern -> Tree FieldPattern_ + PVVar :: CIdent -> Tree PatternVariable_ + PVWild :: Tree PatternVariable_ + ELet :: [LetDef] -> Exp -> Tree Exp_ + ECase :: Exp -> [Case] -> Tree Exp_ + EAbs :: PatternVariable -> Exp -> Tree Exp_ + EPi :: PatternVariable -> Exp -> Exp -> Tree Exp_ + EApp :: Exp -> Exp -> Tree Exp_ + EProj :: Exp -> CIdent -> Tree Exp_ + ERecType :: [FieldType] -> Tree Exp_ + ERec :: [FieldValue] -> Tree Exp_ + EVar :: CIdent -> Tree Exp_ + EType :: Tree Exp_ + EStr :: String -> Tree Exp_ + EInteger :: Integer -> Tree Exp_ + EDouble :: Double -> Tree Exp_ + EMeta :: TMeta -> Tree Exp_ + LetDef :: CIdent -> Exp -> Tree LetDef_ + Case :: Pattern -> Exp -> Exp -> Tree Case_ + FieldType :: CIdent -> Exp -> Tree FieldType_ + FieldValue :: CIdent -> Exp -> Tree FieldValue_ + TMeta :: String -> Tree TMeta_ + CIdent :: String -> Tree CIdent_ + +composOp :: (forall a. Tree a -> Tree a) -> Tree c -> Tree c +composOp f = runIdentity . composOpM (Identity . f) + +composOpM :: Monad m => (forall a. Tree a -> m (Tree a)) -> Tree c -> m (Tree c) +composOpM = compos return ap + +composOpM_ :: Monad m => (forall a. Tree a -> m ()) -> Tree c -> m () +composOpM_ = composOpFold (return ()) (>>) + +composOpMPlus :: MonadPlus m => (forall a. Tree a -> m b) -> Tree c -> m b +composOpMPlus = composOpFold mzero mplus + +composOpMonoid :: Monoid m => (forall a. Tree a -> m) -> Tree c -> m +composOpMonoid = composOpFold mempty mappend + +newtype C b a = C { unC :: b } +composOpFold :: b -> (b -> b -> b) -> (forall a. Tree a -> b) -> Tree c -> b +composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f) + +compos :: (forall a. a -> m a) + -> (forall a b. m (a -> b) -> m a -> m b) + -> (forall a. Tree a -> m (Tree a)) -> Tree c -> m (Tree c) +compos r a f t = case t of + Module decls -> r Module `a` foldr (a . a (r (:)) . f) (r []) decls + DataDecl cident exp consdecls -> r DataDecl `a` f cident `a` f exp `a` foldr (a . a (r (:)) . f) (r []) consdecls + TypeDecl cident exp -> r TypeDecl `a` f cident `a` f exp + ValueDecl cident exp -> r ValueDecl `a` f cident `a` f exp + ConsDecl cident exp -> r ConsDecl `a` f cident `a` f exp + PCons cident patterns -> r PCons `a` f cident `a` foldr (a . a (r (:)) . f) (r []) patterns + PVar patternvariable -> r PVar `a` f patternvariable + PRec fieldpatterns -> r PRec `a` foldr (a . a (r (:)) . f) (r []) fieldpatterns + FieldPattern cident pattern -> r FieldPattern `a` f cident `a` f pattern + PVVar cident -> r PVVar `a` f cident + ELet letdefs exp -> r ELet `a` foldr (a . a (r (:)) . f) (r []) letdefs `a` f exp + ECase exp cases -> r ECase `a` f exp `a` foldr (a . a (r (:)) . f) (r []) cases + EAbs patternvariable exp -> r EAbs `a` f patternvariable `a` f exp + EPi patternvariable exp0 exp1 -> r EPi `a` f patternvariable `a` f exp0 `a` f exp1 + EApp exp0 exp1 -> r EApp `a` f exp0 `a` f exp1 + EProj exp cident -> r EProj `a` f exp `a` f cident + ERecType fieldtypes -> r ERecType `a` foldr (a . a (r (:)) . f) (r []) fieldtypes + ERec fieldvalues -> r ERec `a` foldr (a . a (r (:)) . f) (r []) fieldvalues + EVar cident -> r EVar `a` f cident + EMeta tmeta -> r EMeta `a` f tmeta + LetDef cident exp -> r LetDef `a` f cident `a` f exp + Case pattern exp0 exp1 -> r Case `a` f pattern `a` f exp0 `a` f exp1 + FieldType cident exp -> r FieldType `a` f cident `a` f exp + FieldValue cident exp -> r FieldValue `a` f cident `a` f exp + _ -> r t + +instance Show (Tree c) where + showsPrec n t = case t of + Module decls -> opar n . showString "Module" . showChar ' ' . showsPrec 1 decls . cpar n + DataDecl cident exp consdecls -> opar n . showString "DataDecl" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 consdecls . cpar n + TypeDecl cident exp -> opar n . showString "TypeDecl" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n + ValueDecl cident exp -> opar n . showString "ValueDecl" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n + ConsDecl cident exp -> opar n . showString "ConsDecl" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n + PCons cident patterns -> opar n . showString "PCons" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 patterns . cpar n + PVar patternvariable -> opar n . showString "PVar" . showChar ' ' . showsPrec 1 patternvariable . cpar n + PRec fieldpatterns -> opar n . showString "PRec" . showChar ' ' . showsPrec 1 fieldpatterns . cpar n + PStr str -> opar n . showString "PStr" . showChar ' ' . showsPrec 1 str . cpar n + PInt n -> opar n . showString "PInt" . showChar ' ' . showsPrec 1 n . cpar n + FieldPattern cident pattern -> opar n . showString "FieldPattern" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 pattern . cpar n + PVVar cident -> opar n . showString "PVVar" . showChar ' ' . showsPrec 1 cident . cpar n + PVWild -> showString "PVWild" + ELet letdefs exp -> opar n . showString "ELet" . showChar ' ' . showsPrec 1 letdefs . showChar ' ' . showsPrec 1 exp . cpar n + ECase exp cases -> opar n . showString "ECase" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 cases . cpar n + EAbs patternvariable exp -> opar n . showString "EAbs" . showChar ' ' . showsPrec 1 patternvariable . showChar ' ' . showsPrec 1 exp . cpar n + EPi patternvariable exp0 exp1 -> opar n . showString "EPi" . showChar ' ' . showsPrec 1 patternvariable . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EApp exp0 exp1 -> opar n . showString "EApp" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EProj exp cident -> opar n . showString "EProj" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 cident . cpar n + ERecType fieldtypes -> opar n . showString "ERecType" . showChar ' ' . showsPrec 1 fieldtypes . cpar n + ERec fieldvalues -> opar n . showString "ERec" . showChar ' ' . showsPrec 1 fieldvalues . cpar n + EVar cident -> opar n . showString "EVar" . showChar ' ' . showsPrec 1 cident . cpar n + EType -> showString "EType" + EStr str -> opar n . showString "EStr" . showChar ' ' . showsPrec 1 str . cpar n + EInteger n -> opar n . showString "EInteger" . showChar ' ' . showsPrec 1 n . cpar n + EDouble d -> opar n . showString "EDouble" . showChar ' ' . showsPrec 1 d . cpar n + EMeta tmeta -> opar n . showString "EMeta" . showChar ' ' . showsPrec 1 tmeta . cpar n + LetDef cident exp -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n + Case pattern exp0 exp1 -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + FieldType cident exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n + FieldValue cident exp -> opar n . showString "FieldValue" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n + TMeta str -> opar n . showString "TMeta" . showChar ' ' . showsPrec 1 str . cpar n + CIdent str -> opar n . showString "CIdent" . showChar ' ' . showsPrec 1 str . cpar n + where opar n = if n > 0 then showChar '(' else id + cpar n = if n > 0 then showChar ')' else id + +instance Eq (Tree c) where (==) = johnMajorEq + +johnMajorEq :: Tree a -> Tree b -> Bool +johnMajorEq (Module decls) (Module decls_) = decls == decls_ +johnMajorEq (DataDecl cident exp consdecls) (DataDecl cident_ exp_ consdecls_) = cident == cident_ && exp == exp_ && consdecls == consdecls_ +johnMajorEq (TypeDecl cident exp) (TypeDecl cident_ exp_) = cident == cident_ && exp == exp_ +johnMajorEq (ValueDecl cident exp) (ValueDecl cident_ exp_) = cident == cident_ && exp == exp_ +johnMajorEq (ConsDecl cident exp) (ConsDecl cident_ exp_) = cident == cident_ && exp == exp_ +johnMajorEq (PCons cident patterns) (PCons cident_ patterns_) = cident == cident_ && patterns == patterns_ +johnMajorEq (PVar patternvariable) (PVar patternvariable_) = patternvariable == patternvariable_ +johnMajorEq (PRec fieldpatterns) (PRec fieldpatterns_) = fieldpatterns == fieldpatterns_ +johnMajorEq (PStr str) (PStr str_) = str == str_ +johnMajorEq (PInt n) (PInt n_) = n == n_ +johnMajorEq (FieldPattern cident pattern) (FieldPattern cident_ pattern_) = cident == cident_ && pattern == pattern_ +johnMajorEq (PVVar cident) (PVVar cident_) = cident == cident_ +johnMajorEq PVWild PVWild = True +johnMajorEq (ELet letdefs exp) (ELet letdefs_ exp_) = letdefs == letdefs_ && exp == exp_ +johnMajorEq (ECase exp cases) (ECase exp_ cases_) = exp == exp_ && cases == cases_ +johnMajorEq (EAbs patternvariable exp) (EAbs patternvariable_ exp_) = patternvariable == patternvariable_ && exp == exp_ +johnMajorEq (EPi patternvariable exp0 exp1) (EPi patternvariable_ exp0_ exp1_) = patternvariable == patternvariable_ && exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EApp exp0 exp1) (EApp exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EProj exp cident) (EProj exp_ cident_) = exp == exp_ && cident == cident_ +johnMajorEq (ERecType fieldtypes) (ERecType fieldtypes_) = fieldtypes == fieldtypes_ +johnMajorEq (ERec fieldvalues) (ERec fieldvalues_) = fieldvalues == fieldvalues_ +johnMajorEq (EVar cident) (EVar cident_) = cident == cident_ +johnMajorEq EType EType = True +johnMajorEq (EStr str) (EStr str_) = str == str_ +johnMajorEq (EInteger n) (EInteger n_) = n == n_ +johnMajorEq (EDouble d) (EDouble d_) = d == d_ +johnMajorEq (EMeta tmeta) (EMeta tmeta_) = tmeta == tmeta_ +johnMajorEq (LetDef cident exp) (LetDef cident_ exp_) = cident == cident_ && exp == exp_ +johnMajorEq (Case pattern exp0 exp1) (Case pattern_ exp0_ exp1_) = pattern == pattern_ && exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (FieldType cident exp) (FieldType cident_ exp_) = cident == cident_ && exp == exp_ +johnMajorEq (FieldValue cident exp) (FieldValue cident_ exp_) = cident == cident_ && exp == exp_ +johnMajorEq (TMeta str) (TMeta str_) = str == str_ +johnMajorEq (CIdent str) (CIdent str_) = str == str_ +johnMajorEq _ _ = False + +instance Ord (Tree c) where + compare x y = compare (index x) (index y) `mappend` compareSame x y +index :: Tree c -> Int +index (Module _) = 0 +index (DataDecl _ _ _) = 1 +index (TypeDecl _ _) = 2 +index (ValueDecl _ _) = 3 +index (ConsDecl _ _) = 4 +index (PCons _ _) = 5 +index (PVar _) = 6 +index (PRec _) = 7 +index (PStr _) = 8 +index (PInt _) = 9 +index (FieldPattern _ _) = 10 +index (PVVar _) = 11 +index (PVWild ) = 12 +index (ELet _ _) = 13 +index (ECase _ _) = 14 +index (EAbs _ _) = 15 +index (EPi _ _ _) = 16 +index (EApp _ _) = 17 +index (EProj _ _) = 18 +index (ERecType _) = 19 +index (ERec _) = 20 +index (EVar _) = 21 +index (EType ) = 22 +index (EStr _) = 23 +index (EInteger _) = 24 +index (EDouble _) = 25 +index (EMeta _) = 26 +index (LetDef _ _) = 27 +index (Case _ _ _) = 28 +index (FieldType _ _) = 29 +index (FieldValue _ _) = 30 +index (TMeta _) = 31 +index (CIdent _) = 32 +compareSame :: Tree c -> Tree c -> Ordering +compareSame (Module decls) (Module decls_) = compare decls decls_ +compareSame (DataDecl cident exp consdecls) (DataDecl cident_ exp_ consdecls_) = mappend (compare cident cident_) (mappend (compare exp exp_) (compare consdecls consdecls_)) +compareSame (TypeDecl cident exp) (TypeDecl cident_ exp_) = mappend (compare cident cident_) (compare exp exp_) +compareSame (ValueDecl cident exp) (ValueDecl cident_ exp_) = mappend (compare cident cident_) (compare exp exp_) +compareSame (ConsDecl cident exp) (ConsDecl cident_ exp_) = mappend (compare cident cident_) (compare exp exp_) +compareSame (PCons cident patterns) (PCons cident_ patterns_) = mappend (compare cident cident_) (compare patterns patterns_) +compareSame (PVar patternvariable) (PVar patternvariable_) = compare patternvariable patternvariable_ +compareSame (PRec fieldpatterns) (PRec fieldpatterns_) = compare fieldpatterns fieldpatterns_ +compareSame (PStr str) (PStr str_) = compare str str_ +compareSame (PInt n) (PInt n_) = compare n n_ +compareSame (FieldPattern cident pattern) (FieldPattern cident_ pattern_) = mappend (compare cident cident_) (compare pattern pattern_) +compareSame (PVVar cident) (PVVar cident_) = compare cident cident_ +compareSame PVWild PVWild = EQ +compareSame (ELet letdefs exp) (ELet letdefs_ exp_) = mappend (compare letdefs letdefs_) (compare exp exp_) +compareSame (ECase exp cases) (ECase exp_ cases_) = mappend (compare exp exp_) (compare cases cases_) +compareSame (EAbs patternvariable exp) (EAbs patternvariable_ exp_) = mappend (compare patternvariable patternvariable_) (compare exp exp_) +compareSame (EPi patternvariable exp0 exp1) (EPi patternvariable_ exp0_ exp1_) = mappend (compare patternvariable patternvariable_) (mappend (compare exp0 exp0_) (compare exp1 exp1_)) +compareSame (EApp exp0 exp1) (EApp exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EProj exp cident) (EProj exp_ cident_) = mappend (compare exp exp_) (compare cident cident_) +compareSame (ERecType fieldtypes) (ERecType fieldtypes_) = compare fieldtypes fieldtypes_ +compareSame (ERec fieldvalues) (ERec fieldvalues_) = compare fieldvalues fieldvalues_ +compareSame (EVar cident) (EVar cident_) = compare cident cident_ +compareSame EType EType = EQ +compareSame (EStr str) (EStr str_) = compare str str_ +compareSame (EInteger n) (EInteger n_) = compare n n_ +compareSame (EDouble d) (EDouble d_) = compare d d_ +compareSame (EMeta tmeta) (EMeta tmeta_) = compare tmeta tmeta_ +compareSame (LetDef cident exp) (LetDef cident_ exp_) = mappend (compare cident cident_) (compare exp exp_) +compareSame (Case pattern exp0 exp1) (Case pattern_ exp0_ exp1_) = mappend (compare pattern pattern_) (mappend (compare exp0 exp0_) (compare exp1 exp1_)) +compareSame (FieldType cident exp) (FieldType cident_ exp_) = mappend (compare cident cident_) (compare exp exp_) +compareSame (FieldValue cident exp) (FieldValue cident_ exp_) = mappend (compare cident cident_) (compare exp exp_) +compareSame (TMeta str) (TMeta str_) = compare str str_ +compareSame (CIdent str) (CIdent str_) = compare str str_ +compareSame x y = error "BNFC error:" compareSame diff --git a/src/Transfer/Core/Core.cf b/src/Transfer/Core/Core.cf new file mode 100644 index 000000000..cd4c20569 --- /dev/null +++ b/src/Transfer/Core/Core.cf @@ -0,0 +1,93 @@ +-- This is a subset of the front-end language + +entrypoints Module, Exp ; + +comment "--" ; +comment "{-" "-}" ; + +Module. Module ::= [Decl] ; +separator Decl ";" ; + +DataDecl. Decl ::= "data" CIdent ":" Exp "where" "{" [ConsDecl] "}" ; +TypeDecl. Decl ::= CIdent ":" Exp ; +ValueDecl. Decl ::= CIdent "=" Exp ; + +ConsDecl. ConsDecl ::= CIdent ":" Exp ; +separator ConsDecl ";" ; + +separator Pattern ""; + +-- Constructor patterns. +PCons. Pattern ::= "(" CIdent [Pattern] ")" ; + +-- Variable patterns. Note that in the core language, +-- constructor patterns must have parantheses. +PVar. Pattern ::= PatternVariable ; +-- Record patterns. +PRec. Pattern ::= "rec" "{" [FieldPattern] "}"; +-- String literal patterns. +PStr. Pattern ::= String ; +-- Integer literal patterns. +PInt. Pattern ::= Integer ; + +FieldPattern. FieldPattern ::= CIdent "=" Pattern ; +separator FieldPattern ";" ; + +-- Variable patterns +PVVar. PatternVariable ::= CIdent ; +-- Wild card patterns +PVWild. PatternVariable ::= "_" ; + +-- Let expressions. +ELet. Exp ::= "let" "{" [LetDef] "}" "in" Exp ; +LetDef. LetDef ::= CIdent "=" Exp ; +separator LetDef ";" ; + +-- Case expressions. +ECase. Exp ::= "case" Exp "of" "{" [Case] "}" ; +Case. Case ::= Pattern "|" Exp "->" Exp ; +separator Case ";" ; + +-- Lambda abstractions. +EAbs. Exp1 ::= "\\" PatternVariable "->" Exp ; +-- Function types. +EPi. Exp1 ::= "(" PatternVariable ":" Exp ")" "->" Exp ; + +-- Function application. +EApp. Exp3 ::= Exp3 Exp4 ; + +-- Record field projection. +EProj. Exp4 ::= Exp4 "." CIdent ; + +-- Record types. +ERecType. Exp5 ::= "sig" "{" [FieldType] "}" ; +FieldType. FieldType ::= CIdent ":" Exp ; +separator FieldType ";" ; + +-- Record expressions. +ERec. Exp5 ::= "rec" "{" [FieldValue] "}" ; +FieldValue.FieldValue ::= CIdent "=" Exp ; +separator FieldValue ";" ; + + +-- Functions, constructors and local variables. +EVar. Exp5 ::= CIdent ; +-- The constant Type. +EType. Exp5 ::= "Type" ; +-- String literal expressions. +EStr. Exp5 ::= String ; +-- Integer literal expressions. +EInteger. Exp5 ::= Integer ; +-- Double literal expressions. +EDouble. Exp5 ::= Double ; +-- Meta variables +EMeta. Exp5 ::= TMeta ; + +token TMeta ('?' digit+) ; + +coercions Exp 5 ; + + +-- Identifiers in core can start with underscore to allow +-- generating unique identifiers easily. +token CIdent ((letter | '_') (letter | digit | '_' | '\'')*) ; diff --git a/src/Transfer/Core/Doc.tex b/src/Transfer/Core/Doc.tex new file mode 100644 index 000000000..4ba6f93ed --- /dev/null +++ b/src/Transfer/Core/Doc.tex @@ -0,0 +1,215 @@ +\batchmode +%This Latex file is machine-generated by the BNF-converter + +\documentclass[a4paper,11pt]{article} +\author{BNF-converter} +\title{The Language Core} +\setlength{\parindent}{0mm} +\setlength{\parskip}{1mm} +\begin{document} + +\maketitle + +\newcommand{\emptyP}{\mbox{$\epsilon$}} +\newcommand{\terminal}[1]{\mbox{{\texttt {#1}}}} +\newcommand{\nonterminal}[1]{\mbox{$\langle \mbox{{\sl #1 }} \! \rangle$}} +\newcommand{\arrow}{\mbox{::=}} +\newcommand{\delimit}{\mbox{$|$}} +\newcommand{\reserved}[1]{\mbox{{\texttt {#1}}}} +\newcommand{\literal}[1]{\mbox{{\texttt {#1}}}} +\newcommand{\symb}[1]{\mbox{{\texttt {#1}}}} + +This document was automatically generated by the {\em BNF-Converter}. It was generated together with the lexer, the parser, and the abstract syntax module, which guarantees that the document matches with the implementation of the language (provided no hand-hacking has taken place). + +\section*{The lexical structure of Core} + +\subsection*{Literals} +String literals \nonterminal{String}\ have the form +\terminal{"}$x$\terminal{"}, where $x$ is any sequence of any characters +except \terminal{"}\ unless preceded by \verb6\6. + + +Integer literals \nonterminal{Int}\ are nonempty sequences of digits. + + +Double-precision float literals \nonterminal{Double}\ have the structure +indicated by the regular expression $\nonterminal{digit}+ \mbox{{\it `.'}} \nonterminal{digit}+ (\mbox{{\it `e'}} \mbox{{\it `-'}}? \nonterminal{digit}+)?$ i.e.\ +two sequences of digits separated by a decimal point, optionally +followed by an unsigned or negative exponent. + + + + + +TMeta literals are recognized by the regular expression +\(\mbox{`?'} {\nonterminal{digit}}+\) + +CIdent literals are recognized by the regular expression +\(({\nonterminal{letter}} \mid \mbox{`\_'}) ({\nonterminal{letter}} \mid {\nonterminal{digit}} \mid \mbox{`\_'} \mid \mbox{`''})*\) + + +\subsection*{Reserved words and symbols} +The set of reserved words is the set of terminals appearing in the grammar. Those reserved words that consist of non-letter characters are called symbols, and they are treated in a different way from those that are similar to identifiers. The lexer follows rules familiar from languages like Haskell, C, and Java, including longest match and spacing conventions. + +The reserved words used in Core are the following: \\ + +\begin{tabular}{lll} +{\reserved{Type}} &{\reserved{case}} &{\reserved{data}} \\ +{\reserved{in}} &{\reserved{let}} &{\reserved{of}} \\ +{\reserved{rec}} &{\reserved{sig}} &{\reserved{where}} \\ +\end{tabular}\\ + +The symbols used in Core are the following: \\ + +\begin{tabular}{lll} +{\symb{;}} &{\symb{:}} &{\symb{\{}} \\ +{\symb{\}}} &{\symb{{$=$}}} &{\symb{(}} \\ +{\symb{)}} &{\symb{\_}} &{\symb{{$|$}}} \\ +{\symb{{$-$}{$>$}}} &{\symb{$\backslash$}} &{\symb{.}} \\ +\end{tabular}\\ + +\subsection*{Comments} +Single-line comments begin with {\symb{{$-$}{$-$}}}. \\Multiple-line comments are enclosed with {\symb{\{{$-$}}} and {\symb{{$-$}\}}}. + +\section*{The syntactic structure of Core} +Non-terminals are enclosed between $\langle$ and $\rangle$. +The symbols {\arrow} (production), {\delimit} (union) +and {\emptyP} (empty rule) belong to the BNF notation. +All other symbols are terminals.\\ + +\begin{tabular}{lll} +{\nonterminal{Module}} & {\arrow} &{\nonterminal{ListDecl}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListDecl}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{Decl}} \\ + & {\delimit} &{\nonterminal{Decl}} {\terminal{;}} {\nonterminal{ListDecl}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Decl}} & {\arrow} &{\terminal{data}} {\nonterminal{CIdent}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{where}} {\terminal{\{}} {\nonterminal{ListConsDecl}} {\terminal{\}}} \\ + & {\delimit} &{\nonterminal{CIdent}} {\terminal{:}} {\nonterminal{Exp}} \\ + & {\delimit} &{\nonterminal{CIdent}} {\terminal{{$=$}}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ConsDecl}} & {\arrow} &{\nonterminal{CIdent}} {\terminal{:}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListConsDecl}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{ConsDecl}} \\ + & {\delimit} &{\nonterminal{ConsDecl}} {\terminal{;}} {\nonterminal{ListConsDecl}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListPattern}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{Pattern}} {\nonterminal{ListPattern}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Pattern}} & {\arrow} &{\terminal{(}} {\nonterminal{CIdent}} {\nonterminal{ListPattern}} {\terminal{)}} \\ + & {\delimit} &{\nonterminal{PatternVariable}} \\ + & {\delimit} &{\terminal{rec}} {\terminal{\{}} {\nonterminal{ListFieldPattern}} {\terminal{\}}} \\ + & {\delimit} &{\nonterminal{String}} \\ + & {\delimit} &{\nonterminal{Integer}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{FieldPattern}} & {\arrow} &{\nonterminal{CIdent}} {\terminal{{$=$}}} {\nonterminal{Pattern}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListFieldPattern}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{FieldPattern}} \\ + & {\delimit} &{\nonterminal{FieldPattern}} {\terminal{;}} {\nonterminal{ListFieldPattern}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{PatternVariable}} & {\arrow} &{\nonterminal{CIdent}} \\ + & {\delimit} &{\terminal{\_}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp}} & {\arrow} &{\terminal{let}} {\terminal{\{}} {\nonterminal{ListLetDef}} {\terminal{\}}} {\terminal{in}} {\nonterminal{Exp}} \\ + & {\delimit} &{\terminal{case}} {\nonterminal{Exp}} {\terminal{of}} {\terminal{\{}} {\nonterminal{ListCase}} {\terminal{\}}} \\ + & {\delimit} &{\nonterminal{Exp1}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{LetDef}} & {\arrow} &{\nonterminal{CIdent}} {\terminal{{$=$}}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListLetDef}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{LetDef}} \\ + & {\delimit} &{\nonterminal{LetDef}} {\terminal{;}} {\nonterminal{ListLetDef}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Case}} & {\arrow} &{\nonterminal{Pattern}} {\terminal{{$|$}}} {\nonterminal{Exp}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListCase}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{Case}} \\ + & {\delimit} &{\nonterminal{Case}} {\terminal{;}} {\nonterminal{ListCase}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp1}} & {\arrow} &{\terminal{$\backslash$}} {\nonterminal{PatternVariable}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\ + & {\delimit} &{\terminal{(}} {\nonterminal{PatternVariable}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{)}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\ + & {\delimit} &{\nonterminal{Exp2}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp3}} & {\arrow} &{\nonterminal{Exp3}} {\nonterminal{Exp4}} \\ + & {\delimit} &{\nonterminal{Exp4}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp4}} & {\arrow} &{\nonterminal{Exp4}} {\terminal{.}} {\nonterminal{CIdent}} \\ + & {\delimit} &{\nonterminal{Exp5}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp5}} & {\arrow} &{\terminal{sig}} {\terminal{\{}} {\nonterminal{ListFieldType}} {\terminal{\}}} \\ + & {\delimit} &{\terminal{rec}} {\terminal{\{}} {\nonterminal{ListFieldValue}} {\terminal{\}}} \\ + & {\delimit} &{\nonterminal{CIdent}} \\ + & {\delimit} &{\terminal{Type}} \\ + & {\delimit} &{\nonterminal{String}} \\ + & {\delimit} &{\nonterminal{Integer}} \\ + & {\delimit} &{\nonterminal{Double}} \\ + & {\delimit} &{\nonterminal{TMeta}} \\ + & {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{FieldType}} & {\arrow} &{\nonterminal{CIdent}} {\terminal{:}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListFieldType}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{FieldType}} \\ + & {\delimit} &{\nonterminal{FieldType}} {\terminal{;}} {\nonterminal{ListFieldType}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{FieldValue}} & {\arrow} &{\nonterminal{CIdent}} {\terminal{{$=$}}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListFieldValue}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{FieldValue}} \\ + & {\delimit} &{\nonterminal{FieldValue}} {\terminal{;}} {\nonterminal{ListFieldValue}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp2}} & {\arrow} &{\nonterminal{Exp3}} \\ +\end{tabular}\\ + + + +\end{document} + diff --git a/src/Transfer/Core/Lex.hs b/src/Transfer/Core/Lex.hs new file mode 100644 index 000000000..be1198508 --- /dev/null +++ b/src/Transfer/Core/Lex.hs @@ -0,0 +1,343 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +{-# LINE 3 "Transfer/Core/Lex.x" #-} +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module Transfer.Core.Lex where + + + +#if __GLASGOW_HASKELL__ >= 603 +#include "ghcconfig.h" +#else +#include "config.h" +#endif +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +import Data.Char (ord) +import Data.Array.Base (unsafeAt) +#else +import Array +import Char (ord) +#endif +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif +alex_base :: AlexAddr +alex_base = AlexA# "\x01\x00\x00\x00\x15\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x18\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x45\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x33\x00\x00\x00\xe7\x00\x00\x00\x6c\x01\x00\x00\x3c\x02\x00\x00\x00\x00\x00\x00\x17\x01\x00\x00\xd5\x00\x00\x00\xf4\x00\x00\x00\xb7\x01\x00\x00\x1a\x01\x00\x00\xc1\x01\x00\x00\xcb\x01\x00\x00\xd8\x01\x00\x00"# + +alex_table :: AlexAddr +alex_table = AlexA# "\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\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\x0d\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\x0e\x00\xff\xff\xff\xff\xff\xff\x05\x00\x0e\x00\xff\xff\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x0e\x00\x0e\x00\xff\xff\x0e\x00\xff\xff\x11\x00\xff\xff\x04\x00\xff\xff\xff\xff\x03\x00\x03\x00\x09\x00\x09\x00\x09\x00\x0b\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x0e\x00\xff\xff\xff\xff\x0f\x00\xff\xff\x0d\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0e\x00\x0e\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\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\x06\x00\x07\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x15\x00\xff\xff\x00\x00\x00\x00\x12\x00\x15\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\x10\x00\xff\xff\x1a\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x16\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x1b\x00\x00\x00\x00\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x00\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x13\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x00\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x00\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00"# + +alex_check :: AlexAddr +alex_check = AlexA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\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\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x2d\x00\x0a\x00\x0a\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x20\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x7d\x00\x7d\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xd7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\x22\x00\xf7\x00\xff\xff\xff\xff\x5f\x00\x27\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x0a\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x5c\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\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\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\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\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\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00"# + +alex_deflt :: AlexAddr +alex_deflt = AlexA# "\x13\x00\xff\xff\x02\x00\x02\x00\xff\xff\xff\xff\x0a\x00\xff\xff\x0a\x00\x0a\x00\x0a\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_accept = listArray (0::Int,28) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_7))],[],[],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_9))],[],[],[]] +{-# LINE 36 "Transfer/Core/Lex.x" #-} + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + | T_TMeta !String + | T_CIdent !String + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" + +posLineCol (Pn _ l c) = (l,c) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken t = case t of + PT _ (TS s) -> s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + PT _ (T_TMeta s) -> s + PT _ (T_CIdent s) -> s + + _ -> show t + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords = b "let" (b "data" (b "case" (b "Type" N N) N) (b "in" N N)) (b "sig" (b "rec" (b "of" N N) N) (b "where" N N)) + where b s = B s (TS s) + +unescapeInitTail :: String -> String +unescapeInitTail = unesc . tail where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type AlexInput = (Posn, -- current position, + Char, -- previous char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', str) + where + go :: (Posn, Char, String) -> [Token] + go inp@(pos, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _) -> fail $ show pos ++ ": lexical error" + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p, c, []) = Nothing +alexGetChar (p, _, (c:s)) = + let p' = alexMove p c + in p' `seq` Just (c, (p', c, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, s) = c + +alex_action_3 = tok (\p s -> PT p (TS $ share s)) +alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_TMeta . share) s)) +alex_action_5 = tok (\p s -> PT p (eitherResIdent (T_CIdent . share) s)) +alex_action_6 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_7 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) +alex_action_8 = tok (\p s -> PT p (TI $ share s)) +alex_action_9 = tok (\p s -> PT p (TD $ share s)) +{-# LINE 1 "GenericTemplate.hs" #-} +{-# LINE 1 "<built-in>" #-} +{-# LINE 1 "<command line>" #-} +{-# LINE 1 "GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + +{-# LINE 35 "GenericTemplate.hs" #-} + +{-# LINE 45 "GenericTemplate.hs" #-} + + +data AlexAddr = AlexA# Addr# + +#if __GLASGOW_HASKELL__ < 503 +uncheckedShiftL# = shiftL# +#endif + +{-# INLINE alexIndexInt16OffAddr #-} +alexIndexInt16OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow16Int# i + where + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# +#else + indexInt16OffAddr# arr off +#endif + + + + + +{-# INLINE alexIndexInt32OffAddr #-} +alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow32Int# i + where + i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + (b2 `uncheckedShiftL#` 16#) `or#` + (b1 `uncheckedShiftL#` 8#) `or#` b0) + b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) + b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) + b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + b0 = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 4# +#else + indexInt32OffAddr# arr off +#endif + + + + + +#if __GLASGOW_HASKELL__ < 503 +quickIndex arr i = arr ! i +#else +-- GHC >= 503, unsafeAt is available from Data.Array.Base. +quickIndex = unsafeAt +#endif + + + + +-- ----------------------------------------------------------------------------- +-- Main lexing routines + +data AlexReturn a + = AlexEOF + | AlexError !AlexInput + | AlexSkip !AlexInput !Int + | AlexToken !AlexInput !Int a + +-- alexScan :: AlexInput -> StartCode -> Maybe (AlexInput,Int,act) +alexScan input (I# (sc)) + = alexScanUser undefined input (I# (sc)) + +alexScanUser user input (I# (sc)) + = case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, input') -> + case alexGetChar input of + Nothing -> + + + + AlexEOF + Just _ -> + + + + AlexError input' + + (AlexLastSkip input len, _) -> + + + + AlexSkip input len + + (AlexLastAcc k input len, _) -> + + + + AlexToken input len k + + +-- Push the input through the DFA, remembering the most recent accepting +-- state it encountered. + +alex_scan_tkn user orig_input len input s last_acc = + input `seq` -- strict in the input + case s of + -1# -> (last_acc, input) + _ -> alex_scan_tkn' user orig_input len input s last_acc + +alex_scan_tkn' user orig_input len input s last_acc = + let + new_acc = check_accs (alex_accept `quickIndex` (I# (s))) + in + new_acc `seq` + case alexGetChar input of + Nothing -> (new_acc, input) + Just (c, new_input) -> + + + + let + base = alexIndexInt32OffAddr alex_base s + (I# (ord_c)) = ord c + offset = (base +# ord_c) + check = alexIndexInt16OffAddr alex_check offset + + new_s = if (offset >=# 0#) && (check ==# ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + in + alex_scan_tkn user orig_input (len +# 1#) new_input new_s new_acc + + where + check_accs [] = last_acc + check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) + check_accs (AlexAccPred a pred : rest) + | pred user orig_input (I# (len)) input + = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkipPred pred : rest) + | pred user orig_input (I# (len)) input + = AlexLastSkip input (I# (len)) + check_accs (_ : rest) = check_accs rest + +data AlexLastAcc a + = AlexNone + | AlexLastAcc a !AlexInput !Int + | AlexLastSkip !AlexInput !Int + +data AlexAcc a user + = AlexAcc a + | AlexAccSkip + | AlexAccPred a (AlexAccPred user) + | AlexAccSkipPred (AlexAccPred user) + +type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool + +-- ----------------------------------------------------------------------------- +-- Predicates on a rule + +alexAndPred p1 p2 user in1 len in2 + = p1 user in1 len in2 && p2 user in1 len in2 + +--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input + +--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input + +--alexRightContext :: Int -> AlexAccPred _ +alexRightContext (I# (sc)) user _ _ input = + case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, _) -> False + _ -> True + -- TODO: there's no need to find the longest + -- match when checking the right context, just + -- the first match will do. + +-- used by wrappers +iUnbox (I# (i)) = i diff --git a/src/Transfer/Core/Lex.x b/src/Transfer/Core/Lex.x new file mode 100644 index 000000000..480f366ae --- /dev/null +++ b/src/Transfer/Core/Lex.x @@ -0,0 +1,140 @@ +-- -*- haskell -*- +-- This Alex file was machine-generated by the BNF converter +{ +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module Transfer.Core.Lex where + + +} + + +$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME +$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME +$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME +$d = [0-9] -- digit +$i = [$l $d _ '] -- identifier character +$u = [\0-\255] -- universal: any character + +@rsyms = -- symbols and non-identifier-like reserved words + \; | \: | \{ | \} | \= | \( | \) | \_ | \| | \- \> | \\ | \. + +:- +"--" [.]* ; -- Toss single line comments +"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; + +$white+ ; +@rsyms { tok (\p s -> PT p (TS $ share s)) } +\? $d + { tok (\p s -> PT p (eitherResIdent (T_TMeta . share) s)) } +($l | \_)($l | $d | \_ | \')* { tok (\p s -> PT p (eitherResIdent (T_CIdent . share) s)) } + +$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) } +\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) } + +$d+ { tok (\p s -> PT p (TI $ share s)) } +$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) } + +{ + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + | T_TMeta !String + | T_CIdent !String + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" + +posLineCol (Pn _ l c) = (l,c) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken t = case t of + PT _ (TS s) -> s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + PT _ (T_TMeta s) -> s + PT _ (T_CIdent s) -> s + + _ -> show t + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords = b "let" (b "data" (b "case" (b "Type" N N) N) (b "in" N N)) (b "sig" (b "rec" (b "of" N N) N) (b "where" N N)) + where b s = B s (TS s) + +unescapeInitTail :: String -> String +unescapeInitTail = unesc . tail where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type AlexInput = (Posn, -- current position, + Char, -- previous char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', str) + where + go :: (Posn, Char, String) -> [Token] + go inp@(pos, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _) -> fail $ show pos ++ ": lexical error" + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p, c, []) = Nothing +alexGetChar (p, _, (c:s)) = + let p' = alexMove p c + in p' `seq` Just (c, (p', c, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, s) = c +} diff --git a/src/Transfer/Core/Par.hs b/src/Transfer/Core/Par.hs new file mode 100644 index 000000000..fec63662a --- /dev/null +++ b/src/Transfer/Core/Par.hs @@ -0,0 +1,1149 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module Transfer.Core.Par where +import Transfer.Core.Abs +import Transfer.Core.Lex +import Transfer.ErrM +import Array +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif + +-- parser produced by Happy Version 1.15 + +newtype HappyAbsSyn = HappyAbsSyn (() -> ()) +happyIn5 :: (String) -> (HappyAbsSyn ) +happyIn5 x = unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> (String) +happyOut5 x = unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: (Integer) -> (HappyAbsSyn ) +happyIn6 x = unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn ) -> (Integer) +happyOut6 x = unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: (Double) -> (HappyAbsSyn ) +happyIn7 x = unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> (Double) +happyOut7 x = unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: (TMeta) -> (HappyAbsSyn ) +happyIn8 x = unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> (TMeta) +happyOut8 x = unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: (CIdent) -> (HappyAbsSyn ) +happyIn9 x = unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> (CIdent) +happyOut9 x = unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: (Module) -> (HappyAbsSyn ) +happyIn10 x = unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> (Module) +happyOut10 x = unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: ([Decl]) -> (HappyAbsSyn ) +happyIn11 x = unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> ([Decl]) +happyOut11 x = unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: (Decl) -> (HappyAbsSyn ) +happyIn12 x = unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> (Decl) +happyOut12 x = unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyIn13 :: (ConsDecl) -> (HappyAbsSyn ) +happyIn13 x = unsafeCoerce# x +{-# INLINE happyIn13 #-} +happyOut13 :: (HappyAbsSyn ) -> (ConsDecl) +happyOut13 x = unsafeCoerce# x +{-# INLINE happyOut13 #-} +happyIn14 :: ([ConsDecl]) -> (HappyAbsSyn ) +happyIn14 x = unsafeCoerce# x +{-# INLINE happyIn14 #-} +happyOut14 :: (HappyAbsSyn ) -> ([ConsDecl]) +happyOut14 x = unsafeCoerce# x +{-# INLINE happyOut14 #-} +happyIn15 :: ([Pattern]) -> (HappyAbsSyn ) +happyIn15 x = unsafeCoerce# x +{-# INLINE happyIn15 #-} +happyOut15 :: (HappyAbsSyn ) -> ([Pattern]) +happyOut15 x = unsafeCoerce# x +{-# INLINE happyOut15 #-} +happyIn16 :: (Pattern) -> (HappyAbsSyn ) +happyIn16 x = unsafeCoerce# x +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn ) -> (Pattern) +happyOut16 x = unsafeCoerce# x +{-# INLINE happyOut16 #-} +happyIn17 :: (FieldPattern) -> (HappyAbsSyn ) +happyIn17 x = unsafeCoerce# x +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn ) -> (FieldPattern) +happyOut17 x = unsafeCoerce# x +{-# INLINE happyOut17 #-} +happyIn18 :: ([FieldPattern]) -> (HappyAbsSyn ) +happyIn18 x = unsafeCoerce# x +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn ) -> ([FieldPattern]) +happyOut18 x = unsafeCoerce# x +{-# INLINE happyOut18 #-} +happyIn19 :: (PatternVariable) -> (HappyAbsSyn ) +happyIn19 x = unsafeCoerce# x +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn ) -> (PatternVariable) +happyOut19 x = unsafeCoerce# x +{-# INLINE happyOut19 #-} +happyIn20 :: (Exp) -> (HappyAbsSyn ) +happyIn20 x = unsafeCoerce# x +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn ) -> (Exp) +happyOut20 x = unsafeCoerce# x +{-# INLINE happyOut20 #-} +happyIn21 :: (LetDef) -> (HappyAbsSyn ) +happyIn21 x = unsafeCoerce# x +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn ) -> (LetDef) +happyOut21 x = unsafeCoerce# x +{-# INLINE happyOut21 #-} +happyIn22 :: ([LetDef]) -> (HappyAbsSyn ) +happyIn22 x = unsafeCoerce# x +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn ) -> ([LetDef]) +happyOut22 x = unsafeCoerce# x +{-# INLINE happyOut22 #-} +happyIn23 :: (Case) -> (HappyAbsSyn ) +happyIn23 x = unsafeCoerce# x +{-# INLINE happyIn23 #-} +happyOut23 :: (HappyAbsSyn ) -> (Case) +happyOut23 x = unsafeCoerce# x +{-# INLINE happyOut23 #-} +happyIn24 :: ([Case]) -> (HappyAbsSyn ) +happyIn24 x = unsafeCoerce# x +{-# INLINE happyIn24 #-} +happyOut24 :: (HappyAbsSyn ) -> ([Case]) +happyOut24 x = unsafeCoerce# x +{-# INLINE happyOut24 #-} +happyIn25 :: (Exp) -> (HappyAbsSyn ) +happyIn25 x = unsafeCoerce# x +{-# INLINE happyIn25 #-} +happyOut25 :: (HappyAbsSyn ) -> (Exp) +happyOut25 x = unsafeCoerce# x +{-# INLINE happyOut25 #-} +happyIn26 :: (Exp) -> (HappyAbsSyn ) +happyIn26 x = unsafeCoerce# x +{-# INLINE happyIn26 #-} +happyOut26 :: (HappyAbsSyn ) -> (Exp) +happyOut26 x = unsafeCoerce# x +{-# INLINE happyOut26 #-} +happyIn27 :: (Exp) -> (HappyAbsSyn ) +happyIn27 x = unsafeCoerce# x +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn ) -> (Exp) +happyOut27 x = unsafeCoerce# x +{-# INLINE happyOut27 #-} +happyIn28 :: (Exp) -> (HappyAbsSyn ) +happyIn28 x = unsafeCoerce# x +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn ) -> (Exp) +happyOut28 x = unsafeCoerce# x +{-# INLINE happyOut28 #-} +happyIn29 :: (FieldType) -> (HappyAbsSyn ) +happyIn29 x = unsafeCoerce# x +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn ) -> (FieldType) +happyOut29 x = unsafeCoerce# x +{-# INLINE happyOut29 #-} +happyIn30 :: ([FieldType]) -> (HappyAbsSyn ) +happyIn30 x = unsafeCoerce# x +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn ) -> ([FieldType]) +happyOut30 x = unsafeCoerce# x +{-# INLINE happyOut30 #-} +happyIn31 :: (FieldValue) -> (HappyAbsSyn ) +happyIn31 x = unsafeCoerce# x +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn ) -> (FieldValue) +happyOut31 x = unsafeCoerce# x +{-# INLINE happyOut31 #-} +happyIn32 :: ([FieldValue]) -> (HappyAbsSyn ) +happyIn32 x = unsafeCoerce# x +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn ) -> ([FieldValue]) +happyOut32 x = unsafeCoerce# x +{-# INLINE happyOut32 #-} +happyIn33 :: (Exp) -> (HappyAbsSyn ) +happyIn33 x = unsafeCoerce# x +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn ) -> (Exp) +happyOut33 x = unsafeCoerce# x +{-# INLINE happyOut33 #-} +happyInTok :: Token -> (HappyAbsSyn ) +happyInTok x = unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> Token +happyOutTok x = unsafeCoerce# x +{-# INLINE happyOutTok #-} + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x15\x00\x5f\x01\xcd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x00\x00\x00\x7c\x01\xde\x00\x00\x00\x00\x00\x4a\x01\x09\x00\x00\x00\x5f\x01\xdf\x00\xd7\x00\xd6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\xbc\x00\x00\x00\xd1\x00\xc7\x00\xcf\x00\x15\x00\x5f\x01\x5f\x01\xc6\x00\xc6\x00\xc6\x00\xbe\x00\x00\x00\xc5\x00\x00\x00\x74\x01\xcb\x00\xc0\x00\xac\x00\xb9\x00\x5f\x01\x00\x00\x00\x00\x5f\x01\x5f\x01\xc1\x00\xb8\x00\xbb\x00\xb7\x00\xb5\x00\xb3\x00\xaf\x00\xb0\x00\xa9\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x5f\x01\x94\x00\x00\x00\x86\x00\x5f\x01\x00\x00\x86\x00\x5f\x01\x8f\x00\x84\x00\x5f\x01\x96\x01\x00\x00\x90\x00\x8b\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x8c\x00\x8a\x00\x7a\x00\x89\x00\x00\x00\x00\x00\x5f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x69\x00\x00\x00\x69\x00\x00\x00\x00\x00\x96\x01\x5f\x01\x5f\x01\x00\x00\x71\x00\x00\x00\x91\x01\x75\x00\x78\x00\x74\x00\x6d\x00\x65\x00\x5c\x00\x00\x00\x43\x00\x5f\x01\x00\x00\x43\x00\x96\x01\x00\x00\x00\x00\x5f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x4e\x00\x31\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x01\x00\x00\x00\x00\x00\x00\x01\x00\x04\x00\x00\x00\x14\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x00\x00\x6a\x00\x0b\x01\xee\x00\x28\x00\x44\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x31\x00\x00\x00\xe5\x00\x00\x00\x00\x00\xc8\x00\xbf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x00\x00\x00\x00\x02\x00\x99\x00\x00\x00\x1e\x00\x7c\x00\x00\x00\x03\x00\x73\x00\xb4\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x3e\x00\xff\xff\x00\x00\xae\x01\x4d\x00\x30\x00\x00\x00\x00\x00\x00\x00\xba\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x27\x00\x00\x00\x21\x00\x3e\x01\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\xf7\xff\x00\x00\x00\x00\xfd\xff\xca\xff\xc9\xff\xc8\xff\xc7\xff\xcc\xff\x00\x00\xde\xff\xbd\xff\xd1\xff\xcf\xff\xd3\xff\x00\x00\x00\x00\xcb\xff\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xff\xfb\xff\xfa\xff\xf9\xff\x00\x00\x00\x00\xf8\xff\xf6\xff\x00\x00\x00\x00\xf7\xff\x00\x00\x00\x00\xc4\xff\xc0\xff\xdc\xff\x00\x00\xe2\xff\x00\x00\xe1\xff\xe2\xff\x00\x00\x00\x00\x00\x00\xd2\xff\x00\x00\xd0\xff\xc6\xff\x00\x00\x00\x00\x00\x00\x00\x00\xdb\xff\x00\x00\x00\x00\xbf\xff\x00\x00\x00\x00\xc3\xff\x00\x00\xf2\xff\xf3\xff\xf5\xff\x00\x00\x00\x00\xce\xff\xc4\xff\x00\x00\xcd\xff\xc0\xff\x00\x00\x00\x00\xdc\xff\x00\x00\xd8\xff\xd5\xff\x00\x00\x00\x00\xe8\xff\xe7\xff\x00\x00\xea\xff\xd7\xff\x00\x00\x00\x00\x00\x00\xdd\xff\xda\xff\x00\x00\xc1\xff\xbe\xff\xc5\xff\xc2\xff\x00\x00\xf0\xff\xe0\xff\xe5\xff\xed\xff\xdf\xff\xd8\xff\x00\x00\x00\x00\xd4\xff\x00\x00\xd6\xff\x00\x00\x00\x00\xe4\xff\x00\x00\x00\x00\xef\xff\x00\x00\xf4\xff\xf0\xff\x00\x00\xe9\xff\xe5\xff\x00\x00\xec\xff\xeb\xff\x00\x00\xd9\xff\xe6\xff\xe3\xff\xf1\xff\xee\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x04\x00\x04\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x0e\x00\x0f\x00\x08\x00\x0e\x00\x10\x00\x11\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x18\x00\x19\x00\x04\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x04\x00\x1a\x00\x0f\x00\x04\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0c\x00\x0d\x00\x1a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x02\x00\x1a\x00\x1b\x00\x05\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x18\x00\x19\x00\x04\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x04\x00\x04\x00\x0c\x00\x0d\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x1a\x00\x1a\x00\x1b\x00\x04\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x01\x00\x10\x00\x11\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x04\x00\x02\x00\x06\x00\x07\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x01\x00\x05\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x1a\x00\x03\x00\x08\x00\x09\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x03\x00\x01\x00\x04\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x1a\x00\x0a\x00\x09\x00\x07\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x1a\x00\x10\x00\x1a\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x0f\x00\x15\x00\x01\x00\x08\x00\x09\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x02\x00\x04\x00\x01\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x05\x00\x04\x00\x01\x00\x05\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x03\x00\x0c\x00\x1a\x00\x07\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x02\x00\x0f\x00\x0a\x00\x12\x00\x02\x00\x01\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\x1c\x00\x03\x00\x03\x00\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\x1a\x00\x1a\x00\x03\x00\x16\x00\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x0c\x00\xff\xff\x1c\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x0f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x14\x00\x15\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x00\x00\x01\x00\x0f\x00\xff\xff\x04\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\x17\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\x1c\x00\x16\x00\x17\x00\x06\x00\xff\xff\x08\x00\xff\xff\xff\xff\x0b\x00\xff\xff\x0d\x00\x0e\x00\xff\xff\xff\xff\x11\x00\xff\xff\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\xff\xff\x0d\x00\x0e\x00\xff\xff\xff\xff\x11\x00\xff\xff\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x06\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\x14\x00\x0d\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x06\x00\x07\x00\x08\x00\xff\xff\xff\xff\x06\x00\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\x16\x00\x17\x00\x13\x00\xff\xff\x1a\x00\x16\x00\x17\x00\x00\x00\x01\x00\x1a\x00\xff\xff\x04\x00\xff\xff\x00\x00\x01\x00\xff\xff\xff\xff\x04\x00\x0b\x00\x00\x00\x01\x00\x0e\x00\xff\xff\x04\x00\x0b\x00\x12\x00\x13\x00\x0e\x00\xff\xff\xff\xff\x0b\x00\x12\x00\x13\x00\x0e\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"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x2a\x00\x3b\x00\x35\x00\x27\x00\x6b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x2b\x00\x2c\x00\x2a\x00\x28\x00\x36\x00\x59\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7b\x00\x3c\x00\x5e\x00\x63\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x38\x00\x1a\x00\x1f\x00\x6c\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x3b\x00\x6d\x00\x7d\x00\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x30\x00\x7e\x00\x22\x00\x39\x00\x5c\x00\x23\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x68\x00\x3c\x00\x3d\x00\x6c\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x38\x00\x1f\x00\x6d\x00\x6e\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x35\x00\x69\x00\x1a\x00\x39\x00\x3a\x00\x73\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x61\x00\x74\x00\x36\x00\x37\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x1a\x00\x75\x00\x40\x00\x1d\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x76\x00\x77\x00\x78\x00\x7b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x6f\x00\x58\x00\x1a\x00\x61\x00\x70\x00\x7f\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x5b\x00\x63\x00\x66\x00\x65\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x1a\x00\x68\x00\x67\x00\x50\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1a\x00\x5b\x00\x1a\x00\x44\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x6f\x00\x5d\x00\x60\x00\x45\x00\x70\x00\x71\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x42\x00\x46\x00\x47\x00\x48\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x4d\x00\x2e\x00\x1a\x00\x32\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x33\x00\x4d\x00\x34\x00\x35\x00\x42\x00\x21\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x4e\x00\xff\xff\x24\x00\x25\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x1a\x00\x1a\x00\x26\x00\x04\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x2e\x00\x00\x00\xff\xff\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x26\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x50\x00\x51\x00\x09\x00\x00\x00\x27\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7c\x00\x00\x00\x00\x00\x53\x00\x0e\x00\x2e\x00\x0d\x00\x10\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x11\x00\x00\x00\x12\x00\x13\x00\x00\x00\x00\x00\x14\x00\x00\x00\x15\x00\x16\x00\x00\x00\x04\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x12\x00\x13\x00\x00\x00\x00\x00\x14\x00\x00\x00\x15\x00\x16\x00\x00\x00\x04\x00\x17\x00\x18\x00\x19\x00\x1a\x00\xcc\xff\xcc\xff\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xff\xcc\xff\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xff\xcc\xff\x12\x00\xcc\xff\xcc\xff\xcc\xff\xcc\xff\xcc\xff\x15\x00\x16\x00\x00\x00\x04\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x57\x00\x7a\x00\x2a\x00\x00\x00\x00\x00\x57\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x04\x00\x17\x00\x58\x00\x00\x00\x1a\x00\x04\x00\x17\x00\x50\x00\x51\x00\x1a\x00\x00\x00\x27\x00\x00\x00\x50\x00\x51\x00\x00\x00\x00\x00\x27\x00\x52\x00\x50\x00\x51\x00\x53\x00\x00\x00\x27\x00\x52\x00\x54\x00\x6a\x00\x53\x00\x00\x00\x00\x00\x78\x00\x54\x00\x55\x00\x53\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (2, 66) [ + (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) + ] + +happy_n_terms = 29 :: Int +happy_n_nonterms = 29 :: Int + +happyReduce_2 = happySpecReduce_1 0# happyReduction_2 +happyReduction_2 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> + happyIn5 + (happy_var_1 + )} + +happyReduce_3 = happySpecReduce_1 1# happyReduction_3 +happyReduction_3 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> + happyIn6 + ((read happy_var_1) :: Integer + )} + +happyReduce_4 = happySpecReduce_1 2# happyReduction_4 +happyReduction_4 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> + happyIn7 + ((read happy_var_1) :: Double + )} + +happyReduce_5 = happySpecReduce_1 3# happyReduction_5 +happyReduction_5 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (T_TMeta happy_var_1)) -> + happyIn8 + (TMeta (happy_var_1) + )} + +happyReduce_6 = happySpecReduce_1 4# happyReduction_6 +happyReduction_6 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (T_CIdent happy_var_1)) -> + happyIn9 + (CIdent (happy_var_1) + )} + +happyReduce_7 = happySpecReduce_1 5# happyReduction_7 +happyReduction_7 happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn10 + (Module happy_var_1 + )} + +happyReduce_8 = happySpecReduce_0 6# happyReduction_8 +happyReduction_8 = happyIn11 + ([] + ) + +happyReduce_9 = happySpecReduce_1 6# happyReduction_9 +happyReduction_9 happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn11 + ((:[]) happy_var_1 + )} + +happyReduce_10 = happySpecReduce_3 6# happyReduction_10 +happyReduction_10 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + case happyOut11 happy_x_3 of { happy_var_3 -> + happyIn11 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_11 = happyReduce 8# 7# happyReduction_11 +happyReduction_11 (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 happyOut9 happy_x_2 of { happy_var_2 -> + case happyOut20 happy_x_4 of { happy_var_4 -> + case happyOut14 happy_x_7 of { happy_var_7 -> + happyIn12 + (DataDecl happy_var_2 happy_var_4 happy_var_7 + ) `HappyStk` happyRest}}} + +happyReduce_12 = happySpecReduce_3 7# happyReduction_12 +happyReduction_12 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_3 of { happy_var_3 -> + happyIn12 + (TypeDecl happy_var_1 happy_var_3 + )}} + +happyReduce_13 = happySpecReduce_3 7# happyReduction_13 +happyReduction_13 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_3 of { happy_var_3 -> + happyIn12 + (ValueDecl happy_var_1 happy_var_3 + )}} + +happyReduce_14 = happySpecReduce_3 8# happyReduction_14 +happyReduction_14 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_3 of { happy_var_3 -> + happyIn13 + (ConsDecl happy_var_1 happy_var_3 + )}} + +happyReduce_15 = happySpecReduce_0 9# happyReduction_15 +happyReduction_15 = happyIn14 + ([] + ) + +happyReduce_16 = happySpecReduce_1 9# happyReduction_16 +happyReduction_16 happy_x_1 + = case happyOut13 happy_x_1 of { happy_var_1 -> + happyIn14 + ((:[]) happy_var_1 + )} + +happyReduce_17 = happySpecReduce_3 9# happyReduction_17 +happyReduction_17 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut13 happy_x_1 of { happy_var_1 -> + case happyOut14 happy_x_3 of { happy_var_3 -> + happyIn14 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_18 = happySpecReduce_0 10# happyReduction_18 +happyReduction_18 = happyIn15 + ([] + ) + +happyReduce_19 = happySpecReduce_2 10# happyReduction_19 +happyReduction_19 happy_x_2 + happy_x_1 + = case happyOut15 happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_2 of { happy_var_2 -> + happyIn15 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_20 = happyReduce 4# 11# happyReduction_20 +happyReduction_20 (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 happyOut15 happy_x_3 of { happy_var_3 -> + happyIn16 + (PCons happy_var_2 (reverse happy_var_3) + ) `HappyStk` happyRest}} + +happyReduce_21 = happySpecReduce_1 11# happyReduction_21 +happyReduction_21 happy_x_1 + = case happyOut19 happy_x_1 of { happy_var_1 -> + happyIn16 + (PVar happy_var_1 + )} + +happyReduce_22 = happyReduce 4# 11# happyReduction_22 +happyReduction_22 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut18 happy_x_3 of { happy_var_3 -> + happyIn16 + (PRec happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_23 = happySpecReduce_1 11# happyReduction_23 +happyReduction_23 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn16 + (PStr happy_var_1 + )} + +happyReduce_24 = happySpecReduce_1 11# happyReduction_24 +happyReduction_24 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn16 + (PInt happy_var_1 + )} + +happyReduce_25 = happySpecReduce_3 12# happyReduction_25 +happyReduction_25 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_3 of { happy_var_3 -> + happyIn17 + (FieldPattern happy_var_1 happy_var_3 + )}} + +happyReduce_26 = happySpecReduce_0 13# happyReduction_26 +happyReduction_26 = happyIn18 + ([] + ) + +happyReduce_27 = happySpecReduce_1 13# happyReduction_27 +happyReduction_27 happy_x_1 + = case happyOut17 happy_x_1 of { happy_var_1 -> + happyIn18 + ((:[]) happy_var_1 + )} + +happyReduce_28 = happySpecReduce_3 13# happyReduction_28 +happyReduction_28 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut17 happy_x_1 of { happy_var_1 -> + case happyOut18 happy_x_3 of { happy_var_3 -> + happyIn18 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_29 = happySpecReduce_1 14# happyReduction_29 +happyReduction_29 happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn19 + (PVVar happy_var_1 + )} + +happyReduce_30 = happySpecReduce_1 14# happyReduction_30 +happyReduction_30 happy_x_1 + = happyIn19 + (PVWild + ) + +happyReduce_31 = happyReduce 6# 15# happyReduction_31 +happyReduction_31 (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 happyOut22 happy_x_3 of { happy_var_3 -> + case happyOut20 happy_x_6 of { happy_var_6 -> + happyIn20 + (ELet happy_var_3 happy_var_6 + ) `HappyStk` happyRest}} + +happyReduce_32 = happyReduce 6# 15# happyReduction_32 +happyReduction_32 (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_2 of { happy_var_2 -> + case happyOut24 happy_x_5 of { happy_var_5 -> + happyIn20 + (ECase happy_var_2 happy_var_5 + ) `HappyStk` happyRest}} + +happyReduce_33 = happySpecReduce_1 15# happyReduction_33 +happyReduction_33 happy_x_1 + = case happyOut25 happy_x_1 of { happy_var_1 -> + happyIn20 + (happy_var_1 + )} + +happyReduce_34 = happySpecReduce_3 16# happyReduction_34 +happyReduction_34 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_3 of { happy_var_3 -> + happyIn21 + (LetDef happy_var_1 happy_var_3 + )}} + +happyReduce_35 = happySpecReduce_0 17# happyReduction_35 +happyReduction_35 = happyIn22 + ([] + ) + +happyReduce_36 = happySpecReduce_1 17# happyReduction_36 +happyReduction_36 happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + happyIn22 + ((:[]) happy_var_1 + )} + +happyReduce_37 = happySpecReduce_3 17# happyReduction_37 +happyReduction_37 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_3 of { happy_var_3 -> + happyIn22 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_38 = happyReduce 5# 18# 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 happyOut16 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_3 of { happy_var_3 -> + case happyOut20 happy_x_5 of { happy_var_5 -> + happyIn23 + (Case happy_var_1 happy_var_3 happy_var_5 + ) `HappyStk` happyRest}}} + +happyReduce_39 = happySpecReduce_0 19# happyReduction_39 +happyReduction_39 = happyIn24 + ([] + ) + +happyReduce_40 = happySpecReduce_1 19# happyReduction_40 +happyReduction_40 happy_x_1 + = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn24 + ((:[]) happy_var_1 + )} + +happyReduce_41 = happySpecReduce_3 19# happyReduction_41 +happyReduction_41 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut23 happy_x_1 of { happy_var_1 -> + case happyOut24 happy_x_3 of { happy_var_3 -> + happyIn24 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_42 = happyReduce 4# 20# happyReduction_42 +happyReduction_42 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut19 happy_x_2 of { happy_var_2 -> + case happyOut20 happy_x_4 of { happy_var_4 -> + happyIn25 + (EAbs happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_43 = happyReduce 7# 20# happyReduction_43 +happyReduction_43 (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 happyOut19 happy_x_2 of { happy_var_2 -> + case happyOut20 happy_x_4 of { happy_var_4 -> + case happyOut20 happy_x_7 of { happy_var_7 -> + happyIn25 + (EPi happy_var_2 happy_var_4 happy_var_7 + ) `HappyStk` happyRest}}} + +happyReduce_44 = happySpecReduce_1 20# happyReduction_44 +happyReduction_44 happy_x_1 + = case happyOut33 happy_x_1 of { happy_var_1 -> + happyIn25 + (happy_var_1 + )} + +happyReduce_45 = happySpecReduce_2 21# happyReduction_45 +happyReduction_45 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 + (EApp happy_var_1 happy_var_2 + )}} + +happyReduce_46 = happySpecReduce_1 21# happyReduction_46 +happyReduction_46 happy_x_1 + = case happyOut27 happy_x_1 of { happy_var_1 -> + happyIn26 + (happy_var_1 + )} + +happyReduce_47 = happySpecReduce_3 22# happyReduction_47 +happyReduction_47 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut27 happy_x_1 of { happy_var_1 -> + case happyOut9 happy_x_3 of { happy_var_3 -> + happyIn27 + (EProj happy_var_1 happy_var_3 + )}} + +happyReduce_48 = happySpecReduce_1 22# happyReduction_48 +happyReduction_48 happy_x_1 + = case happyOut28 happy_x_1 of { happy_var_1 -> + happyIn27 + (happy_var_1 + )} + +happyReduce_49 = happyReduce 4# 23# happyReduction_49 +happyReduction_49 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn28 + (ERecType happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_50 = happyReduce 4# 23# happyReduction_50 +happyReduction_50 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut32 happy_x_3 of { happy_var_3 -> + happyIn28 + (ERec happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_51 = happySpecReduce_1 23# happyReduction_51 +happyReduction_51 happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn28 + (EVar happy_var_1 + )} + +happyReduce_52 = happySpecReduce_1 23# happyReduction_52 +happyReduction_52 happy_x_1 + = happyIn28 + (EType + ) + +happyReduce_53 = happySpecReduce_1 23# happyReduction_53 +happyReduction_53 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn28 + (EStr happy_var_1 + )} + +happyReduce_54 = happySpecReduce_1 23# happyReduction_54 +happyReduction_54 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn28 + (EInteger happy_var_1 + )} + +happyReduce_55 = happySpecReduce_1 23# happyReduction_55 +happyReduction_55 happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + happyIn28 + (EDouble happy_var_1 + )} + +happyReduce_56 = happySpecReduce_1 23# happyReduction_56 +happyReduction_56 happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn28 + (EMeta happy_var_1 + )} + +happyReduce_57 = happySpecReduce_3 23# happyReduction_57 +happyReduction_57 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut20 happy_x_2 of { happy_var_2 -> + happyIn28 + (happy_var_2 + )} + +happyReduce_58 = happySpecReduce_3 24# happyReduction_58 +happyReduction_58 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_3 of { happy_var_3 -> + happyIn29 + (FieldType happy_var_1 happy_var_3 + )}} + +happyReduce_59 = happySpecReduce_0 25# happyReduction_59 +happyReduction_59 = happyIn30 + ([] + ) + +happyReduce_60 = happySpecReduce_1 25# happyReduction_60 +happyReduction_60 happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + happyIn30 + ((:[]) happy_var_1 + )} + +happyReduce_61 = happySpecReduce_3 25# happyReduction_61 +happyReduction_61 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn30 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_62 = happySpecReduce_3 26# happyReduction_62 +happyReduction_62 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_3 of { happy_var_3 -> + happyIn31 + (FieldValue happy_var_1 happy_var_3 + )}} + +happyReduce_63 = happySpecReduce_0 27# happyReduction_63 +happyReduction_63 = happyIn32 + ([] + ) + +happyReduce_64 = happySpecReduce_1 27# happyReduction_64 +happyReduction_64 happy_x_1 + = case happyOut31 happy_x_1 of { happy_var_1 -> + happyIn32 + ((:[]) happy_var_1 + )} + +happyReduce_65 = happySpecReduce_3 27# happyReduction_65 +happyReduction_65 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut31 happy_x_1 of { happy_var_1 -> + case happyOut32 happy_x_3 of { happy_var_3 -> + happyIn32 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_66 = happySpecReduce_1 28# happyReduction_66 +happyReduction_66 happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn33 + (happy_var_1 + )} + +happyNewToken action sts stk [] = + happyDoAction 28# (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 "Type") -> cont 13#; + PT _ (TS "case") -> cont 14#; + PT _ (TS "data") -> cont 15#; + PT _ (TS "in") -> cont 16#; + PT _ (TS "let") -> cont 17#; + PT _ (TS "of") -> cont 18#; + PT _ (TS "rec") -> cont 19#; + PT _ (TS "sig") -> cont 20#; + PT _ (TS "where") -> cont 21#; + PT _ (TL happy_dollar_dollar) -> cont 22#; + PT _ (TI happy_dollar_dollar) -> cont 23#; + PT _ (TD happy_dollar_dollar) -> cont 24#; + PT _ (T_TMeta happy_dollar_dollar) -> cont 25#; + PT _ (T_CIdent happy_dollar_dollar) -> cont 26#; + _ -> cont 27#; + _ -> 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 + +pModule tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut10 x)) + +pExp tks = happySomeParser where + happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut20 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 ++ if null ts then [] else (" 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" #-} + +{-# LINE 68 "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 "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 "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/Transfer/Core/Par.y b/src/Transfer/Core/Par.y new file mode 100644 index 000000000..ceeaa313f --- /dev/null +++ b/src/Transfer/Core/Par.y @@ -0,0 +1,203 @@ +-- This Happy file was machine-generated by the BNF converter +{ +{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module Transfer.Core.Par where +import Transfer.Core.Abs +import Transfer.Core.Lex +import Transfer.ErrM +} + +%name pModule Module +%name pExp Exp + +-- no lexer declaration +%monad { Err } { thenM } { returnM } +%tokentype { Token } + +%token + ';' { PT _ (TS ";") } + ':' { PT _ (TS ":") } + '{' { PT _ (TS "{") } + '}' { PT _ (TS "}") } + '=' { PT _ (TS "=") } + '(' { PT _ (TS "(") } + ')' { PT _ (TS ")") } + '_' { PT _ (TS "_") } + '|' { PT _ (TS "|") } + '->' { PT _ (TS "->") } + '\\' { PT _ (TS "\\") } + '.' { PT _ (TS ".") } + 'Type' { PT _ (TS "Type") } + 'case' { PT _ (TS "case") } + 'data' { PT _ (TS "data") } + 'in' { PT _ (TS "in") } + 'let' { PT _ (TS "let") } + 'of' { PT _ (TS "of") } + 'rec' { PT _ (TS "rec") } + 'sig' { PT _ (TS "sig") } + 'where' { PT _ (TS "where") } + +L_quoted { PT _ (TL $$) } +L_integ { PT _ (TI $$) } +L_doubl { PT _ (TD $$) } +L_TMeta { PT _ (T_TMeta $$) } +L_CIdent { PT _ (T_CIdent $$) } +L_err { _ } + + +%% + +String :: { String } : L_quoted { $1 } +Integer :: { Integer } : L_integ { (read $1) :: Integer } +Double :: { Double } : L_doubl { (read $1) :: Double } +TMeta :: { TMeta} : L_TMeta { TMeta ($1)} +CIdent :: { CIdent} : L_CIdent { CIdent ($1)} + +Module :: { Module } +Module : ListDecl { Module $1 } + + +ListDecl :: { [Decl] } +ListDecl : {- empty -} { [] } + | Decl { (:[]) $1 } + | Decl ';' ListDecl { (:) $1 $3 } + + +Decl :: { Decl } +Decl : 'data' CIdent ':' Exp 'where' '{' ListConsDecl '}' { DataDecl $2 $4 $7 } + | CIdent ':' Exp { TypeDecl $1 $3 } + | CIdent '=' Exp { ValueDecl $1 $3 } + + +ConsDecl :: { ConsDecl } +ConsDecl : CIdent ':' Exp { ConsDecl $1 $3 } + + +ListConsDecl :: { [ConsDecl] } +ListConsDecl : {- empty -} { [] } + | ConsDecl { (:[]) $1 } + | ConsDecl ';' ListConsDecl { (:) $1 $3 } + + +ListPattern :: { [Pattern] } +ListPattern : {- empty -} { [] } + | ListPattern Pattern { flip (:) $1 $2 } + + +Pattern :: { Pattern } +Pattern : '(' CIdent ListPattern ')' { PCons $2 (reverse $3) } + | PatternVariable { PVar $1 } + | 'rec' '{' ListFieldPattern '}' { PRec $3 } + | String { PStr $1 } + | Integer { PInt $1 } + + +FieldPattern :: { FieldPattern } +FieldPattern : CIdent '=' Pattern { FieldPattern $1 $3 } + + +ListFieldPattern :: { [FieldPattern] } +ListFieldPattern : {- empty -} { [] } + | FieldPattern { (:[]) $1 } + | FieldPattern ';' ListFieldPattern { (:) $1 $3 } + + +PatternVariable :: { PatternVariable } +PatternVariable : CIdent { PVVar $1 } + | '_' { PVWild } + + +Exp :: { Exp } +Exp : 'let' '{' ListLetDef '}' 'in' Exp { ELet $3 $6 } + | 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 } + | Exp1 { $1 } + + +LetDef :: { LetDef } +LetDef : CIdent '=' Exp { LetDef $1 $3 } + + +ListLetDef :: { [LetDef] } +ListLetDef : {- empty -} { [] } + | LetDef { (:[]) $1 } + | LetDef ';' ListLetDef { (:) $1 $3 } + + +Case :: { Case } +Case : Pattern '|' Exp '->' Exp { Case $1 $3 $5 } + + +ListCase :: { [Case] } +ListCase : {- empty -} { [] } + | Case { (:[]) $1 } + | Case ';' ListCase { (:) $1 $3 } + + +Exp1 :: { Exp } +Exp1 : '\\' PatternVariable '->' Exp { EAbs $2 $4 } + | '(' PatternVariable ':' Exp ')' '->' Exp { EPi $2 $4 $7 } + | Exp2 { $1 } + + +Exp3 :: { Exp } +Exp3 : Exp3 Exp4 { EApp $1 $2 } + | Exp4 { $1 } + + +Exp4 :: { Exp } +Exp4 : Exp4 '.' CIdent { EProj $1 $3 } + | Exp5 { $1 } + + +Exp5 :: { Exp } +Exp5 : 'sig' '{' ListFieldType '}' { ERecType $3 } + | 'rec' '{' ListFieldValue '}' { ERec $3 } + | CIdent { EVar $1 } + | 'Type' { EType } + | String { EStr $1 } + | Integer { EInteger $1 } + | Double { EDouble $1 } + | TMeta { EMeta $1 } + | '(' Exp ')' { $2 } + + +FieldType :: { FieldType } +FieldType : CIdent ':' Exp { FieldType $1 $3 } + + +ListFieldType :: { [FieldType] } +ListFieldType : {- empty -} { [] } + | FieldType { (:[]) $1 } + | FieldType ';' ListFieldType { (:) $1 $3 } + + +FieldValue :: { FieldValue } +FieldValue : CIdent '=' Exp { FieldValue $1 $3 } + + +ListFieldValue :: { [FieldValue] } +ListFieldValue : {- empty -} { [] } + | FieldValue { (:[]) $1 } + | FieldValue ';' ListFieldValue { (:) $1 $3 } + + +Exp2 :: { Exp } +Exp2 : Exp3 { $1 } + + + +{ + +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 ++ if null ts then [] else (" before " ++ unwords (map prToken (take 4 ts))) + +myLexer = tokens +} + diff --git a/src/Transfer/Core/Print.hs b/src/Transfer/Core/Print.hs new file mode 100644 index 000000000..50929716a --- /dev/null +++ b/src/Transfer/Core/Print.hs @@ -0,0 +1,155 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} +module Transfer.Core.Print where + +-- pretty-printer generated by the BNF converter + +import Transfer.Core.Abs +import Data.Char +import Data.List (intersperse) + +-- 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 + +unwordsD :: [Doc] -> Doc +unwordsD = concatD . intersperse (doc (showChar ' ')) + +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 + +instance Print Char where + prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'') + +instance Print String where + prt _ 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 Double where + prt _ x = doc (shows x) + + +instance Print (Tree c) where + prt _i e = case e of + Module decls -> prPrec _i 0 (concatD [prt 0 decls]) + DataDecl cident exp consdecls -> prPrec _i 0 (concatD [doc (showString "data") , prt 0 cident , doc (showString ":") , prt 0 exp , doc (showString "where") , doc (showString "{") , prt 0 consdecls , doc (showString "}")]) + TypeDecl cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString ":") , prt 0 exp]) + ValueDecl cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString "=") , prt 0 exp]) + ConsDecl cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString ":") , prt 0 exp]) + PCons cident patterns -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 patterns , doc (showString ")")]) + PVar patternvariable -> prPrec _i 0 (concatD [prt 0 patternvariable]) + PRec fieldpatterns -> prPrec _i 0 (concatD [doc (showString "rec") , doc (showString "{") , prt 0 fieldpatterns , doc (showString "}")]) + PStr str -> prPrec _i 0 (concatD [prt 0 str]) + PInt n -> prPrec _i 0 (concatD [prt 0 n]) + FieldPattern cident pattern -> prPrec _i 0 (concatD [prt 0 cident , doc (showString "=") , prt 0 pattern]) + PVVar cident -> prPrec _i 0 (concatD [prt 0 cident]) + PVWild -> prPrec _i 0 (concatD [doc (showString "_")]) + ELet letdefs exp -> prPrec _i 0 (concatD [doc (showString "let") , doc (showString "{") , prt 0 letdefs , doc (showString "}") , doc (showString "in") , prt 0 exp]) + ECase exp cases -> prPrec _i 0 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")]) + EAbs patternvariable exp -> prPrec _i 1 (concatD [doc (showString "\\") , prt 0 patternvariable , doc (showString "->") , prt 0 exp]) + EPi patternvariable exp0 exp1 -> prPrec _i 1 (concatD [doc (showString "(") , prt 0 patternvariable , doc (showString ":") , prt 0 exp0 , doc (showString ")") , doc (showString "->") , prt 0 exp1]) + EApp exp0 exp1 -> prPrec _i 3 (concatD [prt 3 exp0 , prt 4 exp1]) + EProj exp cident -> prPrec _i 4 (concatD [prt 4 exp , doc (showString ".") , prt 0 cident]) + ERecType fieldtypes -> prPrec _i 5 (concatD [doc (showString "sig") , doc (showString "{") , prt 0 fieldtypes , doc (showString "}")]) + ERec fieldvalues -> prPrec _i 5 (concatD [doc (showString "rec") , doc (showString "{") , prt 0 fieldvalues , doc (showString "}")]) + EVar cident -> prPrec _i 5 (concatD [prt 0 cident]) + EType -> prPrec _i 5 (concatD [doc (showString "Type")]) + EStr str -> prPrec _i 5 (concatD [prt 0 str]) + EInteger n -> prPrec _i 5 (concatD [prt 0 n]) + EDouble d -> prPrec _i 5 (concatD [prt 0 d]) + EMeta tmeta -> prPrec _i 5 (concatD [prt 0 tmeta]) + LetDef cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString "=") , prt 0 exp]) + Case pattern exp0 exp1 -> prPrec _i 0 (concatD [prt 0 pattern , doc (showString "|") , prt 0 exp0 , doc (showString "->") , prt 0 exp1]) + FieldType cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString ":") , prt 0 exp]) + FieldValue cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString "=") , prt 0 exp]) + TMeta str -> prPrec _i 0 (doc (showString str)) + CIdent str -> prPrec _i 0 (doc (showString str)) + +instance Print [Decl] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [ConsDecl] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [Pattern] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) +instance Print [FieldPattern] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [LetDef] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [Case] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [FieldType] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [FieldValue] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) diff --git a/src/Transfer/Core/Skel.hs b/src/Transfer/Core/Skel.hs new file mode 100644 index 000000000..005ae92b1 --- /dev/null +++ b/src/Transfer/Core/Skel.hs @@ -0,0 +1,119 @@ +module Transfer.Core.Skel where + +-- Haskell module generated by the BNF converter + +import Transfer.Core.Abs +import Transfer.ErrM +type Result = Err String + +failure :: Show a => a -> Result +failure x = Bad $ "Undefined case: " ++ show x + +transTree :: Tree c -> Result +transTree t = case t of + Module decls -> failure t + DataDecl cident exp consdecls -> failure t + TypeDecl cident exp -> failure t + ValueDecl cident exp -> failure t + ConsDecl cident exp -> failure t + PCons cident patterns -> failure t + PVar patternvariable -> failure t + PRec fieldpatterns -> failure t + PStr str -> failure t + PInt n -> failure t + FieldPattern cident pattern -> failure t + PVVar cident -> failure t + PVWild -> failure t + ELet letdefs exp -> failure t + ECase exp cases -> failure t + EAbs patternvariable exp -> failure t + EPi patternvariable exp0 exp1 -> failure t + EApp exp0 exp1 -> failure t + EProj exp cident -> failure t + ERecType fieldtypes -> failure t + ERec fieldvalues -> failure t + EVar cident -> failure t + EType -> failure t + EStr str -> failure t + EInteger n -> failure t + EDouble d -> failure t + EMeta tmeta -> failure t + LetDef cident exp -> failure t + Case pattern exp0 exp1 -> failure t + FieldType cident exp -> failure t + FieldValue cident exp -> failure t + TMeta str -> failure t + CIdent str -> failure t + +transModule :: Module -> Result +transModule t = case t of + Module decls -> failure t + +transDecl :: Decl -> Result +transDecl t = case t of + DataDecl cident exp consdecls -> failure t + TypeDecl cident exp -> failure t + ValueDecl cident exp -> failure t + +transConsDecl :: ConsDecl -> Result +transConsDecl t = case t of + ConsDecl cident exp -> failure t + +transPattern :: Pattern -> Result +transPattern t = case t of + PCons cident patterns -> failure t + PVar patternvariable -> failure t + PRec fieldpatterns -> failure t + PStr str -> failure t + PInt n -> failure t + +transFieldPattern :: FieldPattern -> Result +transFieldPattern t = case t of + FieldPattern cident pattern -> failure t + +transPatternVariable :: PatternVariable -> Result +transPatternVariable t = case t of + PVVar cident -> failure t + PVWild -> failure t + +transExp :: Exp -> Result +transExp t = case t of + ELet letdefs exp -> failure t + ECase exp cases -> failure t + EAbs patternvariable exp -> failure t + EPi patternvariable exp0 exp1 -> failure t + EApp exp0 exp1 -> failure t + EProj exp cident -> failure t + ERecType fieldtypes -> failure t + ERec fieldvalues -> failure t + EVar cident -> failure t + EType -> failure t + EStr str -> failure t + EInteger n -> failure t + EDouble d -> failure t + EMeta tmeta -> failure t + +transLetDef :: LetDef -> Result +transLetDef t = case t of + LetDef cident exp -> failure t + +transCase :: Case -> Result +transCase t = case t of + Case pattern exp0 exp1 -> failure t + +transFieldType :: FieldType -> Result +transFieldType t = case t of + FieldType cident exp -> failure t + +transFieldValue :: FieldValue -> Result +transFieldValue t = case t of + FieldValue cident exp -> failure t + +transTMeta :: TMeta -> Result +transTMeta t = case t of + TMeta str -> failure t + +transCIdent :: CIdent -> Result +transCIdent t = case t of + CIdent str -> failure t + diff --git a/src/Transfer/Core/Test.hs b/src/Transfer/Core/Test.hs new file mode 100644 index 000000000..570beed51 --- /dev/null +++ b/src/Transfer/Core/Test.hs @@ -0,0 +1,58 @@ +-- automatically generated by BNF Converter +module Main where + + +import IO ( stdin, hGetContents ) +import System ( getArgs, getProgName ) + +import Transfer.Core.Lex +import Transfer.Core.Par +import Transfer.Core.Skel +import Transfer.Core.Print +import Transfer.Core.Abs + + + + +import Transfer.ErrM + +type ParseFun a = [Token] -> Err a + +myLLexer = myLexer + +type Verbosity = Int + +putStrV :: Verbosity -> String -> IO () +putStrV v s = if v > 1 then putStrLn s else return () + +runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO () +runFile v p f = putStrLn f >> readFile f >>= run v p + +run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO () +run v p s = let ts = myLLexer s in case p ts of + Bad s -> do putStrLn "\nParse Failed...\n" + putStrV v "Tokens:" + putStrV v $ show ts + putStrLn s + Ok tree -> do putStrLn "\nParse Successful!" + showTree v tree + + + +showTree :: (Show a, Print a) => Int -> a -> IO () +showTree v tree + = do + putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree + putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree + +main :: IO () +main = do args <- getArgs + case args of + [] -> hGetContents stdin >>= run 2 pModule + "-s":fs -> mapM_ (runFile 0 pModule) fs + fs -> mapM_ (runFile 2 pModule) fs + + + + + diff --git a/src/Transfer/ErrM.hs b/src/Transfer/ErrM.hs new file mode 100644 index 000000000..1f3c566fd --- /dev/null +++ b/src/Transfer/ErrM.hs @@ -0,0 +1,16 @@ +-- BNF Converter: Error Monad +-- Copyright (C) 2004 Author: Aarne Ranta + +-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE. +module Transfer.ErrM where + +-- the Error monad: like Maybe type with error msgs + +data Err a = Ok a | Bad String + deriving (Read, Show, Eq) + +instance Monad Err where + return = Ok + fail = Bad + Ok a >>= f = f a + Bad s >>= f = Bad s diff --git a/src/Transfer/Interpreter.hs b/src/Transfer/Interpreter.hs new file mode 100644 index 000000000..926b7bd3a --- /dev/null +++ b/src/Transfer/Interpreter.hs @@ -0,0 +1,240 @@ +module Transfer.Interpreter where + +import Transfer.Core.Abs +import Transfer.Core.Print + +import Control.Monad +import Data.List +import Data.Maybe + +import Debug.Trace + +data Value = VStr String + | VInt Integer + | VDbl Double + | VType + | VRec [(CIdent,Value)] + | VClos Env Exp + | VCons CIdent [Value] + | VPrim (Value -> Value) + | VMeta Integer + deriving (Show) + +instance Show (a -> b) where + show _ = "<<function>>" + +-- +-- * Environment +-- + +newtype Env = Env [(CIdent,Value)] + deriving Show + +mkEnv :: [(CIdent,Value)] -> Env +mkEnv = Env + +addToEnv :: [(CIdent,Value)] -> Env -> Env +addToEnv bs (Env e) = Env (bs ++ e) + +lookupEnv :: Env -> CIdent -> Value +lookupEnv (Env e) id = + case lookup id e of + Just x -> x + Nothing -> error $ "Variable " ++ printTree id ++ " not in environment." + ++ " Environment contains: " ++ show (map (printTree . fst) e) + +prEnv :: Env -> String +prEnv (Env e) = unlines [ printTree id ++ ": " ++ printValue v | (id,v) <- e ] + +seqEnv :: Env -> Env +seqEnv (Env e) = Env $! deepSeqList [ fst p `seq` p | p <- e ] + +-- | The built-in types and functions. +builtin :: Env +builtin = + mkEnv [(CIdent "Integer",VType), + (CIdent "Double",VType), + (CIdent "String",VType), + mkIntUn "neg" negate toInt, + mkIntBin "add" (+) toInt, + mkIntBin "sub" (-) toInt, + mkIntBin "mul" (*) toInt, + mkIntBin "div" div toInt, + mkIntBin "mod" mod toInt, + mkIntBin "eq" (==) toBool, + mkIntBin "cmp" compare toOrd, + mkIntUn "show" show toStr, + mkDblUn "neg" negate toDbl, + mkDblBin "add" (+) toDbl, + mkDblBin "sub" (-) toDbl, + mkDblBin "mul" (*) toDbl, + mkDblBin "div" (/) toDbl, + mkDblBin "mod" (\_ _ -> 0.0) toDbl, + mkDblBin "eq" (==) toBool, + mkDblBin "cmp" compare toOrd, + mkDblUn "show" show toStr, + mkStrBin "add" (++) toStr, + mkStrBin "eq" (==) toBool, + mkStrBin "cmp" compare toOrd, + mkStrUn "show" show toStr + ] + where + toInt i = VInt i + toDbl i = VDbl i + toBool b = VCons (CIdent (show b)) [] + toOrd o = VCons (CIdent (show o)) [] + toStr s = VStr s + mkUn t a x f g = let c = CIdent ("prim_" ++ x ++ "_" ++ t) + in (c, VPrim (\n -> a f g n)) + mkBin t a x f g = let c = CIdent ("prim_" ++ x ++ "_" ++ t) + in (c, VPrim (\n -> VPrim (\m -> a f g n m ))) + mkIntUn = mkUn "Integer" $ \ f g x -> + case x of + VInt n -> g (f n) + _ -> error $ printValue x ++ " is not an integer" + mkIntBin = mkBin "Integer" $ \ f g x y -> + case (x,y) of + (VInt n,VInt m) -> g (f n m) + _ -> error $ printValue x ++ " and " ++ printValue y + ++ " are not both integers" + mkDblUn = mkUn "Double" $ \ f g x -> + case x of + VDbl n -> g (f n) + _ -> error $ printValue x ++ " is not a double" + mkDblBin = mkBin "Double" $ \ f g x y -> + case (x,y) of + (VDbl n,VDbl m) -> g (f n m) + _ -> error $ printValue x ++ " and " ++ printValue y + ++ " are not both doubles" + mkStrUn = mkUn "String" $ \ f g x -> + case x of + VStr n -> g (f n) + _ -> error $ printValue x ++ " is not a string" + mkStrBin = mkBin "String" $ \ f g x y -> + case (x,y) of + (VStr n,VStr m) -> g (f n m) + _ -> error $ printValue x ++ " and " ++ printValue y + ++ " are not both strings" + +addModuleEnv :: Env -> Module -> Env +addModuleEnv env (Module ds) = + let bs = [ (c,VCons c []) | DataDecl _ _ cs <- ds, ConsDecl c _ <- cs ] + ++ [ (t,VCons t []) | DataDecl t _ _ <- ds ] + ++ [ (x,eval env' e) | ValueDecl x e <- ds] + env' = addToEnv bs env + in env' + +-- +-- * Evaluation. +-- + +eval :: Env -> Exp -> Value +eval env x = case x of + ELet defs exp2 -> + let env' = [ (id, v) | LetDef id e <- defs, + let v = eval env' e] + `addToEnv` env + in eval (seqEnv env') exp2 + ECase exp cases -> + let v = eval env exp + r = case firstMatch env v cases of + Nothing -> error $ "No pattern matched " ++ printValue v + Just (e,env') -> eval env' e + in v `seq` r + EAbs _ _ -> VClos env x + EPi _ _ _ -> VClos env x + EApp exp1 exp2 -> + let v1 = eval env exp1 + v2 = eval env exp2 + in case v1 of + VClos env' (EAbs id e) -> eval (bind id v2 `addToEnv` env') e + VPrim f -> f $! v2 + VCons c vs -> (VCons $! c) $! ((++) $! vs) $! [v2] + _ -> error $ "Bad application (" ++ printValue v1 + ++ ") (" ++ printValue v2 ++ ")" + EProj exp id -> let v = eval env exp + in case v of + VRec fs -> recLookup id fs + _ -> error $ printValue v ++ " is not a record, " + ++ "cannot get field " ++ printTree id + + ERecType fts -> VRec $! deepSeqList $! [v `seq` (f,v) | FieldType f e <- fts, + let v = eval env e] + ERec fvs -> VRec $! deepSeqList $! [v `seq` (f,v) | FieldValue f e <- fvs, + let v = eval env e] + EVar id -> lookupEnv env id + EType -> VType + EStr str -> VStr str + EInteger n -> VInt n + EDouble n -> VDbl n + EMeta (TMeta t) -> VMeta (read $ drop 1 t) + +firstMatch :: Env -> Value -> [Case] -> Maybe (Exp,Env) +firstMatch _ _ [] = Nothing +firstMatch env v (Case p g e:cs) = + case match p v of + Nothing -> firstMatch env v cs + Just bs -> let env' = bs `addToEnv` env + in case eval env' g of + VCons (CIdent "True") [] -> Just (e,env') + VCons (CIdent "False") [] -> firstMatch env v cs + x -> error $ "Error in guard: " ++ printValue x + ++ " is not a Bool" + +bind :: PatternVariable -> Value -> [(CIdent,Value)] +bind (PVVar x) v = [(x,v)] +bind PVWild _ = [] + +match :: Pattern -> Value -> Maybe [(CIdent,Value)] +match (PCons c' ps) (VCons c vs) + | c == c' = if length vs == length ps + then concatM $ zipWith match ps vs + else error $ "Wrong number of arguments to " ++ printTree c +match (PVar x) v = Just (bind x v) +match (PRec fps) (VRec fs) = concatM [ match p (recLookup f fs) | FieldPattern f p <- fps ] +match (PInt i) (VInt i') | i == i' = Just [] +match (PStr s) (VStr s') | s == s' = Just [] +match (PInt i) (VInt i') | i == i' = Just [] +match _ _ = Nothing + + +recLookup :: CIdent -> [(CIdent,Value)] -> Value +recLookup l fs = + case lookup l fs of + Just x -> x + Nothing -> error $ printValue (VRec fs) ++ " has no field " ++ printTree l + +-- +-- * Utilities +-- + +concatM :: Monad m => [m [a]] -> m [a] +concatM = liftM concat . sequence + +-- | Force a list and its values. +deepSeqList :: [a] -> [a] +deepSeqList = foldr (\x xs -> x `seq` xs `seq` (x:xs)) [] + +-- +-- * Convert values to expressions +-- + +valueToExp :: Value -> Exp +valueToExp v = + case v of + VStr s -> EStr s + VInt i -> EInteger i + VDbl i -> EDouble i + VType -> EType + VRec fs -> ERec [ FieldValue f (valueToExp v) | (f,v) <- fs] + VClos env e -> e + VCons c vs -> foldl EApp (EVar c) (map valueToExp vs) + VPrim _ -> EVar (CIdent "<<primitive>>") -- FIXME: what to return here? + VMeta n -> EMeta $ TMeta $ "?" ++ show n + +-- +-- * Pretty printing of values +-- + +printValue :: Value -> String +printValue v = printTree (valueToExp v) diff --git a/src/Transfer/InterpreterAPI.hs b/src/Transfer/InterpreterAPI.hs new file mode 100644 index 000000000..2fe04e8f3 --- /dev/null +++ b/src/Transfer/InterpreterAPI.hs @@ -0,0 +1,39 @@ +module Transfer.InterpreterAPI (Env, builtin, + load, loadFile, + evaluateString, evaluateExp + ) where + +import Transfer.Core.Abs +import Transfer.Core.Lex +import Transfer.Core.Par +import Transfer.Core.Print +import Transfer.Interpreter +import Transfer.ErrM + +-- | Read a transfer module in core format from a string. +load :: Monad m => + String -- ^ Input source name, for error messages. + -> String -- ^ Module contents. + -> m Env +load n s = case pModule (myLexer s) of + Bad e -> fail $ "Parse error in " ++ n ++ ": " ++ e + Ok m -> return $ addModuleEnv builtin m + +-- | Read a transfer module in core format from a file. +-- Fails in the IO monad if there is a problem loading the file. +loadFile :: FilePath -> IO Env +loadFile f = readFile f >>= load f + +-- | Read a transfer expression from a string and evaluate it. +-- Returns the result as a string. +evaluateString :: Monad m => Env -> String -> m String +evaluateString env s = + case pExp (myLexer s) of + Bad e -> fail $ "Parse error: " ++ e + Ok e -> do + let v = eval env e + return $ printValue v + +-- | Evaluate an expression in the given environment. +evaluateExp :: Env -> Exp -> Exp +evaluateExp env exp = valueToExp $ eval env exp diff --git a/src/Transfer/PathUtil.hs b/src/Transfer/PathUtil.hs new file mode 100644 index 000000000..b344563c6 --- /dev/null +++ b/src/Transfer/PathUtil.hs @@ -0,0 +1,110 @@ +{-# OPTIONS_GHC -cpp #-} + +----------------------------------------------------------------------------- +-- File name and directory utilities. Stolen from +-- ghc-6.4.1/ghc/compiler/main/DriverUtil.hs +-- +-- (c) The University of Glasgow 2000 +-- +----------------------------------------------------------------------------- + +module Transfer.PathUtil ( + Suffix, splitFilename, getFileSuffix, + splitFilename3, remove_suffix, split_longest_prefix, + replaceFilenameSuffix, directoryOf, filenameOf, + replaceFilenameDirectory, replaceFilename, remove_spaces, escapeSpaces, + ) where + +import Data.Char (isSpace) + +type Suffix = String + +splitFilename :: String -> (String,Suffix) +splitFilename f = split_longest_prefix f (=='.') + +getFileSuffix :: String -> Suffix +getFileSuffix f = drop_longest_prefix f (=='.') + +-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy.ext") +splitFilenameDir :: String -> (String,String) +splitFilenameDir str + = let (dir, rest) = split_longest_prefix str isPathSeparator + real_dir | null dir = "." + | otherwise = dir + in (real_dir, rest) + +-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext") +splitFilename3 :: String -> (String,String,Suffix) +splitFilename3 str + = let (dir, rest) = split_longest_prefix str isPathSeparator + (name, ext) = splitFilename rest + real_dir | null dir = "." + | otherwise = dir + in (real_dir, name, ext) + +remove_suffix :: Char -> String -> Suffix +remove_suffix c s + | null pre = s + | otherwise = reverse pre + where (suf,pre) = break (==c) (reverse s) + +drop_longest_prefix :: String -> (Char -> Bool) -> String +drop_longest_prefix s pred = reverse suf + where (suf,_pre) = break pred (reverse s) + +take_longest_prefix :: String -> (Char -> Bool) -> String +take_longest_prefix s pred = reverse pre + where (_suf,pre) = break pred (reverse s) + +-- split a string at the last character where 'pred' is True, +-- returning a pair of strings. The first component holds the string +-- up (but not including) the last character for which 'pred' returned +-- True, the second whatever comes after (but also not including the +-- last character). +-- +-- If 'pred' returns False for all characters in the string, the original +-- string is returned in the second component (and the first one is just +-- empty). +split_longest_prefix :: String -> (Char -> Bool) -> (String,String) +split_longest_prefix s pred + = case pre of + [] -> ([], reverse suf) + (_:pre) -> (reverse pre, reverse suf) + where (suf,pre) = break pred (reverse s) + +replaceFilenameSuffix :: FilePath -> Suffix -> FilePath +replaceFilenameSuffix s suf = remove_suffix '.' s ++ suf + +-- directoryOf strips the filename off the input string, returning +-- the directory. +directoryOf :: FilePath -> String +directoryOf = fst . splitFilenameDir + +-- filenameOf strips the directory off the input string, returning +-- the filename. +filenameOf :: FilePath -> String +filenameOf = snd . splitFilenameDir + +replaceFilenameDirectory :: FilePath -> String -> FilePath +replaceFilenameDirectory s dir + = dir ++ '/':drop_longest_prefix s isPathSeparator + +replaceFilename :: FilePath -> String -> FilePath +replaceFilename f n + = case directoryOf f of + "" -> n + d -> d ++ '/' : n + +remove_spaces :: String -> String +remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace + +escapeSpaces :: String -> String +escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) "" + +isPathSeparator :: Char -> Bool +isPathSeparator ch = +#ifdef mingw32_TARGET_OS + ch == '/' || ch == '\\' +#else + ch == '/' +#endif diff --git a/src/Transfer/Syntax/Abs.hs b/src/Transfer/Syntax/Abs.hs new file mode 100644 index 000000000..0ccf9ab12 --- /dev/null +++ b/src/Transfer/Syntax/Abs.hs @@ -0,0 +1,485 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} +module Transfer.Syntax.Abs (Tree(..), Module, Import, Decl, ConsDecl, Guard, Pattern, CommaPattern, FieldPattern, Exp, VarOrWild, LetDef, Case, Bind, FieldType, FieldValue, Ident, composOp, composOpM, composOpM_, composOpMPlus, composOpMonoid, composOpFold, compos, johnMajorEq) where + +import Control.Monad (ap,MonadPlus,msum,mplus,mzero) +import Control.Monad.Identity +import Data.Monoid + +-- Haskell module generated by the BNF converter + +data Module_ +type Module = Tree Module_ +data Import_ +type Import = Tree Import_ +data Decl_ +type Decl = Tree Decl_ +data ConsDecl_ +type ConsDecl = Tree ConsDecl_ +data Guard_ +type Guard = Tree Guard_ +data Pattern_ +type Pattern = Tree Pattern_ +data CommaPattern_ +type CommaPattern = Tree CommaPattern_ +data FieldPattern_ +type FieldPattern = Tree FieldPattern_ +data Exp_ +type Exp = Tree Exp_ +data VarOrWild_ +type VarOrWild = Tree VarOrWild_ +data LetDef_ +type LetDef = Tree LetDef_ +data Case_ +type Case = Tree Case_ +data Bind_ +type Bind = Tree Bind_ +data FieldType_ +type FieldType = Tree FieldType_ +data FieldValue_ +type FieldValue = Tree FieldValue_ +data Ident_ +type Ident = Tree Ident_ + +data Tree :: * -> * where + Module :: [Import] -> [Decl] -> Tree Module_ + Import :: Ident -> Tree Import_ + DataDecl :: Ident -> Exp -> [ConsDecl] -> Tree Decl_ + TypeDecl :: Ident -> Exp -> Tree Decl_ + ValueDecl :: Ident -> [Pattern] -> Guard -> Exp -> Tree Decl_ + DeriveDecl :: Ident -> Ident -> Tree Decl_ + ConsDecl :: Ident -> Exp -> Tree ConsDecl_ + GuardExp :: Exp -> Tree Guard_ + GuardNo :: Tree Guard_ + POr :: Pattern -> Pattern -> Tree Pattern_ + PListCons :: Pattern -> Pattern -> Tree Pattern_ + PConsTop :: Ident -> Pattern -> [Pattern] -> Tree Pattern_ + PCons :: Ident -> [Pattern] -> Tree Pattern_ + PRec :: [FieldPattern] -> Tree Pattern_ + PEmptyList :: Tree Pattern_ + PList :: [CommaPattern] -> Tree Pattern_ + PTuple :: CommaPattern -> [CommaPattern] -> Tree Pattern_ + PStr :: String -> Tree Pattern_ + PInt :: Integer -> Tree Pattern_ + PVar :: Ident -> Tree Pattern_ + PWild :: Tree Pattern_ + CommaPattern :: Pattern -> Tree CommaPattern_ + FieldPattern :: Ident -> Pattern -> Tree FieldPattern_ + EPi :: VarOrWild -> Exp -> Exp -> Tree Exp_ + EPiNoVar :: Exp -> Exp -> Tree Exp_ + EAbs :: VarOrWild -> Exp -> Tree Exp_ + ELet :: [LetDef] -> Exp -> Tree Exp_ + ECase :: Exp -> [Case] -> Tree Exp_ + EIf :: Exp -> Exp -> Exp -> Tree Exp_ + EDo :: [Bind] -> Exp -> Tree Exp_ + EBind :: Exp -> Exp -> Tree Exp_ + EBindC :: Exp -> Exp -> Tree Exp_ + EOr :: Exp -> Exp -> Tree Exp_ + EAnd :: Exp -> Exp -> Tree Exp_ + EEq :: Exp -> Exp -> Tree Exp_ + ENe :: Exp -> Exp -> Tree Exp_ + ELt :: Exp -> Exp -> Tree Exp_ + ELe :: Exp -> Exp -> Tree Exp_ + EGt :: Exp -> Exp -> Tree Exp_ + EGe :: Exp -> Exp -> Tree Exp_ + EListCons :: Exp -> Exp -> Tree Exp_ + EAdd :: Exp -> Exp -> Tree Exp_ + ESub :: Exp -> Exp -> Tree Exp_ + EMul :: Exp -> Exp -> Tree Exp_ + EDiv :: Exp -> Exp -> Tree Exp_ + EMod :: Exp -> Exp -> Tree Exp_ + ENeg :: Exp -> Tree Exp_ + EApp :: Exp -> Exp -> Tree Exp_ + EProj :: Exp -> Ident -> Tree Exp_ + ERecType :: [FieldType] -> Tree Exp_ + ERec :: [FieldValue] -> Tree Exp_ + EEmptyList :: Tree Exp_ + EList :: [Exp] -> Tree Exp_ + ETuple :: Exp -> [Exp] -> Tree Exp_ + EVar :: Ident -> Tree Exp_ + EType :: Tree Exp_ + EStr :: String -> Tree Exp_ + EInteger :: Integer -> Tree Exp_ + EDouble :: Double -> Tree Exp_ + EMeta :: Tree Exp_ + VVar :: Ident -> Tree VarOrWild_ + VWild :: Tree VarOrWild_ + LetDef :: Ident -> Exp -> Tree LetDef_ + Case :: Pattern -> Guard -> Exp -> Tree Case_ + BindVar :: VarOrWild -> Exp -> Tree Bind_ + BindNoVar :: Exp -> Tree Bind_ + FieldType :: Ident -> Exp -> Tree FieldType_ + FieldValue :: Ident -> Exp -> Tree FieldValue_ + Ident :: String -> Tree Ident_ + +composOp :: (forall a. Tree a -> Tree a) -> Tree c -> Tree c +composOp f = runIdentity . composOpM (Identity . f) + +composOpM :: Monad m => (forall a. Tree a -> m (Tree a)) -> Tree c -> m (Tree c) +composOpM = compos return ap + +composOpM_ :: Monad m => (forall a. Tree a -> m ()) -> Tree c -> m () +composOpM_ = composOpFold (return ()) (>>) + +composOpMPlus :: MonadPlus m => (forall a. Tree a -> m b) -> Tree c -> m b +composOpMPlus = composOpFold mzero mplus + +composOpMonoid :: Monoid m => (forall a. Tree a -> m) -> Tree c -> m +composOpMonoid = composOpFold mempty mappend + +newtype C b a = C { unC :: b } +composOpFold :: b -> (b -> b -> b) -> (forall a. Tree a -> b) -> Tree c -> b +composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f) + +compos :: (forall a. a -> m a) + -> (forall a b. m (a -> b) -> m a -> m b) + -> (forall a. Tree a -> m (Tree a)) -> Tree c -> m (Tree c) +compos r a f t = case t of + Module imports decls -> r Module `a` foldr (a . a (r (:)) . f) (r []) imports `a` foldr (a . a (r (:)) . f) (r []) decls + Import i -> r Import `a` f i + DataDecl i exp consdecls -> r DataDecl `a` f i `a` f exp `a` foldr (a . a (r (:)) . f) (r []) consdecls + TypeDecl i exp -> r TypeDecl `a` f i `a` f exp + ValueDecl i patterns guard exp -> r ValueDecl `a` f i `a` foldr (a . a (r (:)) . f) (r []) patterns `a` f guard `a` f exp + DeriveDecl i0 i1 -> r DeriveDecl `a` f i0 `a` f i1 + ConsDecl i exp -> r ConsDecl `a` f i `a` f exp + GuardExp exp -> r GuardExp `a` f exp + POr pattern0 pattern1 -> r POr `a` f pattern0 `a` f pattern1 + PListCons pattern0 pattern1 -> r PListCons `a` f pattern0 `a` f pattern1 + PConsTop i pattern patterns -> r PConsTop `a` f i `a` f pattern `a` foldr (a . a (r (:)) . f) (r []) patterns + PCons i patterns -> r PCons `a` f i `a` foldr (a . a (r (:)) . f) (r []) patterns + PRec fieldpatterns -> r PRec `a` foldr (a . a (r (:)) . f) (r []) fieldpatterns + PList commapatterns -> r PList `a` foldr (a . a (r (:)) . f) (r []) commapatterns + PTuple commapattern commapatterns -> r PTuple `a` f commapattern `a` foldr (a . a (r (:)) . f) (r []) commapatterns + PVar i -> r PVar `a` f i + CommaPattern pattern -> r CommaPattern `a` f pattern + FieldPattern i pattern -> r FieldPattern `a` f i `a` f pattern + EPi varorwild exp0 exp1 -> r EPi `a` f varorwild `a` f exp0 `a` f exp1 + EPiNoVar exp0 exp1 -> r EPiNoVar `a` f exp0 `a` f exp1 + EAbs varorwild exp -> r EAbs `a` f varorwild `a` f exp + ELet letdefs exp -> r ELet `a` foldr (a . a (r (:)) . f) (r []) letdefs `a` f exp + ECase exp cases -> r ECase `a` f exp `a` foldr (a . a (r (:)) . f) (r []) cases + EIf exp0 exp1 exp2 -> r EIf `a` f exp0 `a` f exp1 `a` f exp2 + EDo binds exp -> r EDo `a` foldr (a . a (r (:)) . f) (r []) binds `a` f exp + EBind exp0 exp1 -> r EBind `a` f exp0 `a` f exp1 + EBindC exp0 exp1 -> r EBindC `a` f exp0 `a` f exp1 + EOr exp0 exp1 -> r EOr `a` f exp0 `a` f exp1 + EAnd exp0 exp1 -> r EAnd `a` f exp0 `a` f exp1 + EEq exp0 exp1 -> r EEq `a` f exp0 `a` f exp1 + ENe exp0 exp1 -> r ENe `a` f exp0 `a` f exp1 + ELt exp0 exp1 -> r ELt `a` f exp0 `a` f exp1 + ELe exp0 exp1 -> r ELe `a` f exp0 `a` f exp1 + EGt exp0 exp1 -> r EGt `a` f exp0 `a` f exp1 + EGe exp0 exp1 -> r EGe `a` f exp0 `a` f exp1 + EListCons exp0 exp1 -> r EListCons `a` f exp0 `a` f exp1 + EAdd exp0 exp1 -> r EAdd `a` f exp0 `a` f exp1 + ESub exp0 exp1 -> r ESub `a` f exp0 `a` f exp1 + EMul exp0 exp1 -> r EMul `a` f exp0 `a` f exp1 + EDiv exp0 exp1 -> r EDiv `a` f exp0 `a` f exp1 + EMod exp0 exp1 -> r EMod `a` f exp0 `a` f exp1 + ENeg exp -> r ENeg `a` f exp + EApp exp0 exp1 -> r EApp `a` f exp0 `a` f exp1 + EProj exp i -> r EProj `a` f exp `a` f i + ERecType fieldtypes -> r ERecType `a` foldr (a . a (r (:)) . f) (r []) fieldtypes + ERec fieldvalues -> r ERec `a` foldr (a . a (r (:)) . f) (r []) fieldvalues + EList exps -> r EList `a` foldr (a . a (r (:)) . f) (r []) exps + ETuple exp exps -> r ETuple `a` f exp `a` foldr (a . a (r (:)) . f) (r []) exps + EVar i -> r EVar `a` f i + VVar i -> r VVar `a` f i + LetDef i exp -> r LetDef `a` f i `a` f exp + Case pattern guard exp -> r Case `a` f pattern `a` f guard `a` f exp + BindVar varorwild exp -> r BindVar `a` f varorwild `a` f exp + BindNoVar exp -> r BindNoVar `a` f exp + FieldType i exp -> r FieldType `a` f i `a` f exp + FieldValue i exp -> r FieldValue `a` f i `a` f exp + _ -> r t + +instance Show (Tree c) where + showsPrec n t = case t of + Module imports decls -> opar n . showString "Module" . showChar ' ' . showsPrec 1 imports . showChar ' ' . showsPrec 1 decls . cpar n + Import i -> opar n . showString "Import" . showChar ' ' . showsPrec 1 i . cpar n + DataDecl i exp consdecls -> opar n . showString "DataDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 consdecls . cpar n + TypeDecl i exp -> opar n . showString "TypeDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n + ValueDecl i patterns guard exp -> opar n . showString "ValueDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . showChar ' ' . showsPrec 1 guard . showChar ' ' . showsPrec 1 exp . cpar n + DeriveDecl i0 i1 -> opar n . showString "DeriveDecl" . showChar ' ' . showsPrec 1 i0 . showChar ' ' . showsPrec 1 i1 . cpar n + ConsDecl i exp -> opar n . showString "ConsDecl" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n + GuardExp exp -> opar n . showString "GuardExp" . showChar ' ' . showsPrec 1 exp . cpar n + GuardNo -> showString "GuardNo" + POr pattern0 pattern1 -> opar n . showString "POr" . showChar ' ' . showsPrec 1 pattern0 . showChar ' ' . showsPrec 1 pattern1 . cpar n + PListCons pattern0 pattern1 -> opar n . showString "PListCons" . showChar ' ' . showsPrec 1 pattern0 . showChar ' ' . showsPrec 1 pattern1 . cpar n + PConsTop i pattern patterns -> opar n . showString "PConsTop" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 patterns . cpar n + PCons i patterns -> opar n . showString "PCons" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 patterns . cpar n + PRec fieldpatterns -> opar n . showString "PRec" . showChar ' ' . showsPrec 1 fieldpatterns . cpar n + PEmptyList -> showString "PEmptyList" + PList commapatterns -> opar n . showString "PList" . showChar ' ' . showsPrec 1 commapatterns . cpar n + PTuple commapattern commapatterns -> opar n . showString "PTuple" . showChar ' ' . showsPrec 1 commapattern . showChar ' ' . showsPrec 1 commapatterns . cpar n + PStr str -> opar n . showString "PStr" . showChar ' ' . showsPrec 1 str . cpar n + PInt n -> opar n . showString "PInt" . showChar ' ' . showsPrec 1 n . cpar n + PVar i -> opar n . showString "PVar" . showChar ' ' . showsPrec 1 i . cpar n + PWild -> showString "PWild" + CommaPattern pattern -> opar n . showString "CommaPattern" . showChar ' ' . showsPrec 1 pattern . cpar n + FieldPattern i pattern -> opar n . showString "FieldPattern" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 pattern . cpar n + EPi varorwild exp0 exp1 -> opar n . showString "EPi" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EPiNoVar exp0 exp1 -> opar n . showString "EPiNoVar" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EAbs varorwild exp -> opar n . showString "EAbs" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n + ELet letdefs exp -> opar n . showString "ELet" . showChar ' ' . showsPrec 1 letdefs . showChar ' ' . showsPrec 1 exp . cpar n + ECase exp cases -> opar n . showString "ECase" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 cases . cpar n + EIf exp0 exp1 exp2 -> opar n . showString "EIf" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . showChar ' ' . showsPrec 1 exp2 . cpar n + EDo binds exp -> opar n . showString "EDo" . showChar ' ' . showsPrec 1 binds . showChar ' ' . showsPrec 1 exp . cpar n + EBind exp0 exp1 -> opar n . showString "EBind" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EBindC exp0 exp1 -> opar n . showString "EBindC" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EOr exp0 exp1 -> opar n . showString "EOr" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EAnd exp0 exp1 -> opar n . showString "EAnd" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EEq exp0 exp1 -> opar n . showString "EEq" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + ENe exp0 exp1 -> opar n . showString "ENe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + ELt exp0 exp1 -> opar n . showString "ELt" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + ELe exp0 exp1 -> opar n . showString "ELe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EGt exp0 exp1 -> opar n . showString "EGt" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EGe exp0 exp1 -> opar n . showString "EGe" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EListCons exp0 exp1 -> opar n . showString "EListCons" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EAdd exp0 exp1 -> opar n . showString "EAdd" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + ESub exp0 exp1 -> opar n . showString "ESub" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EMul exp0 exp1 -> opar n . showString "EMul" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EDiv exp0 exp1 -> opar n . showString "EDiv" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EMod exp0 exp1 -> opar n . showString "EMod" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + ENeg exp -> opar n . showString "ENeg" . showChar ' ' . showsPrec 1 exp . cpar n + EApp exp0 exp1 -> opar n . showString "EApp" . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n + EProj exp i -> opar n . showString "EProj" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 i . cpar n + ERecType fieldtypes -> opar n . showString "ERecType" . showChar ' ' . showsPrec 1 fieldtypes . cpar n + ERec fieldvalues -> opar n . showString "ERec" . showChar ' ' . showsPrec 1 fieldvalues . cpar n + EEmptyList -> showString "EEmptyList" + EList exps -> opar n . showString "EList" . showChar ' ' . showsPrec 1 exps . cpar n + ETuple exp exps -> opar n . showString "ETuple" . showChar ' ' . showsPrec 1 exp . showChar ' ' . showsPrec 1 exps . cpar n + EVar i -> opar n . showString "EVar" . showChar ' ' . showsPrec 1 i . cpar n + EType -> showString "EType" + EStr str -> opar n . showString "EStr" . showChar ' ' . showsPrec 1 str . cpar n + EInteger n -> opar n . showString "EInteger" . showChar ' ' . showsPrec 1 n . cpar n + EDouble d -> opar n . showString "EDouble" . showChar ' ' . showsPrec 1 d . cpar n + EMeta -> showString "EMeta" + VVar i -> opar n . showString "VVar" . showChar ' ' . showsPrec 1 i . cpar n + VWild -> showString "VWild" + LetDef i exp -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n + Case pattern guard exp -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 guard . showChar ' ' . showsPrec 1 exp . cpar n + BindVar varorwild exp -> opar n . showString "BindVar" . showChar ' ' . showsPrec 1 varorwild . showChar ' ' . showsPrec 1 exp . cpar n + BindNoVar exp -> opar n . showString "BindNoVar" . showChar ' ' . showsPrec 1 exp . cpar n + FieldType i exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n + FieldValue i exp -> opar n . showString "FieldValue" . showChar ' ' . showsPrec 1 i . showChar ' ' . showsPrec 1 exp . cpar n + Ident str -> opar n . showString "Ident" . showChar ' ' . showsPrec 1 str . cpar n + where opar n = if n > 0 then showChar '(' else id + cpar n = if n > 0 then showChar ')' else id + +instance Eq (Tree c) where (==) = johnMajorEq + +johnMajorEq :: Tree a -> Tree b -> Bool +johnMajorEq (Module imports decls) (Module imports_ decls_) = imports == imports_ && decls == decls_ +johnMajorEq (Import i) (Import i_) = i == i_ +johnMajorEq (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = i == i_ && exp == exp_ && consdecls == consdecls_ +johnMajorEq (TypeDecl i exp) (TypeDecl i_ exp_) = i == i_ && exp == exp_ +johnMajorEq (ValueDecl i patterns guard exp) (ValueDecl i_ patterns_ guard_ exp_) = i == i_ && patterns == patterns_ && guard == guard_ && exp == exp_ +johnMajorEq (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = i0 == i0_ && i1 == i1_ +johnMajorEq (ConsDecl i exp) (ConsDecl i_ exp_) = i == i_ && exp == exp_ +johnMajorEq (GuardExp exp) (GuardExp exp_) = exp == exp_ +johnMajorEq GuardNo GuardNo = True +johnMajorEq (POr pattern0 pattern1) (POr pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_ +johnMajorEq (PListCons pattern0 pattern1) (PListCons pattern0_ pattern1_) = pattern0 == pattern0_ && pattern1 == pattern1_ +johnMajorEq (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = i == i_ && pattern == pattern_ && patterns == patterns_ +johnMajorEq (PCons i patterns) (PCons i_ patterns_) = i == i_ && patterns == patterns_ +johnMajorEq (PRec fieldpatterns) (PRec fieldpatterns_) = fieldpatterns == fieldpatterns_ +johnMajorEq PEmptyList PEmptyList = True +johnMajorEq (PList commapatterns) (PList commapatterns_) = commapatterns == commapatterns_ +johnMajorEq (PTuple commapattern commapatterns) (PTuple commapattern_ commapatterns_) = commapattern == commapattern_ && commapatterns == commapatterns_ +johnMajorEq (PStr str) (PStr str_) = str == str_ +johnMajorEq (PInt n) (PInt n_) = n == n_ +johnMajorEq (PVar i) (PVar i_) = i == i_ +johnMajorEq PWild PWild = True +johnMajorEq (CommaPattern pattern) (CommaPattern pattern_) = pattern == pattern_ +johnMajorEq (FieldPattern i pattern) (FieldPattern i_ pattern_) = i == i_ && pattern == pattern_ +johnMajorEq (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = varorwild == varorwild_ && exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EAbs varorwild exp) (EAbs varorwild_ exp_) = varorwild == varorwild_ && exp == exp_ +johnMajorEq (ELet letdefs exp) (ELet letdefs_ exp_) = letdefs == letdefs_ && exp == exp_ +johnMajorEq (ECase exp cases) (ECase exp_ cases_) = exp == exp_ && cases == cases_ +johnMajorEq (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = exp0 == exp0_ && exp1 == exp1_ && exp2 == exp2_ +johnMajorEq (EDo binds exp) (EDo binds_ exp_) = binds == binds_ && exp == exp_ +johnMajorEq (EBind exp0 exp1) (EBind exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EBindC exp0 exp1) (EBindC exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EOr exp0 exp1) (EOr exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EAnd exp0 exp1) (EAnd exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EEq exp0 exp1) (EEq exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (ENe exp0 exp1) (ENe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (ELt exp0 exp1) (ELt exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (ELe exp0 exp1) (ELe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EGt exp0 exp1) (EGt exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EGe exp0 exp1) (EGe exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EListCons exp0 exp1) (EListCons exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EAdd exp0 exp1) (EAdd exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (ESub exp0 exp1) (ESub exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EMul exp0 exp1) (EMul exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EDiv exp0 exp1) (EDiv exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EMod exp0 exp1) (EMod exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (ENeg exp) (ENeg exp_) = exp == exp_ +johnMajorEq (EApp exp0 exp1) (EApp exp0_ exp1_) = exp0 == exp0_ && exp1 == exp1_ +johnMajorEq (EProj exp i) (EProj exp_ i_) = exp == exp_ && i == i_ +johnMajorEq (ERecType fieldtypes) (ERecType fieldtypes_) = fieldtypes == fieldtypes_ +johnMajorEq (ERec fieldvalues) (ERec fieldvalues_) = fieldvalues == fieldvalues_ +johnMajorEq EEmptyList EEmptyList = True +johnMajorEq (EList exps) (EList exps_) = exps == exps_ +johnMajorEq (ETuple exp exps) (ETuple exp_ exps_) = exp == exp_ && exps == exps_ +johnMajorEq (EVar i) (EVar i_) = i == i_ +johnMajorEq EType EType = True +johnMajorEq (EStr str) (EStr str_) = str == str_ +johnMajorEq (EInteger n) (EInteger n_) = n == n_ +johnMajorEq (EDouble d) (EDouble d_) = d == d_ +johnMajorEq EMeta EMeta = True +johnMajorEq (VVar i) (VVar i_) = i == i_ +johnMajorEq VWild VWild = True +johnMajorEq (LetDef i exp) (LetDef i_ exp_) = i == i_ && exp == exp_ +johnMajorEq (Case pattern guard exp) (Case pattern_ guard_ exp_) = pattern == pattern_ && guard == guard_ && exp == exp_ +johnMajorEq (BindVar varorwild exp) (BindVar varorwild_ exp_) = varorwild == varorwild_ && exp == exp_ +johnMajorEq (BindNoVar exp) (BindNoVar exp_) = exp == exp_ +johnMajorEq (FieldType i exp) (FieldType i_ exp_) = i == i_ && exp == exp_ +johnMajorEq (FieldValue i exp) (FieldValue i_ exp_) = i == i_ && exp == exp_ +johnMajorEq (Ident str) (Ident str_) = str == str_ +johnMajorEq _ _ = False + +instance Ord (Tree c) where + compare x y = compare (index x) (index y) `mappend` compareSame x y +index :: Tree c -> Int +index (Module _ _) = 0 +index (Import _) = 1 +index (DataDecl _ _ _) = 2 +index (TypeDecl _ _) = 3 +index (ValueDecl _ _ _ _) = 4 +index (DeriveDecl _ _) = 5 +index (ConsDecl _ _) = 6 +index (GuardExp _) = 7 +index (GuardNo ) = 8 +index (POr _ _) = 9 +index (PListCons _ _) = 10 +index (PConsTop _ _ _) = 11 +index (PCons _ _) = 12 +index (PRec _) = 13 +index (PEmptyList ) = 14 +index (PList _) = 15 +index (PTuple _ _) = 16 +index (PStr _) = 17 +index (PInt _) = 18 +index (PVar _) = 19 +index (PWild ) = 20 +index (CommaPattern _) = 21 +index (FieldPattern _ _) = 22 +index (EPi _ _ _) = 23 +index (EPiNoVar _ _) = 24 +index (EAbs _ _) = 25 +index (ELet _ _) = 26 +index (ECase _ _) = 27 +index (EIf _ _ _) = 28 +index (EDo _ _) = 29 +index (EBind _ _) = 30 +index (EBindC _ _) = 31 +index (EOr _ _) = 32 +index (EAnd _ _) = 33 +index (EEq _ _) = 34 +index (ENe _ _) = 35 +index (ELt _ _) = 36 +index (ELe _ _) = 37 +index (EGt _ _) = 38 +index (EGe _ _) = 39 +index (EListCons _ _) = 40 +index (EAdd _ _) = 41 +index (ESub _ _) = 42 +index (EMul _ _) = 43 +index (EDiv _ _) = 44 +index (EMod _ _) = 45 +index (ENeg _) = 46 +index (EApp _ _) = 47 +index (EProj _ _) = 48 +index (ERecType _) = 49 +index (ERec _) = 50 +index (EEmptyList ) = 51 +index (EList _) = 52 +index (ETuple _ _) = 53 +index (EVar _) = 54 +index (EType ) = 55 +index (EStr _) = 56 +index (EInteger _) = 57 +index (EDouble _) = 58 +index (EMeta ) = 59 +index (VVar _) = 60 +index (VWild ) = 61 +index (LetDef _ _) = 62 +index (Case _ _ _) = 63 +index (BindVar _ _) = 64 +index (BindNoVar _) = 65 +index (FieldType _ _) = 66 +index (FieldValue _ _) = 67 +index (Ident _) = 68 +compareSame :: Tree c -> Tree c -> Ordering +compareSame (Module imports decls) (Module imports_ decls_) = mappend (compare imports imports_) (compare decls decls_) +compareSame (Import i) (Import i_) = compare i i_ +compareSame (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = mappend (compare i i_) (mappend (compare exp exp_) (compare consdecls consdecls_)) +compareSame (TypeDecl i exp) (TypeDecl i_ exp_) = mappend (compare i i_) (compare exp exp_) +compareSame (ValueDecl i patterns guard exp) (ValueDecl i_ patterns_ guard_ exp_) = mappend (compare i i_) (mappend (compare patterns patterns_) (mappend (compare guard guard_) (compare exp exp_))) +compareSame (DeriveDecl i0 i1) (DeriveDecl i0_ i1_) = mappend (compare i0 i0_) (compare i1 i1_) +compareSame (ConsDecl i exp) (ConsDecl i_ exp_) = mappend (compare i i_) (compare exp exp_) +compareSame (GuardExp exp) (GuardExp exp_) = compare exp exp_ +compareSame GuardNo GuardNo = EQ +compareSame (POr pattern0 pattern1) (POr pattern0_ pattern1_) = mappend (compare pattern0 pattern0_) (compare pattern1 pattern1_) +compareSame (PListCons pattern0 pattern1) (PListCons pattern0_ pattern1_) = mappend (compare pattern0 pattern0_) (compare pattern1 pattern1_) +compareSame (PConsTop i pattern patterns) (PConsTop i_ pattern_ patterns_) = mappend (compare i i_) (mappend (compare pattern pattern_) (compare patterns patterns_)) +compareSame (PCons i patterns) (PCons i_ patterns_) = mappend (compare i i_) (compare patterns patterns_) +compareSame (PRec fieldpatterns) (PRec fieldpatterns_) = compare fieldpatterns fieldpatterns_ +compareSame PEmptyList PEmptyList = EQ +compareSame (PList commapatterns) (PList commapatterns_) = compare commapatterns commapatterns_ +compareSame (PTuple commapattern commapatterns) (PTuple commapattern_ commapatterns_) = mappend (compare commapattern commapattern_) (compare commapatterns commapatterns_) +compareSame (PStr str) (PStr str_) = compare str str_ +compareSame (PInt n) (PInt n_) = compare n n_ +compareSame (PVar i) (PVar i_) = compare i i_ +compareSame PWild PWild = EQ +compareSame (CommaPattern pattern) (CommaPattern pattern_) = compare pattern pattern_ +compareSame (FieldPattern i pattern) (FieldPattern i_ pattern_) = mappend (compare i i_) (compare pattern pattern_) +compareSame (EPi varorwild exp0 exp1) (EPi varorwild_ exp0_ exp1_) = mappend (compare varorwild varorwild_) (mappend (compare exp0 exp0_) (compare exp1 exp1_)) +compareSame (EPiNoVar exp0 exp1) (EPiNoVar exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EAbs varorwild exp) (EAbs varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_) +compareSame (ELet letdefs exp) (ELet letdefs_ exp_) = mappend (compare letdefs letdefs_) (compare exp exp_) +compareSame (ECase exp cases) (ECase exp_ cases_) = mappend (compare exp exp_) (compare cases cases_) +compareSame (EIf exp0 exp1 exp2) (EIf exp0_ exp1_ exp2_) = mappend (compare exp0 exp0_) (mappend (compare exp1 exp1_) (compare exp2 exp2_)) +compareSame (EDo binds exp) (EDo binds_ exp_) = mappend (compare binds binds_) (compare exp exp_) +compareSame (EBind exp0 exp1) (EBind exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EBindC exp0 exp1) (EBindC exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EOr exp0 exp1) (EOr exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EAnd exp0 exp1) (EAnd exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EEq exp0 exp1) (EEq exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (ENe exp0 exp1) (ENe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (ELt exp0 exp1) (ELt exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (ELe exp0 exp1) (ELe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EGt exp0 exp1) (EGt exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EGe exp0 exp1) (EGe exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EListCons exp0 exp1) (EListCons exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EAdd exp0 exp1) (EAdd exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (ESub exp0 exp1) (ESub exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EMul exp0 exp1) (EMul exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EDiv exp0 exp1) (EDiv exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EMod exp0 exp1) (EMod exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (ENeg exp) (ENeg exp_) = compare exp exp_ +compareSame (EApp exp0 exp1) (EApp exp0_ exp1_) = mappend (compare exp0 exp0_) (compare exp1 exp1_) +compareSame (EProj exp i) (EProj exp_ i_) = mappend (compare exp exp_) (compare i i_) +compareSame (ERecType fieldtypes) (ERecType fieldtypes_) = compare fieldtypes fieldtypes_ +compareSame (ERec fieldvalues) (ERec fieldvalues_) = compare fieldvalues fieldvalues_ +compareSame EEmptyList EEmptyList = EQ +compareSame (EList exps) (EList exps_) = compare exps exps_ +compareSame (ETuple exp exps) (ETuple exp_ exps_) = mappend (compare exp exp_) (compare exps exps_) +compareSame (EVar i) (EVar i_) = compare i i_ +compareSame EType EType = EQ +compareSame (EStr str) (EStr str_) = compare str str_ +compareSame (EInteger n) (EInteger n_) = compare n n_ +compareSame (EDouble d) (EDouble d_) = compare d d_ +compareSame EMeta EMeta = EQ +compareSame (VVar i) (VVar i_) = compare i i_ +compareSame VWild VWild = EQ +compareSame (LetDef i exp) (LetDef i_ exp_) = mappend (compare i i_) (compare exp exp_) +compareSame (Case pattern guard exp) (Case pattern_ guard_ exp_) = mappend (compare pattern pattern_) (mappend (compare guard guard_) (compare exp exp_)) +compareSame (BindVar varorwild exp) (BindVar varorwild_ exp_) = mappend (compare varorwild varorwild_) (compare exp exp_) +compareSame (BindNoVar exp) (BindNoVar exp_) = compare exp exp_ +compareSame (FieldType i exp) (FieldType i_ exp_) = mappend (compare i i_) (compare exp exp_) +compareSame (FieldValue i exp) (FieldValue i_ exp_) = mappend (compare i i_) (compare exp exp_) +compareSame (Ident str) (Ident str_) = compare str str_ +compareSame x y = error "BNFC error:" compareSame diff --git a/src/Transfer/Syntax/Doc.tex b/src/Transfer/Syntax/Doc.tex new file mode 100644 index 000000000..603940459 --- /dev/null +++ b/src/Transfer/Syntax/Doc.tex @@ -0,0 +1,333 @@ +\batchmode +%This Latex file is machine-generated by the BNF-converter + +\documentclass[a4paper,11pt]{article} +\author{BNF-converter} +\title{The Language Syntax} +\setlength{\parindent}{0mm} +\setlength{\parskip}{1mm} +\begin{document} + +\maketitle + +\newcommand{\emptyP}{\mbox{$\epsilon$}} +\newcommand{\terminal}[1]{\mbox{{\texttt {#1}}}} +\newcommand{\nonterminal}[1]{\mbox{$\langle \mbox{{\sl #1 }} \! \rangle$}} +\newcommand{\arrow}{\mbox{::=}} +\newcommand{\delimit}{\mbox{$|$}} +\newcommand{\reserved}[1]{\mbox{{\texttt {#1}}}} +\newcommand{\literal}[1]{\mbox{{\texttt {#1}}}} +\newcommand{\symb}[1]{\mbox{{\texttt {#1}}}} + +This document was automatically generated by the {\em BNF-Converter}. It was generated together with the lexer, the parser, and the abstract syntax module, which guarantees that the document matches with the implementation of the language (provided no hand-hacking has taken place). + +\section*{The lexical structure of Syntax} +\subsection*{Identifiers} +Identifiers \nonterminal{Ident} are unquoted strings beginning with a letter, +followed by any combination of letters, digits, and the characters {\tt \_ '}, +reserved words excluded. + + +\subsection*{Literals} +String literals \nonterminal{String}\ have the form +\terminal{"}$x$\terminal{"}, where $x$ is any sequence of any characters +except \terminal{"}\ unless preceded by \verb6\6. + + +Integer literals \nonterminal{Int}\ are nonempty sequences of digits. + + +Double-precision float literals \nonterminal{Double}\ have the structure +indicated by the regular expression $\nonterminal{digit}+ \mbox{{\it `.'}} \nonterminal{digit}+ (\mbox{{\it `e'}} \mbox{{\it `-'}}? \nonterminal{digit}+)?$ i.e.\ +two sequences of digits separated by a decimal point, optionally +followed by an unsigned or negative exponent. + + + + +\subsection*{Reserved words and symbols} +The set of reserved words is the set of terminals appearing in the grammar. Those reserved words that consist of non-letter characters are called symbols, and they are treated in a different way from those that are similar to identifiers. The lexer follows rules familiar from languages like Haskell, C, and Java, including longest match and spacing conventions. + +The reserved words used in Syntax are the following: \\ + +\begin{tabular}{lll} +{\reserved{Type}} &{\reserved{case}} &{\reserved{data}} \\ +{\reserved{derive}} &{\reserved{do}} &{\reserved{else}} \\ +{\reserved{if}} &{\reserved{import}} &{\reserved{in}} \\ +{\reserved{let}} &{\reserved{of}} &{\reserved{rec}} \\ +{\reserved{sig}} &{\reserved{then}} &{\reserved{where}} \\ +\end{tabular}\\ + +The symbols used in Syntax are the following: \\ + +\begin{tabular}{lll} +{\symb{;}} &{\symb{:}} &{\symb{\{}} \\ +{\symb{\}}} &{\symb{{$=$}}} &{\symb{{$|$}}} \\ +{\symb{{$|$}{$|$}}} &{\symb{::}} &{\symb{(}} \\ +{\symb{)}} &{\symb{[}} &{\symb{]}} \\ +{\symb{,}} &{\symb{\_}} &{\symb{{$-$}{$>$}}} \\ +{\symb{$\backslash$}} &{\symb{{$<$}{$-$}}} &{\symb{{$>$}{$>$}{$=$}}} \\ +{\symb{{$>$}{$>$}}} &{\symb{\&\&}} &{\symb{{$=$}{$=$}}} \\ +{\symb{/{$=$}}} &{\symb{{$<$}}} &{\symb{{$<$}{$=$}}} \\ +{\symb{{$>$}}} &{\symb{{$>$}{$=$}}} &{\symb{{$+$}}} \\ +{\symb{{$-$}}} &{\symb{*}} &{\symb{/}} \\ +{\symb{\%}} &{\symb{.}} &{\symb{?}} \\ +\end{tabular}\\ + +\subsection*{Comments} +Single-line comments begin with {\symb{{$-$}{$-$}}}. \\Multiple-line comments are enclosed with {\symb{\{{$-$}}} and {\symb{{$-$}\}}}. + +\section*{The syntactic structure of Syntax} +Non-terminals are enclosed between $\langle$ and $\rangle$. +The symbols {\arrow} (production), {\delimit} (union) +and {\emptyP} (empty rule) belong to the BNF notation. +All other symbols are terminals.\\ + +\begin{tabular}{lll} +{\nonterminal{Module}} & {\arrow} &{\nonterminal{ListImport}} {\nonterminal{ListDecl}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Import}} & {\arrow} &{\terminal{import}} {\nonterminal{Ident}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListImport}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{Import}} {\terminal{;}} {\nonterminal{ListImport}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Decl}} & {\arrow} &{\terminal{data}} {\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{where}} {\terminal{\{}} {\nonterminal{ListConsDecl}} {\terminal{\}}} \\ + & {\delimit} &{\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} \\ + & {\delimit} &{\nonterminal{Ident}} {\nonterminal{ListPattern}} {\nonterminal{Guard}} {\terminal{{$=$}}} {\nonterminal{Exp}} \\ + & {\delimit} &{\terminal{derive}} {\nonterminal{Ident}} {\nonterminal{Ident}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListDecl}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{Decl}} {\terminal{;}} {\nonterminal{ListDecl}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ConsDecl}} & {\arrow} &{\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListConsDecl}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{ConsDecl}} \\ + & {\delimit} &{\nonterminal{ConsDecl}} {\terminal{;}} {\nonterminal{ListConsDecl}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Guard}} & {\arrow} &{\terminal{{$|$}}} {\nonterminal{Exp1}} \\ + & {\delimit} &{\emptyP} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Pattern}} & {\arrow} &{\nonterminal{Pattern1}} {\terminal{{$|$}{$|$}}} {\nonterminal{Pattern}} \\ + & {\delimit} &{\nonterminal{Pattern1}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Pattern1}} & {\arrow} &{\nonterminal{Pattern2}} {\terminal{::}} {\nonterminal{Pattern1}} \\ + & {\delimit} &{\nonterminal{Pattern2}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Pattern2}} & {\arrow} &{\nonterminal{Ident}} {\nonterminal{Pattern3}} {\nonterminal{ListPattern}} \\ + & {\delimit} &{\nonterminal{Pattern3}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Pattern3}} & {\arrow} &{\terminal{rec}} {\terminal{\{}} {\nonterminal{ListFieldPattern}} {\terminal{\}}} \\ + & {\delimit} &{\terminal{[}} {\terminal{]}} \\ + & {\delimit} &{\terminal{[}} {\nonterminal{ListCommaPattern}} {\terminal{]}} \\ + & {\delimit} &{\terminal{(}} {\nonterminal{CommaPattern}} {\terminal{,}} {\nonterminal{ListCommaPattern}} {\terminal{)}} \\ + & {\delimit} &{\nonterminal{String}} \\ + & {\delimit} &{\nonterminal{Integer}} \\ + & {\delimit} &{\nonterminal{Ident}} \\ + & {\delimit} &{\terminal{\_}} \\ + & {\delimit} &{\terminal{(}} {\nonterminal{Pattern}} {\terminal{)}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{CommaPattern}} & {\arrow} &{\nonterminal{Pattern}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListCommaPattern}} & {\arrow} &{\nonterminal{CommaPattern}} \\ + & {\delimit} &{\nonterminal{CommaPattern}} {\terminal{,}} {\nonterminal{ListCommaPattern}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListPattern}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{Pattern3}} {\nonterminal{ListPattern}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{FieldPattern}} & {\arrow} &{\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Pattern}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListFieldPattern}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{FieldPattern}} \\ + & {\delimit} &{\nonterminal{FieldPattern}} {\terminal{;}} {\nonterminal{ListFieldPattern}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp}} & {\arrow} &{\terminal{(}} {\nonterminal{VarOrWild}} {\terminal{:}} {\nonterminal{Exp}} {\terminal{)}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\ + & {\delimit} &{\nonterminal{Exp1}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\ + & {\delimit} &{\nonterminal{Exp1}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{VarOrWild}} & {\arrow} &{\nonterminal{Ident}} \\ + & {\delimit} &{\terminal{\_}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp1}} & {\arrow} &{\terminal{$\backslash$}} {\nonterminal{VarOrWild}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp1}} \\ + & {\delimit} &{\terminal{let}} {\terminal{\{}} {\nonterminal{ListLetDef}} {\terminal{\}}} {\terminal{in}} {\nonterminal{Exp1}} \\ + & {\delimit} &{\terminal{case}} {\nonterminal{Exp}} {\terminal{of}} {\terminal{\{}} {\nonterminal{ListCase}} {\terminal{\}}} \\ + & {\delimit} &{\terminal{if}} {\nonterminal{Exp}} {\terminal{then}} {\nonterminal{Exp}} {\terminal{else}} {\nonterminal{Exp1}} \\ + & {\delimit} &{\terminal{do}} {\terminal{\{}} {\nonterminal{ListBind}} {\nonterminal{Exp}} {\terminal{\}}} \\ + & {\delimit} &{\nonterminal{Exp2}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{LetDef}} & {\arrow} &{\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListLetDef}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{LetDef}} \\ + & {\delimit} &{\nonterminal{LetDef}} {\terminal{;}} {\nonterminal{ListLetDef}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Case}} & {\arrow} &{\nonterminal{Pattern}} {\nonterminal{Guard}} {\terminal{{$-$}{$>$}}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListCase}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{Case}} \\ + & {\delimit} &{\nonterminal{Case}} {\terminal{;}} {\nonterminal{ListCase}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Bind}} & {\arrow} &{\nonterminal{VarOrWild}} {\terminal{{$<$}{$-$}}} {\nonterminal{Exp}} \\ + & {\delimit} &{\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListBind}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{Bind}} {\terminal{;}} {\nonterminal{ListBind}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp3}} & {\arrow} &{\nonterminal{Exp3}} {\terminal{{$>$}{$>$}{$=$}}} {\nonterminal{Exp4}} \\ + & {\delimit} &{\nonterminal{Exp3}} {\terminal{{$>$}{$>$}}} {\nonterminal{Exp4}} \\ + & {\delimit} &{\nonterminal{Exp4}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp4}} & {\arrow} &{\nonterminal{Exp5}} {\terminal{{$|$}{$|$}}} {\nonterminal{Exp4}} \\ + & {\delimit} &{\nonterminal{Exp5}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp5}} & {\arrow} &{\nonterminal{Exp6}} {\terminal{\&\&}} {\nonterminal{Exp5}} \\ + & {\delimit} &{\nonterminal{Exp6}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp6}} & {\arrow} &{\nonterminal{Exp7}} {\terminal{{$=$}{$=$}}} {\nonterminal{Exp7}} \\ + & {\delimit} &{\nonterminal{Exp7}} {\terminal{/{$=$}}} {\nonterminal{Exp7}} \\ + & {\delimit} &{\nonterminal{Exp7}} {\terminal{{$<$}}} {\nonterminal{Exp7}} \\ + & {\delimit} &{\nonterminal{Exp7}} {\terminal{{$<$}{$=$}}} {\nonterminal{Exp7}} \\ + & {\delimit} &{\nonterminal{Exp7}} {\terminal{{$>$}}} {\nonterminal{Exp7}} \\ + & {\delimit} &{\nonterminal{Exp7}} {\terminal{{$>$}{$=$}}} {\nonterminal{Exp7}} \\ + & {\delimit} &{\nonterminal{Exp7}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp7}} & {\arrow} &{\nonterminal{Exp8}} {\terminal{::}} {\nonterminal{Exp7}} \\ + & {\delimit} &{\nonterminal{Exp8}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp8}} & {\arrow} &{\nonterminal{Exp8}} {\terminal{{$+$}}} {\nonterminal{Exp9}} \\ + & {\delimit} &{\nonterminal{Exp8}} {\terminal{{$-$}}} {\nonterminal{Exp9}} \\ + & {\delimit} &{\nonterminal{Exp9}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp9}} & {\arrow} &{\nonterminal{Exp9}} {\terminal{*}} {\nonterminal{Exp10}} \\ + & {\delimit} &{\nonterminal{Exp9}} {\terminal{/}} {\nonterminal{Exp10}} \\ + & {\delimit} &{\nonterminal{Exp9}} {\terminal{\%}} {\nonterminal{Exp10}} \\ + & {\delimit} &{\nonterminal{Exp10}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp10}} & {\arrow} &{\terminal{{$-$}}} {\nonterminal{Exp10}} \\ + & {\delimit} &{\nonterminal{Exp11}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp11}} & {\arrow} &{\nonterminal{Exp11}} {\nonterminal{Exp12}} \\ + & {\delimit} &{\nonterminal{Exp12}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp12}} & {\arrow} &{\nonterminal{Exp12}} {\terminal{.}} {\nonterminal{Ident}} \\ + & {\delimit} &{\nonterminal{Exp13}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp13}} & {\arrow} &{\terminal{sig}} {\terminal{\{}} {\nonterminal{ListFieldType}} {\terminal{\}}} \\ + & {\delimit} &{\terminal{rec}} {\terminal{\{}} {\nonterminal{ListFieldValue}} {\terminal{\}}} \\ + & {\delimit} &{\terminal{[}} {\terminal{]}} \\ + & {\delimit} &{\terminal{[}} {\nonterminal{ListExp}} {\terminal{]}} \\ + & {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{,}} {\nonterminal{ListExp}} {\terminal{)}} \\ + & {\delimit} &{\nonterminal{Ident}} \\ + & {\delimit} &{\terminal{Type}} \\ + & {\delimit} &{\nonterminal{String}} \\ + & {\delimit} &{\nonterminal{Integer}} \\ + & {\delimit} &{\nonterminal{Double}} \\ + & {\delimit} &{\terminal{?}} \\ + & {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{FieldType}} & {\arrow} &{\nonterminal{Ident}} {\terminal{:}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListFieldType}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{FieldType}} \\ + & {\delimit} &{\nonterminal{FieldType}} {\terminal{;}} {\nonterminal{ListFieldType}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{FieldValue}} & {\arrow} &{\nonterminal{Ident}} {\terminal{{$=$}}} {\nonterminal{Exp}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListFieldValue}} & {\arrow} &{\emptyP} \\ + & {\delimit} &{\nonterminal{FieldValue}} \\ + & {\delimit} &{\nonterminal{FieldValue}} {\terminal{;}} {\nonterminal{ListFieldValue}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{Exp2}} & {\arrow} &{\nonterminal{Exp3}} \\ +\end{tabular}\\ + +\begin{tabular}{lll} +{\nonterminal{ListExp}} & {\arrow} &{\nonterminal{Exp}} \\ + & {\delimit} &{\nonterminal{Exp}} {\terminal{,}} {\nonterminal{ListExp}} \\ +\end{tabular}\\ + + + +\end{document} + diff --git a/src/Transfer/Syntax/Layout.hs b/src/Transfer/Syntax/Layout.hs new file mode 100644 index 000000000..de5c99870 --- /dev/null +++ b/src/Transfer/Syntax/Layout.hs @@ -0,0 +1,227 @@ +module Transfer.Syntax.Layout where + +import Transfer.Syntax.Lex + + +import Data.Maybe (isNothing, fromJust) + +-- Generated by the BNF Converter + +-- local parameters + +topLayout = True +layoutWords = ["let","where","of","rec","sig","do"] +layoutStopWords = ["in"] + +-- layout separators + +layoutOpen = "{" +layoutClose = "}" +layoutSep = ";" + +-- | Replace layout syntax with explicit layout tokens. +resolveLayout :: Bool -- ^ Whether to use top-level layout. + -> [Token] -> [Token] +resolveLayout tp = res Nothing [if tl then Implicit 1 else Explicit] + where + -- Do top-level layout if the function parameter and the grammar say so. + tl = tp && topLayout + + res :: Maybe Token -- ^ The previous token, if any. + -> [Block] -- ^ A stack of layout blocks. + -> [Token] -> [Token] + + -- The stack should never be empty. + res _ [] ts = error $ "Layout error: stack empty. Tokens: " ++ show ts + + res _ st (t0:ts) + -- We found an open brace in the input, + -- put an explicit layout block on the stack. + -- This is done even if there was no layout word, + -- to keep opening and closing braces. + | isLayoutOpen t0 = moveAlong (Explicit:st) [t0] ts + + res _ st (t0:ts) + -- Start a new layout block if the first token is a layout word + | isLayout t0 = + case ts of + -- Explicit layout, just move on. The case above + -- will push an explicit layout block. + t1:_ | isLayoutOpen t1 -> moveAlong st [t0] ts + -- at end of file, the start column doesn't matter + _ -> let col = if null ts then column t0 else column (head ts) + -- insert an open brace after the layout word + b:ts' = addToken (nextPos t0) layoutOpen ts + -- save the start column + st' = Implicit col:st + in moveAlong st' [t0,b] ts' + + -- If we encounter a closing brace, exit the first explicit layout block. + | isLayoutClose t0 = + let st' = drop 1 (dropWhile isImplicit st) + in if null st' + then error $ "Layout error: Found " ++ layoutClose ++ " at (" + ++ show (line t0) ++ "," ++ show (column t0) + ++ ") without an explicit layout block." + else moveAlong st' [t0] ts + + -- We are in an implicit layout block + res pt st@(Implicit n:ns) (t0:ts) + + -- End of implicit block by a layout stop word + | isStop t0 = + -- Exit the current block and all implicit blocks + -- more indented than the current token + let (ebs,ns') = span (`moreIndent` column t0) ns + moreIndent (Implicit x) y = x > y + moreIndent Explicit _ = False + -- the number of blocks exited + b = 1 + length ebs + bs = replicate b layoutClose + -- Insert closing braces after the previous token. + (ts1,ts2) = splitAt (1+b) $ addTokens (afterPrev pt) bs (t0:ts) + in moveAlong ns' ts1 ts2 + + -- End of an implicit layout block + | newLine && column t0 < n = + -- Insert a closing brace after the previous token. + let b:t0':ts' = addToken (afterPrev pt) layoutClose (t0:ts) + -- Repeat, with the current block removed from the stack + in moveAlong ns [b] (t0':ts') + + -- Encounted a new line in an implicit layout block. + | newLine && column t0 == n = + -- Insert a semicolon after the previous token. + -- unless we are the beginning of the file, + -- or the previous token is a semicolon or open brace. + if isNothing pt || isTokenIn [layoutSep,layoutOpen] (fromJust pt) + then moveAlong st [t0] ts + else let b:t0':ts' = addToken (afterPrev pt) layoutSep (t0:ts) + in moveAlong st [b,t0'] ts' + where newLine = case pt of + Nothing -> True + Just t -> line t /= line t0 + + -- Nothing to see here, move along. + res _ st (t:ts) = moveAlong st [t] ts + + -- At EOF: skip explicit blocks. + res (Just t) (Explicit:bs) [] | null bs = [] + | otherwise = res (Just t) bs [] + + -- If we are using top-level layout, insert a semicolon after + -- the last token, if there isn't one already + res (Just t) [Implicit n] [] + | isTokenIn [layoutSep] t = [] + | otherwise = addToken (nextPos t) layoutSep [] + + -- At EOF in an implicit, non-top-level block: close the block + res (Just t) (Implicit n:bs) [] = + let c = addToken (nextPos t) layoutClose [] + in moveAlong bs c [] + + -- This should only happen if the input is empty. + res Nothing st [] = [] + + -- | Move on to the next token. + moveAlong :: [Block] -- ^ The layout stack. + -> [Token] -- ^ Any tokens just processed. + -> [Token] -- ^ the rest of the tokens. + -> [Token] + moveAlong st [] ts = error $ "Layout error: moveAlong got [] as old tokens" + moveAlong st ot ts = ot ++ res (Just $ last ot) st ts + +data Block = Implicit Int -- ^ An implicit layout block with its start column. + | Explicit + deriving Show + +type Position = Posn + +-- | Check if s block is implicit. +isImplicit :: Block -> Bool +isImplicit (Implicit _) = True +isImplicit _ = False + +-- | Insert a number of tokens at the begninning of a list of tokens. +addTokens :: Position -- ^ Position of the first new token. + -> [String] -- ^ Token symbols. + -> [Token] -- ^ The rest of the tokens. These will have their + -- positions updated to make room for the new tokens . + -> [Token] +addTokens p ss ts = foldr (addToken p) ts ss + +-- | Insert a new symbol token at the begninning of a list of tokens. +addToken :: Position -- ^ Position of the new token. + -> String -- ^ Symbol in the new token. + -> [Token] -- ^ The rest of the tokens. These will have their + -- positions updated to make room for the new token. + -> [Token] +addToken p s ts = sToken p s : map (incrGlobal p (length s)) ts + +-- | Get the position immediately to the right of the given token. +-- If no token is given, gets the first position in the file. +afterPrev :: Maybe Token -> Position +afterPrev = maybe (Pn 0 1 1) nextPos + +-- | Get the position immediately to the right of the given token. +nextPos :: Token -> Position +nextPos t = Pn (g + s) l (c + s + 1) + where Pn g l c = position t + s = tokenLength t + +-- | Add to the global and column positions of a token. +-- The column position is only changed if the token is on +-- the same line as the given position. +incrGlobal :: Position -- ^ If the token is on the same line + -- as this position, update the column position. + -> Int -- ^ Number of characters to add to the position. + -> Token -> Token +incrGlobal (Pn _ l0 _) i (PT (Pn g l c) t) = + if l /= l0 then PT (Pn (g + i) l c) t + else PT (Pn (g + i) l (c + i)) t +incrGlobal _ _ p = error $ "cannot add token at " ++ show p + +-- | Create a symbol token. +sToken :: Position -> String -> Token +sToken p s = PT p (TS s) -- reserved word or symbol + +-- | Get the position of a token. +position :: Token -> Position +position t = case t of + PT p _ -> p + Err p -> p + +-- | Get the line number of a token. +line :: Token -> Int +line t = case position t of Pn _ l _ -> l + +-- | Get the column number of a token. +column :: Token -> Int +column t = case position t of Pn _ _ c -> c + +-- | Check if a token is one of the given symbols. +isTokenIn :: [String] -> Token -> Bool +isTokenIn ts t = case t of + PT _ (TS r) | elem r ts -> True + _ -> False + +-- | Check if a word is a layout start token. +isLayout :: Token -> Bool +isLayout = isTokenIn layoutWords + +-- | Check if a token is a layout stop token. +isStop :: Token -> Bool +isStop = isTokenIn layoutStopWords + +-- | Check if a token is the layout open token. +isLayoutOpen :: Token -> Bool +isLayoutOpen = isTokenIn [layoutOpen] + +-- | Check if a token is the layout close token. +isLayoutClose :: Token -> Bool +isLayoutClose = isTokenIn [layoutClose] + +-- | Get the number of characters in the token. +tokenLength :: Token -> Int +tokenLength t = length $ prToken t + diff --git a/src/Transfer/Syntax/Lex.hs b/src/Transfer/Syntax/Lex.hs new file mode 100644 index 000000000..83c9e1a12 --- /dev/null +++ b/src/Transfer/Syntax/Lex.hs @@ -0,0 +1,337 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +{-# LINE 3 "Transfer/Syntax/Lex.x" #-} +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module Transfer.Syntax.Lex where + + + +#if __GLASGOW_HASKELL__ >= 603 +#include "ghcconfig.h" +#else +#include "config.h" +#endif +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +import Data.Char (ord) +import Data.Array.Base (unsafeAt) +#else +import Array +import Char (ord) +#endif +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif +alex_base :: AlexAddr +alex_base = AlexA# "\x01\x00\x00\x00\x15\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x18\x00\x00\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x45\x00\x00\x00\x1b\x00\x00\x00\x1c\x00\x00\x00\x1d\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\xd4\xff\xff\xff\x17\x00\x00\x00\x26\x00\x00\x00\x1e\x00\x00\x00\x27\x00\x00\x00\x29\x00\x00\x00\x2a\x00\x00\x00\x2c\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x17\x01\x00\x00\xd5\x00\x00\x00\xf2\x00\x00\x00\x6c\x01\x00\x00\x1a\x01\x00\x00\x76\x01\x00\x00\x80\x01\x00\x00\x8d\x01\x00\x00"# + +alex_table :: AlexAddr +alex_table = AlexA# "\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\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\x0d\x00\xff\xff\x19\x00\xff\xff\xff\xff\x0e\x00\x16\x00\xff\xff\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x05\x00\x0e\x00\x15\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x10\x00\x0e\x00\x11\x00\x14\x00\x13\x00\x0e\x00\xff\xff\x04\x00\xff\xff\xff\xff\x03\x00\x03\x00\x09\x00\x09\x00\x09\x00\x0b\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\xff\xff\x0e\x00\xff\xff\x0d\x00\x0e\x00\x0e\x00\x12\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0f\x00\x0e\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\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\x06\x00\x07\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x19\x00\xff\xff\x00\x00\x00\x00\x17\x00\x19\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\xff\xff\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x1a\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x00\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1c\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1f\x00\x00\x00\x00\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +alex_check :: AlexAddr +alex_check = AlexA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\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\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x2d\x00\x0a\x00\x0a\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7c\x00\x3a\x00\x26\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x3e\x00\xff\xff\xff\xff\xff\xff\x3d\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x20\x00\x3d\x00\x3d\x00\x3e\x00\x3d\x00\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x7d\x00\x7d\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xd7\x00\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\x22\x00\xf7\x00\xff\xff\xff\xff\x5f\x00\x27\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x5c\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\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\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\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\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\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"# + +alex_deflt :: AlexAddr +alex_deflt = AlexA# "\x17\x00\xff\xff\x02\x00\x02\x00\xff\xff\xff\xff\x0a\x00\xff\xff\x0a\x00\x0a\x00\x0a\x00\x0a\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\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_accept = listArray (0::Int,32) [[],[],[(AlexAccSkip)],[(AlexAccSkip)],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAccSkip)],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[],[],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_7))],[],[],[]] +{-# LINE 34 "Transfer/Syntax/Lex.x" #-} + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" + +posLineCol (Pn _ l c) = (l,c) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken t = case t of + PT _ (TS s) -> s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + + _ -> show t + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords = b "import" (b "derive" (b "case" (b "Type" N N) (b "data" N N)) (b "else" (b "do" N N) (b "if" N N))) (b "rec" (b "let" (b "in" N N) (b "of" N N)) (b "then" (b "sig" N N) (b "where" N N))) + where b s = B s (TS s) + +unescapeInitTail :: String -> String +unescapeInitTail = unesc . tail where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type AlexInput = (Posn, -- current position, + Char, -- previous char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', str) + where + go :: (Posn, Char, String) -> [Token] + go inp@(pos, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _) -> fail $ show pos ++ ": lexical error" + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p, c, []) = Nothing +alexGetChar (p, _, (c:s)) = + let p' = alexMove p c + in p' `seq` Just (c, (p', c, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, s) = c + +alex_action_3 = tok (\p s -> PT p (TS $ share s)) +alex_action_4 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_5 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) +alex_action_6 = tok (\p s -> PT p (TI $ share s)) +alex_action_7 = tok (\p s -> PT p (TD $ share s)) +{-# LINE 1 "GenericTemplate.hs" #-} +{-# LINE 1 "<built-in>" #-} +{-# LINE 1 "<command line>" #-} +{-# LINE 1 "GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + +{-# LINE 35 "GenericTemplate.hs" #-} + +{-# LINE 45 "GenericTemplate.hs" #-} + + +data AlexAddr = AlexA# Addr# + +#if __GLASGOW_HASKELL__ < 503 +uncheckedShiftL# = shiftL# +#endif + +{-# INLINE alexIndexInt16OffAddr #-} +alexIndexInt16OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow16Int# i + where + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# +#else + indexInt16OffAddr# arr off +#endif + + + + + +{-# INLINE alexIndexInt32OffAddr #-} +alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow32Int# i + where + i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + (b2 `uncheckedShiftL#` 16#) `or#` + (b1 `uncheckedShiftL#` 8#) `or#` b0) + b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) + b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) + b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + b0 = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 4# +#else + indexInt32OffAddr# arr off +#endif + + + + + +#if __GLASGOW_HASKELL__ < 503 +quickIndex arr i = arr ! i +#else +-- GHC >= 503, unsafeAt is available from Data.Array.Base. +quickIndex = unsafeAt +#endif + + + + +-- ----------------------------------------------------------------------------- +-- Main lexing routines + +data AlexReturn a + = AlexEOF + | AlexError !AlexInput + | AlexSkip !AlexInput !Int + | AlexToken !AlexInput !Int a + +-- alexScan :: AlexInput -> StartCode -> Maybe (AlexInput,Int,act) +alexScan input (I# (sc)) + = alexScanUser undefined input (I# (sc)) + +alexScanUser user input (I# (sc)) + = case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, input') -> + case alexGetChar input of + Nothing -> + + + + AlexEOF + Just _ -> + + + + AlexError input' + + (AlexLastSkip input len, _) -> + + + + AlexSkip input len + + (AlexLastAcc k input len, _) -> + + + + AlexToken input len k + + +-- Push the input through the DFA, remembering the most recent accepting +-- state it encountered. + +alex_scan_tkn user orig_input len input s last_acc = + input `seq` -- strict in the input + case s of + -1# -> (last_acc, input) + _ -> alex_scan_tkn' user orig_input len input s last_acc + +alex_scan_tkn' user orig_input len input s last_acc = + let + new_acc = check_accs (alex_accept `quickIndex` (I# (s))) + in + new_acc `seq` + case alexGetChar input of + Nothing -> (new_acc, input) + Just (c, new_input) -> + + + + let + base = alexIndexInt32OffAddr alex_base s + (I# (ord_c)) = ord c + offset = (base +# ord_c) + check = alexIndexInt16OffAddr alex_check offset + + new_s = if (offset >=# 0#) && (check ==# ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + in + alex_scan_tkn user orig_input (len +# 1#) new_input new_s new_acc + + where + check_accs [] = last_acc + check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) + check_accs (AlexAccPred a pred : rest) + | pred user orig_input (I# (len)) input + = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkipPred pred : rest) + | pred user orig_input (I# (len)) input + = AlexLastSkip input (I# (len)) + check_accs (_ : rest) = check_accs rest + +data AlexLastAcc a + = AlexNone + | AlexLastAcc a !AlexInput !Int + | AlexLastSkip !AlexInput !Int + +data AlexAcc a user + = AlexAcc a + | AlexAccSkip + | AlexAccPred a (AlexAccPred user) + | AlexAccSkipPred (AlexAccPred user) + +type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool + +-- ----------------------------------------------------------------------------- +-- Predicates on a rule + +alexAndPred p1 p2 user in1 len in2 + = p1 user in1 len in2 && p2 user in1 len in2 + +--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input + +--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input + +--alexRightContext :: Int -> AlexAccPred _ +alexRightContext (I# (sc)) user _ _ input = + case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, _) -> False + _ -> True + -- TODO: there's no need to find the longest + -- match when checking the right context, just + -- the first match will do. + +-- used by wrappers +iUnbox (I# (i)) = i diff --git a/src/Transfer/Syntax/Lex.x b/src/Transfer/Syntax/Lex.x new file mode 100644 index 000000000..107b67345 --- /dev/null +++ b/src/Transfer/Syntax/Lex.x @@ -0,0 +1,134 @@ +-- -*- haskell -*- +-- This Alex file was machine-generated by the BNF converter +{ +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module Transfer.Syntax.Lex where + + +} + + +$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME +$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME +$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME +$d = [0-9] -- digit +$i = [$l $d _ '] -- identifier character +$u = [\0-\255] -- universal: any character + +@rsyms = -- symbols and non-identifier-like reserved words + \; | \: | \{ | \} | \= | \| | \| \| | \: \: | \( | \) | \[ | \] | \, | \_ | \- \> | \\ | \< \- | \> \> \= | \> \> | \& \& | \= \= | \/ \= | \< | \< \= | \> | \> \= | \+ | \- | \* | \/ | \% | \. | \? + +:- +"--" [.]* ; -- Toss single line comments +"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; + +$white+ ; +@rsyms { tok (\p s -> PT p (TS $ share s)) } + +$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) } +\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) } + +$d+ { tok (\p s -> PT p (TI $ share s)) } +$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) } + +{ + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" + +posLineCol (Pn _ l c) = (l,c) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken t = case t of + PT _ (TS s) -> s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + + _ -> show t + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords = b "import" (b "derive" (b "case" (b "Type" N N) (b "data" N N)) (b "else" (b "do" N N) (b "if" N N))) (b "rec" (b "let" (b "in" N N) (b "of" N N)) (b "then" (b "sig" N N) (b "where" N N))) + where b s = B s (TS s) + +unescapeInitTail :: String -> String +unescapeInitTail = unesc . tail where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type AlexInput = (Posn, -- current position, + Char, -- previous char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', str) + where + go :: (Posn, Char, String) -> [Token] + go inp@(pos, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _) -> fail $ show pos ++ ": lexical error" + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p, c, []) = Nothing +alexGetChar (p, _, (c:s)) = + let p' = alexMove p c + in p' `seq` Just (c, (p', c, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, s) = c +} diff --git a/src/Transfer/Syntax/Par.hs b/src/Transfer/Syntax/Par.hs new file mode 100644 index 000000000..bd83f0a87 --- /dev/null +++ b/src/Transfer/Syntax/Par.hs @@ -0,0 +1,1822 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module Transfer.Syntax.Par where +import Transfer.Syntax.Abs +import Transfer.Syntax.Lex +import Transfer.ErrM +import Array +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif + +-- parser produced by Happy Version 1.15 + +newtype HappyAbsSyn = HappyAbsSyn (() -> ()) +happyIn5 :: (Ident) -> (HappyAbsSyn ) +happyIn5 x = unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn ) -> (Ident) +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 :: (Integer) -> (HappyAbsSyn ) +happyIn7 x = unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn ) -> (Integer) +happyOut7 x = unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: (Double) -> (HappyAbsSyn ) +happyIn8 x = unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn ) -> (Double) +happyOut8 x = unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: (Module) -> (HappyAbsSyn ) +happyIn9 x = unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn ) -> (Module) +happyOut9 x = unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: (Import) -> (HappyAbsSyn ) +happyIn10 x = unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn ) -> (Import) +happyOut10 x = unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: ([Import]) -> (HappyAbsSyn ) +happyIn11 x = unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn ) -> ([Import]) +happyOut11 x = unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: (Decl) -> (HappyAbsSyn ) +happyIn12 x = unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn ) -> (Decl) +happyOut12 x = unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyIn13 :: ([Decl]) -> (HappyAbsSyn ) +happyIn13 x = unsafeCoerce# x +{-# INLINE happyIn13 #-} +happyOut13 :: (HappyAbsSyn ) -> ([Decl]) +happyOut13 x = unsafeCoerce# x +{-# INLINE happyOut13 #-} +happyIn14 :: (ConsDecl) -> (HappyAbsSyn ) +happyIn14 x = unsafeCoerce# x +{-# INLINE happyIn14 #-} +happyOut14 :: (HappyAbsSyn ) -> (ConsDecl) +happyOut14 x = unsafeCoerce# x +{-# INLINE happyOut14 #-} +happyIn15 :: ([ConsDecl]) -> (HappyAbsSyn ) +happyIn15 x = unsafeCoerce# x +{-# INLINE happyIn15 #-} +happyOut15 :: (HappyAbsSyn ) -> ([ConsDecl]) +happyOut15 x = unsafeCoerce# x +{-# INLINE happyOut15 #-} +happyIn16 :: (Guard) -> (HappyAbsSyn ) +happyIn16 x = unsafeCoerce# x +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn ) -> (Guard) +happyOut16 x = unsafeCoerce# x +{-# INLINE happyOut16 #-} +happyIn17 :: (Pattern) -> (HappyAbsSyn ) +happyIn17 x = unsafeCoerce# x +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn ) -> (Pattern) +happyOut17 x = unsafeCoerce# x +{-# INLINE happyOut17 #-} +happyIn18 :: (Pattern) -> (HappyAbsSyn ) +happyIn18 x = unsafeCoerce# x +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn ) -> (Pattern) +happyOut18 x = unsafeCoerce# x +{-# INLINE happyOut18 #-} +happyIn19 :: (Pattern) -> (HappyAbsSyn ) +happyIn19 x = unsafeCoerce# x +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn ) -> (Pattern) +happyOut19 x = unsafeCoerce# x +{-# INLINE happyOut19 #-} +happyIn20 :: (Pattern) -> (HappyAbsSyn ) +happyIn20 x = unsafeCoerce# x +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn ) -> (Pattern) +happyOut20 x = unsafeCoerce# x +{-# INLINE happyOut20 #-} +happyIn21 :: (CommaPattern) -> (HappyAbsSyn ) +happyIn21 x = unsafeCoerce# x +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn ) -> (CommaPattern) +happyOut21 x = unsafeCoerce# x +{-# INLINE happyOut21 #-} +happyIn22 :: ([CommaPattern]) -> (HappyAbsSyn ) +happyIn22 x = unsafeCoerce# x +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn ) -> ([CommaPattern]) +happyOut22 x = unsafeCoerce# x +{-# INLINE happyOut22 #-} +happyIn23 :: ([Pattern]) -> (HappyAbsSyn ) +happyIn23 x = unsafeCoerce# x +{-# INLINE happyIn23 #-} +happyOut23 :: (HappyAbsSyn ) -> ([Pattern]) +happyOut23 x = unsafeCoerce# x +{-# INLINE happyOut23 #-} +happyIn24 :: (FieldPattern) -> (HappyAbsSyn ) +happyIn24 x = unsafeCoerce# x +{-# INLINE happyIn24 #-} +happyOut24 :: (HappyAbsSyn ) -> (FieldPattern) +happyOut24 x = unsafeCoerce# x +{-# INLINE happyOut24 #-} +happyIn25 :: ([FieldPattern]) -> (HappyAbsSyn ) +happyIn25 x = unsafeCoerce# x +{-# INLINE happyIn25 #-} +happyOut25 :: (HappyAbsSyn ) -> ([FieldPattern]) +happyOut25 x = unsafeCoerce# x +{-# INLINE happyOut25 #-} +happyIn26 :: (Exp) -> (HappyAbsSyn ) +happyIn26 x = unsafeCoerce# x +{-# INLINE happyIn26 #-} +happyOut26 :: (HappyAbsSyn ) -> (Exp) +happyOut26 x = unsafeCoerce# x +{-# INLINE happyOut26 #-} +happyIn27 :: (VarOrWild) -> (HappyAbsSyn ) +happyIn27 x = unsafeCoerce# x +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn ) -> (VarOrWild) +happyOut27 x = unsafeCoerce# x +{-# INLINE happyOut27 #-} +happyIn28 :: (Exp) -> (HappyAbsSyn ) +happyIn28 x = unsafeCoerce# x +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn ) -> (Exp) +happyOut28 x = unsafeCoerce# x +{-# INLINE happyOut28 #-} +happyIn29 :: (LetDef) -> (HappyAbsSyn ) +happyIn29 x = unsafeCoerce# x +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn ) -> (LetDef) +happyOut29 x = unsafeCoerce# x +{-# INLINE happyOut29 #-} +happyIn30 :: ([LetDef]) -> (HappyAbsSyn ) +happyIn30 x = unsafeCoerce# x +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn ) -> ([LetDef]) +happyOut30 x = unsafeCoerce# x +{-# INLINE happyOut30 #-} +happyIn31 :: (Case) -> (HappyAbsSyn ) +happyIn31 x = unsafeCoerce# x +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn ) -> (Case) +happyOut31 x = unsafeCoerce# x +{-# INLINE happyOut31 #-} +happyIn32 :: ([Case]) -> (HappyAbsSyn ) +happyIn32 x = unsafeCoerce# x +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn ) -> ([Case]) +happyOut32 x = unsafeCoerce# x +{-# INLINE happyOut32 #-} +happyIn33 :: (Bind) -> (HappyAbsSyn ) +happyIn33 x = unsafeCoerce# x +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn ) -> (Bind) +happyOut33 x = unsafeCoerce# x +{-# INLINE happyOut33 #-} +happyIn34 :: ([Bind]) -> (HappyAbsSyn ) +happyIn34 x = unsafeCoerce# x +{-# INLINE happyIn34 #-} +happyOut34 :: (HappyAbsSyn ) -> ([Bind]) +happyOut34 x = unsafeCoerce# x +{-# INLINE happyOut34 #-} +happyIn35 :: (Exp) -> (HappyAbsSyn ) +happyIn35 x = unsafeCoerce# x +{-# INLINE happyIn35 #-} +happyOut35 :: (HappyAbsSyn ) -> (Exp) +happyOut35 x = unsafeCoerce# x +{-# INLINE happyOut35 #-} +happyIn36 :: (Exp) -> (HappyAbsSyn ) +happyIn36 x = unsafeCoerce# x +{-# INLINE happyIn36 #-} +happyOut36 :: (HappyAbsSyn ) -> (Exp) +happyOut36 x = unsafeCoerce# x +{-# INLINE happyOut36 #-} +happyIn37 :: (Exp) -> (HappyAbsSyn ) +happyIn37 x = unsafeCoerce# x +{-# INLINE happyIn37 #-} +happyOut37 :: (HappyAbsSyn ) -> (Exp) +happyOut37 x = unsafeCoerce# x +{-# INLINE happyOut37 #-} +happyIn38 :: (Exp) -> (HappyAbsSyn ) +happyIn38 x = unsafeCoerce# x +{-# INLINE happyIn38 #-} +happyOut38 :: (HappyAbsSyn ) -> (Exp) +happyOut38 x = unsafeCoerce# x +{-# INLINE happyOut38 #-} +happyIn39 :: (Exp) -> (HappyAbsSyn ) +happyIn39 x = unsafeCoerce# x +{-# INLINE happyIn39 #-} +happyOut39 :: (HappyAbsSyn ) -> (Exp) +happyOut39 x = unsafeCoerce# x +{-# INLINE happyOut39 #-} +happyIn40 :: (Exp) -> (HappyAbsSyn ) +happyIn40 x = unsafeCoerce# x +{-# INLINE happyIn40 #-} +happyOut40 :: (HappyAbsSyn ) -> (Exp) +happyOut40 x = unsafeCoerce# x +{-# INLINE happyOut40 #-} +happyIn41 :: (Exp) -> (HappyAbsSyn ) +happyIn41 x = unsafeCoerce# x +{-# INLINE happyIn41 #-} +happyOut41 :: (HappyAbsSyn ) -> (Exp) +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 :: (Exp) -> (HappyAbsSyn ) +happyIn43 x = unsafeCoerce# x +{-# INLINE happyIn43 #-} +happyOut43 :: (HappyAbsSyn ) -> (Exp) +happyOut43 x = unsafeCoerce# x +{-# INLINE happyOut43 #-} +happyIn44 :: (Exp) -> (HappyAbsSyn ) +happyIn44 x = unsafeCoerce# x +{-# INLINE happyIn44 #-} +happyOut44 :: (HappyAbsSyn ) -> (Exp) +happyOut44 x = unsafeCoerce# x +{-# INLINE happyOut44 #-} +happyIn45 :: (Exp) -> (HappyAbsSyn ) +happyIn45 x = unsafeCoerce# x +{-# INLINE happyIn45 #-} +happyOut45 :: (HappyAbsSyn ) -> (Exp) +happyOut45 x = unsafeCoerce# x +{-# INLINE happyOut45 #-} +happyIn46 :: (FieldType) -> (HappyAbsSyn ) +happyIn46 x = unsafeCoerce# x +{-# INLINE happyIn46 #-} +happyOut46 :: (HappyAbsSyn ) -> (FieldType) +happyOut46 x = unsafeCoerce# x +{-# INLINE happyOut46 #-} +happyIn47 :: ([FieldType]) -> (HappyAbsSyn ) +happyIn47 x = unsafeCoerce# x +{-# INLINE happyIn47 #-} +happyOut47 :: (HappyAbsSyn ) -> ([FieldType]) +happyOut47 x = unsafeCoerce# x +{-# INLINE happyOut47 #-} +happyIn48 :: (FieldValue) -> (HappyAbsSyn ) +happyIn48 x = unsafeCoerce# x +{-# INLINE happyIn48 #-} +happyOut48 :: (HappyAbsSyn ) -> (FieldValue) +happyOut48 x = unsafeCoerce# x +{-# INLINE happyOut48 #-} +happyIn49 :: ([FieldValue]) -> (HappyAbsSyn ) +happyIn49 x = unsafeCoerce# x +{-# INLINE happyIn49 #-} +happyOut49 :: (HappyAbsSyn ) -> ([FieldValue]) +happyOut49 x = unsafeCoerce# x +{-# INLINE happyOut49 #-} +happyIn50 :: (Exp) -> (HappyAbsSyn ) +happyIn50 x = unsafeCoerce# x +{-# INLINE happyIn50 #-} +happyOut50 :: (HappyAbsSyn ) -> (Exp) +happyOut50 x = unsafeCoerce# x +{-# INLINE happyOut50 #-} +happyIn51 :: ([Exp]) -> (HappyAbsSyn ) +happyIn51 x = unsafeCoerce# x +{-# INLINE happyIn51 #-} +happyOut51 :: (HappyAbsSyn ) -> ([Exp]) +happyOut51 x = unsafeCoerce# x +{-# INLINE happyOut51 #-} +happyInTok :: Token -> (HappyAbsSyn ) +happyInTok x = unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> Token +happyOutTok x = unsafeCoerce# x +{-# INLINE happyOutTok #-} + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x00\x00\x48\x03\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x01\xa8\x01\x34\x00\x00\x00\xaf\x01\xa1\x01\x6c\x00\x9f\x00\xb6\x00\x00\x00\x64\x03\x7d\x01\x00\x00\x00\x00\xd4\x02\xb8\x02\xf9\xff\x50\x03\x00\x00\x00\x00\x48\x03\xb1\x01\x48\x03\xa5\x01\xa0\x01\x9e\x01\x00\x00\x00\x00\x00\x00\x68\x01\x73\x01\x9a\x01\x7d\x00\x5e\x01\x5e\x01\x5e\x01\x5e\x01\x5b\x01\x00\x00\x5c\x01\x00\x00\x48\x03\x00\x00\x75\x01\x00\x00\x78\x01\x77\x01\x00\x00\x03\x00\x41\x00\x80\x01\x45\x01\x51\x01\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x50\x03\x48\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x03\x00\x00\x48\x03\x00\x00\x48\x03\x34\x03\x6c\x01\xa4\x02\x18\x03\x67\x01\x6a\x01\x66\x01\x58\x01\x57\x01\x65\x01\x54\x01\x52\x01\x4e\x01\x00\x00\x4f\x01\x3e\x01\x1f\x01\x1f\x01\x00\x00\x1f\x01\x3b\x01\x00\x00\x8c\x02\x18\x03\x00\x00\x13\x01\x18\x03\x00\x00\x13\x01\x18\x03\x10\x01\x08\x01\x18\x03\x04\x01\x34\x01\x26\x01\x20\x01\x85\x03\x00\x00\x00\x00\x1c\x01\x1a\x01\x11\x01\x00\x00\x85\x03\x00\x00\x00\x00\x19\x01\x17\x01\x0a\x01\x00\x00\x0c\x01\x07\x01\x85\x03\x7e\x03\x00\x00\x05\x01\x00\x00\x18\x03\x00\x00\x04\x03\x00\x00\x00\x00\x04\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x00\x00\x04\x03\xe8\x02\x00\x00\xd6\x00\x00\x00\xe8\x02\x00\x00\x00\x00\x00\x00\xd4\x00\x00\x00\xec\x00\xe6\x00\x00\x00\xea\x00\xe2\x00\x00\x00\x85\x03\x85\x03\x85\x03\xde\x00\x00\x00\xe8\x02\x00\x00\x85\x03\xe8\x02\x00\x00\x00\x00\x00\x00\x85\x03\x00\x00\x00\x00\x85\x03\xe9\x00\xdf\x00\xe8\x00\x00\x00\xd8\x00\xa8\x00\x00\x00\xa8\x00\x85\x03\x00\x00\xcc\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x00\xbb\x00\xa5\x00\x00\x00\x8c\x00\xe8\x02\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\xbc\x00\x21\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x04\x00\x00\x00\x00\x00\x00\x78\x00\x35\x00\x17\x00\x67\x04\x00\x00\x00\x00\x08\x02\x00\x00\xef\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x0a\x00\x95\x00\x60\x00\x19\x00\x67\x00\x00\x00\x6f\x00\x00\x00\x00\x00\xd6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8b\x00\x00\x00\x63\x04\x5f\x04\x5b\x04\x29\x04\x57\x04\x52\x04\x22\x04\x1b\x04\x14\x04\x0d\x04\xe4\x03\xdd\x03\xd6\x03\xcd\x03\xa4\x03\x9a\x03\xbd\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x01\x00\x00\x1b\x00\x00\x00\x01\x00\x81\x02\x00\x00\x4f\x00\x8b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x00\x00\x61\x00\x4d\x00\x00\x00\x0e\x00\x00\x00\x00\x00\xe5\x04\x72\x01\x00\x00\x5e\x00\x59\x01\x00\x00\x08\x00\x40\x01\x00\x00\x13\x00\x27\x01\x00\x00\x00\x00\x00\x00\x00\x00\x98\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x02\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\x04\xba\x04\x00\x00\x00\x00\x00\x00\x0e\x01\x00\x00\x69\x02\x00\x00\x00\x00\x51\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x02\xf5\x00\x00\x00\x00\x00\x00\x00\xdc\x00\x00\x00\x00\x00\x00\x00\x90\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x94\x04\x9f\x03\xd5\x04\x00\x00\xf7\xff\xc3\x00\x00\x00\x0b\x00\xaa\x00\x00\x00\x00\x00\x00\x00\xb4\x04\x00\x00\x00\x00\x9c\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x6a\x00\xd1\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x91\x00\x00\x00\x00\x00\x00\x00"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\xf7\xff\x00\x00\x00\x00\xfd\xff\x98\xff\x96\xff\x95\xff\x94\xff\x00\x00\xcf\xff\x89\xff\xb8\xff\xb6\xff\xb4\xff\xad\xff\xab\xff\xa8\xff\xa4\xff\xa2\xff\xa0\xff\x9e\xff\xc7\xff\x00\x00\x00\x00\x00\x00\x00\x00\x93\xff\x97\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xff\xfb\xff\xfa\xff\x00\x00\xf1\xff\x00\x00\xf9\xff\x00\x00\x90\xff\x8c\xff\xc5\xff\x00\x00\xbc\xff\x00\x00\xa3\xff\x00\x00\xce\xff\x00\x00\xcd\xff\x88\xff\x00\x00\x9b\xff\x98\xff\x00\x00\x00\x00\x00\x00\xa1\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\xd0\xff\xb9\xff\xba\xff\xb7\xff\xb5\xff\xae\xff\xaf\xff\xb0\xff\xb1\xff\xb2\xff\xb3\xff\xa9\xff\xaa\xff\xac\xff\xa5\xff\xa6\xff\xa7\xff\x9f\xff\x00\x00\x92\xff\x00\x00\x9a\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\xff\x00\x00\x00\x00\x8b\xff\x00\x00\x00\x00\x8f\xff\x00\x00\xf8\xff\xd7\xff\x00\x00\x00\x00\x00\x00\xf6\xff\x00\x00\x00\x00\xf0\xff\xea\xff\x00\x00\x9d\xff\x90\xff\x00\x00\x9c\xff\x8c\xff\x00\x00\x00\x00\xc5\xff\x00\x00\x00\x00\xbd\xff\x00\x00\x00\x00\xc1\xff\xcc\xff\x87\xff\x00\x00\x00\x00\x00\x00\x99\xff\xdd\xff\xdf\xff\xde\xff\xea\xff\xe8\xff\xe6\xff\xe4\xff\xc0\xff\x00\x00\x00\x00\x00\x00\xdc\xff\x00\x00\xbb\xff\x00\x00\xc8\xff\x00\x00\xc6\xff\xc3\xff\x00\x00\x8d\xff\x8a\xff\x91\xff\x8e\xff\xf4\xff\xdd\xff\x00\x00\xd6\xff\x00\x00\x00\x00\xf2\xff\x00\x00\xeb\xff\x00\x00\xcb\xff\xc9\xff\xbe\xff\xd4\xff\xda\xff\xd9\xff\x00\x00\xe2\xff\xda\xff\x00\x00\xca\xff\xc1\xff\x00\x00\x00\x00\x00\x00\xd7\xff\x00\x00\xd1\xff\xe5\xff\x00\x00\xe9\xff\xe7\xff\xbf\xff\x00\x00\xdb\xff\xe1\xff\x00\x00\x00\x00\xd3\xff\x00\x00\xf3\xff\x00\x00\xee\xff\xe3\xff\xd4\xff\x00\x00\xd8\xff\x00\x00\xc2\xff\xe0\xff\xd5\xff\xd2\xff\x00\x00\xed\xff\x00\x00\xf5\xff\xee\xff\x00\x00\xef\xff\xec\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x02\x00\x00\x00\x0e\x00\x00\x00\x12\x00\x00\x00\x00\x00\x01\x00\x02\x00\x00\x00\x09\x00\x0a\x00\x07\x00\x05\x00\x00\x00\x11\x00\x08\x00\x15\x00\x00\x00\x17\x00\x00\x00\x0f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x31\x00\x18\x00\x19\x00\x16\x00\x2d\x00\x2e\x00\x15\x00\x0b\x00\x17\x00\x2b\x00\x2c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x2b\x00\x2c\x00\x12\x00\x13\x00\x2d\x00\x2e\x00\x15\x00\x0a\x00\x17\x00\x00\x00\x0d\x00\x00\x00\x01\x00\x02\x00\x03\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\x00\x00\x00\x00\x00\x00\x2d\x00\x2e\x00\x15\x00\x16\x00\x17\x00\x00\x00\x09\x00\x0a\x00\x00\x00\x1c\x00\x12\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\x03\x00\x2d\x00\x13\x00\x14\x00\x18\x00\x19\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x29\x00\x2a\x00\x29\x00\x2a\x00\x00\x00\x1d\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x24\x00\x25\x00\x13\x00\x14\x00\x2d\x00\x15\x00\x08\x00\x17\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x31\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x1b\x00\x1c\x00\x01\x00\x31\x00\x2d\x00\x15\x00\x04\x00\x17\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x02\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x1d\x00\x1e\x00\x1f\x00\x0a\x00\x2d\x00\x15\x00\x31\x00\x17\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x01\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x04\x00\x0f\x00\x05\x00\x0d\x00\x2d\x00\x15\x00\x0c\x00\x17\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x31\x00\x30\x00\x05\x00\x03\x00\x2d\x00\x15\x00\x04\x00\x17\x00\x01\x00\x00\x00\x01\x00\x02\x00\x03\x00\x08\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x07\x00\x06\x00\x0f\x00\x01\x00\x2d\x00\x15\x00\x0a\x00\x17\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x27\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x11\x00\x04\x00\x31\x00\x2a\x00\x2d\x00\x15\x00\x02\x00\x17\x00\x01\x00\x00\x00\x01\x00\x02\x00\x03\x00\x31\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x31\x00\x02\x00\x04\x00\x01\x00\x2d\x00\x15\x00\x02\x00\x17\x00\x01\x00\x00\x00\x01\x00\x02\x00\x03\x00\x05\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x04\x00\x04\x00\x01\x00\x05\x00\x2d\x00\x15\x00\x03\x00\x17\x00\x20\x00\x00\x00\x01\x00\x02\x00\x03\x00\x31\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x02\x00\x0c\x00\x0f\x00\x0d\x00\x2d\x00\x15\x00\x2c\x00\x17\x00\x2f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x31\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x01\x00\x29\x00\x20\x00\x36\x00\x2d\x00\x15\x00\x03\x00\x17\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x03\x00\x14\x00\x07\x00\x0f\x00\x2d\x00\x15\x00\x36\x00\x17\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x31\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\x15\x00\xff\xff\x17\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\x15\x00\xff\xff\x17\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\x15\x00\xff\xff\x17\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\x15\x00\xff\xff\x17\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\x15\x00\xff\xff\x17\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x17\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x17\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x17\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x06\x00\xff\xff\xff\xff\x09\x00\x2d\x00\x0b\x00\x17\x00\xff\xff\x0e\x00\x00\x00\x01\x00\x02\x00\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x0f\x00\xff\xff\xff\xff\x09\x00\x2d\x00\x0b\x00\xff\xff\xff\xff\x0e\x00\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x1c\x00\x09\x00\xff\xff\x0b\x00\x0c\x00\x21\x00\x22\x00\x23\x00\x10\x00\xff\xff\x26\x00\xff\xff\x28\x00\xff\xff\xff\xff\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\x1c\x00\x31\x00\x32\x00\x33\x00\x34\x00\x21\x00\x22\x00\x23\x00\xff\xff\x09\x00\x26\x00\x0b\x00\x28\x00\xff\xff\x0e\x00\x2b\x00\x10\x00\x2d\x00\x2e\x00\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x09\x00\xff\xff\x0b\x00\xff\xff\x21\x00\x22\x00\x23\x00\x10\x00\xff\xff\x26\x00\xff\xff\x28\x00\xff\xff\xff\xff\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\x1c\x00\x31\x00\x32\x00\x33\x00\x34\x00\x21\x00\x22\x00\x23\x00\xff\xff\x09\x00\x26\x00\x0b\x00\x28\x00\xff\xff\xff\xff\x2b\x00\x10\x00\x2d\x00\x2e\x00\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x09\x00\xff\xff\x0b\x00\xff\xff\x21\x00\x22\x00\x23\x00\x10\x00\xff\xff\x26\x00\xff\xff\x28\x00\xff\xff\xff\xff\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\x1c\x00\x31\x00\x32\x00\x33\x00\x34\x00\x21\x00\x22\x00\x23\x00\xff\xff\x09\x00\x26\x00\x0b\x00\x28\x00\xff\xff\xff\xff\x2b\x00\x10\x00\x2d\x00\x2e\x00\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x09\x00\xff\xff\x0b\x00\xff\xff\x21\x00\x22\x00\x23\x00\x10\x00\x09\x00\x26\x00\x0b\x00\x28\x00\xff\xff\xff\xff\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\x1c\x00\x31\x00\x32\x00\x33\x00\x34\x00\x21\x00\x22\x00\x23\x00\x1c\x00\x09\x00\x26\x00\x0b\x00\x28\x00\x21\x00\x22\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x2d\x00\x2e\x00\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\x21\x00\x22\x00\x09\x00\xff\xff\x0b\x00\x0c\x00\xff\xff\x0e\x00\xff\xff\x09\x00\xff\xff\x0b\x00\x2d\x00\x2e\x00\x0e\x00\xff\xff\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x00\x00\x01\x00\x02\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x2d\x00\x0d\x00\x0e\x00\x0f\x00\x31\x00\x32\x00\x33\x00\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\x33\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\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\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x25\x00\x26\x00\x27\x00\x28\x00\x25\x00\x26\x00\x27\x00\x28\x00\x25\x00\x26\x00\x27\x00\x28\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\x27\x00\x28\x00\x00\x00\x01\x00\x02\x00\xff\xff\x00\x00\x01\x00\x02\x00\xff\xff\x00\x00\x01\x00\x02\x00\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x1a\x00\x1b\x00\xff\xff\xff\xff\x1a\x00\x1b\x00\x00\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x00\x00\x01\x00\x02\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\xff\xff\x00\x00\x01\x00\x02\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x00\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\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\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\xce\xff\xdd\x00\x35\x00\x6c\x00\xc5\x00\x73\x00\xaa\x00\x92\x00\x93\x00\xaf\x00\xde\x00\xe4\x00\x74\x00\x27\x00\x69\x00\xce\xff\x28\x00\x35\x00\x32\x00\x09\x00\x6c\x00\xac\x00\x04\x00\x05\x00\x06\x00\x07\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x04\x00\x6a\x00\xa3\x00\x33\x00\x15\x00\x8c\x00\x35\x00\xc1\x00\x09\x00\x6d\x00\xa6\x00\x04\x00\x05\x00\x06\x00\x07\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x6d\x00\x6e\x00\x4c\x00\x4d\x00\x15\x00\x8d\x00\x35\x00\x62\x00\x09\x00\x78\x00\x63\x00\x38\x00\x05\x00\x06\x00\x07\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x6f\x00\xdd\x00\x6f\x00\x79\x00\x15\x00\x36\x00\x87\x00\x88\x00\x09\x00\x69\x00\xde\x00\xdf\x00\xce\x00\x89\x00\x7b\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x38\x00\x05\x00\x06\x00\x07\x00\x15\x00\xcf\x00\xdc\x00\x6a\x00\x6b\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x70\x00\xa8\x00\x70\x00\x71\x00\x5f\x00\x67\x00\x39\x00\x3a\x00\x09\x00\xce\x00\x04\x00\x05\x00\x06\x00\x07\x00\x72\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x76\x00\x77\x00\xcf\x00\xd0\x00\x15\x00\xe3\x00\x41\x00\x09\x00\xe1\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x42\x00\x43\x00\xe2\x00\x04\x00\x15\x00\xd9\x00\x25\x00\x09\x00\x26\x00\x04\x00\x05\x00\x06\x00\x07\x00\xe3\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x3e\x00\x3f\x00\x40\x00\xdb\x00\x15\x00\xc4\x00\x04\x00\x09\x00\xd4\x00\x04\x00\x05\x00\x06\x00\x07\x00\xd6\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\xd5\x00\xc7\x00\xd7\x00\xcb\x00\x15\x00\xd1\x00\xcd\x00\x09\x00\xcc\x00\x04\x00\x05\x00\x06\x00\x07\x00\xce\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x04\x00\xd3\x00\xb3\x00\xb7\x00\x15\x00\xb0\x00\xbe\x00\x09\x00\xbf\x00\x04\x00\x05\x00\x06\x00\x07\x00\xc0\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\xc1\x00\xae\x00\xc4\x00\x9f\x00\x15\x00\xb5\x00\x90\x00\x09\x00\x91\x00\x04\x00\x05\x00\x06\x00\x07\x00\xa2\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\xa0\x00\xa1\x00\x04\x00\xa5\x00\x15\x00\xa2\x00\xaf\x00\x09\x00\x7b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x04\x00\x7d\x00\x7e\x00\x7f\x00\x15\x00\xa5\x00\x80\x00\x09\x00\x82\x00\x04\x00\x05\x00\x06\x00\x07\x00\x83\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x81\x00\x84\x00\x85\x00\x86\x00\x15\x00\xa7\x00\x8b\x00\x09\x00\x3c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x61\x00\x64\x00\x66\x00\x65\x00\x15\x00\xa9\x00\x67\x00\x09\x00\x69\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x78\x00\x2a\x00\x3c\x00\xff\xff\x15\x00\x86\x00\x2b\x00\x09\x00\x2c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x2d\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x2f\x00\x4a\x00\x4b\x00\x4e\x00\x15\x00\x8e\x00\xff\xff\x09\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x4e\x00\x00\x00\x09\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x39\x00\x00\x00\x09\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x2d\x00\x00\x00\x09\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x2f\x00\x00\x00\x09\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x08\x00\x00\x00\x09\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xb1\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xb3\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xb4\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\xae\x00\x00\x00\x00\x00\x9b\x00\x15\x00\x9c\x00\x8b\x00\x00\x00\x9d\x00\xaa\x00\x92\x00\x93\x00\x00\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\xc2\x00\x00\x00\x00\x00\x17\x00\x15\x00\x18\x00\x00\x00\x00\x00\x35\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x04\x00\x23\x00\x24\x00\x1a\x00\x17\x00\x00\x00\x18\x00\x38\x00\x1b\x00\x1c\x00\x1d\x00\x19\x00\x00\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x00\x00\x21\x00\x22\x00\x00\x00\x1a\x00\x04\x00\x23\x00\x24\x00\x25\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x17\x00\x1e\x00\x18\x00\x1f\x00\x00\x00\x35\x00\x20\x00\x19\x00\x21\x00\x22\x00\x00\x00\x00\x00\x04\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x17\x00\x00\x00\x18\x00\x00\x00\x1b\x00\x1c\x00\x1d\x00\x19\x00\x00\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x00\x00\x21\x00\x22\x00\x00\x00\x1a\x00\x04\x00\x23\x00\x24\x00\x25\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x32\x00\x1e\x00\x18\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x19\x00\x21\x00\x22\x00\x00\x00\x00\x00\x04\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x17\x00\x00\x00\x18\x00\x00\x00\x1b\x00\x1c\x00\x1d\x00\x19\x00\x00\x00\x1e\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x00\x00\x21\x00\x22\x00\x00\x00\x1a\x00\x04\x00\x23\x00\x24\x00\x25\x00\x1b\x00\x1c\x00\x1d\x00\x00\x00\x32\x00\x1e\x00\x18\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x19\x00\x21\x00\x22\x00\x00\x00\x00\x00\x04\x00\x23\x00\x24\x00\x25\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x17\x00\x00\x00\x18\x00\x00\x00\x1b\x00\x1c\x00\x1d\x00\x19\x00\x32\x00\x1e\x00\x18\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x00\x00\x21\x00\x22\x00\x00\x00\x1a\x00\x04\x00\x23\x00\x24\x00\x25\x00\x1b\x00\x1c\x00\x1d\x00\x1a\x00\x32\x00\x1e\x00\x18\x00\x1f\x00\x1b\x00\x1c\x00\x20\x00\x00\x00\x21\x00\x22\x00\x00\x00\x00\x00\x04\x00\x23\x00\x24\x00\x25\x00\x21\x00\x22\x00\x00\x00\x00\x00\x04\x00\x23\x00\x24\x00\x25\x00\x1b\x00\x1c\x00\x9b\x00\x00\x00\x9c\x00\xbb\x00\x00\x00\x9d\x00\x00\x00\x9b\x00\x00\x00\x9c\x00\x21\x00\x22\x00\x9d\x00\x00\x00\x04\x00\x23\x00\x24\x00\x25\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x91\x00\x92\x00\x93\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x9e\x00\xc8\x00\x96\x00\x97\x00\x04\x00\x23\x00\x24\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x04\x00\x23\x00\x24\x00\x4f\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x50\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x52\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x53\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x54\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x55\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x56\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x57\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x58\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x5b\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x05\x00\x06\x00\x07\x00\x04\x00\x05\x00\x06\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x11\x00\x12\x00\x13\x00\x14\x00\x5a\x00\x11\x00\x12\x00\x13\x00\x14\x00\x5c\x00\x12\x00\x13\x00\x14\x00\x5d\x00\x12\x00\x13\x00\x14\x00\x5e\x00\x12\x00\x13\x00\x14\x00\x30\x00\x12\x00\x13\x00\x14\x00\x00\x00\x00\x00\x3c\x00\x14\x00\x91\x00\x92\x00\x93\x00\x00\x00\x91\x00\x92\x00\x93\x00\x00\x00\x91\x00\x92\x00\x93\x00\x00\x00\x94\x00\x95\x00\x96\x00\x97\x00\x94\x00\x95\x00\x96\x00\x97\x00\xb7\x00\x95\x00\x96\x00\x97\x00\xb8\x00\xd7\x00\x98\x00\xc9\x00\x00\x00\x00\x00\x98\x00\x99\x00\x91\x00\x92\x00\x93\x00\x00\x00\x00\x00\x00\x00\x91\x00\x92\x00\x93\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x95\x00\x96\x00\x97\x00\xb8\x00\xd8\x00\xb7\x00\x95\x00\x96\x00\x97\x00\xb8\x00\xb9\x00\x91\x00\x92\x00\x93\x00\x00\x00\x00\x00\x91\x00\x92\x00\x93\x00\x00\x00\x91\x00\x92\x00\x93\x00\xbb\x00\x95\x00\x96\x00\x97\x00\xbc\x00\xdb\x00\x95\x00\x96\x00\x97\x00\xc7\x00\x95\x00\x96\x00\x97\x00\xaa\x00\x92\x00\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (2, 120) [ + (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) + ] + +happy_n_terms = 55 :: Int +happy_n_nonterms = 47 :: Int + +happyReduce_2 = happySpecReduce_1 0# happyReduction_2 +happyReduction_2 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TV happy_var_1)) -> + happyIn5 + (Ident happy_var_1 + )} + +happyReduce_3 = happySpecReduce_1 1# happyReduction_3 +happyReduction_3 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> + happyIn6 + (happy_var_1 + )} + +happyReduce_4 = happySpecReduce_1 2# happyReduction_4 +happyReduction_4 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> + happyIn7 + ((read happy_var_1) :: Integer + )} + +happyReduce_5 = happySpecReduce_1 3# happyReduction_5 +happyReduction_5 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> + happyIn8 + ((read happy_var_1) :: Double + )} + +happyReduce_6 = happySpecReduce_2 4# happyReduction_6 +happyReduction_6 happy_x_2 + happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut13 happy_x_2 of { happy_var_2 -> + happyIn9 + (Module (reverse happy_var_1) (reverse happy_var_2) + )}} + +happyReduce_7 = happySpecReduce_2 5# happyReduction_7 +happyReduction_7 happy_x_2 + happy_x_1 + = case happyOut5 happy_x_2 of { happy_var_2 -> + happyIn10 + (Import happy_var_2 + )} + +happyReduce_8 = happySpecReduce_0 6# happyReduction_8 +happyReduction_8 = happyIn11 + ([] + ) + +happyReduce_9 = happySpecReduce_3 6# happyReduction_9 +happyReduction_9 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + case happyOut10 happy_x_2 of { happy_var_2 -> + happyIn11 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_10 = happyReduce 8# 7# happyReduction_10 +happyReduction_10 (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 happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut26 happy_x_4 of { happy_var_4 -> + case happyOut15 happy_x_7 of { happy_var_7 -> + happyIn12 + (DataDecl happy_var_2 happy_var_4 happy_var_7 + ) `HappyStk` happyRest}}} + +happyReduce_11 = happySpecReduce_3 7# happyReduction_11 +happyReduction_11 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn12 + (TypeDecl happy_var_1 happy_var_3 + )}} + +happyReduce_12 = happyReduce 5# 7# 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 happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut23 happy_x_2 of { happy_var_2 -> + case happyOut16 happy_x_3 of { happy_var_3 -> + case happyOut26 happy_x_5 of { happy_var_5 -> + happyIn12 + (ValueDecl happy_var_1 (reverse happy_var_2) happy_var_3 happy_var_5 + ) `HappyStk` happyRest}}}} + +happyReduce_13 = happySpecReduce_3 7# happyReduction_13 +happyReduction_13 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_2 of { happy_var_2 -> + case happyOut5 happy_x_3 of { happy_var_3 -> + happyIn12 + (DeriveDecl happy_var_2 happy_var_3 + )}} + +happyReduce_14 = happySpecReduce_0 8# happyReduction_14 +happyReduction_14 = happyIn13 + ([] + ) + +happyReduce_15 = happySpecReduce_3 8# happyReduction_15 +happyReduction_15 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut13 happy_x_1 of { happy_var_1 -> + case happyOut12 happy_x_2 of { happy_var_2 -> + happyIn13 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_16 = happySpecReduce_3 9# happyReduction_16 +happyReduction_16 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn14 + (ConsDecl happy_var_1 happy_var_3 + )}} + +happyReduce_17 = happySpecReduce_0 10# happyReduction_17 +happyReduction_17 = happyIn15 + ([] + ) + +happyReduce_18 = happySpecReduce_1 10# happyReduction_18 +happyReduction_18 happy_x_1 + = case happyOut14 happy_x_1 of { happy_var_1 -> + happyIn15 + ((:[]) happy_var_1 + )} + +happyReduce_19 = happySpecReduce_3 10# happyReduction_19 +happyReduction_19 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut14 happy_x_1 of { happy_var_1 -> + case happyOut15 happy_x_3 of { happy_var_3 -> + happyIn15 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_20 = happySpecReduce_2 11# happyReduction_20 +happyReduction_20 happy_x_2 + happy_x_1 + = case happyOut28 happy_x_2 of { happy_var_2 -> + happyIn16 + (GuardExp happy_var_2 + )} + +happyReduce_21 = happySpecReduce_0 11# happyReduction_21 +happyReduction_21 = happyIn16 + (GuardNo + ) + +happyReduce_22 = happySpecReduce_3 12# happyReduction_22 +happyReduction_22 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut18 happy_x_1 of { happy_var_1 -> + case happyOut17 happy_x_3 of { happy_var_3 -> + happyIn17 + (POr happy_var_1 happy_var_3 + )}} + +happyReduce_23 = happySpecReduce_1 12# happyReduction_23 +happyReduction_23 happy_x_1 + = case happyOut18 happy_x_1 of { happy_var_1 -> + happyIn17 + (happy_var_1 + )} + +happyReduce_24 = happySpecReduce_3 13# happyReduction_24 +happyReduction_24 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut19 happy_x_1 of { happy_var_1 -> + case happyOut18 happy_x_3 of { happy_var_3 -> + happyIn18 + (PListCons happy_var_1 happy_var_3 + )}} + +happyReduce_25 = happySpecReduce_1 13# happyReduction_25 +happyReduction_25 happy_x_1 + = case happyOut19 happy_x_1 of { happy_var_1 -> + happyIn18 + (happy_var_1 + )} + +happyReduce_26 = happySpecReduce_3 14# happyReduction_26 +happyReduction_26 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_2 of { happy_var_2 -> + case happyOut23 happy_x_3 of { happy_var_3 -> + happyIn19 + (PConsTop happy_var_1 happy_var_2 (reverse happy_var_3) + )}}} + +happyReduce_27 = happySpecReduce_1 14# happyReduction_27 +happyReduction_27 happy_x_1 + = case happyOut20 happy_x_1 of { happy_var_1 -> + happyIn19 + (happy_var_1 + )} + +happyReduce_28 = happyReduce 4# 15# happyReduction_28 +happyReduction_28 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut25 happy_x_3 of { happy_var_3 -> + happyIn20 + (PRec happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_29 = happySpecReduce_2 15# happyReduction_29 +happyReduction_29 happy_x_2 + happy_x_1 + = happyIn20 + (PEmptyList + ) + +happyReduce_30 = happySpecReduce_3 15# happyReduction_30 +happyReduction_30 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut22 happy_x_2 of { happy_var_2 -> + happyIn20 + (PList happy_var_2 + )} + +happyReduce_31 = happyReduce 5# 15# happyReduction_31 +happyReduction_31 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut21 happy_x_2 of { happy_var_2 -> + case happyOut22 happy_x_4 of { happy_var_4 -> + happyIn20 + (PTuple happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_32 = happySpecReduce_1 15# happyReduction_32 +happyReduction_32 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn20 + (PStr happy_var_1 + )} + +happyReduce_33 = happySpecReduce_1 15# happyReduction_33 +happyReduction_33 happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + happyIn20 + (PInt happy_var_1 + )} + +happyReduce_34 = happySpecReduce_1 15# happyReduction_34 +happyReduction_34 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn20 + (PVar happy_var_1 + )} + +happyReduce_35 = happySpecReduce_1 15# happyReduction_35 +happyReduction_35 happy_x_1 + = happyIn20 + (PWild + ) + +happyReduce_36 = happySpecReduce_3 15# happyReduction_36 +happyReduction_36 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut17 happy_x_2 of { happy_var_2 -> + happyIn20 + (happy_var_2 + )} + +happyReduce_37 = happySpecReduce_1 16# happyReduction_37 +happyReduction_37 happy_x_1 + = case happyOut17 happy_x_1 of { happy_var_1 -> + happyIn21 + (CommaPattern happy_var_1 + )} + +happyReduce_38 = happySpecReduce_1 17# happyReduction_38 +happyReduction_38 happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + happyIn22 + ((:[]) happy_var_1 + )} + +happyReduce_39 = happySpecReduce_3 17# happyReduction_39 +happyReduction_39 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_3 of { happy_var_3 -> + happyIn22 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_40 = happySpecReduce_0 18# happyReduction_40 +happyReduction_40 = happyIn23 + ([] + ) + +happyReduce_41 = happySpecReduce_2 18# happyReduction_41 +happyReduction_41 happy_x_2 + happy_x_1 + = case happyOut23 happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_2 of { happy_var_2 -> + happyIn23 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_42 = happySpecReduce_3 19# happyReduction_42 +happyReduction_42 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut17 happy_x_3 of { happy_var_3 -> + happyIn24 + (FieldPattern happy_var_1 happy_var_3 + )}} + +happyReduce_43 = happySpecReduce_0 20# happyReduction_43 +happyReduction_43 = happyIn25 + ([] + ) + +happyReduce_44 = happySpecReduce_1 20# happyReduction_44 +happyReduction_44 happy_x_1 + = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn25 + ((:[]) happy_var_1 + )} + +happyReduce_45 = happySpecReduce_3 20# happyReduction_45 +happyReduction_45 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut24 happy_x_1 of { happy_var_1 -> + case happyOut25 happy_x_3 of { happy_var_3 -> + happyIn25 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_46 = happyReduce 7# 21# happyReduction_46 +happyReduction_46 (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 happyOut27 happy_x_2 of { happy_var_2 -> + case happyOut26 happy_x_4 of { happy_var_4 -> + case happyOut26 happy_x_7 of { happy_var_7 -> + happyIn26 + (EPi happy_var_2 happy_var_4 happy_var_7 + ) `HappyStk` happyRest}}} + +happyReduce_47 = happySpecReduce_3 21# happyReduction_47 +happyReduction_47 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut28 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn26 + (EPiNoVar happy_var_1 happy_var_3 + )}} + +happyReduce_48 = happySpecReduce_1 21# happyReduction_48 +happyReduction_48 happy_x_1 + = case happyOut28 happy_x_1 of { happy_var_1 -> + happyIn26 + (happy_var_1 + )} + +happyReduce_49 = happySpecReduce_1 22# happyReduction_49 +happyReduction_49 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn27 + (VVar happy_var_1 + )} + +happyReduce_50 = happySpecReduce_1 22# happyReduction_50 +happyReduction_50 happy_x_1 + = happyIn27 + (VWild + ) + +happyReduce_51 = happyReduce 4# 23# happyReduction_51 +happyReduction_51 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut27 happy_x_2 of { happy_var_2 -> + case happyOut28 happy_x_4 of { happy_var_4 -> + happyIn28 + (EAbs happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_52 = happyReduce 6# 23# happyReduction_52 +happyReduction_52 (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 happyOut30 happy_x_3 of { happy_var_3 -> + case happyOut28 happy_x_6 of { happy_var_6 -> + happyIn28 + (ELet happy_var_3 happy_var_6 + ) `HappyStk` happyRest}} + +happyReduce_53 = happyReduce 6# 23# happyReduction_53 +happyReduction_53 (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 happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut32 happy_x_5 of { happy_var_5 -> + happyIn28 + (ECase happy_var_2 happy_var_5 + ) `HappyStk` happyRest}} + +happyReduce_54 = happyReduce 6# 23# happyReduction_54 +happyReduction_54 (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 happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut26 happy_x_4 of { happy_var_4 -> + case happyOut28 happy_x_6 of { happy_var_6 -> + happyIn28 + (EIf happy_var_2 happy_var_4 happy_var_6 + ) `HappyStk` happyRest}}} + +happyReduce_55 = happyReduce 5# 23# 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 happyOut34 happy_x_3 of { happy_var_3 -> + case happyOut26 happy_x_4 of { happy_var_4 -> + happyIn28 + (EDo (reverse happy_var_3) happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_56 = happySpecReduce_1 23# happyReduction_56 +happyReduction_56 happy_x_1 + = case happyOut50 happy_x_1 of { happy_var_1 -> + happyIn28 + (happy_var_1 + )} + +happyReduce_57 = happySpecReduce_3 24# happyReduction_57 +happyReduction_57 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn29 + (LetDef happy_var_1 happy_var_3 + )}} + +happyReduce_58 = happySpecReduce_0 25# happyReduction_58 +happyReduction_58 = happyIn30 + ([] + ) + +happyReduce_59 = happySpecReduce_1 25# happyReduction_59 +happyReduction_59 happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + happyIn30 + ((:[]) happy_var_1 + )} + +happyReduce_60 = happySpecReduce_3 25# happyReduction_60 +happyReduction_60 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_3 of { happy_var_3 -> + happyIn30 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_61 = happyReduce 4# 26# happyReduction_61 +happyReduction_61 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut17 happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_2 of { happy_var_2 -> + case happyOut26 happy_x_4 of { happy_var_4 -> + happyIn31 + (Case happy_var_1 happy_var_2 happy_var_4 + ) `HappyStk` happyRest}}} + +happyReduce_62 = happySpecReduce_0 27# happyReduction_62 +happyReduction_62 = happyIn32 + ([] + ) + +happyReduce_63 = happySpecReduce_1 27# happyReduction_63 +happyReduction_63 happy_x_1 + = case happyOut31 happy_x_1 of { happy_var_1 -> + happyIn32 + ((:[]) happy_var_1 + )} + +happyReduce_64 = happySpecReduce_3 27# happyReduction_64 +happyReduction_64 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut31 happy_x_1 of { happy_var_1 -> + case happyOut32 happy_x_3 of { happy_var_3 -> + happyIn32 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_65 = happySpecReduce_3 28# happyReduction_65 +happyReduction_65 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut27 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn33 + (BindVar happy_var_1 happy_var_3 + )}} + +happyReduce_66 = happySpecReduce_1 28# happyReduction_66 +happyReduction_66 happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn33 + (BindNoVar happy_var_1 + )} + +happyReduce_67 = happySpecReduce_0 29# happyReduction_67 +happyReduction_67 = happyIn34 + ([] + ) + +happyReduce_68 = happySpecReduce_3 29# happyReduction_68 +happyReduction_68 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut34 happy_x_1 of { happy_var_1 -> + case happyOut33 happy_x_2 of { happy_var_2 -> + happyIn34 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_69 = happySpecReduce_3 30# happyReduction_69 +happyReduction_69 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut35 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + happyIn35 + (EBind happy_var_1 happy_var_3 + )}} + +happyReduce_70 = happySpecReduce_3 30# happyReduction_70 +happyReduction_70 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut35 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + happyIn35 + (EBindC happy_var_1 happy_var_3 + )}} + +happyReduce_71 = happySpecReduce_1 30# happyReduction_71 +happyReduction_71 happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn35 + (happy_var_1 + )} + +happyReduce_72 = happySpecReduce_3 31# happyReduction_72 +happyReduction_72 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + happyIn36 + (EOr happy_var_1 happy_var_3 + )}} + +happyReduce_73 = happySpecReduce_1 31# happyReduction_73 +happyReduction_73 happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn36 + (happy_var_1 + )} + +happyReduce_74 = happySpecReduce_3 32# happyReduction_74 +happyReduction_74 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + case happyOut37 happy_x_3 of { happy_var_3 -> + happyIn37 + (EAnd happy_var_1 happy_var_3 + )}} + +happyReduce_75 = happySpecReduce_1 32# happyReduction_75 +happyReduction_75 happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + happyIn37 + (happy_var_1 + )} + +happyReduce_76 = happySpecReduce_3 33# happyReduction_76 +happyReduction_76 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut39 happy_x_3 of { happy_var_3 -> + happyIn38 + (EEq happy_var_1 happy_var_3 + )}} + +happyReduce_77 = happySpecReduce_3 33# happyReduction_77 +happyReduction_77 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut39 happy_x_3 of { happy_var_3 -> + happyIn38 + (ENe happy_var_1 happy_var_3 + )}} + +happyReduce_78 = happySpecReduce_3 33# happyReduction_78 +happyReduction_78 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut39 happy_x_3 of { happy_var_3 -> + happyIn38 + (ELt happy_var_1 happy_var_3 + )}} + +happyReduce_79 = happySpecReduce_3 33# happyReduction_79 +happyReduction_79 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut39 happy_x_3 of { happy_var_3 -> + happyIn38 + (ELe happy_var_1 happy_var_3 + )}} + +happyReduce_80 = happySpecReduce_3 33# happyReduction_80 +happyReduction_80 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut39 happy_x_3 of { happy_var_3 -> + happyIn38 + (EGt happy_var_1 happy_var_3 + )}} + +happyReduce_81 = happySpecReduce_3 33# happyReduction_81 +happyReduction_81 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut39 happy_x_3 of { happy_var_3 -> + happyIn38 + (EGe happy_var_1 happy_var_3 + )}} + +happyReduce_82 = happySpecReduce_1 33# happyReduction_82 +happyReduction_82 happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + happyIn38 + (happy_var_1 + )} + +happyReduce_83 = happySpecReduce_3 34# happyReduction_83 +happyReduction_83 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + case happyOut39 happy_x_3 of { happy_var_3 -> + happyIn39 + (EListCons happy_var_1 happy_var_3 + )}} + +happyReduce_84 = happySpecReduce_1 34# happyReduction_84 +happyReduction_84 happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + happyIn39 + (happy_var_1 + )} + +happyReduce_85 = happySpecReduce_3 35# happyReduction_85 +happyReduction_85 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + case happyOut41 happy_x_3 of { happy_var_3 -> + happyIn40 + (EAdd happy_var_1 happy_var_3 + )}} + +happyReduce_86 = happySpecReduce_3 35# happyReduction_86 +happyReduction_86 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + case happyOut41 happy_x_3 of { happy_var_3 -> + happyIn40 + (ESub happy_var_1 happy_var_3 + )}} + +happyReduce_87 = happySpecReduce_1 35# happyReduction_87 +happyReduction_87 happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + happyIn40 + (happy_var_1 + )} + +happyReduce_88 = happySpecReduce_3 36# happyReduction_88 +happyReduction_88 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + case happyOut42 happy_x_3 of { happy_var_3 -> + happyIn41 + (EMul happy_var_1 happy_var_3 + )}} + +happyReduce_89 = happySpecReduce_3 36# happyReduction_89 +happyReduction_89 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + case happyOut42 happy_x_3 of { happy_var_3 -> + happyIn41 + (EDiv happy_var_1 happy_var_3 + )}} + +happyReduce_90 = happySpecReduce_3 36# happyReduction_90 +happyReduction_90 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + case happyOut42 happy_x_3 of { happy_var_3 -> + happyIn41 + (EMod happy_var_1 happy_var_3 + )}} + +happyReduce_91 = happySpecReduce_1 36# happyReduction_91 +happyReduction_91 happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + happyIn41 + (happy_var_1 + )} + +happyReduce_92 = happySpecReduce_2 37# happyReduction_92 +happyReduction_92 happy_x_2 + happy_x_1 + = case happyOut42 happy_x_2 of { happy_var_2 -> + happyIn42 + (ENeg happy_var_2 + )} + +happyReduce_93 = happySpecReduce_1 37# happyReduction_93 +happyReduction_93 happy_x_1 + = case happyOut43 happy_x_1 of { happy_var_1 -> + happyIn42 + (happy_var_1 + )} + +happyReduce_94 = happySpecReduce_2 38# happyReduction_94 +happyReduction_94 happy_x_2 + happy_x_1 + = case happyOut43 happy_x_1 of { happy_var_1 -> + case happyOut44 happy_x_2 of { happy_var_2 -> + happyIn43 + (EApp happy_var_1 happy_var_2 + )}} + +happyReduce_95 = happySpecReduce_1 38# happyReduction_95 +happyReduction_95 happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + happyIn43 + (happy_var_1 + )} + +happyReduce_96 = happySpecReduce_3 39# happyReduction_96 +happyReduction_96 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + case happyOut5 happy_x_3 of { happy_var_3 -> + happyIn44 + (EProj happy_var_1 happy_var_3 + )}} + +happyReduce_97 = happySpecReduce_1 39# happyReduction_97 +happyReduction_97 happy_x_1 + = case happyOut45 happy_x_1 of { happy_var_1 -> + happyIn44 + (happy_var_1 + )} + +happyReduce_98 = happyReduce 4# 40# happyReduction_98 +happyReduction_98 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut47 happy_x_3 of { happy_var_3 -> + happyIn45 + (ERecType happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_99 = happyReduce 4# 40# happyReduction_99 +happyReduction_99 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut49 happy_x_3 of { happy_var_3 -> + happyIn45 + (ERec happy_var_3 + ) `HappyStk` happyRest} + +happyReduce_100 = happySpecReduce_2 40# happyReduction_100 +happyReduction_100 happy_x_2 + happy_x_1 + = happyIn45 + (EEmptyList + ) + +happyReduce_101 = happySpecReduce_3 40# happyReduction_101 +happyReduction_101 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut51 happy_x_2 of { happy_var_2 -> + happyIn45 + (EList happy_var_2 + )} + +happyReduce_102 = happyReduce 5# 40# happyReduction_102 +happyReduction_102 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut51 happy_x_4 of { happy_var_4 -> + happyIn45 + (ETuple happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_103 = happySpecReduce_1 40# happyReduction_103 +happyReduction_103 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn45 + (EVar happy_var_1 + )} + +happyReduce_104 = happySpecReduce_1 40# happyReduction_104 +happyReduction_104 happy_x_1 + = happyIn45 + (EType + ) + +happyReduce_105 = happySpecReduce_1 40# happyReduction_105 +happyReduction_105 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn45 + (EStr happy_var_1 + )} + +happyReduce_106 = happySpecReduce_1 40# happyReduction_106 +happyReduction_106 happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + happyIn45 + (EInteger happy_var_1 + )} + +happyReduce_107 = happySpecReduce_1 40# happyReduction_107 +happyReduction_107 happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn45 + (EDouble happy_var_1 + )} + +happyReduce_108 = happySpecReduce_1 40# happyReduction_108 +happyReduction_108 happy_x_1 + = happyIn45 + (EMeta + ) + +happyReduce_109 = happySpecReduce_3 40# happyReduction_109 +happyReduction_109 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut26 happy_x_2 of { happy_var_2 -> + happyIn45 + (happy_var_2 + )} + +happyReduce_110 = happySpecReduce_3 41# happyReduction_110 +happyReduction_110 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn46 + (FieldType happy_var_1 happy_var_3 + )}} + +happyReduce_111 = happySpecReduce_0 42# happyReduction_111 +happyReduction_111 = happyIn47 + ([] + ) + +happyReduce_112 = happySpecReduce_1 42# happyReduction_112 +happyReduction_112 happy_x_1 + = case happyOut46 happy_x_1 of { happy_var_1 -> + happyIn47 + ((:[]) happy_var_1 + )} + +happyReduce_113 = happySpecReduce_3 42# happyReduction_113 +happyReduction_113 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut46 happy_x_1 of { happy_var_1 -> + case happyOut47 happy_x_3 of { happy_var_3 -> + happyIn47 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_114 = happySpecReduce_3 43# happyReduction_114 +happyReduction_114 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn48 + (FieldValue happy_var_1 happy_var_3 + )}} + +happyReduce_115 = happySpecReduce_0 44# happyReduction_115 +happyReduction_115 = happyIn49 + ([] + ) + +happyReduce_116 = happySpecReduce_1 44# happyReduction_116 +happyReduction_116 happy_x_1 + = case happyOut48 happy_x_1 of { happy_var_1 -> + happyIn49 + ((:[]) happy_var_1 + )} + +happyReduce_117 = happySpecReduce_3 44# happyReduction_117 +happyReduction_117 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut48 happy_x_1 of { happy_var_1 -> + case happyOut49 happy_x_3 of { happy_var_3 -> + happyIn49 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_118 = happySpecReduce_1 45# happyReduction_118 +happyReduction_118 happy_x_1 + = case happyOut35 happy_x_1 of { happy_var_1 -> + happyIn50 + (happy_var_1 + )} + +happyReduce_119 = happySpecReduce_1 46# happyReduction_119 +happyReduction_119 happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn51 + ((:[]) happy_var_1 + )} + +happyReduce_120 = happySpecReduce_3 46# happyReduction_120 +happyReduction_120 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut51 happy_x_3 of { happy_var_3 -> + happyIn51 + ((:) happy_var_1 happy_var_3 + )}} + +happyNewToken action sts stk [] = + happyDoAction 54# (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 "&&") -> cont 20#; + PT _ (TS "==") -> cont 21#; + PT _ (TS "/=") -> cont 22#; + PT _ (TS "<") -> cont 23#; + PT _ (TS "<=") -> cont 24#; + PT _ (TS ">") -> cont 25#; + PT _ (TS ">=") -> cont 26#; + PT _ (TS "+") -> cont 27#; + PT _ (TS "-") -> cont 28#; + PT _ (TS "*") -> cont 29#; + PT _ (TS "/") -> cont 30#; + PT _ (TS "%") -> cont 31#; + PT _ (TS ".") -> cont 32#; + PT _ (TS "?") -> cont 33#; + PT _ (TS "Type") -> cont 34#; + PT _ (TS "case") -> cont 35#; + PT _ (TS "data") -> cont 36#; + PT _ (TS "derive") -> cont 37#; + PT _ (TS "do") -> cont 38#; + PT _ (TS "else") -> cont 39#; + PT _ (TS "if") -> cont 40#; + PT _ (TS "import") -> cont 41#; + PT _ (TS "in") -> cont 42#; + PT _ (TS "let") -> cont 43#; + PT _ (TS "of") -> cont 44#; + PT _ (TS "rec") -> cont 45#; + PT _ (TS "sig") -> cont 46#; + PT _ (TS "then") -> cont 47#; + PT _ (TS "where") -> cont 48#; + PT _ (TV happy_dollar_dollar) -> cont 49#; + PT _ (TL happy_dollar_dollar) -> cont 50#; + PT _ (TI happy_dollar_dollar) -> cont 51#; + PT _ (TD happy_dollar_dollar) -> cont 52#; + _ -> cont 53#; + _ -> 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 + +pModule tks = happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut9 x)) + +pExp tks = happySomeParser where + happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut26 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 ++ if null ts then [] else (" 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" #-} + +{-# LINE 68 "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 "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 "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/Transfer/Syntax/Par.y b/src/Transfer/Syntax/Par.y new file mode 100644 index 000000000..13c7800a8 --- /dev/null +++ b/src/Transfer/Syntax/Par.y @@ -0,0 +1,340 @@ +-- This Happy file was machine-generated by the BNF converter +{ +{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module Transfer.Syntax.Par where +import Transfer.Syntax.Abs +import Transfer.Syntax.Lex +import Transfer.ErrM +} + +%name pModule Module +%name pExp Exp + +-- no lexer declaration +%monad { Err } { thenM } { returnM } +%tokentype { Token } + +%token + ';' { PT _ (TS ";") } + ':' { PT _ (TS ":") } + '{' { PT _ (TS "{") } + '}' { PT _ (TS "}") } + '=' { PT _ (TS "=") } + '|' { PT _ (TS "|") } + '||' { PT _ (TS "||") } + '::' { PT _ (TS "::") } + '(' { PT _ (TS "(") } + ')' { PT _ (TS ")") } + '[' { PT _ (TS "[") } + ']' { PT _ (TS "]") } + ',' { PT _ (TS ",") } + '_' { PT _ (TS "_") } + '->' { PT _ (TS "->") } + '\\' { PT _ (TS "\\") } + '<-' { PT _ (TS "<-") } + '>>=' { PT _ (TS ">>=") } + '>>' { PT _ (TS ">>") } + '&&' { PT _ (TS "&&") } + '==' { PT _ (TS "==") } + '/=' { PT _ (TS "/=") } + '<' { PT _ (TS "<") } + '<=' { PT _ (TS "<=") } + '>' { PT _ (TS ">") } + '>=' { PT _ (TS ">=") } + '+' { PT _ (TS "+") } + '-' { PT _ (TS "-") } + '*' { PT _ (TS "*") } + '/' { PT _ (TS "/") } + '%' { PT _ (TS "%") } + '.' { PT _ (TS ".") } + '?' { PT _ (TS "?") } + 'Type' { PT _ (TS "Type") } + 'case' { PT _ (TS "case") } + 'data' { PT _ (TS "data") } + 'derive' { PT _ (TS "derive") } + 'do' { PT _ (TS "do") } + 'else' { PT _ (TS "else") } + 'if' { PT _ (TS "if") } + 'import' { PT _ (TS "import") } + 'in' { PT _ (TS "in") } + 'let' { PT _ (TS "let") } + 'of' { PT _ (TS "of") } + 'rec' { PT _ (TS "rec") } + 'sig' { PT _ (TS "sig") } + 'then' { PT _ (TS "then") } + 'where' { PT _ (TS "where") } + +L_ident { PT _ (TV $$) } +L_quoted { PT _ (TL $$) } +L_integ { PT _ (TI $$) } +L_doubl { PT _ (TD $$) } +L_err { _ } + + +%% + +Ident :: { Ident } : L_ident { Ident $1 } +String :: { String } : L_quoted { $1 } +Integer :: { Integer } : L_integ { (read $1) :: Integer } +Double :: { Double } : L_doubl { (read $1) :: Double } + +Module :: { Module } +Module : ListImport ListDecl { Module (reverse $1) (reverse $2) } + + +Import :: { Import } +Import : 'import' Ident { Import $2 } + + +ListImport :: { [Import] } +ListImport : {- empty -} { [] } + | ListImport Import ';' { flip (:) $1 $2 } + + +Decl :: { Decl } +Decl : 'data' Ident ':' Exp 'where' '{' ListConsDecl '}' { DataDecl $2 $4 $7 } + | Ident ':' Exp { TypeDecl $1 $3 } + | Ident ListPattern Guard '=' Exp { ValueDecl $1 (reverse $2) $3 $5 } + | 'derive' Ident Ident { DeriveDecl $2 $3 } + + +ListDecl :: { [Decl] } +ListDecl : {- empty -} { [] } + | ListDecl Decl ';' { flip (:) $1 $2 } + + +ConsDecl :: { ConsDecl } +ConsDecl : Ident ':' Exp { ConsDecl $1 $3 } + + +ListConsDecl :: { [ConsDecl] } +ListConsDecl : {- empty -} { [] } + | ConsDecl { (:[]) $1 } + | ConsDecl ';' ListConsDecl { (:) $1 $3 } + + +Guard :: { Guard } +Guard : '|' Exp1 { GuardExp $2 } + | {- empty -} { GuardNo } + + +Pattern :: { Pattern } +Pattern : Pattern1 '||' Pattern { POr $1 $3 } + | Pattern1 { $1 } + + +Pattern1 :: { Pattern } +Pattern1 : Pattern2 '::' Pattern1 { PListCons $1 $3 } + | Pattern2 { $1 } + + +Pattern2 :: { Pattern } +Pattern2 : Ident Pattern3 ListPattern { PConsTop $1 $2 (reverse $3) } + | Pattern3 { $1 } + + +Pattern3 :: { Pattern } +Pattern3 : 'rec' '{' ListFieldPattern '}' { PRec $3 } + | '[' ']' { PEmptyList } + | '[' ListCommaPattern ']' { PList $2 } + | '(' CommaPattern ',' ListCommaPattern ')' { PTuple $2 $4 } + | String { PStr $1 } + | Integer { PInt $1 } + | Ident { PVar $1 } + | '_' { PWild } + | '(' Pattern ')' { $2 } + + +CommaPattern :: { CommaPattern } +CommaPattern : Pattern { CommaPattern $1 } + + +ListCommaPattern :: { [CommaPattern] } +ListCommaPattern : CommaPattern { (:[]) $1 } + | CommaPattern ',' ListCommaPattern { (:) $1 $3 } + + +ListPattern :: { [Pattern] } +ListPattern : {- empty -} { [] } + | ListPattern Pattern3 { flip (:) $1 $2 } + + +FieldPattern :: { FieldPattern } +FieldPattern : Ident '=' Pattern { FieldPattern $1 $3 } + + +ListFieldPattern :: { [FieldPattern] } +ListFieldPattern : {- empty -} { [] } + | FieldPattern { (:[]) $1 } + | FieldPattern ';' ListFieldPattern { (:) $1 $3 } + + +Exp :: { Exp } +Exp : '(' VarOrWild ':' Exp ')' '->' Exp { EPi $2 $4 $7 } + | Exp1 '->' Exp { EPiNoVar $1 $3 } + | Exp1 { $1 } + + +VarOrWild :: { VarOrWild } +VarOrWild : Ident { VVar $1 } + | '_' { VWild } + + +Exp1 :: { Exp } +Exp1 : '\\' VarOrWild '->' Exp1 { EAbs $2 $4 } + | 'let' '{' ListLetDef '}' 'in' Exp1 { ELet $3 $6 } + | 'case' Exp 'of' '{' ListCase '}' { ECase $2 $5 } + | 'if' Exp 'then' Exp 'else' Exp1 { EIf $2 $4 $6 } + | 'do' '{' ListBind Exp '}' { EDo (reverse $3) $4 } + | Exp2 { $1 } + + +LetDef :: { LetDef } +LetDef : Ident '=' Exp { LetDef $1 $3 } + + +ListLetDef :: { [LetDef] } +ListLetDef : {- empty -} { [] } + | LetDef { (:[]) $1 } + | LetDef ';' ListLetDef { (:) $1 $3 } + + +Case :: { Case } +Case : Pattern Guard '->' Exp { Case $1 $2 $4 } + + +ListCase :: { [Case] } +ListCase : {- empty -} { [] } + | Case { (:[]) $1 } + | Case ';' ListCase { (:) $1 $3 } + + +Bind :: { Bind } +Bind : VarOrWild '<-' Exp { BindVar $1 $3 } + | Exp { BindNoVar $1 } + + +ListBind :: { [Bind] } +ListBind : {- empty -} { [] } + | ListBind Bind ';' { flip (:) $1 $2 } + + +Exp3 :: { Exp } +Exp3 : Exp3 '>>=' Exp4 { EBind $1 $3 } + | Exp3 '>>' Exp4 { EBindC $1 $3 } + | Exp4 { $1 } + + +Exp4 :: { Exp } +Exp4 : Exp5 '||' Exp4 { EOr $1 $3 } + | Exp5 { $1 } + + +Exp5 :: { Exp } +Exp5 : Exp6 '&&' Exp5 { EAnd $1 $3 } + | Exp6 { $1 } + + +Exp6 :: { Exp } +Exp6 : Exp7 '==' Exp7 { EEq $1 $3 } + | Exp7 '/=' Exp7 { ENe $1 $3 } + | Exp7 '<' Exp7 { ELt $1 $3 } + | Exp7 '<=' Exp7 { ELe $1 $3 } + | Exp7 '>' Exp7 { EGt $1 $3 } + | Exp7 '>=' Exp7 { EGe $1 $3 } + | Exp7 { $1 } + + +Exp7 :: { Exp } +Exp7 : Exp8 '::' Exp7 { EListCons $1 $3 } + | Exp8 { $1 } + + +Exp8 :: { Exp } +Exp8 : Exp8 '+' Exp9 { EAdd $1 $3 } + | Exp8 '-' Exp9 { ESub $1 $3 } + | Exp9 { $1 } + + +Exp9 :: { Exp } +Exp9 : Exp9 '*' Exp10 { EMul $1 $3 } + | Exp9 '/' Exp10 { EDiv $1 $3 } + | Exp9 '%' Exp10 { EMod $1 $3 } + | Exp10 { $1 } + + +Exp10 :: { Exp } +Exp10 : '-' Exp10 { ENeg $2 } + | Exp11 { $1 } + + +Exp11 :: { Exp } +Exp11 : Exp11 Exp12 { EApp $1 $2 } + | Exp12 { $1 } + + +Exp12 :: { Exp } +Exp12 : Exp12 '.' Ident { EProj $1 $3 } + | Exp13 { $1 } + + +Exp13 :: { Exp } +Exp13 : 'sig' '{' ListFieldType '}' { ERecType $3 } + | 'rec' '{' ListFieldValue '}' { ERec $3 } + | '[' ']' { EEmptyList } + | '[' ListExp ']' { EList $2 } + | '(' Exp ',' ListExp ')' { ETuple $2 $4 } + | Ident { EVar $1 } + | 'Type' { EType } + | String { EStr $1 } + | Integer { EInteger $1 } + | Double { EDouble $1 } + | '?' { EMeta } + | '(' Exp ')' { $2 } + + +FieldType :: { FieldType } +FieldType : Ident ':' Exp { FieldType $1 $3 } + + +ListFieldType :: { [FieldType] } +ListFieldType : {- empty -} { [] } + | FieldType { (:[]) $1 } + | FieldType ';' ListFieldType { (:) $1 $3 } + + +FieldValue :: { FieldValue } +FieldValue : Ident '=' Exp { FieldValue $1 $3 } + + +ListFieldValue :: { [FieldValue] } +ListFieldValue : {- empty -} { [] } + | FieldValue { (:[]) $1 } + | FieldValue ';' ListFieldValue { (:) $1 $3 } + + +Exp2 :: { Exp } +Exp2 : Exp3 { $1 } + + +ListExp :: { [Exp] } +ListExp : Exp { (:[]) $1 } + | Exp ',' ListExp { (:) $1 $3 } + + + +{ + +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 ++ if null ts then [] else (" before " ++ unwords (map prToken (take 4 ts))) + +myLexer = tokens +} + diff --git a/src/Transfer/Syntax/Print.hs b/src/Transfer/Syntax/Print.hs new file mode 100644 index 000000000..50164477d --- /dev/null +++ b/src/Transfer/Syntax/Print.hs @@ -0,0 +1,206 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} +module Transfer.Syntax.Print where + +-- pretty-printer generated by the BNF converter + +import Transfer.Syntax.Abs +import Data.Char +import Data.List (intersperse) + +-- 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 + +unwordsD :: [Doc] -> Doc +unwordsD = concatD . intersperse (doc (showChar ' ')) + +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 + +instance Print Char where + prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'') + +instance Print String where + prt _ 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 Double where + prt _ x = doc (shows x) + + +instance Print (Tree c) where + prt _i e = case e of + Module imports decls -> prPrec _i 0 (concatD [prt 0 imports , prt 0 decls]) + Import i -> prPrec _i 0 (concatD [doc (showString "import") , prt 0 i]) + DataDecl i exp consdecls -> prPrec _i 0 (concatD [doc (showString "data") , prt 0 i , doc (showString ":") , prt 0 exp , doc (showString "where") , doc (showString "{") , prt 0 consdecls , doc (showString "}")]) + TypeDecl i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp]) + ValueDecl i patterns guard exp -> prPrec _i 0 (concatD [prt 0 i , prt 0 patterns , prt 0 guard , doc (showString "=") , prt 0 exp]) + DeriveDecl i0 i1 -> prPrec _i 0 (concatD [doc (showString "derive") , prt 0 i0 , prt 0 i1]) + ConsDecl i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp]) + GuardExp exp -> prPrec _i 0 (concatD [doc (showString "|") , prt 1 exp]) + GuardNo -> prPrec _i 0 (concatD []) + POr pattern0 pattern1 -> prPrec _i 0 (concatD [prt 1 pattern0 , doc (showString "||") , prt 0 pattern1]) + PListCons pattern0 pattern1 -> prPrec _i 1 (concatD [prt 2 pattern0 , doc (showString "::") , prt 1 pattern1]) + PConsTop i pattern patterns -> prPrec _i 2 (concatD [prt 0 i , prt 3 pattern , prt 0 patterns]) + PCons i patterns -> prPrec _i 3 (concatD [doc (showString "(") , prt 0 i , prt 0 patterns , doc (showString ")")]) + PRec fieldpatterns -> prPrec _i 3 (concatD [doc (showString "rec") , doc (showString "{") , prt 0 fieldpatterns , doc (showString "}")]) + PEmptyList -> prPrec _i 3 (concatD [doc (showString "[") , doc (showString "]")]) + PList commapatterns -> prPrec _i 3 (concatD [doc (showString "[") , prt 0 commapatterns , doc (showString "]")]) + PTuple commapattern commapatterns -> prPrec _i 3 (concatD [doc (showString "(") , prt 0 commapattern , doc (showString ",") , prt 0 commapatterns , doc (showString ")")]) + PStr str -> prPrec _i 3 (concatD [prt 0 str]) + PInt n -> prPrec _i 3 (concatD [prt 0 n]) + PVar i -> prPrec _i 3 (concatD [prt 0 i]) + PWild -> prPrec _i 3 (concatD [doc (showString "_")]) + CommaPattern pattern -> prPrec _i 0 (concatD [prt 0 pattern]) + FieldPattern i pattern -> prPrec _i 0 (concatD [prt 0 i , doc (showString "=") , prt 0 pattern]) + EPi varorwild exp0 exp1 -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 varorwild , doc (showString ":") , prt 0 exp0 , doc (showString ")") , doc (showString "->") , prt 0 exp1]) + EPiNoVar exp0 exp1 -> prPrec _i 0 (concatD [prt 1 exp0 , doc (showString "->") , prt 0 exp1]) + EAbs varorwild exp -> prPrec _i 1 (concatD [doc (showString "\\") , prt 0 varorwild , doc (showString "->") , prt 1 exp]) + ELet letdefs exp -> prPrec _i 1 (concatD [doc (showString "let") , doc (showString "{") , prt 0 letdefs , doc (showString "}") , doc (showString "in") , prt 1 exp]) + ECase exp cases -> prPrec _i 1 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")]) + EIf exp0 exp1 exp2 -> prPrec _i 1 (concatD [doc (showString "if") , prt 0 exp0 , doc (showString "then") , prt 0 exp1 , doc (showString "else") , prt 1 exp2]) + EDo binds exp -> prPrec _i 1 (concatD [doc (showString "do") , doc (showString "{") , prt 0 binds , prt 0 exp , doc (showString "}")]) + EBind exp0 exp1 -> prPrec _i 3 (concatD [prt 3 exp0 , doc (showString ">>=") , prt 4 exp1]) + EBindC exp0 exp1 -> prPrec _i 3 (concatD [prt 3 exp0 , doc (showString ">>") , prt 4 exp1]) + EOr exp0 exp1 -> prPrec _i 4 (concatD [prt 5 exp0 , doc (showString "||") , prt 4 exp1]) + EAnd exp0 exp1 -> prPrec _i 5 (concatD [prt 6 exp0 , doc (showString "&&") , prt 5 exp1]) + EEq exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString "==") , prt 7 exp1]) + ENe exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString "/=") , prt 7 exp1]) + ELt exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString "<") , prt 7 exp1]) + ELe exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString "<=") , prt 7 exp1]) + EGt exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString ">") , prt 7 exp1]) + EGe exp0 exp1 -> prPrec _i 6 (concatD [prt 7 exp0 , doc (showString ">=") , prt 7 exp1]) + EListCons exp0 exp1 -> prPrec _i 7 (concatD [prt 8 exp0 , doc (showString "::") , prt 7 exp1]) + EAdd exp0 exp1 -> prPrec _i 8 (concatD [prt 8 exp0 , doc (showString "+") , prt 9 exp1]) + ESub exp0 exp1 -> prPrec _i 8 (concatD [prt 8 exp0 , doc (showString "-") , prt 9 exp1]) + EMul exp0 exp1 -> prPrec _i 9 (concatD [prt 9 exp0 , doc (showString "*") , prt 10 exp1]) + EDiv exp0 exp1 -> prPrec _i 9 (concatD [prt 9 exp0 , doc (showString "/") , prt 10 exp1]) + EMod exp0 exp1 -> prPrec _i 9 (concatD [prt 9 exp0 , doc (showString "%") , prt 10 exp1]) + ENeg exp -> prPrec _i 10 (concatD [doc (showString "-") , prt 10 exp]) + EApp exp0 exp1 -> prPrec _i 11 (concatD [prt 11 exp0 , prt 12 exp1]) + EProj exp i -> prPrec _i 12 (concatD [prt 12 exp , doc (showString ".") , prt 0 i]) + ERecType fieldtypes -> prPrec _i 13 (concatD [doc (showString "sig") , doc (showString "{") , prt 0 fieldtypes , doc (showString "}")]) + ERec fieldvalues -> prPrec _i 13 (concatD [doc (showString "rec") , doc (showString "{") , prt 0 fieldvalues , doc (showString "}")]) + EEmptyList -> prPrec _i 13 (concatD [doc (showString "[") , doc (showString "]")]) + EList exps -> prPrec _i 13 (concatD [doc (showString "[") , prt 0 exps , doc (showString "]")]) + ETuple exp exps -> prPrec _i 13 (concatD [doc (showString "(") , prt 0 exp , doc (showString ",") , prt 0 exps , doc (showString ")")]) + EVar i -> prPrec _i 13 (concatD [prt 0 i]) + EType -> prPrec _i 13 (concatD [doc (showString "Type")]) + EStr str -> prPrec _i 13 (concatD [prt 0 str]) + EInteger n -> prPrec _i 13 (concatD [prt 0 n]) + EDouble d -> prPrec _i 13 (concatD [prt 0 d]) + EMeta -> prPrec _i 13 (concatD [doc (showString "?")]) + VVar i -> prPrec _i 0 (concatD [prt 0 i]) + VWild -> prPrec _i 0 (concatD [doc (showString "_")]) + LetDef i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString "=") , prt 0 exp]) + Case pattern guard exp -> prPrec _i 0 (concatD [prt 0 pattern , prt 0 guard , doc (showString "->") , prt 0 exp]) + BindVar varorwild exp -> prPrec _i 0 (concatD [prt 0 varorwild , doc (showString "<-") , prt 0 exp]) + BindNoVar exp -> prPrec _i 0 (concatD [prt 0 exp]) + FieldType i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString ":") , prt 0 exp]) + FieldValue i exp -> prPrec _i 0 (concatD [prt 0 i , doc (showString "=") , prt 0 exp]) + Ident str -> prPrec _i 0 (doc (showString str)) + +instance Print [Import] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [Decl] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [ConsDecl] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [CommaPattern] where + prt _ es = case es of + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) +instance Print [Pattern] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 3 x , prt 0 xs]) +instance Print [FieldPattern] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [LetDef] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [Case] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [Bind] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [FieldType] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [FieldValue] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [Exp] where + prt _ es = case es of + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) diff --git a/src/Transfer/Syntax/ResolveLayout.hs b/src/Transfer/Syntax/ResolveLayout.hs new file mode 100644 index 000000000..9d7ab607a --- /dev/null +++ b/src/Transfer/Syntax/ResolveLayout.hs @@ -0,0 +1,29 @@ +module Main where + +import System.Environment (getArgs) + +import Transfer.Syntax.Lex +import Transfer.Syntax.Layout + +prTokens :: [Token] -> String +prTokens = prTokens_ 1 1 + where + prTokens_ _ _ [] = "" + prTokens_ l c (t@(PT (Pn _ l' c') _):ts) = + replicate (l'-l) '\n' + ++ replicate (if l' == l then c'-c else c'-1) ' ' + ++ s ++ prTokens_ l' (c'+length s) ts + where s = prToken t +-- prTokens_ l c (Err p:ts) = + +layout :: String -> String +layout s = prTokens ts' +-- ++ "\n" ++ show ts' + where ts = tokens s + ts' = resolveLayout True ts + +main :: IO () +main = do args <- getArgs + case args of + [] -> getContents >>= putStrLn . layout + fs -> mapM_ (\f -> readFile f >>= putStrLn . layout) fs diff --git a/src/Transfer/Syntax/Skel.hs b/src/Transfer/Syntax/Skel.hs new file mode 100644 index 000000000..b2376478b --- /dev/null +++ b/src/Transfer/Syntax/Skel.hs @@ -0,0 +1,200 @@ +module Transfer.Syntax.Skel where + +-- Haskell module generated by the BNF converter + +import Transfer.Syntax.Abs +import Transfer.ErrM +type Result = Err String + +failure :: Show a => a -> Result +failure x = Bad $ "Undefined case: " ++ show x + +transTree :: Tree c -> Result +transTree t = case t of + Module imports decls -> failure t + Import i -> failure t + DataDecl i exp consdecls -> failure t + TypeDecl i exp -> failure t + ValueDecl i patterns guard exp -> failure t + DeriveDecl i0 i1 -> failure t + ConsDecl i exp -> failure t + GuardExp exp -> failure t + GuardNo -> failure t + POr pattern0 pattern1 -> failure t + PListCons pattern0 pattern1 -> failure t + PConsTop i pattern patterns -> failure t + PCons i patterns -> failure t + PRec fieldpatterns -> failure t + PEmptyList -> failure t + PList commapatterns -> failure t + PTuple commapattern commapatterns -> failure t + PStr str -> failure t + PInt n -> failure t + PVar i -> failure t + PWild -> failure t + CommaPattern pattern -> failure t + FieldPattern i pattern -> failure t + EPi varorwild exp0 exp1 -> failure t + EPiNoVar exp0 exp1 -> failure t + EAbs varorwild exp -> failure t + ELet letdefs exp -> failure t + ECase exp cases -> failure t + EIf exp0 exp1 exp2 -> failure t + EDo binds exp -> failure t + EBind exp0 exp1 -> failure t + EBindC exp0 exp1 -> failure t + EOr exp0 exp1 -> failure t + EAnd exp0 exp1 -> failure t + EEq exp0 exp1 -> failure t + ENe exp0 exp1 -> failure t + ELt exp0 exp1 -> failure t + ELe exp0 exp1 -> failure t + EGt exp0 exp1 -> failure t + EGe exp0 exp1 -> failure t + EListCons exp0 exp1 -> failure t + EAdd exp0 exp1 -> failure t + ESub exp0 exp1 -> failure t + EMul exp0 exp1 -> failure t + EDiv exp0 exp1 -> failure t + EMod exp0 exp1 -> failure t + ENeg exp -> failure t + EApp exp0 exp1 -> failure t + EProj exp i -> failure t + ERecType fieldtypes -> failure t + ERec fieldvalues -> failure t + EEmptyList -> failure t + EList exps -> failure t + ETuple exp exps -> failure t + EVar i -> failure t + EType -> failure t + EStr str -> failure t + EInteger n -> failure t + EDouble d -> failure t + EMeta -> failure t + VVar i -> failure t + VWild -> failure t + LetDef i exp -> failure t + Case pattern guard exp -> failure t + BindVar varorwild exp -> failure t + BindNoVar exp -> failure t + FieldType i exp -> failure t + FieldValue i exp -> failure t + Ident str -> failure t + +transModule :: Module -> Result +transModule t = case t of + Module imports decls -> failure t + +transImport :: Import -> Result +transImport t = case t of + Import i -> failure t + +transDecl :: Decl -> Result +transDecl t = case t of + DataDecl i exp consdecls -> failure t + TypeDecl i exp -> failure t + ValueDecl i patterns guard exp -> failure t + DeriveDecl i0 i1 -> failure t + +transConsDecl :: ConsDecl -> Result +transConsDecl t = case t of + ConsDecl i exp -> failure t + +transGuard :: Guard -> Result +transGuard t = case t of + GuardExp exp -> failure t + GuardNo -> failure t + +transPattern :: Pattern -> Result +transPattern t = case t of + POr pattern0 pattern1 -> failure t + PListCons pattern0 pattern1 -> failure t + PConsTop i pattern patterns -> failure t + PCons i patterns -> failure t + PRec fieldpatterns -> failure t + PEmptyList -> failure t + PList commapatterns -> failure t + PTuple commapattern commapatterns -> failure t + PStr str -> failure t + PInt n -> failure t + PVar i -> failure t + PWild -> failure t + +transCommaPattern :: CommaPattern -> Result +transCommaPattern t = case t of + CommaPattern pattern -> failure t + +transFieldPattern :: FieldPattern -> Result +transFieldPattern t = case t of + FieldPattern i pattern -> failure t + +transExp :: Exp -> Result +transExp t = case t of + EPi varorwild exp0 exp1 -> failure t + EPiNoVar exp0 exp1 -> failure t + EAbs varorwild exp -> failure t + ELet letdefs exp -> failure t + ECase exp cases -> failure t + EIf exp0 exp1 exp2 -> failure t + EDo binds exp -> failure t + EBind exp0 exp1 -> failure t + EBindC exp0 exp1 -> failure t + EOr exp0 exp1 -> failure t + EAnd exp0 exp1 -> failure t + EEq exp0 exp1 -> failure t + ENe exp0 exp1 -> failure t + ELt exp0 exp1 -> failure t + ELe exp0 exp1 -> failure t + EGt exp0 exp1 -> failure t + EGe exp0 exp1 -> failure t + EListCons exp0 exp1 -> failure t + EAdd exp0 exp1 -> failure t + ESub exp0 exp1 -> failure t + EMul exp0 exp1 -> failure t + EDiv exp0 exp1 -> failure t + EMod exp0 exp1 -> failure t + ENeg exp -> failure t + EApp exp0 exp1 -> failure t + EProj exp i -> failure t + ERecType fieldtypes -> failure t + ERec fieldvalues -> failure t + EEmptyList -> failure t + EList exps -> failure t + ETuple exp exps -> failure t + EVar i -> failure t + EType -> failure t + EStr str -> failure t + EInteger n -> failure t + EDouble d -> failure t + EMeta -> failure t + +transVarOrWild :: VarOrWild -> Result +transVarOrWild t = case t of + VVar i -> failure t + VWild -> failure t + +transLetDef :: LetDef -> Result +transLetDef t = case t of + LetDef i exp -> failure t + +transCase :: Case -> Result +transCase t = case t of + Case pattern guard exp -> failure t + +transBind :: Bind -> Result +transBind t = case t of + BindVar varorwild exp -> failure t + BindNoVar exp -> failure t + +transFieldType :: FieldType -> Result +transFieldType t = case t of + FieldType i exp -> failure t + +transFieldValue :: FieldValue -> Result +transFieldValue t = case t of + FieldValue i exp -> failure t + +transIdent :: Ident -> Result +transIdent t = case t of + Ident str -> failure t + diff --git a/src/Transfer/Syntax/Syntax.cf b/src/Transfer/Syntax/Syntax.cf new file mode 100644 index 000000000..7429e34f9 --- /dev/null +++ b/src/Transfer/Syntax/Syntax.cf @@ -0,0 +1,147 @@ +entrypoints Module, Exp ; + +layout "let", "where", "of","rec", "sig", "do" ; +layout stop "in" ; +layout toplevel ; + +comment "--" ; +comment "{-" "-}" ; + +Module. Module ::= [Import] [Decl] ; + +Import. Import ::= "import" Ident ; +-- FIXME: this is terminator to ensure that the pretty printer +-- produces a semicolon after the last import. This could cause +-- problems in a program which only does imports and uses layout syntax. +terminator Import ";" ; + +DataDecl. Decl ::= "data" Ident ":" Exp "where" "{" [ConsDecl] "}" ; +TypeDecl. Decl ::= Ident ":" Exp ; +ValueDecl. Decl ::= Ident [Pattern] Guard "=" Exp ; +DeriveDecl. Decl ::= "derive" Ident Ident ; +terminator Decl ";" ; + +ConsDecl. ConsDecl ::= Ident ":" Exp ; +separator ConsDecl ";" ; + +GuardExp. Guard ::= "|" Exp1 ; +GuardNo. Guard ::= ; + +-- Disjunctive patterns. +POr. Pattern ::= Pattern1 "||" Pattern ; + +-- List constructor patterns +PListCons. Pattern1 ::= Pattern2 "::" Pattern1 ; + +-- Hack: constructor applied to at least one pattern +-- this is to separate it from variable patterns +PConsTop. Pattern2 ::= Ident Pattern3 [Pattern] ; + +-- Real constructor pattern +internal PCons. Pattern3 ::= "(" Ident [Pattern] ")" ; + +-- Record patterns +PRec. Pattern3 ::= "rec" "{" [FieldPattern] "}"; + +-- List patterns +PEmptyList. Pattern3 ::= "[" "]" ; +PList. Pattern3 ::= "[" [CommaPattern] "]" ; + +-- Tuple patterns +PTuple. Pattern3 ::= "(" CommaPattern "," [CommaPattern] ")" ; + +-- hack to allow a different [Pattern] from the one defined +-- for constructor patterns +CommaPattern. CommaPattern ::= Pattern ; +separator nonempty CommaPattern "," ; + +-- String literal patterns +PStr. Pattern3 ::= String ; +-- Integer literal patterns +PInt. Pattern3 ::= Integer ; +-- Variable patterns +PVar. Pattern3 ::= Ident ; +-- Wild card patterns +PWild. Pattern3 ::= "_" ; + +coercions Pattern 3 ; + +[]. [Pattern] ::= ; +(:). [Pattern] ::= Pattern3 [Pattern] ; + +FieldPattern. FieldPattern ::= Ident "=" Pattern ; +separator FieldPattern ";" ; + +-- Function types have precedence < 1 to keep the +-- "->" from conflicting with the "->" after guards +EPi. Exp ::= "(" VarOrWild ":" Exp ")" "->" Exp ; +EPiNoVar. Exp ::= Exp1 "->" Exp ; +VVar. VarOrWild ::= Ident ; +VWild. VarOrWild ::= "_" ; + +EAbs. Exp1 ::= "\\" VarOrWild "->" Exp1 ; +ELet. Exp1 ::= "let" "{" [LetDef] "}" "in" Exp1 ; +LetDef. LetDef ::= Ident "=" Exp ; +separator LetDef ";" ; +ECase. Exp1 ::= "case" Exp "of" "{" [Case] "}" ; +Case. Case ::= Pattern Guard "->" Exp ; +separator Case ";" ; +EIf. Exp1 ::= "if" Exp "then" Exp "else" Exp1 ; +EDo. Exp1 ::= "do" "{" [Bind] Exp "}" ; +BindVar. Bind ::= VarOrWild "<-" Exp ; +BindNoVar. Bind ::= Exp ; +terminator Bind ";" ; + +EBind. Exp3 ::= Exp3 ">>=" Exp4 ; +EBindC. Exp3 ::= Exp3 ">>" Exp4 ; + +EOr. Exp4 ::= Exp5 "||" Exp4 ; + +EAnd. Exp5 ::= Exp6 "&&" Exp5 ; + +EEq. Exp6 ::= Exp7 "==" Exp7 ; +ENe. Exp6 ::= Exp7 "/=" Exp7 ; +ELt. Exp6 ::= Exp7 "<" Exp7 ; +ELe. Exp6 ::= Exp7 "<=" Exp7 ; +EGt. Exp6 ::= Exp7 ">" Exp7 ; +EGe. Exp6 ::= Exp7 ">=" Exp7 ; + +EListCons. Exp7 ::= Exp8 "::" Exp7 ; + +EAdd. Exp8 ::= Exp8 "+" Exp9 ; +ESub. Exp8 ::= Exp8 "-" Exp9 ; + +EMul. Exp9 ::= Exp9 "*" Exp10 ; +EDiv. Exp9 ::= Exp9 "/" Exp10 ; +EMod. Exp9 ::= Exp9 "%" Exp10 ; + +ENeg. Exp10 ::= "-" Exp10 ; + +EApp. Exp11 ::= Exp11 Exp12 ; + +EProj. Exp12 ::= Exp12 "." Ident ; + +ERecType. Exp13 ::= "sig" "{" [FieldType] "}" ; +FieldType. FieldType ::= Ident ":" Exp ; +separator FieldType ";" ; + +ERec. Exp13 ::= "rec" "{" [FieldValue] "}" ; +FieldValue.FieldValue ::= Ident "=" Exp ; +separator FieldValue ";" ; + +EEmptyList.Exp13 ::= "[" "]" ; +EList. Exp13 ::= "[" [Exp] "]" ; + +-- n-tuple, where n>=2 +ETuple. Exp13 ::= "(" Exp "," [Exp] ")" ; + +EVar. Exp13 ::= Ident ; +EType. Exp13 ::= "Type" ; +EStr. Exp13 ::= String ; +EInteger. Exp13 ::= Integer ; +EDouble. Exp13 ::= Double ; +EMeta. Exp13 ::= "?" ; + +coercions Exp 13 ; + +separator nonempty Exp "," ; diff --git a/src/Transfer/Syntax/Test.hs b/src/Transfer/Syntax/Test.hs new file mode 100644 index 000000000..3f5fab7ad --- /dev/null +++ b/src/Transfer/Syntax/Test.hs @@ -0,0 +1,58 @@ +-- automatically generated by BNF Converter +module Main where + + +import IO ( stdin, hGetContents ) +import System ( getArgs, getProgName ) + +import Transfer.Syntax.Lex +import Transfer.Syntax.Par +import Transfer.Syntax.Skel +import Transfer.Syntax.Print +import Transfer.Syntax.Abs +import Transfer.Syntax.Layout + + + +import Transfer.ErrM + +type ParseFun a = [Token] -> Err a + +myLLexer = resolveLayout True . myLexer + +type Verbosity = Int + +putStrV :: Verbosity -> String -> IO () +putStrV v s = if v > 1 then putStrLn s else return () + +runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO () +runFile v p f = putStrLn f >> readFile f >>= run v p + +run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO () +run v p s = let ts = myLLexer s in case p ts of + Bad s -> do putStrLn "\nParse Failed...\n" + putStrV v "Tokens:" + putStrV v $ show ts + putStrLn s + Ok tree -> do putStrLn "\nParse Successful!" + showTree v tree + + + +showTree :: (Show a, Print a) => Int -> a -> IO () +showTree v tree + = do + putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree + putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree + +main :: IO () +main = do args <- getArgs + case args of + [] -> hGetContents stdin >>= run 2 pModule + "-s":fs -> mapM_ (runFile 0 pModule) fs + fs -> mapM_ (runFile 2 pModule) fs + + + + + diff --git a/src/Transfer/SyntaxToCore.hs b/src/Transfer/SyntaxToCore.hs new file mode 100644 index 000000000..32796eb50 --- /dev/null +++ b/src/Transfer/SyntaxToCore.hs @@ -0,0 +1,766 @@ +-- | Translate to the core language +module Transfer.SyntaxToCore where + +import Transfer.Syntax.Abs +import Transfer.Syntax.Print + +import Control.Monad.State +import Data.List +import Data.Maybe +import qualified Data.Set as Set +import Data.Set (Set) +import qualified Data.Map as Map +import Data.Map (Map) +import Data.Monoid + +import Debug.Trace + +type C a = State CState a + +data CState = CState { + nextVar :: Integer, + nextMeta :: Integer + } + + + +declsToCore :: [Decl] -> [Decl] +declsToCore m = evalState (declsToCore_ m) newState + +declsToCore_ :: [Decl] -> C [Decl] +declsToCore_ = deriveDecls + >>> desugar + >>> compilePattDecls + >>> numberMetas + >>> replaceCons + >>> expandOrPatts + >>> optimize + +optimize :: [Decl] -> C [Decl] +optimize = uniqueVars + >>> removeUselessMatch + >>> betaReduce + +newState :: CState +newState = CState { + nextVar = 0, + nextMeta = 0 + } + + +-- +-- * Make all variable names unique +-- + +uniqueVars :: [Decl] -> C [Decl] +uniqueVars = mapM (f Map.empty) + where + f :: Map Ident Ident -> Tree a -> C (Tree a) + f ss t = case t of + ELet ds _ -> + do + let vs = Set.toList (letDefBinds ds) + vs' <- freshIdents (length vs) + let ss' = addToSubstEnv (zip vs vs') ss + composOpM (f ss') t + LetDef i e -> + case Map.lookup i ss of + Nothing -> fail $ "let var " ++ printTree i ++ " not renamed" + Just i' -> liftM (LetDef i') (f ss e) + Case p _ _ -> + do + let vs = Set.toList (binds p) + vs' <- freshIdents (length vs) + let ss' = addToSubstEnv (zip vs vs') ss + composOpM (f ss') t + EAbs (VVar i) e -> + do + i' <- freshIdent + let ss' = addToSubstEnv [(i,i')] ss + liftM (EAbs (VVar i')) (f ss' e) + EPi (VVar i) e1 e2 -> + do + i' <- freshIdent + let ss' = addToSubstEnv [(i,i')] ss + liftM2 (EPi (VVar i')) (f ss e1) (f ss' e2) + EVar i -> return $ case Map.lookup i ss of + Nothing -> t -- constructor + Just i' -> EVar i' + PVar i -> return $ case Map.lookup i ss of + Nothing -> t -- constructor + Just i' -> PVar i' + _ -> composOpM (f ss) t + where addToSubstEnv bs m = foldr (\ (k,v) -> Map.insert k v) m bs + +-- +-- * Number meta variables +-- + +numberMetas :: [Decl] -> C [Decl] +numberMetas = mapM f + where + f :: Tree a -> C (Tree a) + f t = case t of + EMeta -> do + st <- get + put (st { nextMeta = nextMeta st + 1}) + return $ EVar $ Ident $ "?" ++ show (nextMeta st) -- FIXME: hack + _ -> composOpM f t + + +-- +-- * Pattern equations +-- + +compilePattDecls :: [Decl] -> C [Decl] +compilePattDecls [] = return [] +compilePattDecls (d@(ValueDecl x _ _ _):ds) = + do + let (xs,rest) = span (isValueDecl x) ds + d <- mergeDecls (d:xs) + rs <- compilePattDecls rest + return (d:rs) +compilePattDecls (d:ds) = liftM (d:) (compilePattDecls ds) + +-- | Checks if a declaration is a value declaration +-- of the given identifier. +isValueDecl :: Ident -> Decl -> Bool +isValueDecl x (ValueDecl y _ _ _) = x == y +isValueDecl _ _ = False + +-- | Take a non-empty list of pattern equations with guards +-- for the same function, and produce a single declaration. +mergeDecls :: [Decl] -> C Decl +mergeDecls ds@(ValueDecl x p _ _:_) + = do let cs = [ (ps,g,rhs) | ValueDecl _ ps g rhs <- ds ] + (pss,_,_) = unzip3 cs + n = length p + when (not (all ((== n) . length) pss)) + $ fail $ "Pattern count mismatch for " ++ printTree x + vs <- freshIdents n + let cases = map (\ (ps,g,rhs) -> Case (mkPTuple ps) g rhs) cs + c = ECase (mkETuple (map EVar vs)) cases + f = foldr (EAbs . VVar) c vs + return $ ValueDecl x [] GuardNo f + +-- +-- * Derived function definitions +-- + +deriveDecls :: [Decl] -> C [Decl] +deriveDecls ds = liftM concat (mapM der ds) + where + ts = dataTypes ds + der (DeriveDecl (Ident f) t) = + case lookup f derivators of + Just d -> d t k cs + _ -> fail $ "Don't know how to derive " ++ f + where (k,cs) = getDataType ts t + der d = return [d] + +type Derivator = Ident -> Exp -> [(Ident,Exp)] -> C [Decl] + +derivators :: [(String, Derivator)] +derivators = [ + ("Compos", deriveCompos), + ("Show", deriveShow), + ("Eq", deriveEq), + ("Ord", deriveOrd) + ] + +-- +-- * Deriving instances of Compos +-- + +deriveCompos :: Derivator +deriveCompos t@(Ident ts) k cs = + do + co <- deriveComposOp t k cs + cf <- deriveComposFold t k cs + let [c] = argumentTypes k -- FIXME: what if there is not exactly one argument to t? + d = Ident ("compos_"++ts) + dt = apply (var "Compos") [c, EVar t] + r = ERec [FieldValue (Ident "composOp") co, + FieldValue (Ident "composFold") cf] + return [TypeDecl d dt, ValueDecl d [] GuardNo r] + +deriveComposOp :: Ident -> Exp -> [(Ident,Exp)] -> C Exp +deriveComposOp t k cs = + do + f <- freshIdent + x <- freshIdent + let e = EVar + pv = VVar + infixr 3 \-> + (\->) = EAbs + mkCase ci ct = + do + vars <- freshIdents (arity ct) + -- FIXME: the type argument to f is wrong if the constructor + -- has a dependent type + -- FIXME: make a special case for lists? + let rec v at = case at of + EApp (EVar t') c | t' == t -> apply (e f) [c, e v] + _ -> e v + calls = zipWith rec vars (argumentTypes ct) + return $ Case (PCons ci (map PVar vars)) gtrue (apply (e ci) calls) + cases <- mapM (uncurry mkCase) cs + let cases' = cases ++ [Case PWild gtrue (e x)] + fb <- abstract (arity k) $ const $ pv f \-> pv x \-> ECase (e x) cases' + return fb + +deriveComposFold :: Ident -> Exp -> [(Ident,Exp)] -> C Exp +deriveComposFold t k cs = + do + f <- freshIdent + x <- freshIdent + b <- freshIdent + r <- freshIdent + let e = EVar + pv = VVar + infixr 3 \-> + (\->) = EAbs + mkCase ci ct = + do + vars <- freshIdents (arity ct) + -- FIXME: the type argument to f is wrong if the constructor + -- has a dependent type + -- FIXME: make a special case for lists? + let rec v at = case at of + EApp (EVar t') c | t' == t -> apply (e f) [c, e v] + _ -> e v + calls = zipWith rec vars (argumentTypes ct) + z = EProj (e r) (Ident "mzero") + p = EProj (e r) (Ident "mplus") + joinCalls [] = z + joinCalls cs = foldr1 (\x y -> apply p [x,y]) cs + return $ Case (PCons ci (map PVar vars)) gtrue (joinCalls calls) + cases <- mapM (uncurry mkCase) cs + let cases' = cases ++ [Case PWild gtrue (e x)] + fb <- abstract (arity k) $ const $ pv f \-> pv x \-> ECase (e x) cases' + return $ VWild \-> pv r \-> fb + +-- +-- * Deriving instances of Show +-- + +deriveShow :: Derivator +deriveShow t k cs = fail $ "derive Show not implemented" + +-- +-- * Deriving instances of Eq +-- + +-- FIXME: how do we require Eq instances for all +-- constructor arguments? + +deriveEq :: Derivator +deriveEq t@(Ident tn) k cs = + do + dt <- abstractType ats (EApp (var "Eq") . apply (EVar t)) + f <- mkEq + r <- abstract (arity k) (\_ -> ERec [FieldValue (Ident "eq") f]) + return [TypeDecl d dt, ValueDecl d [] GuardNo r] + where + ats = argumentTypes k + d = Ident ("eq_"++tn) + mkEq = do + x <- freshIdent + y <- freshIdent + cases <- mapM (uncurry mkEqCase) cs + let fc = Case PWild gtrue false + abstract 2 (\es -> ECase (mkETuple es) (cases++[fc])) + mkEqCase c ct = + do + let n = arity ct + ts = argumentTypes ct + vs1 <- freshIdents n + vs2 <- freshIdents n + let pr = mkPTuple [PCons c (map PVar vs1), PCons c (map PVar vs2)] + eqs = concat $ zipWith3 child_eq ts vs1 vs2 + rhs [] = true + rhs xs = foldr1 EAnd xs + return $ Case pr gtrue (rhs eqs) + -- FIXME: hack: this returns a list to skip testing type arguments. + child_eq EType _ _ = [] + child_eq t x y = [apply (var "eq") [t,eq_dict t, EVar x, EVar y]] + -- FIXME: this is a hack to at least support Tree types + eq_dict (EApp (EVar t') _) + | t' == t = apply (EVar d) (replicate (arity k) EMeta) + eq_dict (EVar (Ident x)) + | x `elem` ["String","Integer","Double"] = var ("eq_"++x) + eq_dict _ = EMeta + +-- +-- * Deriving instances of Ord +-- + +deriveOrd :: Derivator +deriveOrd t k cs = fail $ "derive Ord not implemented" + +-- +-- * Constructor patterns and applications. +-- + +type DataConsInfo = Map Ident Int + +consArities :: [Decl] -> DataConsInfo +consArities ds = Map.fromList [ (c, arity t) | DataDecl _ _ cs <- ds, + ConsDecl c t <- cs ] + +-- | Get the arity of a function type. +arity :: Exp -> Int +arity = length . argumentTypes + +-- | Get the argument type of a function type. Note that +-- the returned types may contains free variables +-- which should be bound to the values of earlier arguments. +argumentTypes :: Exp -> [Exp] +argumentTypes e = case e of + EPi _ t e' -> t : argumentTypes e' + EPiNoVar t e' -> t : argumentTypes e' + _ -> [] + +-- | Fix up constructor patterns and applications. +replaceCons :: [Decl] -> C [Decl] +replaceCons ds = mapM (f cs) ds + where + cs = consArities ds + f :: DataConsInfo -> Tree a -> C (Tree a) + f cs x = case x of + -- get rid of the PConsTop hack + PConsTop id p1 ps -> f cs (PCons id (p1:ps)) + -- replace patterns C where C is a constructor with (C) + PVar id | isCons id -> return $ PCons id [] + -- don't eta-expand overshadowed constructors + EAbs (VVar id) e | isCons id -> + liftM (EAbs (VVar id)) (f (Map.delete id cs) e) + EPi (VVar id) t e | isCons id -> + liftM2 (EPi (VVar id)) (f cs t) (f (Map.delete id cs) e) + -- eta-expand constructors. betaReduce will remove any beta + -- redexes produced here. + EVar id | isCons id -> do + let Just n = Map.lookup id cs + abstract n (apply x) + _ -> composOpM (f cs) x + where isCons = (`Map.member` cs) + +-- +-- * Do simple beta reductions. +-- + +betaReduce :: [Decl] -> C [Decl] +betaReduce = return . map f + where + f :: Tree a -> Tree a + f t = case t of + EApp e1 e2 -> + case (f e1, f e2) of + (EAbs (VVar x) b, e) | countFreeOccur x b == 1 -> f (subst x e b) + (e1',e2') -> EApp e1' e2' + _ -> composOp f t + +-- +-- * Remove useless pattern matching and variable binding. +-- + +removeUselessMatch :: [Decl] -> C [Decl] +removeUselessMatch = return . map f + where + f :: Tree a -> Tree a + f x = case x of + EAbs (VVar x) b -> + case f b of + -- replace \x -> case x of { y | True -> e } with \y -> e, + -- if x is not free in e + ECase (EVar x') [Case (PVar y) g e] + | x' == x && isTrueGuard g && not (x `isFreeIn` e) + -> f (EAbs (VVar y) e) + -- replace unused variable in lambda with wild card + e | not (x `isFreeIn` e) -> f (EAbs VWild e) + e -> EAbs (VVar x) e + -- replace unused variable in pi with wild card + EPi (VVar x) t e -> + let e' = f e + v = if not (x `isFreeIn` e') then VWild else VVar x + in EPi v (f t) e' + -- replace unused variables in case patterns with wild cards + Case p (GuardExp g) e -> + let g' = f g + e' = f e + used = freeVars g' `Set.union` freeVars e' + p' = f (removeUnusedVarPatts used p) + in Case p' (GuardExp g') e' + -- for value declarations without patterns, compilePattDecls + -- generates pattern matching on the empty record, remove these + ECase (ERec []) [Case (PRec []) g e] | isTrueGuard g -> f e + -- if the pattern matching is on a single field of a record expression + -- with only one field, there is no need to wrap it in a record + ECase (ERec [FieldValue x e]) cs | all (isSingleFieldPattern x) (casePatterns cs) + -> f (ECase e [ Case p g r | Case (PRec [FieldPattern _ p]) g r <- cs ]) + -- for all fields in record matching where all patterns for the field just + -- bind variables, substitute in the field value (if it is a variable) + -- in the guards and right hand sides. + ECase (ERec fs) cs | all isPRec (casePatterns cs) -> + let h (FieldValue f v@(EVar _):fs) xs + | all (onlyBindsFieldToVariable f) (casePatterns xs) + = h fs (map (inlineField f v) xs) + h (f:fs) xs = let (fs',xs') = h fs xs in (f:fs',xs') + h [] xs = ([],xs) + inlineField f v (Case (PRec fps) (GuardExp g) e) = + let p' = PRec [fp | fp@(FieldPattern f' _) <- fps, f' /= f] + ss = zip (fieldPatternVars f fps) (repeat v) + in Case p' (GuardExp (substs ss g)) (substs ss e) + (fs',cs') = h fs cs + x' = ECase (ERec fs') cs' + in if length fs' < length fs then f x' else composOp f x' + -- Remove wild card patterns in record patterns + PRec fps -> PRec (map f (fps \\ wildcards)) + where wildcards = [fp | fp@(FieldPattern _ PWild) <- fps] + _ -> composOp f x + +isTrueGuard :: Guard -> Bool +isTrueGuard (GuardExp (EVar (Ident "True"))) = True +isTrueGuard GuardNo = True +isTrueGuard _ = False + +removeUnusedVarPatts :: Set Ident -> Tree a -> Tree a +removeUnusedVarPatts keep x = case x of + PVar id | not (id `Set.member` keep) -> PWild + _ -> composOp (removeUnusedVarPatts keep) x + +isSingleFieldPattern :: Ident -> Pattern -> Bool +isSingleFieldPattern x p = case p of + PRec [FieldPattern y _] -> x == y + _ -> False + +casePatterns :: [Case] -> [Pattern] +casePatterns cs = [p | Case p _ _ <- cs] + +isPRec :: Pattern -> Bool +isPRec (PRec _) = True +isPRec _ = False + +-- | Checks if given pattern is a record pattern, and matches the field +-- with just a variable, with a wild card, or not at all. +onlyBindsFieldToVariable :: Ident -> Pattern -> Bool +onlyBindsFieldToVariable f (PRec fps) = + all isVar [p | FieldPattern f' p <- fps, f == f'] + where isVar (PVar _) = True + isVar PWild = True + isVar _ = False +onlyBindsFieldToVariable _ _ = False + +fieldPatternVars :: Ident -> [FieldPattern] -> [Ident] +fieldPatternVars f fps = [p | FieldPattern f' (PVar p) <- fps, f == f'] + +-- +-- * Expand disjunctive patterns. +-- + +expandOrPatts :: [Decl] -> C [Decl] +expandOrPatts = return . map f + where + f :: Tree a -> Tree a + f x = case x of + ECase e cs -> ECase (f e) (concatMap (expandCase . f) cs) + _ -> composOp f x + +expandCase :: Case -> [Case] +expandCase (Case p g e) = [ Case p' g e | p' <- expandPatt p ] + +expandPatt :: Pattern -> [Pattern] +expandPatt p = case p of + POr p1 p2 -> expandPatt p1 ++ expandPatt p2 + PCons i ps -> map (PCons i) $ expandPatts ps + PRec fps -> let (fs,ps) = unzip $ fromPRec fps + fpss = map (zip fs) (expandPatts ps) + in map (PRec . toPRec) fpss + _ -> [p] + +expandPatts :: [Pattern] -> [[Pattern]] +expandPatts [] = [[]] +expandPatts (p:ps) = [ p':ps' | p' <- expandPatt p, ps' <- expandPatts ps] + +-- +-- * Remove simple syntactic sugar. +-- + +desugar :: [Decl] -> C [Decl] +desugar = return . map f + where + f :: Tree a -> Tree a + f x = case x of + PListCons p1 p2 -> pListCons <| p1 <| p2 + PEmptyList -> pList [] + PList xs -> pList [f p | CommaPattern p <- xs] + PTuple x xs -> mkPTuple [f p | CommaPattern p <- (x:xs)] + GuardNo -> gtrue + EIf exp0 exp1 exp2 -> ifBool <| exp0 <| exp1 <| exp2 + EDo bs e -> mkDo (map f bs) (f e) + BindNoVar exp0 -> BindVar VWild <| exp0 + EPiNoVar exp0 exp1 -> EPi VWild <| exp0 <| exp1 + EBind exp0 exp1 -> appBind <| exp0 <| exp1 + EBindC exp0 exp1 -> appBindC <| exp0 <| exp1 + EOr exp0 exp1 -> orBool <| exp0 <| exp1 + EAnd exp0 exp1 -> andBool <| exp0 <| exp1 + EEq exp0 exp1 -> overlBin "eq" <| exp0 <| exp1 + ENe exp0 exp1 -> overlBin "ne" <| exp0 <| exp1 + ELt exp0 exp1 -> overlBin "lt" <| exp0 <| exp1 + ELe exp0 exp1 -> overlBin "le" <| exp0 <| exp1 + EGt exp0 exp1 -> overlBin "gt" <| exp0 <| exp1 + EGe exp0 exp1 -> overlBin "ge" <| exp0 <| exp1 + EListCons exp0 exp1 -> appCons <| exp0 <| exp1 + EAdd exp0 exp1 -> overlBin "plus" <| exp0 <| exp1 + ESub exp0 exp1 -> overlBin "minus" <| exp0 <| exp1 + EMul exp0 exp1 -> overlBin "times" <| exp0 <| exp1 + EDiv exp0 exp1 -> overlBin "div" <| exp0 <| exp1 + EMod exp0 exp1 -> overlBin "mod" <| exp0 <| exp1 + ENeg exp0 -> overlUn "neg" <| exp0 + EEmptyList -> mkList [] + EList exps -> mkList (map f exps) + ETuple exp1 exps -> mkETuple (map f (exp1:exps)) + _ -> composOp f x + where g <| x = g (f x) + +-- +-- * List patterns +-- + +pListCons :: Pattern -> Pattern -> Pattern +pListCons p1 p2 = PCons (Ident "Cons") [PWild,p1,p2] + +pList :: [Pattern] -> Pattern +pList = foldr pListCons (PCons (Ident "Nil") [PWild]) + +-- +-- * Use an overloaded function. +-- + +overlUn :: String -> Exp -> Exp +overlUn f e1 = apply (EVar (Ident f)) [EMeta,EVar (Ident "num_Integer"),e1] -- FIXME: hack, should be ? + +overlBin :: String -> Exp -> Exp -> Exp +overlBin f e1 e2 = apply (EVar (Ident f)) [EMeta,EVar (Ident "num_Integer"),e1,e2] -- FIXME: hack, should be ? + +-- +-- * Monad +-- + +mkDo :: [Bind] -> Exp -> Exp +mkDo bs e = foldr (\ (BindVar v r) x -> appBind r (EAbs v x)) e bs + +appBind :: Exp -> Exp -> Exp +appBind e1 e2 = apply (EVar (Ident "bind")) [EMeta,EMeta,EMeta,EMeta,e1,e2] + +appBindC :: Exp -> Exp -> Exp +appBindC e1 e2 = appBind e1 (EAbs VWild e2) + +-- +-- * List +-- + +mkList :: [Exp] -> Exp +mkList = foldr appCons (EApp (EVar (Ident "Nil")) EMeta) + +appCons :: Exp -> Exp -> Exp +appCons e1 e2 = apply (EVar (Ident "Cons")) [EMeta,e1,e2] + + +-- +-- * Booleans +-- + +andBool :: Exp -> Exp -> Exp +andBool e1 e2 = ifBool e1 e2 false + +orBool :: Exp -> Exp -> Exp +orBool e1 e2 = ifBool e1 true e2 + +ifBool :: Exp -> Exp -> Exp -> Exp +ifBool c t e = ECase c [Case (PCons (Ident "True") []) gtrue t, + Case (PCons (Ident "False") []) gtrue e] + + +-- +-- * Substitution +-- + +subst :: Ident -> Exp -> Exp -> Exp +subst x e = substs [(x,e)] + + + +-- | Simultaneuous substitution +substs :: [(Ident, Exp)] -> Exp -> Exp +substs ss = f (Map.fromList ss) + where + f :: Map Ident Exp -> Tree a -> Tree a + f ss t | Map.null ss = t + f ss t = case t of + EVar i -> Map.findWithDefault t i ss + _ -> composOp (f ss) t + + +{- +-- not needed now that variable names are unique +-- FIXE: this function does not properly rename bound variables +substs :: [(Ident, Exp)] -> Exp -> Exp +substs ss = f (Map.fromList ss) + where + f :: Map Ident Exp -> Tree a -> Tree a + f ss t | Map.null ss = t + f ss t = case t of + ELet ds e3 -> + ELet [LetDef id (f ss' e2) | LetDef id e2 <- ds] (f ss' e3) + where ss' = ss `mapMinusSet` letDefBinds ds + Case p g e -> Case p (f ss' g) (f ss' e) where ss' = ss `mapMinusSet` binds p + EAbs (VVar id) e -> EAbs (VVar id) (f ss' e) where ss' = Map.delete id ss + EPi (VVar id) e1 e2 -> + EPi (VVar id) (f ss e1) (f ss' e2) where ss' = Map.delete id ss + EVar i -> Map.findWithDefault t i ss + _ -> composOp (f ss) t +-} + +-- +-- * Abstract syntax utilities +-- + +var :: String -> Exp +var s = EVar (Ident s) + +true :: Exp +true = var "True" + +false :: Exp +false = var "False" + +gtrue :: Guard +gtrue = GuardExp true + + +mkETuple :: [Exp] -> Exp +mkETuple = ERec . zipWith (\i -> FieldValue (Ident ("p"++show i))) [1..] + +mkPTuple :: [Pattern] -> Pattern +mkPTuple = PRec . zipWith (\i -> FieldPattern (Ident ("p"++show i))) [1..] + +-- | Apply an expression to a list of arguments. +apply :: Exp -> [Exp] -> Exp +apply = foldl EApp + +-- | Abstract a value over some arguments. +abstract :: Int -- ^ number of arguments + -> ([Exp] -> Exp) -> C Exp +abstract n f = + do + vs <- freshIdents n + return $ foldr EAbs (f (map EVar vs)) (map VVar vs) + +-- | Abstract a type over some arguments. +abstractType :: [Exp] -- ^ argument types + -> ([Exp] -> Exp) -- ^ function from variable expressions + -- to the expression to return + -> C Exp +abstractType ts f = + do + vs <- freshIdents (length ts) + let pi (v,t) e = EPi (VVar v) t e + return $ foldr pi (f (map EVar vs)) (zip vs ts) + +-- | Get an identifier which cannot occur in user-written +-- code, and which has not been generated before. +freshIdent :: C Ident +freshIdent = do + st <- get + put (st { nextVar = nextVar st + 1 }) + return (Ident ("x_"++show (nextVar st))) + +freshIdents :: Int -> C [Ident] +freshIdents n = replicateM n freshIdent + +-- | Get the variables bound by a set of let definitions. +letDefBinds :: [LetDef] -> Set Ident +letDefBinds defs = Set.fromList [ id | LetDef id _ <- defs] + +letDefRhss :: [LetDef] -> [Exp] +letDefRhss defs = [ exp | LetDef _ exp <- defs ] + +-- | Get the free variables in an expression. +freeVars :: Exp -> Set Ident +freeVars = f + where + f :: Tree a -> Set Ident + f t = case t of + ELet defs exp -> + Set.unions (f exp:map f (letDefRhss defs)) Set.\\ letDefBinds defs + ECase exp cases -> f exp `Set.union` + Set.unions [(f g `Set.union` f e) Set.\\ binds p + | Case p g e <- cases] + EAbs (VVar id) exp -> Set.delete id (f exp) + EPi (VVar id) exp1 exp2 -> f exp1 `Set.union` Set.delete id (f exp2) + EVar i -> Set.singleton i + _ -> composOpMonoid f t + +isFreeIn :: Ident -> Exp -> Bool +isFreeIn x e = countFreeOccur x e > 0 + +-- | Count the number of times a variable occurs free in an expression. +countFreeOccur :: Ident -> Exp -> Int +countFreeOccur x = f + where + f :: Tree a -> Int + f t = case t of + ELet defs _ | x `Set.member` letDefBinds defs -> 0 + Case p _ _ | x `Set.member` binds p -> 0 + EAbs (VVar id) _ | id == x -> 0 + EPi (VVar id) exp1 _ | id == x -> f exp1 + EVar id | id == x -> 1 + _ -> composOpFold 0 (+) f t + +-- | Get the variables bound by a pattern. +binds :: Pattern -> Set Ident +binds = f + where + f :: Tree a -> Set Ident + f p = case p of + -- replaceCons removes non-variable PVars + PVar id -> Set.singleton id + _ -> composOpMonoid f p + + +fromPRec :: [FieldPattern] -> [(Ident,Pattern)] +fromPRec fps = [ (l,p) | FieldPattern l p <- fps ] + +toPRec :: [(Ident,Pattern)] -> [FieldPattern] +toPRec = map (uncurry FieldPattern) + +-- +-- * Data types +-- + +type DataTypes = Map Ident (Exp,[(Ident,Exp)]) + +-- | Get a map of data type names to the type of the type constructor +-- and all data constructors with their types. +dataTypes :: [Decl] -> Map Ident (Exp,[(Ident,Exp)]) +dataTypes ds = Map.fromList [ (i,(t,[(c,ct) | ConsDecl c ct <- cs])) | DataDecl i t cs <- ds] + +getDataType :: DataTypes -> Ident -> (Exp,[(Ident,Exp)]) +getDataType ts i = + case Map.lookup i ts of + Just t -> t + Nothing -> error $ "Data type " ++ printTree i ++ " not found." + ++ " Known types: " ++ show (Map.keysSet ts) + +-- +-- * Utilities +-- + +infixl 1 >>> + +(>>>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c +f >>> g = (g =<<) . f + +mapMinusSet :: Ord k => Map k a -> Set k -> Map k a +mapMinusSet m s = m Map.\\ (Map.fromList [(x,()) | x <- Set.toList s]) diff --git a/src/config.guess b/src/config.guess new file mode 100644 index 000000000..c085f4f51 --- /dev/null +++ b/src/config.guess @@ -0,0 +1,1497 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, +# Inc. + +timestamp='2006-05-13' + +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# 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. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA +# 02110-1301, USA. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + + +# Originally written by Per Bothner <per@bothner.com>. +# Please send patches to <config-patches@gnu.org>. Submit a context +# diff and a properly formatted ChangeLog entry. +# +# This script attempts to guess a canonical system name similar to +# config.sub. If it succeeds, it prints the system name on stdout, and +# exits with 0. Otherwise, it exits with 1. +# +# The plan is that this can be called by configure scripts if you +# don't specify an explicit build system type. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to <config-patches@gnu.org>." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +trap 'exit 1' 1 2 15 + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +set_cc_for_build=' +trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; +trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; +: ${TMPDIR=/tmp} ; + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; +dummy=$tmp/dummy ; +tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; +case $CC_FOR_BUILD,$HOST_CC,$CC in + ,,) echo "int x;" > $dummy.c ; + for c in cc gcc c89 c99 ; do + if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then + CC_FOR_BUILD="$c"; break ; + fi ; + done ; + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found ; + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; +esac ; set_cc_for_build= ;' + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if (test -f /.attbin/uname) >/dev/null 2>&1 ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown +UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown + +# Note: order is significant - the case branches are not exclusive. + +case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + sysctl="sysctl -n hw.machine_arch" + UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ + /usr/sbin/$sysctl 2>/dev/null || echo unknown)` + case "${UNAME_MACHINE_ARCH}" in + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently, or will in the future. + case "${UNAME_MACHINE_ARCH}" in + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep __ELF__ >/dev/null + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case "${UNAME_VERSION}" in + Debian*) + release='-gnu' + ;; + *) + release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "${machine}-${os}${release}" + exit ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} + exit ;; + *:ekkoBSD:*:*) + echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} + exit ;; + *:SolidBSD:*:*) + echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} + exit ;; + macppc:MirBSD:*:*) + echo powerppc-unknown-mirbsd${UNAME_RELEASE} + exit ;; + *:MirBSD:*:*) + echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} + exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` + ;; + *5.*) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + ;; + esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` + case "$ALPHA_CPU_TYPE" in + "EV4 (21064)") + UNAME_MACHINE="alpha" ;; + "EV4.5 (21064)") + UNAME_MACHINE="alpha" ;; + "LCA4 (21066/21068)") + UNAME_MACHINE="alpha" ;; + "EV5 (21164)") + UNAME_MACHINE="alphaev5" ;; + "EV5.6 (21164A)") + UNAME_MACHINE="alphaev56" ;; + "EV5.6 (21164PC)") + UNAME_MACHINE="alphapca56" ;; + "EV5.7 (21164PC)") + UNAME_MACHINE="alphapca57" ;; + "EV6 (21264)") + UNAME_MACHINE="alphaev6" ;; + "EV6.7 (21264A)") + UNAME_MACHINE="alphaev67" ;; + "EV6.8CB (21264C)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8AL (21264B)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8CX (21264D)") + UNAME_MACHINE="alphaev68" ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE="alphaev69" ;; + "EV7 (21364)") + UNAME_MACHINE="alphaev7" ;; + "EV7.9 (21364A)") + UNAME_MACHINE="alphaev79" ;; + esac + # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + exit ;; + Alpha\ *:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # Should we change UNAME_MACHINE based on the output of uname instead + # of the specific Alpha model? + echo alpha-pc-interix + exit ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 + exit ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 + exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-amigaos + exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-morphos + exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe + exit ;; + *:OS400:*:*) + echo powerpc-ibm-os400 + exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix${UNAME_RELEASE} + exit ;; + arm:riscos:*:*|arm:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp + exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "`(/bin/universe) 2>/dev/null`" = att ; then + echo pyramid-pyramid-sysv3 + else + echo pyramid-pyramid-bsd + fi + exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 + exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 + exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case `/usr/bin/uname -p` in + sparc) echo sparc-icl-nx7; exit ;; + esac ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + i86pc:SunOS:5.*:*) + echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:*:*) + case "`/usr/bin/arch -k`" in + Series*|S4*) + UNAME_RELEASE=`uname -v` + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` + exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos${UNAME_RELEASE} + exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 + case "`/bin/arch`" in + sun3) + echo m68k-sun-sunos${UNAME_RELEASE} + ;; + sun4) + echo sparc-sun-sunos${UNAME_RELEASE} + ;; + esac + exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos${UNAME_RELEASE} + exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; + m68k:machten:*:*) + echo m68k-apple-machten${UNAME_RELEASE} + exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten${UNAME_RELEASE} + exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 + exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix${UNAME_RELEASE} + exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix${UNAME_RELEASE} + exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix${UNAME_RELEASE} + exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +#ifdef __cplusplus +#include <stdio.h> /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && + dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && + SYSTEM_NAME=`$dummy $dummyarg` && + { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos${UNAME_RELEASE} + exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax + exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix + exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 + exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 + exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 + exit ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` + if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] + then + if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ + [ ${TARGET_BINARY_INTERFACE}x = x ] + then + echo m88k-dg-dgux${UNAME_RELEASE} + else + echo m88k-dg-dguxbcs${UNAME_RELEASE} + fi + else + echo i586-dg-dgux${UNAME_RELEASE} + fi + exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 + exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 + exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 + exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd + exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` + exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix + exit ;; + ia64:AIX:*:*) + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} + exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include <sys/systemcfg.h> + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` + then + echo "$SYSTEM_NAME" + else + echo rs6000-ibm-aix3.2.5 + fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi + exit ;; + *:AIX:*:[45]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${IBM_ARCH}-ibm-aix${IBM_REV} + exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix + exit ;; + ibmrt:4.4BSD:*|romp-ibm:BSD:*) + echo romp-ibm-bsd4.4 + exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to + exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx + exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd + exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 + exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + case "${UNAME_MACHINE}" in + 9000/31? ) HP_ARCH=m68000 ;; + 9000/[34]?? ) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if [ -x /usr/bin/getconf ]; then + sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; + '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 + esac ;; + esac + fi + if [ "${HP_ARCH}" = "" ]; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if [ ${HP_ARCH} = "hppa2.0w" ] + then + eval $set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | + grep __LP64__ >/dev/null + then + HP_ARCH="hppa2.0w" + else + HP_ARCH="hppa64" + fi + fi + echo ${HP_ARCH}-hp-hpux${HPUX_REV} + exit ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + echo ia64-hp-hpux${HPUX_REV} + exit ;; + 3050*:HI-UX:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include <unistd.h> + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 + exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) + echo hppa1.1-hp-bsd + exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) + echo hppa1.1-hp-osf + exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf + exit ;; + i*86:OSF1:*:*) + if [ -x /usr/sbin/sysversion ] ; then + echo ${UNAME_MACHINE}-unknown-osf1mk + else + echo ${UNAME_MACHINE}-unknown-osf1 + fi + exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites + exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd + exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd + exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd + exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd + exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*[A-Z]90:*:*:*) + echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + *:UNICOS/mp:*:*) + echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} + exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:FreeBSD:*:*) + case ${UNAME_MACHINE} in + pc98) + echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + amd64) + echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + *) + echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + esac + exit ;; + i*:CYGWIN*:*) + echo ${UNAME_MACHINE}-pc-cygwin + exit ;; + i*:MINGW*:*) + echo ${UNAME_MACHINE}-pc-mingw32 + exit ;; + i*:windows32*:*) + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 + exit ;; + i*:PW*:*) + echo ${UNAME_MACHINE}-pc-pw32 + exit ;; + x86:Interix*:[345]*) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + EM64T:Interix*:[345]*) + echo x86_64-unknown-interix${UNAME_RELEASE} + exit ;; + [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) + echo i${UNAME_MACHINE}-pc-mks + exit ;; + i*:Windows_NT*:* | Pentium*:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we + # UNAME_MACHINE based on the output of uname instead of i386? + echo i586-pc-interix + exit ;; + i*:UWIN*:*) + echo ${UNAME_MACHINE}-pc-uwin + exit ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-unknown-cygwin + exit ;; + p*:CYGWIN*:*) + echo powerpcle-unknown-cygwin + exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + *:GNU:*:*) + # the GNU system + echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu + exit ;; + i*86:Minix:*:*) + echo ${UNAME_MACHINE}-pc-minix + exit ;; + arm*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + cris:Linux:*:*) + echo cris-axis-linux-gnu + exit ;; + crisv32:Linux:*:*) + echo crisv32-axis-linux-gnu + exit ;; + frv:Linux:*:*) + echo frv-unknown-linux-gnu + exit ;; + ia64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + m32r*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + m68*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + mips:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef mips + #undef mipsel + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=mipsel + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=mips + #else + CPU= + #endif + #endif +EOF + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' + /^CPU/{ + s: ::g + p + }'`" + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } + ;; + mips64:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef mips64 + #undef mips64el + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=mips64el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=mips64 + #else + CPU= + #endif + #endif +EOF + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' + /^CPU/{ + s: ::g + p + }'`" + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } + ;; + or32:Linux:*:*) + echo or32-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu + exit ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in + PA7*) echo hppa1.1-unknown-linux-gnu ;; + PA8*) echo hppa2.0-unknown-linux-gnu ;; + *) echo hppa-unknown-linux-gnu ;; + esac + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu + exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo ${UNAME_MACHINE}-ibm-linux + exit ;; + sh64*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + sh*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + vax:Linux:*:*) + echo ${UNAME_MACHINE}-dec-linux-gnu + exit ;; + x86_64:Linux:*:*) + echo x86_64-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + # The BFD linker knows what the default object file format is, so + # first see if it will tell us. cd to the root directory to prevent + # problems with other programs or directories called `ld' in the path. + # Set LC_ALL=C to ensure ld outputs messages in English. + ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ + | sed -ne '/supported targets:/!d + s/[ ][ ]*/ /g + s/.*supported targets: *// + s/ .*// + p'` + case "$ld_supported_targets" in + elf32-i386) + TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" + ;; + a.out-i386-linux) + echo "${UNAME_MACHINE}-pc-linux-gnuaout" + exit ;; + coff-i386) + echo "${UNAME_MACHINE}-pc-linux-gnucoff" + exit ;; + "") + # Either a pre-BFD a.out linker (linux-gnuoldld) or + # one that does not give us useful --help. + echo "${UNAME_MACHINE}-pc-linux-gnuoldld" + exit ;; + esac + # Determine whether the default compiler is a.out or elf + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include <features.h> + #ifdef __ELF__ + # ifdef __GLIBC__ + # if __GLIBC__ >= 2 + LIBC=gnu + # else + LIBC=gnulibc1 + # endif + # else + LIBC=gnulibc1 + # endif + #else + #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) + LIBC=gnu + #else + LIBC=gnuaout + #endif + #endif + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' + /^LIBC/{ + s: ::g + p + }'`" + test x"${LIBC}" != x && { + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" + exit + } + test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } + ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 + exit ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} + exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo ${UNAME_MACHINE}-pc-os2-emx + exit ;; + i*86:XTS-300:*:STOP) + echo ${UNAME_MACHINE}-unknown-stop + exit ;; + i*86:atheos:*:*) + echo ${UNAME_MACHINE}-unknown-atheos + exit ;; + i*86:syllable:*:*) + echo ${UNAME_MACHINE}-pc-syllable + exit ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + echo i386-unknown-lynxos${UNAME_RELEASE} + exit ;; + i*86:*DOS:*:*) + echo ${UNAME_MACHINE}-pc-msdosdjgpp + exit ;; + i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) + UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} + else + echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} + fi + exit ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} + exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name` + echo ${UNAME_MACHINE}-pc-isc$UNAME_REL + elif /bin/uname -X 2>/dev/null >/dev/null ; then + UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + echo ${UNAME_MACHINE}-pc-sco$UNAME_REL + else + echo ${UNAME_MACHINE}-pc-sysv32 + fi + exit ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i386. + echo i386-pc-msdosdjgpp + exit ;; + Intel:Mach:3*:*) + echo i386-pc-mach3 + exit ;; + paragon:*:*:*) + echo i860-intel-osf1 + exit ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 + fi + exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv + exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv + exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix + exit ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos${UNAME_RELEASE} + exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 + exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos${UNAME_RELEASE} + exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos${UNAME_RELEASE} + exit ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + echo powerpc-unknown-lynxos${UNAME_RELEASE} + exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv${UNAME_RELEASE} + exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` + echo ${UNAME_MACHINE}-sni-sysv4 + else + echo ns32k-sni-sysv + fi + exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <Richard.M.Bartel@ccMail.Census.GOV> + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes <hewes@openmarket.com>. + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 + exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo ${UNAME_MACHINE}-stratus-vos + exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos + exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux${UNAME_RELEASE} + exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 + exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if [ -d /usr/nec ]; then + echo mips-nec-sysv${UNAME_RELEASE} + else + echo mips-unknown-sysv${UNAME_RELEASE} + fi + exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos + exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos + exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos + exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} + exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux${UNAME_RELEASE} + exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux${UNAME_RELEASE} + exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Rhapsody:*:*) + echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown + case $UNAME_PROCESSOR in + unknown) UNAME_PROCESSOR=powerpc ;; + esac + echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} + exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = "x86"; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} + exit ;; + *:QNX:*:4*) + echo i386-pc-qnx + exit ;; + NSE-?:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk${UNAME_RELEASE} + exit ;; + NSR-?:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk${UNAME_RELEASE} + exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux + exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv + exit ;; + DS/*:UNIX_System_V:*:*) + echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} + exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + if test "$cputype" = "386"; then + UNAME_MACHINE=i386 + else + UNAME_MACHINE="$cputype" + fi + echo ${UNAME_MACHINE}-unknown-plan9 + exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 + exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex + exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 + exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 + exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 + exit ;; + *:ITS:*:*) + echo pdp10-unknown-its + exit ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux${UNAME_RELEASE} + exit ;; + *:DragonFly:*:*) + echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` + exit ;; + *:*VMS:*:*) + UNAME_MACHINE=`(uname -p) 2>/dev/null` + case "${UNAME_MACHINE}" in + A*) echo alpha-dec-vms ; exit ;; + I*) echo ia64-dec-vms ; exit ;; + V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix + exit ;; + i*86:skyos:*:*) + echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' + exit ;; + i*86:rdos:*:*) + echo ${UNAME_MACHINE}-pc-rdos + exit ;; +esac + +#echo '(No uname command or uname output not recognized.)' 1>&2 +#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 + +eval $set_cc_for_build +cat >$dummy.c <<EOF +#ifdef _SEQUENT_ +# include <sys/types.h> +# include <sys/utsname.h> +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include <sys/param.h> + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (__arm) && defined (__acorn) && defined (__unix) + printf ("arm-acorn-riscix\n"); exit (0); +#endif + +#if defined (hp300) && !defined (hpux) + printf ("m68k-hp-bsd\n"); exit (0); +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); + +#endif + +#if defined (vax) +# if !defined (ultrix) +# include <sys/param.h> +# if defined (BSD) +# if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +# else +# if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# endif +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# else + printf ("vax-dec-ultrix\n"); exit (0); +# endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + +# Apollos put the system type in the environment. + +test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } + +# Convex versions that predate uname can use getsysinfo(1) + +if [ -x /usr/convex/getsysinfo ] +then + case `getsysinfo -f cpu_type` in + c1*) + echo c1-convex-bsd + exit ;; + c2*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + c34*) + echo c34-convex-bsd + exit ;; + c38*) + echo c38-convex-bsd + exit ;; + c4*) + echo c4-convex-bsd + exit ;; + esac +fi + +cat >&2 <<EOF +$0: unable to guess system type + +This script, last modified $timestamp, has failed to recognize +the operating system you are using. It is advised that you +download the most up to date version of the config scripts from + + http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess +and + http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + +If the version you run ($0) is already up to date, please +send the following data and any information you think might be +pertinent to <config-patches@gnu.org> in order to provide the needed +information to handle your system. + +config.guess timestamp = $timestamp + +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null` + +hostinfo = `(hostinfo) 2>/dev/null` +/bin/universe = `(/bin/universe) 2>/dev/null` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` +/bin/arch = `(/bin/arch) 2>/dev/null` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` + +UNAME_MACHINE = ${UNAME_MACHINE} +UNAME_RELEASE = ${UNAME_RELEASE} +UNAME_SYSTEM = ${UNAME_SYSTEM} +UNAME_VERSION = ${UNAME_VERSION} +EOF + +exit 1 + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/src/config.mk.in b/src/config.mk.in new file mode 100644 index 000000000..e8a8ab567 --- /dev/null +++ b/src/config.mk.in @@ -0,0 +1,37 @@ +# GF configuration file. configure will produce config.mk from this file +# @configure_input@ + +PACKAGE_VERSION = @PACKAGE_VERSION@ + +prefix = @prefix@ +exec_prefix = @exec_prefix@ +bindir = @bindir@ +libdir = @libdir@ +datadir = @datadir@ + +host = @host@ +build = @build@ + +GHCFLAGS = @GHCFLAGS@ +CPPFLAGS = @CPPFLAGS@ +LDFLAGS = @LDFLAGS@ + +EXEEXT = @EXEEXT@ + +INSTALL = @INSTALL@ +TAR = @TAR@ + +GHC = "@GHC@" +GHCI = "@GHCI@" + +READLINE = @READLINE@ + +INTERRUPT = @INTERRUPT@ + +ATK = @ATK@ + +ENABLE_JAVA = @ENABLE_JAVA@ + +JAVAC = "@JAVAC@" +JAR = "@JAR@" + diff --git a/src/config.sub b/src/config.sub new file mode 100644 index 000000000..4d936e239 --- /dev/null +++ b/src/config.sub @@ -0,0 +1,1608 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, +# Inc. + +timestamp='2006-05-13' + +# This file is (in principle) common to ALL GNU software. +# The presence of a machine in this file suggests that SOME GNU software +# can handle that machine. It does not imply ALL GNU software can. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# 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. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA +# 02110-1301, USA. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + + +# Please send patches to <config-patches@gnu.org>. Submit a context +# diff and a properly formatted ChangeLog entry. +# +# Configuration subroutine to validate and canonicalize a configuration type. +# Supply the specified configuration type as an argument. +# If it is invalid, we print an error message on stderr and exit with code 1. +# Otherwise, we print the canonical config type on stdout and succeed. + +# This file is supposed to be the same for all GNU packages +# and recognize all the CPU types, system types and aliases +# that are meaningful with *any* GNU software. +# Each package is responsible for reporting which valid configurations +# it does not support. The user should be able to distinguish +# a failure to support a valid configuration from a meaningless +# configuration. + +# The goal of this file is to map all the various variations of a given +# machine specification into a single specification in the form: +# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM +# or in some cases, the newer four-part form: +# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM +# It is wrong to echo any other type of specification. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] CPU-MFR-OPSYS + $0 [OPTION] ALIAS + +Canonicalize a configuration name. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to <config-patches@gnu.org>." + +version="\ +GNU config.sub ($timestamp) + +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo $1 + exit ;; + + * ) + break ;; + esac +done + +case $# in + 0) echo "$me: missing argument$help" >&2 + exit 1;; + 1) ;; + *) echo "$me: too many arguments$help" >&2 + exit 1;; +esac + +# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). +# Here we must recognize all the valid KERNEL-OS combinations. +maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` +case $maybe_os in + nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ + uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) + os=-$maybe_os + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` + ;; + *) + basic_machine=`echo $1 | sed 's/-[^-]*$//'` + if [ $basic_machine != $1 ] + then os=`echo $1 | sed 's/.*-/-/'` + else os=; fi + ;; +esac + +### Let's recognize common machines as not being operating systems so +### that things like config.sub decstation-3100 work. We also +### recognize some manufacturers as not being operating systems, so we +### can provide default operating systems below. +case $os in + -sun*os*) + # Prevent following clause from handling this invalid input. + ;; + -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ + -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ + -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ + -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ + -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ + -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ + -apple | -axis | -knuth | -cray) + os= + basic_machine=$1 + ;; + -sim | -cisco | -oki | -wec | -winbond) + os= + basic_machine=$1 + ;; + -scout) + ;; + -wrs) + os=-vxworks + basic_machine=$1 + ;; + -chorusos*) + os=-chorusos + basic_machine=$1 + ;; + -chorusrdb) + os=-chorusrdb + basic_machine=$1 + ;; + -hiux*) + os=-hiuxwe2 + ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5) + os=-sco3.2v5 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco4) + os=-sco3.2v4 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2.[4-9]*) + os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2v[4-9]*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco*) + os=-sco3.2v2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -udk*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -isc) + os=-isc2.2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -clix*) + basic_machine=clipper-intergraph + ;; + -isc*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -lynx*) + os=-lynxos + ;; + -ptx*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` + ;; + -windowsnt*) + os=`echo $os | sed -e 's/windowsnt/winnt/'` + ;; + -psos*) + os=-psos + ;; + -mint | -mint[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; +esac + +# Decode aliases for certain CPU-COMPANY combinations. +case $basic_machine in + # Recognize the basic CPU types without company name. + # Some are omitted here because they have special meanings below. + 1750a | 580 \ + | a29k \ + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ + | am33_2.0 \ + | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \ + | bfin \ + | c4x | clipper \ + | d10v | d30v | dlx | dsp16xx \ + | fr30 | frv \ + | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | i370 | i860 | i960 | ia64 \ + | ip2k | iq2000 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | mcore \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ + | mips64vr | mips64vrel \ + | mips64orion | mips64orionel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipstx39 | mipstx39el \ + | mn10200 | mn10300 \ + | mt \ + | msp430 \ + | nios | nios2 \ + | ns16k | ns32k \ + | or32 \ + | pdp10 | pdp11 | pj | pjl \ + | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | pyramid \ + | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh64 | sh64le \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu | strongarm \ + | tahoe | thumb | tic4x | tic80 | tron \ + | v850 | v850e \ + | we32k \ + | x86 | xscale | xscalee[bl] | xstormy16 | xtensa \ + | z8k) + basic_machine=$basic_machine-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12) + # Motorola 68HC11/12. + basic_machine=$basic_machine-unknown + os=-none + ;; + m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) + ;; + ms1) + basic_machine=mt-unknown + ;; + + # We use `pc' rather than `unknown' + # because (1) that's what they normally are, and + # (2) the word "unknown" tends to confuse beginning users. + i*86 | x86_64) + basic_machine=$basic_machine-pc + ;; + # Object if more than one company name word. + *-*-*) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; + # Recognize the basic CPU types with company name. + 580-* \ + | a29k-* \ + | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ + | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ + | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ + | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ + | avr-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | clipper-* | craynv-* | cydra-* \ + | d10v-* | d30v-* | dlx-* \ + | elxsi-* \ + | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \ + | h8300-* | h8500-* \ + | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | i*86-* | i860-* | i960-* | ia64-* \ + | ip2k-* | iq2000-* \ + | m32c-* | m32r-* | m32rle-* \ + | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ + | m88110-* | m88k-* | maxq-* | mcore-* \ + | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ + | mips16-* \ + | mips64-* | mips64el-* \ + | mips64vr-* | mips64vrel-* \ + | mips64orion-* | mips64orionel-* \ + | mips64vr4100-* | mips64vr4100el-* \ + | mips64vr4300-* | mips64vr4300el-* \ + | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ + | mipsisa32-* | mipsisa32el-* \ + | mipsisa32r2-* | mipsisa32r2el-* \ + | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ + | mipsisa64sb1-* | mipsisa64sb1el-* \ + | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ + | msp430-* \ + | nios-* | nios2-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | orion-* \ + | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | pyramid-* \ + | romp-* | rs6000-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ + | tahoe-* | thumb-* \ + | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tron-* \ + | v850-* | v850e-* | vax-* \ + | we32k-* \ + | x86-* | x86_64-* | xps100-* | xscale-* | xscalee[bl]-* \ + | xstormy16-* | xtensa-* \ + | ymp-* \ + | z8k-*) + ;; + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. + 386bsd) + basic_machine=i386-unknown + os=-bsd + ;; + 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) + basic_machine=m68000-att + ;; + 3b*) + basic_machine=we32k-att + ;; + a29khif) + basic_machine=a29k-amd + os=-udi + ;; + abacus) + basic_machine=abacus-unknown + ;; + adobe68k) + basic_machine=m68010-adobe + os=-scout + ;; + alliant | fx80) + basic_machine=fx80-alliant + ;; + altos | altos3068) + basic_machine=m68k-altos + ;; + am29k) + basic_machine=a29k-none + os=-bsd + ;; + amd64) + basic_machine=x86_64-pc + ;; + amd64-*) + basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + amdahl) + basic_machine=580-amdahl + os=-sysv + ;; + amiga | amiga-*) + basic_machine=m68k-unknown + ;; + amigaos | amigados) + basic_machine=m68k-unknown + os=-amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + os=-sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + os=-sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + os=-bsd + ;; + aux) + basic_machine=m68k-apple + os=-aux + ;; + balance) + basic_machine=ns32k-sequent + os=-dynix + ;; + c90) + basic_machine=c90-cray + os=-unicos + ;; + convex-c1) + basic_machine=c1-convex + os=-bsd + ;; + convex-c2) + basic_machine=c2-convex + os=-bsd + ;; + convex-c32) + basic_machine=c32-convex + os=-bsd + ;; + convex-c34) + basic_machine=c34-convex + os=-bsd + ;; + convex-c38) + basic_machine=c38-convex + os=-bsd + ;; + cray | j90) + basic_machine=j90-cray + os=-unicos + ;; + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16c) + basic_machine=cr16c-unknown + os=-elf + ;; + crds | unos) + basic_machine=m68k-crds + ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; + cris | cris-* | etrax*) + basic_machine=cris-axis + ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; + da30 | da30-*) + basic_machine=m68k-da30 + ;; + decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) + basic_machine=mips-dec + ;; + decsystem10* | dec10*) + basic_machine=pdp10-dec + os=-tops10 + ;; + decsystem20* | dec20*) + basic_machine=pdp10-dec + os=-tops20 + ;; + delta | 3300 | motorola-3300 | motorola-delta \ + | 3300-motorola | delta-motorola) + basic_machine=m68k-motorola + ;; + delta88) + basic_machine=m88k-motorola + os=-sysv3 + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; + dpx20 | dpx20-*) + basic_machine=rs6000-bull + os=-bosx + ;; + dpx2* | dpx2*-bull) + basic_machine=m68k-bull + os=-sysv3 + ;; + ebmon29k) + basic_machine=a29k-amd + os=-ebmon + ;; + elxsi) + basic_machine=elxsi-elxsi + os=-bsd + ;; + encore | umax | mmax) + basic_machine=ns32k-encore + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + os=-ose + ;; + fx2800) + basic_machine=i860-alliant + ;; + genix) + basic_machine=ns32k-ns + ;; + gmicro) + basic_machine=tron-gmicro + os=-sysv + ;; + go32) + basic_machine=i386-pc + os=-go32 + ;; + h3050r* | hiux*) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + h8300hms) + basic_machine=h8300-hitachi + os=-hms + ;; + h8300xray) + basic_machine=h8300-hitachi + os=-xray + ;; + h8500hms) + basic_machine=h8500-hitachi + os=-hms + ;; + harris) + basic_machine=m88k-harris + os=-sysv3 + ;; + hp300-*) + basic_machine=m68k-hp + ;; + hp300bsd) + basic_machine=m68k-hp + os=-bsd + ;; + hp300hpux) + basic_machine=m68k-hp + os=-hpux + ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k2[0-9][0-9] | hp9k31[0-9]) + basic_machine=m68000-hp + ;; + hp9k3[2-9][0-9]) + basic_machine=m68k-hp + ;; + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + basic_machine=hppa1.1-hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][0-9] | hp8[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hppa-next) + os=-nextstep3 + ;; + hppaosf) + basic_machine=hppa1.1-hp + os=-osf + ;; + hppro) + basic_machine=hppa1.1-hp + os=-proelf + ;; + i370-ibm* | ibm*) + basic_machine=i370-ibm + ;; +# I'm not sure what "Sysv32" means. Should this be sysv3.2? + i*86v32) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv32 + ;; + i*86v4*) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv4 + ;; + i*86v) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv + ;; + i*86sol2) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-solaris2 + ;; + i386mach) + basic_machine=i386-mach + os=-mach + ;; + i386-vsta | vsta) + basic_machine=i386-unknown + os=-vsta + ;; + iris | iris4d) + basic_machine=mips-sgi + case $os in + -irix*) + ;; + *) + os=-irix4 + ;; + esac + ;; + isi68 | isi) + basic_machine=m68k-isi + os=-sysv + ;; + m88k-omron*) + basic_machine=m88k-omron + ;; + magnum | m3230) + basic_machine=mips-mips + os=-sysv + ;; + merlin) + basic_machine=ns32k-utek + os=-sysv + ;; + mingw32) + basic_machine=i386-pc + os=-mingw32 + ;; + miniframe) + basic_machine=m68000-convergent + ;; + *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; + mips3*-*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` + ;; + mips3*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown + ;; + monitor) + basic_machine=m68k-rom68k + os=-coff + ;; + morphos) + basic_machine=powerpc-unknown + os=-morphos + ;; + msdos) + basic_machine=i386-pc + os=-msdos + ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + mvs) + basic_machine=i370-ibm + os=-mvs + ;; + ncr3000) + basic_machine=i486-ncr + os=-sysv4 + ;; + netbsd386) + basic_machine=i386-unknown + os=-netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + os=-linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + os=-newsos + ;; + news1000) + basic_machine=m68030-sony + os=-newsos + ;; + news-3600 | risc-news) + basic_machine=mips-sony + os=-newsos + ;; + necv70) + basic_machine=v70-nec + os=-sysv + ;; + next | m*-next ) + basic_machine=m68k-next + case $os in + -nextstep* ) + ;; + -ns2*) + os=-nextstep2 + ;; + *) + os=-nextstep3 + ;; + esac + ;; + nh3000) + basic_machine=m68k-harris + os=-cxux + ;; + nh[45]000) + basic_machine=m88k-harris + os=-cxux + ;; + nindy960) + basic_machine=i960-intel + os=-nindy + ;; + mon960) + basic_machine=i960-intel + os=-mon960 + ;; + nonstopux) + basic_machine=mips-compaq + os=-nonstopux + ;; + np1) + basic_machine=np1-gould + ;; + nsr-tandem) + basic_machine=nsr-tandem + ;; + op50n-* | op60c-*) + basic_machine=hppa1.1-oki + os=-proelf + ;; + openrisc | openrisc-*) + basic_machine=or32-unknown + ;; + os400) + basic_machine=powerpc-ibm + os=-os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + os=-ose + ;; + os68k) + basic_machine=m68k-none + os=-os68k + ;; + pa-hitachi) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + paragon) + basic_machine=i860-intel + os=-osf + ;; + pbd) + basic_machine=sparc-tti + ;; + pbb) + basic_machine=m68k-tti + ;; + pc532 | pc532-*) + basic_machine=ns32k-pc532 + ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium | p5 | k5 | k6 | nexgen | viac3) + basic_machine=i586-pc + ;; + pentiumpro | p6 | 6x86 | athlon | athlon_*) + basic_machine=i686-pc + ;; + pentiumii | pentium2 | pentiumiii | pentium3) + basic_machine=i686-pc + ;; + pentium4) + basic_machine=i786-pc + ;; + pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) + basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumpro-* | p6-* | 6x86-* | athlon-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium4-*) + basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pn) + basic_machine=pn-gould + ;; + power) basic_machine=power-ibm + ;; + ppc) basic_machine=powerpc-unknown + ;; + ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppcle | powerpclittle | ppc-le | powerpc-little) + basic_machine=powerpcle-unknown + ;; + ppcle-* | powerpclittle-*) + basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64) basic_machine=powerpc64-unknown + ;; + ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64le | powerpc64little | ppc64-le | powerpc64-little) + basic_machine=powerpc64le-unknown + ;; + ppc64le-* | powerpc64little-*) + basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ps2) + basic_machine=i386-ibm + ;; + pw32) + basic_machine=i586-unknown + os=-pw32 + ;; + rdos) + basic_machine=i386-pc + os=-rdos + ;; + rom68k) + basic_machine=m68k-rom68k + os=-coff + ;; + rm[46]00) + basic_machine=mips-siemens + ;; + rtpc | rtpc-*) + basic_machine=romp-ibm + ;; + s390 | s390-*) + basic_machine=s390-ibm + ;; + s390x | s390x-*) + basic_machine=s390x-ibm + ;; + sa29200) + basic_machine=a29k-amd + os=-udi + ;; + sb1) + basic_machine=mipsisa64sb1-unknown + ;; + sb1el) + basic_machine=mipsisa64sb1el-unknown + ;; + sei) + basic_machine=mips-sei + os=-seiux + ;; + sequent) + basic_machine=i386-sequent + ;; + sh) + basic_machine=sh-hitachi + os=-hms + ;; + sh64) + basic_machine=sh64-unknown + ;; + sparclite-wrs | simso-wrs) + basic_machine=sparclite-wrs + os=-vxworks + ;; + sps7) + basic_machine=m68k-bull + os=-sysv2 + ;; + spur) + basic_machine=spur-unknown + ;; + st2000) + basic_machine=m68k-tandem + ;; + stratus) + basic_machine=i860-stratus + os=-sysv4 + ;; + sun2) + basic_machine=m68000-sun + ;; + sun2os3) + basic_machine=m68000-sun + os=-sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + os=-sunos4 + ;; + sun3os3) + basic_machine=m68k-sun + os=-sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + os=-sunos4 + ;; + sun4os3) + basic_machine=sparc-sun + os=-sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + os=-sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + os=-solaris2 + ;; + sun3 | sun3-*) + basic_machine=m68k-sun + ;; + sun4) + basic_machine=sparc-sun + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + ;; + sv1) + basic_machine=sv1-cray + os=-unicos + ;; + symmetry) + basic_machine=i386-sequent + os=-dynix + ;; + t3e) + basic_machine=alphaev5-cray + os=-unicos + ;; + t90) + basic_machine=t90-cray + os=-unicos + ;; + tic54x | c54x*) + basic_machine=tic54x-unknown + os=-coff + ;; + tic55x | c55x*) + basic_machine=tic55x-unknown + os=-coff + ;; + tic6x | c6x*) + basic_machine=tic6x-unknown + os=-coff + ;; + tx39) + basic_machine=mipstx39-unknown + ;; + tx39el) + basic_machine=mipstx39el-unknown + ;; + toad1) + basic_machine=pdp10-xkl + os=-tops20 + ;; + tower | tower-32) + basic_machine=m68k-ncr + ;; + tpf) + basic_machine=s390x-ibm + os=-tpf + ;; + udi29k) + basic_machine=a29k-amd + os=-udi + ;; + ultra3) + basic_machine=a29k-nyu + os=-sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + os=-none + ;; + vaxv) + basic_machine=vax-dec + os=-sysv + ;; + vms) + basic_machine=vax-dec + os=-vms + ;; + vpp*|vx|vx-*) + basic_machine=f301-fujitsu + ;; + vxworks960) + basic_machine=i960-wrs + os=-vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + os=-vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + os=-vxworks + ;; + w65*) + basic_machine=w65-wdc + os=-none + ;; + w89k-*) + basic_machine=hppa1.1-winbond + os=-proelf + ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; + xps | xps100) + basic_machine=xps100-honeywell + ;; + ymp) + basic_machine=ymp-cray + os=-unicos + ;; + z8k-*-coff) + basic_machine=z8k-unknown + os=-sim + ;; + none) + basic_machine=none-none + os=-none + ;; + +# Here we handle the default manufacturer of certain CPU types. It is in +# some cases the only manufacturer, in others, it is the most popular. + w89k) + basic_machine=hppa1.1-winbond + ;; + op50n) + basic_machine=hppa1.1-oki + ;; + op60c) + basic_machine=hppa1.1-oki + ;; + romp) + basic_machine=romp-ibm + ;; + mmix) + basic_machine=mmix-knuth + ;; + rs6000) + basic_machine=rs6000-ibm + ;; + vax) + basic_machine=vax-dec + ;; + pdp10) + # there are many clones, so DEC is not a safe bet + basic_machine=pdp10-unknown + ;; + pdp11) + basic_machine=pdp11-dec + ;; + we32k) + basic_machine=we32k-att + ;; + sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + basic_machine=sh-unknown + ;; + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) + basic_machine=sparc-sun + ;; + cydra) + basic_machine=cydra-cydrome + ;; + orion) + basic_machine=orion-highlevel + ;; + orion105) + basic_machine=clipper-highlevel + ;; + mac | mpw | mac-mpw) + basic_machine=m68k-apple + ;; + pmac | pmac-mpw) + basic_machine=powerpc-apple + ;; + *-unknown) + # Make sure to match an already-canonicalized machine name. + ;; + *) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; +esac + +# Here we canonicalize certain aliases for manufacturers. +case $basic_machine in + *-digital*) + basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` + ;; + *-commodore*) + basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` + ;; + *) + ;; +esac + +# Decode manufacturer-specific aliases for certain operating systems. + +if [ x"$os" != x"" ] +then +case $os in + # First match some system type aliases + # that might get confused with valid system types. + # -solaris* is a basic system type, with this one exception. + -solaris1 | -solaris1.*) + os=`echo $os | sed -e 's|solaris1|sunos4|'` + ;; + -solaris) + os=-solaris2 + ;; + -svr4*) + os=-sysv4 + ;; + -unixware*) + os=-sysv4.2uw + ;; + -gnu/linux*) + os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` + ;; + # First accept the basic system types. + # The portable systems comes first. + # Each alternative MUST END IN A *, to match a version number. + # -sysv* is not here because it comes later, after sysvr4. + -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ + | -aos* \ + | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ + | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ + | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ + | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ + | -chorusos* | -chorusrdb* \ + | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ + | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ + | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ + | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ + | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ + | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ + | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos*) + # Remember, each alternative MUST END IN *, to match a version number. + ;; + -qnx*) + case $basic_machine in + x86-* | i*86-*) + ;; + *) + os=-nto$os + ;; + esac + ;; + -nto-qnx*) + ;; + -nto*) + os=`echo $os | sed -e 's|nto|nto-qnx|'` + ;; + -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ + | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) + ;; + -mac*) + os=`echo $os | sed -e 's|mac|macos|'` + ;; + -linux-dietlibc) + os=-linux-dietlibc + ;; + -linux*) + os=`echo $os | sed -e 's|linux|linux-gnu|'` + ;; + -sunos5*) + os=`echo $os | sed -e 's|sunos5|solaris2|'` + ;; + -sunos6*) + os=`echo $os | sed -e 's|sunos6|solaris3|'` + ;; + -opened*) + os=-openedition + ;; + -os400*) + os=-os400 + ;; + -wince*) + os=-wince + ;; + -osfrose*) + os=-osfrose + ;; + -osf*) + os=-osf + ;; + -utek*) + os=-bsd + ;; + -dynix*) + os=-bsd + ;; + -acis*) + os=-aos + ;; + -atheos*) + os=-atheos + ;; + -syllable*) + os=-syllable + ;; + -386bsd) + os=-bsd + ;; + -ctix* | -uts*) + os=-sysv + ;; + -nova*) + os=-rtmk-nova + ;; + -ns2 ) + os=-nextstep2 + ;; + -nsk*) + os=-nsk + ;; + # Preserve the version number of sinix5. + -sinix5.*) + os=`echo $os | sed -e 's|sinix|sysv|'` + ;; + -sinix*) + os=-sysv4 + ;; + -tpf*) + os=-tpf + ;; + -triton*) + os=-sysv3 + ;; + -oss*) + os=-sysv3 + ;; + -svr4) + os=-sysv4 + ;; + -svr3) + os=-sysv3 + ;; + -sysvr4) + os=-sysv4 + ;; + # This must come after -sysvr4. + -sysv*) + ;; + -ose*) + os=-ose + ;; + -es1800*) + os=-ose + ;; + -xenix) + os=-xenix + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + os=-mint + ;; + -aros*) + os=-aros + ;; + -kaos*) + os=-kaos + ;; + -zvmoe) + os=-zvmoe + ;; + -none) + ;; + *) + # Get rid of the `-' at the beginning of $os. + os=`echo $os | sed 's/[^-]*-//'` + echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 + exit 1 + ;; +esac +else + +# Here we handle the default operating systems that come with various machines. +# The value should be what the vendor currently ships out the door with their +# machine or put another way, the most popular os provided with the machine. + +# Note that if you're going to try to match "-MANUFACTURER" here (say, +# "-sun"), then you have to tell the case statement up towards the top +# that MANUFACTURER isn't an operating system. Otherwise, code above +# will signal an error saying that MANUFACTURER isn't an operating +# system, and we'll never get to this point. + +case $basic_machine in + spu-*) + os=-elf + ;; + *-acorn) + os=-riscix1.2 + ;; + arm*-rebel) + os=-linux + ;; + arm*-semi) + os=-aout + ;; + c4x-* | tic4x-*) + os=-coff + ;; + # This must come before the *-dec entry. + pdp10-*) + os=-tops20 + ;; + pdp11-*) + os=-none + ;; + *-dec | vax-*) + os=-ultrix4.2 + ;; + m68*-apollo) + os=-domain + ;; + i386-sun) + os=-sunos4.0.2 + ;; + m68000-sun) + os=-sunos3 + # This also exists in the configure program, but was not the + # default. + # os=-sunos4 + ;; + m68*-cisco) + os=-aout + ;; + mips*-cisco) + os=-elf + ;; + mips*-*) + os=-elf + ;; + or32-*) + os=-coff + ;; + *-tti) # must be before sparc entry or we get the wrong os. + os=-sysv3 + ;; + sparc-* | *-sun) + os=-sunos4.1.1 + ;; + *-be) + os=-beos + ;; + *-haiku) + os=-haiku + ;; + *-ibm) + os=-aix + ;; + *-knuth) + os=-mmixware + ;; + *-wec) + os=-proelf + ;; + *-winbond) + os=-proelf + ;; + *-oki) + os=-proelf + ;; + *-hp) + os=-hpux + ;; + *-hitachi) + os=-hiux + ;; + i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) + os=-sysv + ;; + *-cbm) + os=-amigaos + ;; + *-dg) + os=-dgux + ;; + *-dolphin) + os=-sysv3 + ;; + m68k-ccur) + os=-rtu + ;; + m88k-omron*) + os=-luna + ;; + *-next ) + os=-nextstep + ;; + *-sequent) + os=-ptx + ;; + *-crds) + os=-unos + ;; + *-ns) + os=-genix + ;; + i370-*) + os=-mvs + ;; + *-next) + os=-nextstep3 + ;; + *-gould) + os=-sysv + ;; + *-highlevel) + os=-bsd + ;; + *-encore) + os=-bsd + ;; + *-sgi) + os=-irix + ;; + *-siemens) + os=-sysv4 + ;; + *-masscomp) + os=-rtu + ;; + f30[01]-fujitsu | f700-fujitsu) + os=-uxpv + ;; + *-rom68k) + os=-coff + ;; + *-*bug) + os=-coff + ;; + *-apple) + os=-macos + ;; + *-atari*) + os=-mint + ;; + *) + os=-none + ;; +esac +fi + +# Here we handle the case where we know the os, and the CPU type, but not the +# manufacturer. We pick the logical manufacturer. +vendor=unknown +case $basic_machine in + *-unknown) + case $os in + -riscix*) + vendor=acorn + ;; + -sunos*) + vendor=sun + ;; + -aix*) + vendor=ibm + ;; + -beos*) + vendor=be + ;; + -hpux*) + vendor=hp + ;; + -mpeix*) + vendor=hp + ;; + -hiux*) + vendor=hitachi + ;; + -unos*) + vendor=crds + ;; + -dgux*) + vendor=dg + ;; + -luna*) + vendor=omron + ;; + -genix*) + vendor=ns + ;; + -mvs* | -opened*) + vendor=ibm + ;; + -os400*) + vendor=ibm + ;; + -ptx*) + vendor=sequent + ;; + -tpf*) + vendor=ibm + ;; + -vxsim* | -vxworks* | -windiss*) + vendor=wrs + ;; + -aux*) + vendor=apple + ;; + -hms*) + vendor=hitachi + ;; + -mpw* | -macos*) + vendor=apple + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + vendor=atari + ;; + -vos*) + vendor=stratus + ;; + esac + basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` + ;; +esac + +echo $basic_machine$os +exit + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/src/configure.ac b/src/configure.ac new file mode 100644 index 000000000..5e82d71d1 --- /dev/null +++ b/src/configure.ac @@ -0,0 +1,229 @@ +dnl Run autoconf to generate configure from this file + +AC_INIT([GF],[3.0-alpha],[aarne@cs.chalmers.se],[GF]) + +AC_PREREQ(2.53) + +AC_REVISION($Revision: 1.26 $) + +AC_CONFIG_FILES([config.mk gfc jgf gfeditor]) + +AC_CANONICAL_HOST + +dnl *********************************************** +dnl Executable suffix +dnl *********************************************** + + +AC_MSG_CHECKING([executable suffix]) +case $host_os in + cygwin) + EXEEXT='.exe';; + *) + EXEEXT='';; +esac +AC_MSG_RESULT(['$EXEEXT']) +AC_SUBST(EXEEXT) + +dnl *********************************************** +dnl GHC +dnl *********************************************** + +AC_ARG_WITH(ghc, + AC_HELP_STRING([--with-ghc=<ghc command>], + [Use a different command instead of + 'ghc' for the Haskell compiler.]), + [AC_CHECK_FILE("$withval",GHC="$withval",[AC_PATH_PROG(GHC,"$withval")])], + [AC_PATH_PROG(GHC,ghc)]) + +GHCI=$(dirname $GHC)/ghci + +GHC_VERSION=`$GHC --version | sed -e 's/.*version //'` +AC_MSG_CHECKING([GHC version]) +AC_MSG_RESULT($GHC_VERSION) + + +AC_SUBST(GHC) +AC_SUBST(GHCI) + +dnl *********************************************** +dnl readline +dnl *********************************************** + +AC_ARG_WITH(readline, + AC_HELP_STRING([--with-readline=<readline alternative>], + [Select which readline implementation to use. + Available alternatives are: 'readline' (GNU readline), + 'no' (don't use readline) + (default = readline)]), + [if test "$withval" = "yes"; then + READLINE="readline" + else + READLINE="$withval" + fi], + [if test "$host_os" = "cygwin"; then + AC_MSG_WARN([There are problems with readline for Windows, + for example, pipe characters do not work. + Disabling readline support. + Use --with-readline to override.]) + READLINE="no" + else + READLINE="readline" + fi]) + +case $READLINE in + readline) + ;; + no) + ;; + *) + AC_MSG_ERROR([Bad value for --with-readline: $READLINE]) + ;; +esac + +AC_SUBST(READLINE) + +dnl *********************************************** +dnl command interruption +dnl *********************************************** + +AC_ARG_WITH(interrupt, + AC_HELP_STRING([--with-interrupt=<allow command interruption>], + [Choose whether to enable interruption of commands + with SIGINT (Ctrl-C) + Available alternatives are: 'yes', 'no' + (default = yes)]), + [INTERRUPT="$withval"], + [if test "$host_os" = "cygwin"; then + AC_MSG_WARN([Command interruption does not work under + Cygwin, because of missing signal handler support. + Disabling command interruption support. + Use --with-interrupt to override.]) + INTERRUPT="no" + else + INTERRUPT="yes" + fi]) + +case $INTERRUPT in + yes) + ;; + no) + ;; + *) + AC_MSG_ERROR([Bad value for --with-interrupt: $INTERRUPT]) + ;; +esac + +AC_SUBST(INTERRUPT) + +dnl *********************************************** +dnl ATK speech recognition +dnl *********************************************** + +AC_ARG_WITH(atk, + AC_HELP_STRING([--with-atk=<use ATK speech recognition>], + [Choose whether to compile in support for speech + recognition using ATK. Requires ATK and libatkrec. + Available alternatives are: 'yes', 'no' + (default = no)]), + [ATK="$withval"], + [ATK="no"]) + +case $ATK in + yes) + AC_MSG_CHECKING([for atkrec package]) + ATKREC_VERSION=`ghc-pkg field atkrec version` + if test "$ATKREC_VERSION" = ""; then + AC_MSG_RESULT(['not found']) + AC_MSG_WARN([Disabling ATK support.]) + ATK="no" + else + AC_MSG_RESULT([$ATKREC_VERSION]) + fi + ;; + no) + ;; + *) + AC_MSG_ERROR([Bad value for --with-atk: $ATK]) + + ;; +esac + +AC_SUBST(ATK) + +dnl *********************************************** +dnl java stuff +dnl *********************************************** + +AC_ARG_ENABLE(java, +AC_HELP_STRING([--enable-java], + [Build Java components. (default = yes)]), +[ENABLE_JAVA="$enableval"], +[ENABLE_JAVA=yes] +) + +if test "$ENABLE_JAVA" = "yes"; then + + AC_ARG_WITH(javac, + AC_HELP_STRING([--with-javac=<javac command>], + [Use a different command instead of + 'javac' for the Java compiler.]), + [AC_CHECK_FILE("$withval",JAVAC="$withval",[AC_PATH_PROG(JAVAC,"$withval")])], + [AC_PATH_PROG(JAVAC,javac)]) + AC_SUBST(JAVAC) + + AC_ARG_WITH(java, + AC_HELP_STRING([--with-java=<java command>], + [Use a different command instead of + 'java' for the Java Virtual Machine.]), + [AC_CHECK_FILE("$withval",JAVA="$withval",[AC_PATH_PROG(JAVA,"$withval")])], + [AC_PATH_PROG(JAVA,java)]) + AC_SUBST(JAVA) + + AC_ARG_WITH(jar, + AC_HELP_STRING([--with-jar=<jar command>], + [Use a different command instead of + 'jar' for the Java archive tool.]), + [AC_CHECK_FILE("$withval",JAR="$withval",[AC_PATH_PROG(JAR,"$withval")])], + [AC_PATH_PROG(JAR,jar)]) + AC_SUBST(JAR) + + if test "$JAVAC" = "" || test ! -x "$JAVAC" \ + || test "$JAVA" = "" || test ! -x "$JAVA" \ + || test "$JAR" = "" || test ! -x "$JAR"; then + + AC_MSG_WARN([Not building Java components.]) + ENABLE_JAVA=no + fi + +fi + +AC_SUBST(ENABLE_JAVA) + + +dnl *********************************************** +dnl TAR +dnl *********************************************** + +AC_CHECK_PROGS(TAR, gtar tar) + +dnl *********************************************** +dnl Other programs +dnl *********************************************** + +AC_PROG_INSTALL + +dnl *********************************************** +dnl Program flags +dnl *********************************************** + +AC_SUBST(GHCFLAGS) +AC_SUBST(CPPFLAGS) +AC_SUBST(LDFLAGS) + +dnl *********************************************** +dnl Output +dnl *********************************************** + +AC_OUTPUT + diff --git a/src/exper/Evaluate.hs b/src/exper/Evaluate.hs new file mode 100644 index 000000000..7c5fb4b6a --- /dev/null +++ b/src/exper/Evaluate.hs @@ -0,0 +1,461 @@ +---------------------------------------------------------------------- +-- | +-- Module : Evaluate +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/11/01 15:39:12 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.19 $ +-- +-- Computation of source terms. Used in compilation and in @cc@ command. +----------------------------------------------------------------------------- + +module GF.Compile.Evaluate (appEvalConcrete) where + +import GF.Data.Operations +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Data.Str +import GF.Grammar.PrGrammar +import GF.Infra.Modules +import GF.Infra.Option +import GF.Grammar.Macros +import GF.Grammar.Lookup +import GF.Grammar.Refresh +import GF.Grammar.PatternMatch +import GF.Grammar.Lockfield (isLockLabel) ---- + +import GF.Grammar.AppPredefined + +import qualified Data.Map as Map + +import Data.List (nub,intersperse) +import Control.Monad (liftM2, liftM) +import Debug.Trace + + +data EEnv = EEnv { + computd :: Map.Map (Ident,Ident) FTerm, + temp :: Int + } + +emptyEEnv = EEnv Map.empty 0 + +lookupComputed :: (Ident,Ident) -> STM EEnv (Maybe FTerm) +lookupComputed mc = do + env <- readSTM + return $ Map.lookup mc $ computd env + +updateComputed :: (Ident,Ident) -> FTerm -> STM EEnv () +updateComputed mc t = updateSTM (\e -> e{computd = Map.insert mc t (computd e)}) + +getTemp :: STM EEnv Ident +getTemp = do + env <- readSTM + updateSTM (\e -> e{temp = temp e + 1}) + return $ identC ("#" ++ show (temp env)) + +data FTerm = + FTC Term + | FTF (Term -> FTerm) + +prFTerm :: Integer -> FTerm -> String +prFTerm i t = case t of + FTC t -> prt t + FTF f -> show i +++ "->" +++ prFTerm (i + 1) (f (EInt i)) + +term2fterm t = case t of + Abs x b -> FTF (\t -> term2fterm (subst [(x,t)] b)) + _ -> FTC t + +traceFTerm c ft = ft ----trace ("\n" ++ prt c +++ "=" +++ take 60 (prFTerm 0 ft)) ft + +fterm2term :: FTerm -> STM EEnv Term +fterm2term t = case t of + FTC t -> return t + FTF f -> do + x <- getTemp + b <- fterm2term $ f (Vr x) + return $ Abs x b + +subst g t = case t of + Vr x -> maybe t id $ lookup x g + _ -> composSafeOp (subst g) t + + +appFTerm :: FTerm -> [Term] -> FTerm +appFTerm ft ts = case (ft,ts) of + (FTF f, x:xs) -> appFTerm (f x) xs + _ -> ft +{- + (FTC _, []) -> ft + (FTC f, [a]) -> case appPredefined (App f a) of + Ok (t,_) -> FTC t + _ -> error $ "error: appFTerm" +++ prFTerm 0 ft +++ unwords (map prt ts) + _ -> error $ "error: appFTerm" +++ prFTerm 0 ft +++ unwords (map prt ts) +-} + +apps :: Term -> (Term,[Term]) +apps t = case t of + App f a -> (f',xs ++ [a]) where (f',xs) = apps f + _ -> (t,[]) + +appEvalConcrete gr bt = liftM fst $ appSTM (evalConcrete gr bt) emptyEEnv + +evalConcrete :: SourceGrammar -> BinTree Ident Info -> STM EEnv (BinTree Ident Info) +evalConcrete gr mo = mapMTree evaldef mo where + + evaldef (f,info) = case info of + CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr -> + evalIn ("\nerror in linearization of function" +++ prt f +++ ":") $ + do + pde' <- case pde of + Yes de -> do + liftM yes $ pEval ty de + _ -> return pde + --- ppr' <- liftM yes $ evalPrintname gr c ppr pde' + return $ (f, CncFun mt pde' ppr) -- only cat in type actually needed + + _ -> return (f,info) + + pEval (context,val) trm = do ---- errIn ("parteval" +++ prt_ trm) $ do + let + vars = map fst context + args = map Vr vars + subst = [(v, Vr v) | v <- vars] + trm1 = mkApp trm args + trm3 <- recordExpand val trm1 >>= comp subst + return $ mkAbs vars trm3 + + recordExpand typ trm = case unComputed typ of + RecType tys -> case trm of + FV rs -> return $ FV [R [assign lab (P r lab) | (lab,_) <- tys] | r <- rs] + _ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys] + _ -> return trm + + comp g t = case t of + + Q (IC "Predef") _ -> trace ("\nPredef:\n" ++ prt t) $ return t + + Q p c -> do + md <- lookupComputed (p,c) + case md of + Nothing -> do + d <- lookRes (p,c) + updateComputed (p,c) $ traceFTerm c $ term2fterm d + return d + Just d -> fterm2term d >>= comp g + App f a -> case apps t of + (h@(Q p c),xs) | p == IC "Predef" -> do + xs' <- mapM (comp g) xs + (t',b) <- stmErr $ appPredefined (foldl App h xs') + if b then return t' else comp g t' + (h@(Q p c),xs) -> do + xs' <- mapM (comp g) xs + md <- lookupComputed (p,c) + case md of + Just ft -> do + t <- fterm2term $ appFTerm ft xs' + comp g t + Nothing -> do + d <- lookRes (p,c) + let ft = traceFTerm c $ term2fterm d + updateComputed (p,c) ft + t' <- fterm2term $ appFTerm ft xs' + comp g t' + _ -> do + f' <- comp g f + a' <- comp g a + case (f',a') of + (Abs x b,_) -> comp (ext x a' g) b + (QC _ _,_) -> returnC $ App f' a' + (FV fs, _) -> mapM (\c -> comp g (App c a')) fs >>= return . variants + (_, FV as) -> mapM (\c -> comp g (App f' c)) as >>= return . variants + + (Alias _ _ d, _) -> comp g (App d a') + + (S (T i cs) e,_) -> prawitz g i (flip App a') cs e + + _ -> do + (t',b) <- stmErr $ appPredefined (App f' a') + if b then return t' else comp g t' + + + Vr x -> do + t' <- maybe (prtRaise ( + "context" +++ show g +++ ": no value given to variable") x) return $ lookup x g + case t' of + _ | t == t' -> return t + _ -> comp g t' + + Abs x b -> do + b' <- comp (ext x (Vr x) g) b + return $ Abs x b' + + Let (x,(_,a)) b -> do + a' <- comp g a + comp (ext x a' g) b + + Prod x a b -> do + a' <- comp g a + b' <- comp (ext x (Vr x) g) b + return $ Prod x a' b' + + P t l | isLockLabel l -> return $ R [] + ---- a workaround 18/2/2005: take this away and find the reason + ---- why earlier compilation destroys the lock field + + + P t l -> do + t' <- comp g t + case t' of + FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . variants + R r -> maybe + (prtRaise (prt t' ++ ": no value for label") l) (comp g . snd) $ + lookup l r + + ExtR a (R b) -> case lookup l b of ----comp g (P (R b) l) of + Just (_,v) -> comp g v + _ -> comp g (P a l) + + S (T i cs) e -> prawitz g i (flip P l) cs e + + _ -> returnC $ P t' l + + S t@(T _ cc) v -> do + v' <- comp g v + case v' of + FV vs -> do + ts' <- mapM (comp g . S t) vs + return $ variants ts' + _ -> case matchPattern cc v' of + Ok (c,g') -> comp (g' ++ g) c + _ | isCan v' -> prtRaise ("missing case" +++ prt v' +++ "in") t + _ -> do + t' <- comp g t + return $ S t' v' -- if v' is not canonical + + S t v -> do + t' <- comp g t + v' <- comp g v + case t' of + T _ [(PV IW,c)] -> comp g c --- an optimization + T _ [(PT _ (PV IW),c)] -> comp g c + + T _ [(PV z,c)] -> comp (ext z v' g) c --- another optimization + T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c + + FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants + + V ptyp ts -> do + vs <- stmErr $ allParamValues gr ptyp + ps <- stmErr $ mapM term2patt vs + let cc = zip ps ts + case v' of + FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants + _ -> case matchPattern cc v' of + Ok (c,g') -> comp (g' ++ g) c + _ | isCan v' -> prtRaise ("missing case" +++ prt v' +++ "in") t + _ -> return $ S t' v' -- if v' is not canonical + + T _ cc -> case v' of + FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants + _ -> case matchPattern cc v' of + Ok (c,g') -> comp (g' ++ g) c + _ | isCan v' -> prtRaise ("missing case" +++ prt v' +++ "in") t + _ -> return $ S t' v' -- if v' is not canonical + + Alias _ _ d -> comp g (S d v') + + S (T i cs) e -> prawitz g i (flip S v') cs e + + _ -> returnC $ S t' v' + + -- normalize away empty tokens + K "" -> return Empty + + -- glue if you can + Glue x0 y0 -> do + x <- comp g x0 + y <- comp g y0 + case (x,y) of + (Alias _ _ d, y) -> comp g $ Glue d y + (x, Alias _ _ d) -> comp g $ Glue x d + + (S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e + (s, S (T i cs) e) -> prawitz g i (Glue s) cs e + (_,Empty) -> return x + (Empty,_) -> return y + (K a, K b) -> return $ K (a ++ b) + (_, Alts (d,vs)) -> do +---- (K a, Alts (d,vs)) -> do + let glx = Glue x + comp g $ Alts (glx d, [(glx v,c) | (v,c) <- vs]) + (Alts _, ka) -> checks [do + y' <- stmErr $ strsFromTerm ka +---- (Alts _, K a) -> checks [do + x' <- stmErr $ strsFromTerm x -- this may fail when compiling opers + return $ variants [ + foldr1 C (map K (str2strings (glueStr v u))) | v <- x', u <- y'] +---- foldr1 C (map K (str2strings (glueStr v (str a)))) | v <- x'] + ,return $ Glue x y + ] + (FV ks,_) -> do + kys <- mapM (comp g . flip Glue y) ks + return $ variants kys + (_,FV ks) -> do + xks <- mapM (comp g . Glue x) ks + return $ variants xks + + _ -> do + mapM_ checkNoArgVars [x,y] + r <- composOp (comp g) t + returnC r + + Alts _ -> do + r <- composOp (comp g) t + returnC r + + -- remove empty + C a b -> do + a' <- comp g a + b' <- comp g b + case (a',b') of + (Alts _, K a) -> checks [do + as <- stmErr $ strsFromTerm a' -- this may fail when compiling opers + return $ variants [ + foldr1 C (map K (str2strings (plusStr v (str a)))) | v <- as] + , + return $ C a' b' + ] + (Empty,_) -> returnC b' + (_,Empty) -> returnC a' + _ -> returnC $ C a' b' + + -- reduce free variation as much as you can + FV ts -> mapM (comp g) ts >>= returnC . variants + + -- merge record extensions if you can + ExtR r s -> do + r' <- comp g r + s' <- comp g s + case (r',s') of + (Alias _ _ d, _) -> comp g $ ExtR d s' + (_, Alias _ _ d) -> comp g $ Glue r' d + + (R rs, R ss) -> stmErr $ plusRecord r' s' + (RecType rs, RecType ss) -> stmErr $ plusRecType r' s' + _ -> return $ ExtR r' s' + + -- case-expand tables + -- if already expanded, don't expand again + T i@(TComp _) cs -> do + -- if there are no variables, don't even go inside + cs' <- if (null g) then return cs else mapPairsM (comp g) cs + return $ T i cs' + + --- this means some extra work; should implement TSh directly + TSh i cs -> comp g $ T i [(p,v) | (ps,v) <- cs, p <- ps] + + T i cs -> do + pty0 <- stmErr $ getTableType i + ptyp <- comp g pty0 + case allParamValues gr ptyp of + Ok vs -> do + + cs' <- mapM (compBranchOpt g) cs + sts <- stmErr $ mapM (matchPattern cs') vs + ts <- mapM (\ (c,g') -> comp (g' ++ g) c) sts + ps <- stmErr $ mapM term2patt vs + let ps' = ps --- PT ptyp (head ps) : tail ps + return $ --- V ptyp ts -- to save space, just course of values + T (TComp ptyp) (zip ps' ts) + _ -> do + cs' <- mapM (compBranch g) cs + return $ T i cs' -- happens with variable types + + -- otherwise go ahead + _ -> composOp (comp g) t >>= returnC + + lookRes (p,c) = case lookupResDefKind gr p c of + Ok (t,_) | noExpand p -> return t + Ok (t,0) -> comp [] t + Ok (t,_) -> return t + Bad s -> raise s + + noExpand p = errVal False $ do + mo <- lookupModMod gr p + return $ case getOptVal (iOpts (flags mo)) useOptimizer of + Just "noexpand" -> True + _ -> False + + prtRaise s t = raise (s +++ prt t) + + ext x a g = (x,a):g + + returnC = return --- . computed + + variants ts = case nub ts of + [t] -> t + ts -> FV ts + + isCan v = case v of + Con _ -> True + QC _ _ -> True + App f a -> isCan f && isCan a + R rs -> all (isCan . snd . snd) rs + _ -> False + + compBranch g (p,v) = do + let g' = contP p ++ g + v' <- comp g' v + return (p,v') + + compBranchOpt g c@(p,v) = case contP p of + [] -> return c + _ -> compBranch g c +---- _ -> err (const (return c)) return $ compBranch g c + + contP p = case p of + PV x -> [(x,Vr x)] + PC _ ps -> concatMap contP ps + PP _ _ ps -> concatMap contP ps + PT _ p -> contP p + PR rs -> concatMap (contP . snd) rs + + PAs x p -> (x,Vr x) : contP p + + PSeq p q -> concatMap contP [p,q] + PAlt p q -> concatMap contP [p,q] + PRep p -> contP p + PNeg p -> contP p + + _ -> [] + + prawitz g i f cs e = do + cs' <- mapM (compBranch g) [(p, f v) | (p,v) <- cs] + return $ S (T i cs') e + +-- | argument variables cannot be glued +checkNoArgVars :: Term -> STM EEnv Term +checkNoArgVars t = case t of + Vr (IA _) -> raise $ glueErrorMsg $ prt t + Vr (IAV _) -> raise $ glueErrorMsg $ prt t + _ -> composOp checkNoArgVars t + +glueErrorMsg s = + "Cannot glue (+) term with run-time variable" +++ s ++ "." ++++ + "Use Prelude.bind instead." + +stmErr :: Err a -> STM s a +stmErr e = stm (\s -> do + v <- e + return (v,s) + ) + +evalIn :: String -> STM s a -> STM s a +evalIn msg st = stm $ \s -> case appSTM st s of + Bad e -> Bad $ msg ++++ e + Ok vs -> Ok vs diff --git a/src/exper/Optimize.hs b/src/exper/Optimize.hs new file mode 100644 index 000000000..93346bc70 --- /dev/null +++ b/src/exper/Optimize.hs @@ -0,0 +1,274 @@ +---------------------------------------------------------------------- +-- | +-- Module : Optimize +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/09/16 13:56:13 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.18 $ +-- +-- Top-level partial evaluation for GF source modules. +----------------------------------------------------------------------------- + +module GF.Compile.Optimize (optimizeModule) where + +import GF.Grammar.Grammar +import GF.Infra.Ident +import GF.Infra.Modules +import GF.Grammar.PrGrammar +import GF.Grammar.Macros +import GF.Grammar.Lookup +import GF.Grammar.Refresh +import GF.Grammar.Compute +import GF.Compile.BackOpt +import GF.Compile.CheckGrammar +import GF.Compile.Update + +import GF.Compile.Evaluate + +import GF.Data.Operations +import GF.Infra.CheckM +import GF.Infra.Option + +import Control.Monad +import Data.List + +-- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005. +-- only do this for resource: concrete is optimized in gfc form +optimizeModule :: Options -> [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) -> + Err (Ident,SourceModInfo) +optimizeModule opts ms mo@(_,mi) = case mi of + ModMod m0@(Module mt st fs me ops js) | st == MSComplete && isModRes m0 -> do + mo1 <- evalModule oopts ms mo + return $ case optim of + "parametrize" -> shareModule paramOpt mo1 -- parametrization and sharing + "values" -> shareModule valOpt mo1 -- tables as courses-of-values + "share" -> shareModule shareOpt mo1 -- sharing of branches + "all" -> shareModule allOpt mo1 -- first parametrize then values + "none" -> mo1 -- no optimization + _ -> mo1 -- none; default for src + _ -> evalModule oopts ms mo + where + oopts = addOptions opts (iOpts (flagsModule mo)) + optim = maybe "all" id $ getOptVal oopts useOptimizer + +evalModule :: Options -> [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) -> + Err (Ident,SourceModInfo) +evalModule oopts ms mo@(name,mod) = case mod of + + ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of +{- + -- now: don't optimize resource + + _ | isModRes m0 -> do + let deps = allOperDependencies name js + ids <- topoSortOpers deps + MGrammar (mod' : _) <- foldM evalOp gr ids + return $ mod' +-} + MTConcrete a -> do +----- + js0 <- appEvalConcrete gr js + js' <- mapMTree (evalCncInfo oopts gr name a) js0 ---- <- gr0 6/12/2005 + return $ (name, ModMod (Module mt st fs me ops js')) + + _ -> return $ (name,mod) + _ -> return $ (name,mod) + where + gr0 = MGrammar $ ms + gr = MGrammar $ (name,mod) : ms + + evalOp g@(MGrammar ((_, ModMod m) : _)) i = do + info <- lookupTree prt i $ jments m + info' <- evalResInfo oopts gr (i,info) + return $ updateRes g name i info' + +-- | only operations need be compiled in a resource, and this is local to each +-- definition since the module is traversed in topological order +evalResInfo :: Options -> SourceGrammar -> (Ident,Info) -> Err Info +evalResInfo oopts gr (c,info) = case info of + + ResOper pty pde -> eIn "operation" $ do + pde' <- case pde of + Yes de | optres -> liftM yes $ comp de + _ -> return pde + return $ ResOper pty pde' + + _ -> return info + where + comp = if optres then computeConcrete gr else computeConcreteRec gr + eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":") + optim = maybe "all" id $ getOptVal oopts useOptimizer + optres = case optim of + "noexpand" -> False + _ -> True + + +evalCncInfo :: + Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err (Ident,Info) +evalCncInfo opts gr cnc abs (c,info) = errIn ("optimizing" +++ prt c) $ case info of + + CncCat ptyp pde ppr -> do + + pde' <- case (ptyp,pde) of + (Yes typ, Yes de) -> + liftM yes $ pEval ([(varStr, typeStr)], typ) de + (Yes typ, Nope) -> + liftM yes $ mkLinDefault gr typ >>= partEval noOptions gr ([(varStr, typeStr)],typ) + (May b, Nope) -> + return $ May b + _ -> return pde -- indirection + + ppr' <- liftM yes $ evalPrintname gr c ppr (yes $ K $ prt c) + + return (c, CncCat ptyp pde' ppr') + + CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr -> + eIn ("linearization in type" +++ prt (mkProd (cont,val,[])) ++++ "of function") $ do + pde' <- case pde of +----- Yes de -> do +----- liftM yes $ pEval ty de + _ -> return pde + ppr' <- liftM yes $ evalPrintname gr c ppr pde' + return $ (c, CncFun mt pde' ppr') -- only cat in type actually needed + + _ -> return (c,info) + where + pEval = partEval opts gr + eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":") + +-- | the main function for compiling linearizations +partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term +partEval opts gr (context, val) trm = errIn ("parteval" +++ prt_ trm) $ do + let vars = map fst context + args = map Vr vars + subst = [(v, Vr v) | v <- vars] + trm1 = mkApp trm args + trm3 <- if globalTable + then etaExpand trm1 >>= comp subst >>= outCase subst + else etaExpand trm1 >>= comp subst + return $ mkAbs vars trm3 + + where + + globalTable = oElem showAll opts --- i -all + + comp g t = {- refreshTerm t >>= -} computeTerm gr g t + + etaExpand t = recordExpand val t --- >>= caseEx -- done by comp + + outCase subst t = do + pts <- getParams context + let (args,ptyps) = unzip $ filter (flip occur t . fst) pts + if null args + then return t + else do + let argtyp = RecType $ tuple2recordType ptyps + let pvars = map (Vr . zIdent . prt) args -- gets eliminated + patt <- term2patt $ R $ tuple2record $ pvars + let t' = replace (zip args pvars) t + t1 <- comp subst $ T (TTyped argtyp) [(patt, t')] + return $ S t1 $ R $ tuple2record args + + --- notice: this assumes that all lin types follow the "old JFP style" + getParams = liftM concat . mapM getParam + getParam (argv,RecType rs) = return + [(P (Vr argv) lab, ptyp) | (lab,ptyp) <- rs, not (isLinLabel lab)] + ---getParam (_,ty) | ty==typeStr = return [] --- in lindef + getParam (av,ty) = + Bad ("record type expected not" +++ prt ty +++ "for" +++ prt av) + --- all lin types are rec types + + replace :: [(Term,Term)] -> Term -> Term + replace reps trm = case trm of + -- this is the important case + P _ _ -> maybe trm id $ lookup trm reps + _ -> composSafeOp (replace reps) trm + + occur t trm = case trm of + + -- this is the important case + P _ _ -> t == trm + S x y -> occur t y || occur t x + App f x -> occur t x || occur t f + Abs _ f -> occur t f + R rs -> any (occur t) (map (snd . snd) rs) + T _ cs -> any (occur t) (map snd cs) + C x y -> occur t x || occur t y + Glue x y -> occur t x || occur t y + ExtR x y -> occur t x || occur t y + FV ts -> any (occur t) ts + V _ ts -> any (occur t) ts + Let (_,(_,x)) y -> occur t x || occur t y + _ -> False + + +-- here we must be careful not to reduce +-- variants {{s = "Auto" ; g = N} ; {s = "Wagen" ; g = M}} +-- {s = variants {"Auto" ; "Wagen"} ; g = variants {N ; M}} ; + +recordExpand :: Type -> Term -> Err Term +recordExpand typ trm = case unComputed typ of + RecType tys -> case trm of + FV rs -> return $ FV [R [assign lab (P r lab) | (lab,_) <- tys] | r <- rs] + _ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys] + _ -> return trm + + +-- | auxiliaries for compiling the resource + +mkLinDefault :: SourceGrammar -> Type -> Err Term +mkLinDefault gr typ = do + case unComputed typ of + RecType lts -> mapPairsM mkDefField lts >>= (return . Abs varStr . R . mkAssign) + _ -> prtBad "linearization type must be a record type, not" typ + where + mkDefField typ = case unComputed typ of + Table p t -> do + t' <- mkDefField t + let T _ cs = mkWildCases t' + return $ T (TWild p) cs + Sort "Str" -> return $ Vr varStr + QC q p -> lookupFirstTag gr q p + RecType r -> do + let (ls,ts) = unzip r + ts' <- mapM mkDefField ts + return $ R $ [assign l t | (l,t) <- zip ls ts'] + _ | isTypeInts typ -> return $ EInt 0 -- exists in all as first val + _ -> prtBad "linearization type field cannot be" typ + +-- | Form the printname: if given, compute. If not, use the computed +-- lin for functions, cat name for cats (dispatch made in evalCncDef above). +--- We cannot use linearization at this stage, since we do not know the +--- defaults we would need for question marks - and we're not yet in canon. +evalPrintname :: SourceGrammar -> Ident -> MPr -> Perh Term -> Err Term +evalPrintname gr c ppr lin = + case ppr of + Yes pr -> comp pr + _ -> case lin of + Yes t -> return $ K $ clean $ prt $ oneBranch t ---- stringFromTerm + _ -> return $ K $ prt c ---- + where + comp = computeConcrete gr + + oneBranch t = case t of + Abs _ b -> oneBranch b + R (r:_) -> oneBranch $ snd $ snd r + T _ (c:_) -> oneBranch $ snd c + V _ (c:_) -> oneBranch c + FV (t:_) -> oneBranch t + C x y -> C (oneBranch x) (oneBranch y) + S x _ -> oneBranch x + P x _ -> oneBranch x + Alts (d,_) -> oneBranch d + _ -> t + + --- very unclean cleaner + clean s = case s of + '+':'+':' ':cs -> clean cs + '"':cs -> clean cs + c:cs -> c: clean cs + _ -> s + diff --git a/src/gf.spec b/src/gf.spec new file mode 100644 index 000000000..b46b9be62 --- /dev/null +++ b/src/gf.spec @@ -0,0 +1,119 @@ +%define name GF +%define version 2.8 +%define release 1 + +Name: %{name} +Summary: Grammatical Framework +Version: %{version} +Release: %{release} +License: GPL +Group: Sciences/Other +Vendor: The Language Technology Group +URL: http://www.cs.chalmers.se/~aarne/GF/ +Source: GF-%{version}.tgz +BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-buildroot +BuildRequires: ghc + +%description +The Grammatical Framework (=GF) is a grammar formalism based on type theory. +It consists of + + * a special-purpose programming language + * a compiler of the language + * a generic grammar processor + +The compiler reads GF grammars from user-provided files, and the +generic grammar processor performs various tasks with the grammars: + + * generation + * parsing + * translation + * type checking + * computation + * paraphrasing + * random generation + * syntax editing + +GF particularly addresses the following aspects of grammars: + + * multilinguality (parallel grammars for different languages) + * semantics (semantic conditions of well-formedness, semantic + properties of expressions) + * grammar engineering (modularity, information hiding, reusable + libraries) + + +%package editor +Summary: Java syntax editor for Grammatical Framework (GF). +Group: Sciences/Other +Requires: %{name} + +%description editor +This package contains the syntax editor GUI for GF. + +%package editor2 +Summary: Java syntax editor for Grammatical Framework (GF). +Group: Sciences/Other +Requires: %{name} + +%description editor2 +This package contains the syntax editor GUI for GF with printname enhancements and HTML support. + + +%prep +rm -rf $RPM_BUILD_ROOT +%setup -q + +%build +cd src +%configure +make all + +%install +cd src +%makeinstall + +%clean +rm -rf $RPM_BUILD_ROOT + +%files +%defattr(-,root,root,0755) +%{_bindir}/gf +%{_bindir}/gfdoc +%doc LICENSE README doc/{DocGF.pdf,gf2-highlights.html,index.html} + +%files editor +%defattr(-,root,root,0755) +%{_bindir}/jgf +%{_datadir}/%{name}-%{version}/gf-java.jar + +%files editor2 +%defattr(-,root,root,0755) +%{_bindir}/gfeditor +%{_datadir}/%{name}-%{version}/gfeditor.jar + + +%changelog +* Tue Jun 21 2005 Hans-Joachim Daniels <daniels@ira.uka.de> 2.3pre +- added the printnames and HTML enhanced editor as editor2 + +* Thu May 12 2005 Bjorn Bringert <bringert@cs.chalmers.se> 2.2pre2-1 +- Split package into gf and gf-editor packages. + +* Wed May 11 2005 Bjorn Bringert <bringert@cs.chalmers.se> 2.2pre1-1 +- Release of GF 2.2 + +* Mon Nov 8 2004 Aarne Ranta <aarne@cs.chalmers.se> 2.1-1 +- Release of GF 2.1 + +* Thu Jun 24 2004 Bjorn Bringert <bringert@cs.chalmers.se> 2.0-2 +- Set ownership correctly. +- Move jar-file to share (thanks to Anders Carlsson for pointing this out.) +- Added vendor tag. + +* Tue Jun 22 2004 Bjorn Bringert <bringert@cs.chalmers.se> 2.0-1 +- Include gfdoc binary + +* Mon Jun 21 2004 Bjorn Bringert <bringert@cs.chalmers.se> 2.0-1 +- Initial packaging + diff --git a/src/gf.wxs.in b/src/gf.wxs.in new file mode 100644 index 000000000..e2b21f12b --- /dev/null +++ b/src/gf.wxs.in @@ -0,0 +1,63 @@ +<?xml version="1.0"?> +<Wix xmlns="http://schemas.microsoft.com/wix/2003/01/wi"> + <Product Id="4717AF5D-52AC-4D13-85E6-D87278CE9BBC" + UpgradeCode="0BB7BB08-1A79-4981-A03F-32B401B01010" + Name="Grammatical Framework, version @PACKAGE_VERSION@" + Language="1033" Version="2.2" Manufacturer="The GF Developers"> + <Package Id="????????-????-????-????-????????????" + Description="Grammatical Framework, version @PACKAGE_VERSION@" + Comments="This package contains the Grammatical Framework system, version @PACKAGE_VERSION@." + InstallerVersion="200" Compressed="yes" /> + + <Media Id="1" Cabinet="gf.cab" EmbedCab="yes" /> + + <Directory Id="TARGETDIR" Name="SourceDir"> + + <Directory Id="ProgramFilesFolder"> + <Directory Id="INSTALLDIR" Name="GF-@PACKAGE_VERSION@"> + + <Component Id="GFBinary" Guid="E2A44A6C-0252-4346-85AE-BC6A16BFB0FC" DiskId="1"> + <File Id="GFEXE" Name="gf.exe" src="../bin/gf.exe" /> + <Shortcut Id="GFStartMenu" Directory="GFProgramMenuDir" + Name="GF" Target="[!GFEXE]" /> + </Component> + + <Component Id="GFDocBinary" Guid="BDCA6F34-EE0A-4E72-8D00-CB7CAF3CEAEA" DiskId="1"> + <File Id="GFDocEXE" Name="gfdoc.exe" src="tools/gfdoc.exe" /> + </Component> + + <Component Id="GFEditor" Guid="39F885F7-BC49-4CBC-9DCD-569C95AA3364" DiskId="1"> + <Environment Id="GFHomeEnv" Name="GF_HOME" Action="create" Part="all" + Permanent="no" Value="[INSTALLDIR]" /> + <File Id="GFEditorBat" Name="jgf.bat" src="jgf.bat" /> + <File Id="GFEditorJar" Name="gf-java.jar" src="JavaGUI/gf-java.jar" /> + <Shortcut Id="GFEditorStartMenu" Directory="GFProgramMenuDir" + Name="GFEditor" LongName="GF Editor" Target="[!GFEditorBat]" + WorkingDirectory="INSTALLDIR" /> + </Component> + + <Directory Id="GFDocDir" Name="doc"> + <Component Id="GFDoc" Guid="23BEEBBF-F9AB-459F-B8D2-8414BB47834A" DiskId="1"> + <File Id="GFReadme" Name="README.txt" src="../README" /> + <File Id="GFLicenee" Name="LICENSE.txt" src="../LICENSE" /> + </Component> + </Directory> + + </Directory> + </Directory> + + <Directory Id="ProgramMenuFolder" Name="PMenu" LongName="Programs"> + <Directory Id="GFProgramMenuDir" Name='GF-@PACKAGE_VERSION@' /> + </Directory> + + </Directory> + + <Feature Id="ProductFeature" Title="Feature Title" Level="1"> + <ComponentRef Id="GFBinary" /> + <ComponentRef Id="GFDocBinary" /> + <ComponentRef Id="GFEditor" /> + <ComponentRef Id="GFDoc" /> + </Feature> + + </Product> +</Wix>
\ No newline at end of file diff --git a/src/gf_atk.cfg b/src/gf_atk.cfg new file mode 100644 index 000000000..37bb2c4f5 --- /dev/null +++ b/src/gf_atk.cfg @@ -0,0 +1,98 @@ +# GF ATK configuration file +# ------------------------ + +# -- Basic audio signal processing -- + +SOURCEFORMAT = HAUDIO +SOURCERATE = 625 + +# Set in GF/System/ATKSpeechInput.hs +# TARGETKIND = MFCC_0_D_A + +TARGETRATE = 100000.0 +WINDOWSIZE = 250000.0 +ENORMALISE = F +ZMEANSOURCE = F +USEHAMMING = T +PREEMCOEF = 0.97 +USEPOWER = T +NUMCHANS = 26 +CEPLIFTER = 22 +NUMCEPS = 12 +SILFLOOR = 50.0 +USESILDET = T +MEASURESIL = F +OUTSILWARN = T + +# -- Silence detection --- + +HPARM: CALWINDOW = 40 +HPARM: SPEECHTHRESH = 9.0 +HPARM: SILDISCARD = 10.0 +HPARM: SILENERGY = 0.0 +HPARM: SPCSEQCOUNT = 10 +HPARM: SPCGLCHCOUNT = 0 +HPARM: SILGLCHCOUNT = 2 +HPARM: SILSEQCOUNT = 50 + +# -- Cepstral mean --- + +HPARM: CMNTCONST = 0.995 +HPARM: CMNRESETONSTOP = F +HPARM: CMNMINFRAMES = 12 + +# -- Recogniser -- + +AREC: TRBAKFREQ = 1 + +# hands free, don't return results until end +AREC: RUNMODE = 01441 + +AREC: GENBEAM = 200.0 +AREC: WORDBEAM = 175.0 +AREC: WORDPEN = -10.0 + +HNET: FORCECXTEXP = T +HNET: ALLOWXWRDEXP = F +HNET: MARKSUBLAT = F +ARMAN: AUTOSIL = F + +HREC: CONFSCALE = 0.15 +HREC: CONFOFFSET = 0.0 +#HREC: CONFBGHMM = bghmm + +# -- Set visibility and positions of ATK controls -- + +AIN: DISPSHOW = T +AIN: DISPXORIGIN = 440 +AIN: DISPYORIGIN = 220 +AIN: DISPHEIGHT = 40 +AIN: DISPWIDTH = 160 + +ACODE: DISPSHOW = F +ACODE: DISPXORIGIN = 40 +ACODE: DISPYORIGIN = 220 +ACODE: DISPHEIGHT = 220 +ACODE: DISPWIDTH = 380 +ACODE: MAXFGFEATS = 13 +ACODE: NUMSTREAMS = 1 + +AREC: DISPSHOW = T +AREC: DISPXORIGIN = 40 +AREC: DISPYORIGIN = 20 +AREC: DISPHEIGHT = 160 +AREC: DISPWIDTH = 560 + + +# -- Debugging -- + +HMMSET: TRACE = 0 +ADICT: TRACE = 0 +AGRAM: TRACE = 0 +GGRAM: TRACE = 0 +AREC: TRACE = 0 +ARMAN: TRACE = 0 +HPARM: TRACE = 0 +HNET: TRACE = 0 +HREC: TRACE = 0 + diff --git a/src/gfc.in b/src/gfc.in new file mode 100644 index 000000000..05addb2cb --- /dev/null +++ b/src/gfc.in @@ -0,0 +1,25 @@ +#!/bin/sh + +prefix="@prefix@" + +case "@host@" in + *-cygwin) + prefix=`cygpath -w "$prefix"`;; +esac + +exec_prefix="@exec_prefix@" +GF_BIN_DIR="@bindir@" +GF_DATA_DIR="@datadir@/GF-@PACKAGE_VERSION@" + +GFBIN="$GF_BIN_DIR/gf3" + +if [ ! -x "${GFBIN}" ]; then + GFBIN=`which gf3` +fi + +if [ ! -x "${GFBIN}" ]; then + echo "gf3 not found." + exit 1 +fi + +exec $GFBIN --batch "$@" diff --git a/src/gfeditor.in b/src/gfeditor.in new file mode 100644 index 000000000..129cd5e1f --- /dev/null +++ b/src/gfeditor.in @@ -0,0 +1,42 @@ +#!/bin/sh + +prefix="@prefix@" + +case "@host@" in + *-cygwin) + prefix=`cygpath -w "$prefix"`;; +esac + +exec_prefix="@exec_prefix@" +GF_BIN_DIR="@bindir@" +GF_DATA_DIR="@datadir@/GF-@PACKAGE_VERSION@" + +JAVA="@JAVA@" + +GF="$GF_BIN_DIR/gf" +JARFILE="$GF_DATA_DIR/gfeditor.jar" + +if [ ! -x "${JAVA}" ]; then + JAVA=`which java` +fi + +if [ ! -x "${JAVA}" ]; then + echo "No Java VM found." + exit 1 +fi + +if [ ! -r "${JARFILE}" ]; then + echo "Cannot read JAR file ${JARFILE}." + exit 1 +fi + +if [ ! -x "${GF}" ]; then + GF=`which gf` +fi + +if [ ! -x "${GF}" ]; then + echo "GF not found." + exit 1 +fi + +exec "${JAVA}" -jar "${JARFILE}" -g "${GF}" $* diff --git a/src/haddock/haddock-check.perl b/src/haddock/haddock-check.perl new file mode 100644 index 000000000..93647bac7 --- /dev/null +++ b/src/haddock/haddock-check.perl @@ -0,0 +1,169 @@ + +# checking that a file is haddocky: +# - checking if it has an export list +# - if there is no export list, it tries to find all defined functions +# - checking that all exported functions have type signatures +# - checking that the module header is OK + +# changes on files: +# - transforming hard space to ordinary space + +# limitations: +# - there might be some problems with nested comments +# - cannot handle type signatures for several functions +# (i.e. "a, b, c :: t") +# but on the other hand -- haddock has some problems with these too... + +$operChar = qr/[\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~]/; +$operCharColon = qr/[\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~\:]/; +$nonOperChar = qr/[^\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~]/; +$nonOperCharColon = qr/[^\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~\:]/; + +$operSym = qr/$operChar $operCharColon*/x; +$funSym = qr/[a-z] \w* \'*/x; +$funOrOper = qr/(?: $funSym | \($operSym\) )/x; + +$keyword = qr/(?: type | data | module | newtype | infix[lr]? | import | instance | class )/x; +$keyOper = qr/^(?: \.\. | \:\:? | \= | \\ | \| | \<\- | \-\> | \@ | \~ | \=\> | \. )$/x; + +sub check_headerline { + my ($title, $regexp) = @_; + if (s/^-- \s $title \s* : \s+ (.+?) \s*\n//sx) { + $name = $1; + push @ERR, "Incorrect ".lcfirst $title.": $name" + unless $name =~ $regexp; + return $&; + } else { + push @ERR, "Header missing: ".lcfirst $title.""; + } +} + +if ($#ARGV >= 0) { + @FILES = @ARGV; +} else { +# @dirs = qw{. api canonical cf cfgm compile for-ghc-nofud +# grammar infra notrace parsers shell +# source speech translate useGrammar util visualization +# GF GF/* GF/*/* GF/*/*/*}; + @dirs = qw{GF GF/* GF/*/* GF/*/*/*}; + @FILES = grep(!/\/(Par|Lex)(GF|GFC|CFG)\.hs$/, + glob "{".join(",",@dirs)."}/*.hs"); +} + +for $file (@FILES) { + $file =~ s/\.hs//; + + open F, "<$file.hs"; + $_ = join "", <F>; + close F; + + @ERR = (); + + # substituting hard spaces for ordinary spaces + $nchars = tr/\240/ /; + if ($nchars > 0) { + push @ERR, "!! > Substituted $nchars hard spaces"; + open F, ">$file.hs"; + print F $_; + close F; + } + + # the module header + $hdr_module = $module = ""; + + s/^ \{-\# \s+ OPTIONS \s+ -cpp \s+ \#-\} //sx; # removing ghc options (cpp) + s/^ \s+ //sx; # removing initial whitespace + s/^ (--+ \s* \n) +//sx; # removing initial comment lines + unless (s/^ -- \s \| \s* \n//sx) { + push @ERR, "Incorrect module header"; + } else { + $hdr_module = s/^-- \s Module \s* : \s+ (.+?) \s*\n//sx ? $1 : ""; + &check_headerline("Maintainer", qr/^ [\wåäöÅÄÖüÜ\s\@\.]+ $/x); + &check_headerline("Stability", qr/.*/); + &check_headerline("Portability", qr/.*/); + s/^ (--+ \s* \n) +//sx; + push @ERR, "Missing CVS information" + unless s/^(-- \s+ \> \s+ CVS \s+ \$ .*? \$ \s* \n)+//sx; + s/^ (--+ \s* \n) +//sx; + push @ERR, "Missing module description" + unless /^ -- \s+ [^\(]/x; + } + + # removing comments + s/\{- .*? -\}//gsx; + s/-- ($nonOperSymColon .*? \n | \n)/\n/gx; + + # removing \n in front of whitespace (for simplification) + s/\n+[ \t]/ /gs; + + # the export list + $exportlist = ""; + + if (/\n module \s+ ((?: \w | \.)+) \s+ \( (.*?) \) \s+ where/sx) { + ($module, $exportlist) = ($1, $2); + + $exportlist =~ s/\b module \s+ [A-Z] \w*//gsx; + $exportlist =~ s/\(\.\.\)//g; + + } elsif (/\n module \s+ ((?: \w | \.)+) \s+ where/sx) { + $module = $1; + + # modules without export lists + # push @ERR, "No export list"; + + # function definitions + while (/^ (.*? $nonOperCharColon) = (?! $operCharColon)/gmx) { + $defn = $1; + next if $defn =~ /^ $keyword \b/x; + + if ($defn =~ /\` ($funSym) \`/x) { + $fn = $1; + } elsif ($defn =~ /(?<! $operCharColon) ($operSym)/x + && $1 !~ $keyOper) { + $fn = "($1)"; + } elsif ($defn =~ /^($funSym)/x) { + $fn = $1; + } else { + push @ERR, "!! > Error in function defintion: $defn"; + next; + } + + $exportlist .= " $fn "; + } + } else { + push @ERR, "No module header found"; + } + + push @ERR, "Module names not matching: $module != $hdr_module" + if $hdr_module && $module !~ /\Q$hdr_module\E$/; + + # fixing exportlist (double spaces as separator) + $exportlist = " $exportlist "; + $exportlist =~ s/(\s | \,)+/ /gx; + + # removing functions with type signatures from export list + while (/^ ($funOrOper (\s* , \s* $funOrOper)*) \s* ::/gmx) { + $functionlist = $1; + while ($functionlist =~ s/^ ($funOrOper) (\s* , \s*)?//x) { + $function = $1; + $exportlist =~ s/\s \Q$function\E \s/ /gx; + } + } + + # reporting exported functions without type signatures + $reported = 0; + $untyped = ""; + while ($exportlist =~ /\s ($funOrOper) \s/x) { + $function = $1; + $exportlist =~ s/\s \Q$function\E \s/ /gx; + $reported++; + $untyped .= " $function"; + } + push @ERR, "No type signature for $reported function(s):\n " . $untyped + if $reported; + + print "-- $file\n > " . join("\n > ", @ERR) . "\n" + if @ERR; +} + + diff --git a/src/haddock/haddock-script.csh b/src/haddock/haddock-script.csh new file mode 100644 index 000000000..77b3761f8 --- /dev/null +++ b/src/haddock/haddock-script.csh @@ -0,0 +1,73 @@ +#!/bin/tcsh + +###################################################################### +# Author: Peter Ljunglöf +# Time-stamp: "2005-05-12, 23:17" +# CVS $Date: 2005/05/13 12:40:20 $ +# CVS $Author: peb $ +# +# a script for producing documentation through Haddock +###################################################################### + +set basedir = `pwd` +set docdir = haddock/html +set tempdir = haddock/.temp-files +set resourcedir = haddock/resources + +set files = (`find GF -name '*.hs'` GF.hs) + +###################################################################### + +echo 1. Creating and cleaning Haddock directory +echo -- $docdir + +mkdir -p $docdir +rm -rf $docdir/* + +###################################################################### + +echo +echo 2. Copying Haskell files to temporary directory: $tempdir + +rm -rf $tempdir + +foreach f ($files) + # echo -- $f + mkdir -p `dirname $tempdir/$f` + perl -pe 's/^#/-- CPP #/' $f > $tempdir/$f +end + +###################################################################### + +echo +echo 3. Invoking Haddock + +cd $tempdir +haddock -o $basedir/$docdir -h -t 'Grammatical Framework' $files +cd $basedir + +###################################################################### + +echo +echo 4. Restructuring to HTML framesets + +echo -- Substituting for frame targets inside html files +mv $docdir/index.html $docdir/index-frame.html +foreach f ($docdir/*.html) + # echo -- $f + perl -pe 's/<HEAD/<HEAD><BASE TARGET="contents"/; s/"index.html"/"index-frame.html"/; s/(<A HREF = "\S*index\S*.html")/$1 TARGET="index"/' $f > .tempfile + mv .tempfile $f +end + +echo -- Copying resource files: +echo -- `ls $resourcedir/*.*` +cp $resourcedir/*.* $docdir + +###################################################################### + +echo +echo 5. Finished +echo -- The documentation is located at: +echo -- $docdir/index.html + + diff --git a/src/haddock/resources/blank.html b/src/haddock/resources/blank.html new file mode 100644 index 000000000..63ab0b172 --- /dev/null +++ b/src/haddock/resources/blank.html @@ -0,0 +1,10 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
+
+<!-- Time-stamp: "2005-02-03, 15:59" -->
+<HTML>
+<HEAD>
+<LINK HREF="haddock.css" REL=stylesheet>
+</HEAD>
+<BODY>
+</BODY>
+</HTML>
diff --git a/src/haddock/resources/index.html b/src/haddock/resources/index.html new file mode 100644 index 000000000..5d8822dc5 --- /dev/null +++ b/src/haddock/resources/index.html @@ -0,0 +1,14 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" + "http://www.w3.org/TR/html4/frameset.dtd"> + +<!-- Time-stamp: "2005-02-03, 15:53" --> +<html> +<head> +<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1" /> +<title>Grammatical Framework programmer's documentation</title> +</head> +<frameset cols="1*,2*"> + <frame name="index" src="index-frame.html"> + <frame name="contents" src="blank.html"> +</frameset> +</html> diff --git a/src/install-sh b/src/install-sh new file mode 100644 index 000000000..e9de23842 --- /dev/null +++ b/src/install-sh @@ -0,0 +1,251 @@ +#!/bin/sh +# +# install - install a program, script, or datafile +# This comes from X11R5 (mit/util/scripts/install.sh). +# +# Copyright 1991 by the Massachusetts Institute of Technology +# +# Permission to use, copy, modify, distribute, and sell this software and its +# documentation for any purpose is hereby granted without fee, provided that +# the above copyright notice appear in all copies and that both that +# copyright notice and this permission notice appear in supporting +# documentation, and that the name of M.I.T. not be used in advertising or +# publicity pertaining to distribution of the software without specific, +# written prior permission. M.I.T. makes no representations about the +# suitability of this software for any purpose. It is provided "as is" +# without express or implied warranty. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. It can only install one file at a time, a restriction +# shared with many OS's install programs. + + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit="${DOITPROG-}" + + +# put in absolute paths if you don't have them in your path; or use env. vars. + +mvprog="${MVPROG-mv}" +cpprog="${CPPROG-cp}" +chmodprog="${CHMODPROG-chmod}" +chownprog="${CHOWNPROG-chown}" +chgrpprog="${CHGRPPROG-chgrp}" +stripprog="${STRIPPROG-strip}" +rmprog="${RMPROG-rm}" +mkdirprog="${MKDIRPROG-mkdir}" + +transformbasename="" +transform_arg="" +instcmd="$mvprog" +chmodcmd="$chmodprog 0755" +chowncmd="" +chgrpcmd="" +stripcmd="" +rmcmd="$rmprog -f" +mvcmd="$mvprog" +src="" +dst="" +dir_arg="" + +while [ x"$1" != x ]; do + case $1 in + -c) instcmd="$cpprog" + shift + continue;; + + -d) dir_arg=true + shift + continue;; + + -m) chmodcmd="$chmodprog $2" + shift + shift + continue;; + + -o) chowncmd="$chownprog $2" + shift + shift + continue;; + + -g) chgrpcmd="$chgrpprog $2" + shift + shift + continue;; + + -s) stripcmd="$stripprog" + shift + continue;; + + -t=*) transformarg=`echo $1 | sed 's/-t=//'` + shift + continue;; + + -b=*) transformbasename=`echo $1 | sed 's/-b=//'` + shift + continue;; + + *) if [ x"$src" = x ] + then + src=$1 + else + # this colon is to work around a 386BSD /bin/sh bug + : + dst=$1 + fi + shift + continue;; + esac +done + +if [ x"$src" = x ] +then + echo "install: no input file specified" + exit 1 +else + true +fi + +if [ x"$dir_arg" != x ]; then + dst=$src + src="" + + if [ -d $dst ]; then + instcmd=: + chmodcmd="" + else + instcmd=mkdir + fi +else + +# Waiting for this to be detected by the "$instcmd $src $dsttmp" command +# might cause directories to be created, which would be especially bad +# if $src (and thus $dsttmp) contains '*'. + + if [ -f $src -o -d $src ] + then + true + else + echo "install: $src does not exist" + exit 1 + fi + + if [ x"$dst" = x ] + then + echo "install: no destination specified" + exit 1 + else + true + fi + +# If destination is a directory, append the input filename; if your system +# does not like double slashes in filenames, you may need to add some logic + + if [ -d $dst ] + then + dst="$dst"/`basename $src` + else + true + fi +fi + +## this sed command emulates the dirname command +dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` + +# Make sure that the destination directory exists. +# this part is taken from Noah Friedman's mkinstalldirs script + +# Skip lots of stat calls in the usual case. +if [ ! -d "$dstdir" ]; then +defaultIFS=' +' +IFS="${IFS-${defaultIFS}}" + +oIFS="${IFS}" +# Some sh's can't handle IFS=/ for some reason. +IFS='%' +set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` +IFS="${oIFS}" + +pathcomp='' + +while [ $# -ne 0 ] ; do + pathcomp="${pathcomp}${1}" + shift + + if [ ! -d "${pathcomp}" ] ; + then + $mkdirprog "${pathcomp}" + else + true + fi + + pathcomp="${pathcomp}/" +done +fi + +if [ x"$dir_arg" != x ] +then + $doit $instcmd $dst && + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi +else + +# If we're going to rename the final executable, determine the name now. + + if [ x"$transformarg" = x ] + then + dstfile=`basename $dst` + else + dstfile=`basename $dst $transformbasename | + sed $transformarg`$transformbasename + fi + +# don't allow the sed command to completely eliminate the filename + + if [ x"$dstfile" = x ] + then + dstfile=`basename $dst` + else + true + fi + +# Make a temp file name in the proper directory. + + dsttmp=$dstdir/#inst.$$# + +# Move or copy the file name to the temp name + + $doit $instcmd $src $dsttmp && + + trap "rm -f ${dsttmp}" 0 && + +# and set any options; do chmod last to preserve setuid bits + +# If any of these fail, we abort the whole thing. If we want to +# ignore errors from any of these, just make sure not to ignore +# errors from the above "$doit $instcmd $src $dsttmp" command. + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && + +# Now rename the file to the real destination. + + $doit $rmcmd -f $dstdir/$dstfile && + $doit $mvcmd $dsttmp $dstdir/$dstfile + +fi && + + +exit 0 diff --git a/src/jgf.bat b/src/jgf.bat new file mode 100644 index 000000000..d56a638d5 --- /dev/null +++ b/src/jgf.bat @@ -0,0 +1 @@ +java -jar "%GF_HOME%\gf-java.jar" "%GF_HOME%\gf.exe" %* diff --git a/src/jgf.in b/src/jgf.in new file mode 100644 index 000000000..3df121a64 --- /dev/null +++ b/src/jgf.in @@ -0,0 +1,42 @@ +#!/bin/sh + +prefix="@prefix@" + +case "@host@" in + *-cygwin) + prefix=`cygpath -w "$prefix"`;; +esac + +exec_prefix="@exec_prefix@" +GF_BIN_DIR="@bindir@" +GF_DATA_DIR="@datadir@/GF-@PACKAGE_VERSION@" + +JAVA="@JAVA@" + +GF="$GF_BIN_DIR/gf" +JARFILE="$GF_DATA_DIR/gf-java.jar" + +if [ ! -x "${JAVA}" ]; then + JAVA=`which java` +fi + +if [ ! -x "${JAVA}" ]; then + echo "No Java VM found." + exit 1 +fi + +if [ ! -r "${JARFILE}" ]; then + echo "Cannot read JAR file ${JARFILE}." + exit 1 +fi + +if [ ! -x "${GF}" ]; then + GF=`which gf` +fi + +if [ ! -x "${GF}" ]; then + echo "GF not found." + exit 1 +fi + +exec "${JAVA}" -jar "${JARFILE}" "$GF -java $*" diff --git a/src/module-structure.txt b/src/module-structure.txt new file mode 100644 index 000000000..d3b596d9f --- /dev/null +++ b/src/module-structure.txt @@ -0,0 +1,76 @@ + + +följande är en föreslagen hierarkisk modulstruktur för GF 2.2 + +* katalogen src kommer att innehålla (åtminstone) följande: + - GF.hs modulen Main + - GF/ resten av Haskell-filerna + - JavaGUI/ java-filer + - haddock/ filer för haddock + - html/ + - resources/ + - run-haddock.csh + - check-haddock.perl + + +* struktur för haskell-filer: + + GF.Formalism (finns redan) + GF.Conversion (...) + GF.Parsing (heter nu GF.NewParsing, bör byta namn) + GF.System (finns redan, för filer som har med + operativsystemet att göra, t.ex. Tracing och Arch) + +filerna GF.NewParsing.GeneralChart och GF.NewParsing.IncrementalChart +flyttas och byter namn till GF.Data.GeneralDeduction och GF.Data.IncrementalDeduction + +vart ska filerna GFModes, Help, HelpFile, Today flyttas? +förslag: Help, HelpFile, Today -> GF.System + +api -> GF.API +cf -> GF.CF +canonical -> GF.Canon +compile -> GF.Compile + +infra -> GF.Data (datatyper, algoritmer - helst ej direkt beroende av GF) + GF.Infra (GF-infrastruktur) + GF.Text (t.ex. olika språk, teckenkodningar) + +(...) -> GF.Fudgets (alla filer som har med fudgets att göra) +grammar -> GF.Grammar +cfgm -> GF.CFGM +source -> GF.Source +shell -> GF.Shell +speech -> GF.Speech +translate -> GF.Translate +useGrammar -> GF.UseGrammar +visuali... -> GF.Visualization + +parsers -> filerna (ParGF och ParGFC) flyttas till där GF.cf och GFC.cf finns + +util -> Extras (kanske på toppnivå - inte GF.Extras) + + +* java-katalogen byter namn: + +java -> JavaGUI + + +* haddock samlas på ett ställe: + +haddock-check.perl -> haddock/check-haddock.perl +haddock-script.csh -> haddock/run-haddock.csh +haddock-resources/ -> haddock/resources/ +haddock/ -> haddock/html + + +* kataloger som kan tas bort? + +for-xxx (obsoleta) +haddock +newparsing (tom) +notrace (tom) +trace (tom) +parsers (tom efter flytt av filer) +old-stuff (obsolet) +GF.OldParsing (obsolet) diff --git a/src/tools/AlphaConvGF.hs b/src/tools/AlphaConvGF.hs new file mode 100644 index 000000000..0e87bdb7a --- /dev/null +++ b/src/tools/AlphaConvGF.hs @@ -0,0 +1,43 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/16 05:40:50 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.4 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module Main (main) where + +import LexGF +import Alex +import System + +main :: IO () +main = do + file1:file2:_ <- getArgs + s <- readFile file1 + ts <- tokens s + if file1==file2 then print (length ts) else return () -- make sure file1 is in mem + writeFile file2 [] -- create file2 or remove its old contents + alphaConv file2 ts (Pn 1 1 1) + +alphaConv :: FilePath -> [Token] -> Posn -> IO () +alphaConv file (t:ts) p0 = case t of + PT p (TV s) -> changeId file p0 p s ts + _ -> putToken file p0 t >>= alphaConv file ts +alphaConv _ _ = putStrLn "Ready." + +putToken :: FilePath -> Posn -> Token -> IO Posn +putToken file (Pn _ l0 c0) t@(PT (Pn a l c) _) = do + let s = prToken t + ns = l - l0 + ls = length s + replicate ns $ appendFile file '\n' + replicate (if ns == 0 then c - c0 else c-1) $ putChar ' ' + putStr s + return $ Pn (a + ls) l (c + ls) ts diff --git a/src/tools/GFDoc.hs b/src/tools/GFDoc.hs new file mode 100644 index 000000000..91410864a --- /dev/null +++ b/src/tools/GFDoc.hs @@ -0,0 +1,366 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/16 05:40:50 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.7 $ +-- +-- produce a HTML document from a list of GF grammar files. AR 6\/10\/2002 +-- +-- Added @--!@ (NewPage) and @--*@ (Item) 21\/11\/2003 +----------------------------------------------------------------------------- + +module Main (main) where + + +import Data.Char +import Data.List +import System.Cmd +import System.Directory +import System.Environment +import System.Locale +import System.Time + +-- to read files and write a file + +main :: IO () +main = do + xx <- getArgs + let + (typ,format,names) = case xx of + "-latex" : xs -> (0,doc2latex,xs) + "-htmls" : xs -> (2,doc2html,xs) + "-txt" : xs -> (3,doc2txt,xs) + "-txt2" : xs -> (3,doc2txt2,xs) + "-txthtml": xs -> (4,doc2txt,xs) + xs -> (1,doc2html,xs) + if null xx + then do + putStrLn welcome + putStrLn help + else flip mapM_ names (\name -> do + ss <- readFile name + time <- modTime name + let outfile = fileFormat typ name + writeFile outfile $ format $ pDoc time ss) + case typ of + 2 -> + mapM_ (\name -> system $ "htmls " ++ (fileFormat typ name)) names + 4 -> + mapM_ (\name -> + system $ "txt2tags -thtml --toc " ++ (fileFormat typ name)) names + _ -> return () + return () + +modTime :: FilePath -> IO ModTime +modTime name = + do + t <- getModificationTime name + ct <- toCalendarTime t + let timeFmt = "%Y-%m-%d %H:%M:%S %Z" + return $ formatCalendarTime defaultTimeLocale timeFmt ct + +welcome = unlines [ + "", + "gfdoc - a rudimentary GF document generator.", + "(c) Aarne Ranta (aarne@cs.chalmers.se) 2002 under GNU GPL." + ] + +help = unlines $ [ + "", + "Usage: gfdoc (-latex|-htmls|-txt|-txthtml) <file>+", + "", + "The program operates with lines in GF code, treating them into LaTeX", + "(flag -latex), to a set of HTML documents (flag -htmls), to a txt2tags file", + "(flag -txt), to HTML via txt (flag -txthtml), or to one", + "HTML file (by default). The output is written in a file", + "whose name is formed from the input file name by replacing its suffix", + "with html or tex; in case of set of HTML files, the names are prefixed", + "by 01-, 02-, etc, and each file has navigation links.", + "", + "The translation is line by line", + "depending as follows on how the line begins", + "", + " --[Int] heading of level Int", + " -- new paragraph", + " --! new page (in HTML, recognized by the htmls program)", + " --. end of document", +--- " --- ignore this comment line in document", +--- " {---} ignore this code line in document", + " --*[Text] Text paragraph starting with a bullet", + " --[Text] Text belongs to text paragraph", + " [Text] Text belongs to code paragraph", + "", + "Within a text paragraph, text enclosed between certain characters", + "is treated specially:", + "", + " *[Text]* emphasized (boldface)", + " \"[Text]\" example string (italics)", + " $[Text]$ example code (courier)", + "", + "For other formatting and links, we recommend the txt2tags format." + ] + +fileFormat typ x = body ++ suff where + body = reverse $ dropWhile (/='.') $ reverse x + suff = case typ of + 0 -> "tex" + _ | typ < 3 -> "html" + _ -> "txt" + +-- the document datatype + +data Doc = Doc Title ModTime [Paragraph] + +type ModTime = String + +type Title = [TextItem] + +data Paragraph = + Text [TextItem] -- text line starting with -- + | List [[TextItem]] -- + | Code String -- other text line + | Item [TextItem] -- bulleted item: line prefixed by --* + | New -- new paragraph: line consisting of -- + | NewPage -- new parage: line consisting of --! + | Heading Int [TextItem] -- text line starting with --n where n = 1,2,3,4 + +data TextItem = + Str String + | Emp String -- emphasized, *...* + | Lit String -- string literal, "..." + | Inl String -- inlined code, '...' + + +-- parse document + +pDoc :: ModTime -> String -> Doc +pDoc time s = case dropWhile emptyOrPragma (lines s) of + ('-':'-':'1':title) : paras -> Doc (pItems title) time (map pPara (grp paras)) + paras -> Doc [] time (map pPara (grp paras)) + where + grp ss = case ss of + s : rest --- | ignore s -> grp rest + | isEnd s -> [] + | begComment s -> let (s1,s2) = getComment (drop 2 s : rest) + in map ("-- " ++) s1 ++ grp s2 + | isComment s -> s : grp rest + | all isSpace s -> grp rest + [] -> [] + _ -> unlines code : grp rest where (code,rest) = span (not . isComment) ss + pPara s = case s of + '-':'-':d:text | isDigit d -> Heading (read [d]) (pItems text) + '-':'-':'!':[] -> NewPage + '-':'-':[] -> New + '-':'-':'*':text -> Item (pItems (dropWhile isSpace text)) + '-':'-':text -> Text (pItems (dropWhile isSpace text)) + _ -> Code s + pItems s = case s of + '*' : cs -> get 1 Emp (=='*') cs + '"' : cs -> get 1 Lit (=='"') cs + '$' : cs -> get 1 Inl (=='$') cs + [] -> [] + _ -> get 0 Str (flip elem "*\"$") s + + get _ _ _ [] = [] + get k con isEnd cs = con beg : pItems (drop k rest) + where (beg,rest) = span (not . isEnd) cs + + ignore s = case s of + '-':'-':'-':_ -> True + '{':'-':'-':'-':'}':_ -> True + _ -> False + + isEnd s = case s of + '-':'-':'.':_ -> True + _ -> False + + emptyOrPragma s = all isSpace s || "--#" `isPrefixOf` s + +-- render in html + +doc2html :: Doc -> String +doc2html (Doc title time paras) = unlines $ + tagXML "html" $ + tagXML "body" $ + unwords (tagXML "i" ["Produced by " ++ welcome]) : + mkTagXML "p" : + concat (tagXML "h1" [concat (map item2html title)]) : + empty : + map para2html paras + +para2html :: Paragraph -> String +para2html p = case p of + Text its -> concat (map item2html its) + Item its -> mkTagXML "li" ++ concat (map item2html its) + Code s -> unlines $ tagXML "pre" $ map (indent 2) $ + remEmptyLines $ lines $ spec s + New -> mkTagXML "p" + NewPage -> mkTagXML "p" ++ "\n" ++ mkTagXML "!-- NEW --" + Heading i its -> concat $ tagXML ('h':show i) [concat (map item2html its)] + +item2html :: TextItem -> String +item2html i = case i of + Str s -> spec s + Emp s -> concat $ tagXML "b" [spec s] + Lit s -> concat $ tagXML "i" [spec s] + Inl s -> concat $ tagXML "tt" [spec s] + +mkTagXML t = '<':t ++ ">" +mkEndTagXML t = mkTagXML ('/':t) +tagXML t ss = mkTagXML t : ss ++ [mkEndTagXML t] + +spec = elimLt + +elimLt s = case s of + '<':cs -> "<" ++ elimLt cs + c :cs -> c : elimLt cs + _ -> s + + +-- render in latex + +doc2latex :: Doc -> String +doc2latex (Doc title time paras) = unlines $ + preludeLatex : + funLatex "title" [concat (map item2latex title)] : + funLatex "author" [fontLatex "footnotesize" (welcome)] : + envLatex "document" ( + funLatex "maketitle" [] : + map para2latex paras) + +para2latex :: Paragraph -> String +para2latex p = case p of + Text its -> concat (map item2latex its) + Item its -> "\n\n$\\bullet$" ++ concat (map item2latex its) ++ "\n\n" + Code s -> unlines $ envLatex "verbatim" $ map (indent 2) $ + remEmptyLines $ lines $ s + New -> "\n" + NewPage -> "\\newpage" + Heading i its -> headingLatex i (concat (map item2latex its)) + +item2latex :: TextItem -> String +item2latex i = case i of + Str s -> specl s + Emp s -> fontLatex "bf" (specl s) + Lit s -> fontLatex "it" (specl s) + Inl s -> fontLatex "tt" (specl s) + +funLatex :: String -> [String] -> String +funLatex f xs = "\\" ++ f ++ concat ["{" ++ x ++ "}" | x <- xs] + +envLatex :: String -> [String] -> [String] +envLatex e ss = + funLatex "begin" [e] : + ss ++ + [funLatex "end" [e]] + +headingLatex :: Int -> String -> String +-- for slides +-- headingLatex _ s = funLatex "newone" [] ++ "\n" ++ funLatex "heading" [s] +headingLatex i s = funLatex t [s] where + t = case i of + 2 -> "section" + 3 -> "subsection" + _ -> "subsubsection" + +fontLatex :: String -> String -> String +fontLatex f s = "{\\" ++ f ++ " " ++ s ++ "}" + +specl = eliml + +eliml s = case s of + '|':cs -> mmath "mid" ++ elimLt cs + '{':cs -> mmath "\\{" ++ elimLt cs + '}':cs -> mmath "\\}" ++ elimLt cs + _ -> s + +mmath s = funLatex "mbox" ["$" ++ s ++ "$"] + +preludeLatex = unlines $ [ + "\\documentclass[12pt]{article}", + "\\usepackage{isolatin1}", + "\\setlength{\\oddsidemargin}{0mm}", + "\\setlength{\\evensidemargin}{-2mm}", + "\\setlength{\\topmargin}{-16mm}", + "\\setlength{\\textheight}{240mm}", + "\\setlength{\\textwidth}{158mm}", + "\\setlength{\\parskip}{2mm}", + "\\setlength{\\parindent}{0mm}" + ] + +-- render in txt2tags +-- as main document (welcome, top-level subtitles) +-- as chapter (no welcome, subtitle level + i) + +doc2txt :: Doc -> String +doc2txt (Doc title time paras) = unlines $ + let tit = concat (map item2txt title) in + tit: + ("Last update: " ++ time): + "": + "% NOTE: this is a txt2tags file.": + "% Create an html file from this file using:": + ("% txt2tags " ++ tit): + "\n": + concat (["Produced by " ++ welcome]) : + "\n" : + empty : + map (para2txt 0) paras + +doc2txt2 :: Doc -> String +doc2txt2 (Doc title time paras) = unlines $ + let tit = concat (map item2txt title) in + tit: + "": + concat (tagTxt (replicate 2 '=') [tit]): + "\n": + empty : + map (para2txt 2) paras + +para2txt :: Int -> Paragraph -> String +para2txt j p = case p of + Text its -> concat (map item2txt its) + Item its -> "- " ++ concat (map item2txt its) + Code s -> unlines $ tagTxt "```" $ map (indent 2) $ + remEmptyLines $ lines s + New -> "\n" + NewPage -> "\n" ++ "!-- NEW --" + Heading i its -> + concat $ tagTxt (replicate (i + j) '=') [concat (map item2txt its)] + +item2txt :: TextItem -> String +item2txt i = case i of + Str s -> s + Emp s -> concat $ tagTxt "**" [spec s] + Lit s -> concat $ tagTxt "//" [spec s] + Inl s -> concat $ tagTxt "``" [spec s] + +tagTxt t ss = t : ss ++ [t] + + + +-- auxiliaries + +empty = "" + +isComment = (== "--") . take 2 + +begComment = (== "{-") . take 2 + +getComment ss = case ss of + "-}":ls -> ([],ls) + l:ls -> (l : s1, s2) where (s1,s2) = getComment ls + _ -> ([],[]) + +indent n = (replicate n ' ' ++) + +remEmptyLines = rem False where + rem prevGood ls = case span empty ls of + (_ :_, ss@(_ : _)) -> (if prevGood then ("":) else id) $ rem False ss + (_, []) -> [] + (_, s:ss) -> s : rem True ss + empty = all isSpace diff --git a/src/tools/Htmls.hs b/src/tools/Htmls.hs new file mode 100644 index 000000000..ce0b3bb28 --- /dev/null +++ b/src/tools/Htmls.hs @@ -0,0 +1,102 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/16 17:07:18 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.11 $ +-- +-- chop an HTML file into separate files, each linked to the next and previous. +-- the names of the files are n-file, with n = 01,02,... +-- the chopping is performed at each separator, here defined as @\<!-- NEW --\>@ +-- +-- AR 7\/1\/2002 for the Vinnova meeting in Linköping. +-- Added table of contents generation in file 00, 16/4/2005 +----------------------------------------------------------------------------- + +module Main (main) where + +import System +import Char + +main :: IO () +main = do + file:_ <- getArgs + htmls file + +htmls :: FilePath -> IO () +htmls file = do + s <- readFile file + let ss = allPages file s + lg = length ss + putStrLn $ show lg ++ " slides" + mapM_ (uncurry writeFile . mkFile file lg) ss + +allPages :: FilePath -> String -> [(Int,String)] +allPages file s = addIndex $ zip [1..] $ map unlines $ chop lss where + chop ls = case span isNoSep ls of + (s,_:ss) -> s : chop ss + _ -> [ls] + isNoSep = (/= separator) + addIndex = ((0,mkIndex file lss) :) + lss = lines s + +mkFile :: FilePath -> Int -> (Int,String) -> (FilePath,String) +mkFile base mx (number,content) = + (fileName base number, + unlines [ + begHTML, + "<font size=1>", + pageNum mx number, + link base mx number, + "</font>", + "<p>", + content, + endHTML + ] + ) + +begHTML, endHTML, separator :: String +begHTML = "<html><body bgcolor=\"#FFFFFF\" text=\"#000000\">" +endHTML = "</body></html>" +separator = "<!-- NEW -->" + +link :: FilePath -> Int -> Int -> String +link file mx n = + (if n >= mx-1 then "" else (" <a href=\"" ++ file' ++ "\">Next</a>")) ++ + (if n == 1 then "" else (" <a href=\"" ++ file_ ++ "\">Previous</a>")) ++ + (" <a href=\"" ++ file0 ++ "\">Contents</a>") ++ + (" <a href=\"" ++ file ++ "\">Fulltext</a>") ++ + (" <a href=\"" ++ file1 ++ "\">First</a>") ++ + (" <a href=\"" ++ file2 ++ "\">Last</a>") + where + file_ = fileName file (n - 1) + file' = fileName file (n + 1) + file0 = fileName file 0 + file1 = fileName file 1 + file2 = fileName file (mx - 1) + +fileName :: FilePath -> Int -> FilePath +fileName file n = (if n < 10 then ('0':) else id) $ show n ++ "-" ++ file + +pageNum mx num = "<p align=right>" ++ show num ++"/" ++ show (mx-1) ++ "</p>" + +mkIndex file = unlines . mkInd 1 where + mkInd n ss = case ss of + s : rest | (s==separator) -> mkInd (n+1) rest + s : rest -> case getHeading s of + Just (i,t) -> mkLine n i t : mkInd n rest + _ -> mkInd n rest + _ -> [] + getHeading s = case dropWhile isSpace s of + '<':h:i:_:t | isDigit i -> return (i,take (length t - 5) t) -- drop final </hi> + _ -> Nothing + mkLine _ '1' t = t ++ " : Table of Contents<p>" -- heading of whole document + mkLine n i t = stars i ++ link n t ++ "<br>" + stars i = case i of + '3' -> "<li> " + '4' -> "<li>* " + _ -> "" + link n t = "<a href=\"" ++ fileName file n ++ "\">" ++ t ++ "</a>" diff --git a/src/tools/MkHelpFile.hs b/src/tools/MkHelpFile.hs new file mode 100644 index 000000000..a0fafa918 --- /dev/null +++ b/src/tools/MkHelpFile.hs @@ -0,0 +1,61 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/05/12 10:03:34 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.9 $ +-- +-- Compile @HelpFile.hs@ from the text file @HelpFile@. +----------------------------------------------------------------------------- + +module Main (main) where + +main = do + s <- readFile "HelpFile" + let s' = mkHsFile (lines s) + writeFile "GF/Shell/HelpFile.hs" s' + +mkHsFile ss = + helpHeader ++ + "module GF.Shell.HelpFile where\n\n" ++ + "import GF.Data.Operations\n\n" ++ + "txtHelpFileSummary =\n" ++ + " unlines $ map (concat . take 1 . lines) $ paragraphs txtHelpFile\n\n" ++ + "txtHelpCommand c =\n" ++ + " case lookup c [(takeWhile (/=',') p,p) | p <- paragraphs txtHelpFile] of\n" ++ + " Just s -> s\n" ++ + " _ -> \"Command not found.\"\n\n" ++ + "txtHelpFile =\n" ++ + unlines (map mkOne ss) ++ + " []" + +mkOne s = " \"" ++ pref s ++ (escs s) ++ "\" ++" + where + pref (' ':_) = "\\n" + pref _ = "\\n" --- + escs [] = [] + escs (c:cs) | elem c "\"\\" = '\\':c:escs cs + | fromEnum c > 127 = "\\" ++show (fromEnum c)++escs cs + escs (c:cs) = c:escs cs + +helpHeader = unlines [ + "----------------------------------------------------------------------", + "-- |", + "-- Module : GF.Shell.HelpFile", + "-- Maintainer : Aarne Ranta", + "-- Stability : (stable)", + "-- Portability : (portable)", + "--", + "-- > CVS $Date: 2005/05/12 10:03:34 $", + "-- > CVS $Author: aarne $", + "-- > CVS $Revision: 1.9 $", + "--", + "-- Help on shell commands. Generated from HelpFile by 'make help'.", + "-- PLEASE DON'T EDIT THIS FILE.", + "-----------------------------------------------------------------------------", + "", + "" + ]
\ No newline at end of file diff --git a/src/tools/WriteF.hs b/src/tools/WriteF.hs new file mode 100644 index 000000000..2e5b299dc --- /dev/null +++ b/src/tools/WriteF.hs @@ -0,0 +1,70 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : AR +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/04/16 05:40:51 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.4 $ +-- +-- (Description of the module) +----------------------------------------------------------------------------- + +module Main (main) where +import Fudgets +import System + +import Operations + +import Greek (mkGreek) +import Arabic (mkArabic) +import Hebrew (mkHebrew) +import Russian (mkRussian) + +-- AR 12/4/2000 + +main = do + xx <- getArgs + (case xx of + "HELP" : _ -> putStrLn usageWriteF + "FILE" : file : _ -> do + str <- readFileIf file + fudlogueWrite (Just str) + w:_ -> fudlogueWrite (Just (unwords xx)) + _ -> fudlogueWrite Nothing) + +usageWriteF = + "Usage: WriteF [-H20Mg -A5M] [FILE <filename> | <inputstring> | HELP]" ++++ + "Without arguments, an interactive display is opened." ++++ + "Prefix your string with / for Greek, - for Arabic, + for Hebrew, _ for Russian." + +fudlogueWrite mbstr = + fudlogue $ + shellF "Unicode Output" (writeF mbstr >+< quitButtonF) + +writeF Nothing = writeOutputF >==< writeInputF +writeF (Just str) = startupF [str] writeOutputF + +displaySizeP = placerF (spacerP (sizeS (Point 440 500)) verticalP) + +writeOutputF = + displaySizeP (moreF' (setFont myFont)) +--- displaySizeP (scrollF (displayF' (setFont myFont))) +--- >=^< +--- vboxD' 0 . map g + >==< + mapF (map mkUnicode . lines) + +writeInputF = stringInputF' (setShowString mkUnicode . setFont myFont) + +mkUnicode s = case s of + '/':cs -> mkGreek cs + '+':cs -> mkHebrew cs + '-':cs -> mkArabic cs + '_':cs -> mkRussian cs + _ -> s + +myFont = "-mutt-clearlyu-medium-r-normal--17-120-100-100-p-101-iso10646-1" +--- myFont = "-arabic-newspaper-medium-r-normal--32-246-100-100-p-137-iso10646-1" +--- myFont = "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1" diff --git a/src/tools/c++/README b/src/tools/c++/README new file mode 100644 index 000000000..696e39469 --- /dev/null +++ b/src/tools/c++/README @@ -0,0 +1,21 @@ +Aarne Ranta 21/9/2006 + +Interpreter for ready-made translation lists. Supports +translation, random generation, and translation quiz. + +To compile: + + g++ -o gfex gfex.cpp + +To use: + + ./gfex peace.gft + +To produce a gft file in GF: + + gt | tb -unlexer=unwords -compact | wf foo.gft + +The format uses encoding of words as integers, which +gives a memory-efficient run-time program. Also the +treebank file size is about 1/3 of sentences stored +in words. diff --git a/src/tools/c++/exgf.gft b/src/tools/c++/exgf.gft new file mode 100644 index 000000000..644fecdb9 --- /dev/null +++ b/src/tools/c++/exgf.gft @@ -0,0 +1,20 @@ +14 3 4 2 +English Swedish German + +I Sie du ich ihr jag ni schlafe schlafen schlafst schlaft sleep sover you + +1 12 +14 12 +14 12 +14 12 + +6 13 +3 13 +7 13 +7 13 + +4 8 +3 10 +5 11 +2 9 + diff --git a/src/tools/c++/gfex.cpp b/src/tools/c++/gfex.cpp new file mode 100644 index 000000000..65d65fffb --- /dev/null +++ b/src/tools/c++/gfex.cpp @@ -0,0 +1,340 @@ +#include <algorithm> +#include <cctype> +#include <cstdlib> +#include <fstream> +#include <iomanip> +#include <ios> +#include <iostream> +#include <iterator> +#include <map> +#include <set> +#include <stdexcept> +#include <string> +#include <vector> +#include <list> +#include <time.h> +#include <stdio.h> + +using std::cin ; +using std::cout ; +using std::endl ; +using std::equal ; +using std::find_if ; +using std::getline ; +using std::istream ; +using std::logic_error ; +using std::map ; +using std::max ; +using std::multimap ; +using std::rand ; +using std::set ; +using std::setw ; +using std::sort ; +using std::streamsize ; +using std::string ; +using std::vector ; +using std::list ; + + +typedef vector<string> Wordlist ; +typedef map<string,int> Lexicon ; +typedef vector<int> Sentence ; +typedef int Tree ; +typedef vector<Sentence> Linearizer ; +typedef map<Sentence,vector<Tree> > Parser ; + +// interpreter of compact translation lists, generated in GF by +// tb -compact. AR 22/9/2006 + +// map words to indices +Sentence getSentence(Lexicon& lexicon, const vector<string>& ws, int mx) +{ + + Sentence sent ; + int wc = 0 ; + for (vector<string>::const_iterator i = ws.begin() ; i != ws.end() ; ++i) { + sent.push_back(lexicon[*i]) ; + ++ wc ; + } + for (int i = wc ; i != mx ; ++i) sent.push_back(0) ; + + //debug + // for (Sentence::const_iterator i = sent.begin() ; i != sent.end() ; ++i) + // cout << *i << " " ; + cout << endl ; + + return sent ; +} + +// render a sentence in words +void putSentence(const Wordlist& wlist, const Sentence sent) +{ + for (Sentence::const_iterator i = sent.begin() ; i != sent.end() ; ++i) { + if (*i != 0) + cout << wlist[*i-1] << " " ; + } + cout << endl ; + +} + + +// Haskell words +bool space(char c) +{ + return isspace(c) ; +} +bool not_space(char c) +{ + return !space(c) ; +} + +vector<string> words(const string& s) +{ + typedef string::const_iterator iter ; + vector<string> ws ; + iter i = s.begin() ; + while (i != s.end()) { + // ignore space + i = find_if(i, s.end(), not_space) ; + // collect characters until space + iter j = find_if(i, s.end(), space) ; + + // add the string to the vector + if (i != s.end()) + ws.push_back(string(i,j)) ; + i = j ; + } + return ws ; +} + + +// the run-time grammar structure +struct Grammar { + vector<string> langnames ; + int nwords ; + int nlangs ; + int nsents ; + int smaxlen ; + Wordlist wlist ; + Lexicon lexicon ; + vector<Linearizer> lin ; + vector<Parser> parser ; +} ; + + +// read grammar from file or stdio +Grammar readGrammar (istream& in) +{ + Grammar g ; + + in >> g.nwords >> g.nlangs >> g.nsents >> g.smaxlen ; + + string tok ; + + for (int ls = 0 ; ls != g.nlangs ; ++ls) { + in >> tok ; + g.langnames.push_back(tok) ; + } + + for (int ls = 0 ; ls != g.nwords ; ++ls) { + in >> tok ; + g.lexicon[tok] = ls + 1 ; + g.wlist.push_back(tok) ; + } + + g.lin = vector<Linearizer>(g.nlangs) ; + g.parser = vector<Parser>(g.nlangs) ; + + int w ; + Sentence temp ; + + for (int ls = 0 ; ls != g.nlangs ; ++ls) { + for (int ss = 0 ; ss != g.nsents ; ++ss) { + temp = vector<int>() ; + for (int ws = 0 ; ws != g.smaxlen ; ++ws) { + + in >> w ; + temp.push_back(w) ; + } + + g.lin[ls].push_back(temp) ; + g.parser[ls][temp].push_back(ss) ; + } + } + + cout << "Grammar ready with languages " ; + for (int i = 0 ; i != g.nlangs ; ++i) cout << g.langnames[i] << " " ; + cout << endl << endl ; + + return g ; +} + +// translate string from any language to all other languages +void translate (Grammar& g, const string input) +{ + Sentence s ; // source + + s = getSentence(g.lexicon,words(input),g.smaxlen) ; + + Sentence t ; // target + + for (int k = 0 ; k != g.nlangs ; ++k) { + if (!g.parser[k][s].empty()) { + for (int m = 0 ; m != g.nlangs ; ++m) { + if (m != k) cout << "** " << g.langnames[m] << ":" << endl ; + for (vector<Tree>::const_iterator i = g.parser[k][s].begin() ; + i != g.parser[k][s].end() ; ++i){ + if (m != k) cout << "tree #" << *i << ": " ; // debug + if (m != k) putSentence (g.wlist, g.lin[m][*i]) ; + } + } + } + } +} + +// balanced random generator +inline int nrand(int n) +{ + /// if (n <= 0 || n > RAND_MAX) + const int bucket_size = RAND_MAX / n ; + int r ; + + // randomness from clock + srand(time(NULL)) ; + do r = (rand() + clock())/ bucket_size ; + while (r >= n) ; + + return r ; + +} + +// generate random sentence and show it in all languages +void genRandom (const Grammar& g) +{ + Tree t = nrand(g.nsents) ; + + for (int k = 0 ; k != g.nlangs ; ++k) { + cout << "** " << g.langnames[k] << ":" << endl ; + putSentence (g.wlist, g.lin[k][t]) ; + } +} + +// quiz of ten translation examples +void quiz (Grammar& g, int src, int trg) +{ + int score = 0 ; + + for (int q = 0 ; q != 10 ; ++q) { + Tree t = nrand(g.nsents) ; + Sentence question = g.lin[src][t] ; + putSentence (g.wlist, question) ; + cout << "Translation:" << endl ; + cout.flush() ; + string answer ; + /// if (q == 0) {string foo ; cin >> foo ; cin.clear() ;} ; + getline (cin, answer) ; + Sentence s = getSentence(g.lexicon,words(answer),g.smaxlen) ; + + bool result = false ; + vector<Sentence> corrects ; + for (vector<Tree>::const_iterator i = g.parser[src][question].begin() ; + i != g.parser[src][question].end() ; ++i){ + if (equal(s.begin(), s.end(), g.lin[trg][*i].begin())){ + result = true ; + break ; + } else { + corrects.push_back(g.lin[trg][*i]) ; + } + } + if (result) { + ++ score ; + cout << "Correct." << endl ; + } else { + cout << "Incorrect. Correct answers are:" << endl ; + for (int c = 0 ; c != corrects.size() ; ++c) + putSentence(g.wlist, corrects[c]) ; + } + cout << "Score: " << score << "/" << q+1 << endl << endl ; + } +} + +// generate all sentences in one language +void genAll(const Grammar& g, int lang) +{ + for (int i = 0 ; i != g.nsents ; ++i) + putSentence(g.wlist, g.lin[lang][i]) ; +} + +// translate language name to index in language vector +int getLang(const Grammar& g, const string lang) +{ + int res = 0 ; + for (vector<string>::const_iterator i = g.langnames.begin() ; + i != g.langnames.end() ; ++i) + if (*i == lang) + return res ; + else + ++res ; + +} + +void help () +{ + cout << "Commands:" << endl ; + cout << " h print this help" << endl ; + cout << " . quit" << endl ; + cout << " ! generate random example" << endl ; + cout << " ? <Lang1> <Lang2> translation quiz from Lang1 to Lang2" << endl ; + cout << " * <Lang> generate all sentences of Lang" << endl ; + cout << " <other sentence> translate" << endl ; + cout << endl ; +} + +int main (int argc, char* argv[]) +{ + + if (argc != 2) { + cout << "usage: gfex <grammarfile>" << endl ; + return 1 ; + } + + std::ifstream from(argv[1]) ; + + Grammar g = readGrammar (from) ; + + help() ; + + string input ; + + while (getline (cin,input)){ + + if (input == ".") { + cout << "bye" << endl ; + return 0 ; + } + else if (input == "h") + help() ; + else if (input == "!") + genRandom(g) ; + else if (input[0] == '?') { + string src = words(input)[1] ; + string trg = words(input)[2] ; + quiz(g,getLang(g,src), getLang(g,trg)) ; + } + else if (input[0] == '*') { + string src = words(input)[1] ; + genAll(g,getLang(g,src)) ; + } + else + translate(g,input) ; + + cin.clear() ; + + // cout << clock()/10000 ; + + cout << endl ; + } + + return 0 ; +} + diff --git a/src/tools/c++/peace.gft b/src/tools/c++/peace.gft new file mode 100644 index 000000000..1e9adf1e5 --- /dev/null +++ b/src/tools/c++/peace.gft @@ -0,0 +1,8021 @@ +149 2 4008 8 +Peace_Swe Peace_Eng +I air am andas are behöver black blod blood blue blå blåa blått breathe breathes cold cooperate cooperates cough coughs dangerous de dead dem det dig dricker drink drinks drop drops du där död döda dött eat eats er farlig farliga farligt food ger give gives green grön gröna grönt gul gula gult går gör han har has have he here het heta hett him honom hostar hot hungrig hungriga hungrigt hungry hurt hurts här is jag kall kalla kallt large liten litet luft mat me med medicin medicine mig need needs ni ont oss own owns red röd röda rött samarbetar see sees ser show shows sick sjuk sjuka sjukt skin skinn sleep sleeps släpper small små sover stor stora stort svart svarta that them there they this till to us vatten vi visar vit vita vitt walk walks water we white with yellow you äger är äter + + +25 33 148 123 0 0 0 0 +25 75 148 123 0 0 0 0 +25 33 148 13 0 0 0 0 +25 75 148 13 0 0 0 0 +25 33 148 80 0 0 0 0 +25 75 148 80 0 0 0 0 +25 33 148 50 0 0 0 0 +25 75 148 50 0 0 0 0 +25 33 148 64 0 0 0 0 +25 75 148 64 0 0 0 0 +25 33 148 101 0 0 0 0 +25 75 148 101 0 0 0 0 +25 33 148 83 0 0 0 0 +25 75 148 83 0 0 0 0 +25 33 148 138 0 0 0 0 +25 75 148 138 0 0 0 0 +25 33 148 53 0 0 0 0 +25 75 148 53 0 0 0 0 +25 33 148 42 0 0 0 0 +25 75 148 42 0 0 0 0 +25 33 148 36 0 0 0 0 +25 75 148 36 0 0 0 0 +25 33 148 71 0 0 0 0 +25 75 148 71 0 0 0 0 +25 33 148 122 0 0 0 0 +25 75 148 122 0 0 0 0 +25 33 148 111 0 0 0 0 +25 75 148 111 0 0 0 0 +25 33 4 75 0 0 0 0 +25 33 4 33 0 0 0 0 +25 75 4 75 0 0 0 0 +25 75 4 33 0 0 0 0 +25 33 119 75 0 0 0 0 +25 33 119 33 0 0 0 0 +25 75 119 75 0 0 0 0 +25 75 119 33 0 0 0 0 +25 33 54 75 0 0 0 0 +25 33 54 33 0 0 0 0 +25 75 54 75 0 0 0 0 +25 75 54 33 0 0 0 0 +25 33 67 75 0 0 0 0 +25 33 67 33 0 0 0 0 +25 75 67 75 0 0 0 0 +25 75 67 33 0 0 0 0 +25 33 55 94 75 0 0 0 +25 33 55 94 33 0 0 0 +25 75 55 94 75 0 0 0 +25 75 55 94 33 0 0 0 +25 33 27 25 33 75 0 0 +25 33 27 25 33 33 0 0 +25 33 27 25 75 75 0 0 +25 33 27 25 75 33 0 0 +25 75 27 25 33 75 0 0 +25 75 27 25 33 33 0 0 +25 75 27 25 75 75 0 0 +25 75 27 25 75 33 0 0 +25 33 149 25 33 75 0 0 +25 33 149 25 33 33 0 0 +25 33 149 25 75 75 0 0 +25 33 149 25 75 33 0 0 +25 75 149 25 33 75 0 0 +25 75 149 25 33 33 0 0 +25 75 149 25 75 75 0 0 +25 75 149 25 75 33 0 0 +25 33 57 25 33 75 0 0 +25 33 57 25 33 33 0 0 +25 33 57 25 75 75 0 0 +25 33 57 25 75 33 0 0 +25 75 57 25 33 75 0 0 +25 75 57 25 33 33 0 0 +25 75 57 25 75 75 0 0 +25 75 57 25 75 33 0 0 +25 33 105 25 33 75 0 0 +25 33 105 25 33 33 0 0 +25 33 105 25 75 75 0 0 +25 33 105 25 75 33 0 0 +25 75 105 25 33 75 0 0 +25 75 105 25 33 33 0 0 +25 75 105 25 75 75 0 0 +25 75 105 25 75 33 0 0 +25 33 102 87 25 33 75 0 +25 33 102 87 25 33 33 0 +25 33 102 87 25 75 75 0 +25 33 102 87 25 75 33 0 +25 75 102 87 25 33 75 0 +25 75 102 87 25 33 33 0 +25 75 102 87 25 75 75 0 +25 75 102 87 25 75 33 0 +25 33 116 25 33 75 0 0 +25 33 116 25 33 33 0 0 +25 33 116 25 75 75 0 0 +25 33 116 25 75 33 0 0 +25 75 116 25 33 75 0 0 +25 75 116 25 33 33 0 0 +25 75 116 25 75 75 0 0 +25 75 116 25 75 33 0 0 +25 33 6 25 33 75 0 0 +25 33 6 25 33 33 0 0 +25 33 6 25 75 75 0 0 +25 33 6 25 75 33 0 0 +25 75 6 25 33 75 0 0 +25 75 6 25 33 33 0 0 +25 75 6 25 75 75 0 0 +25 75 6 25 75 33 0 0 +25 33 147 25 33 75 0 0 +25 33 147 25 33 33 0 0 +25 33 147 25 75 75 0 0 +25 33 147 25 75 33 0 0 +25 75 147 25 33 75 0 0 +25 75 147 25 33 33 0 0 +25 75 147 25 75 75 0 0 +25 75 147 25 75 33 0 0 +25 33 148 25 33 0 0 0 +25 75 148 25 33 0 0 0 +25 33 148 25 75 0 0 0 +25 75 148 25 75 0 0 0 +25 33 4 0 0 0 0 0 +25 75 4 0 0 0 0 0 +25 33 119 0 0 0 0 0 +25 75 119 0 0 0 0 0 +25 33 54 0 0 0 0 0 +25 75 54 0 0 0 0 0 +25 33 67 0 0 0 0 0 +25 75 67 0 0 0 0 0 +25 33 55 94 0 0 0 0 +25 75 55 94 0 0 0 0 +25 33 27 25 33 0 0 0 +25 33 27 25 75 0 0 0 +25 75 27 25 33 0 0 0 +25 75 27 25 75 0 0 0 +25 33 149 25 33 0 0 0 +25 33 149 25 75 0 0 0 +25 75 149 25 33 0 0 0 +25 75 149 25 75 0 0 0 +25 33 57 25 33 0 0 0 +25 33 57 25 75 0 0 0 +25 75 57 25 33 0 0 0 +25 75 57 25 75 0 0 0 +25 33 105 25 33 0 0 0 +25 33 105 25 75 0 0 0 +25 75 105 25 33 0 0 0 +25 75 105 25 75 0 0 0 +25 33 102 87 25 33 0 0 +25 33 102 87 25 75 0 0 +25 75 102 87 25 33 0 0 +25 75 102 87 25 75 0 0 +25 33 116 25 33 0 0 0 +25 33 116 25 75 0 0 0 +25 75 116 25 33 0 0 0 +25 75 116 25 75 0 0 0 +25 33 6 25 33 0 0 0 +25 33 6 25 75 0 0 0 +25 75 6 25 33 0 0 0 +25 75 6 25 75 0 0 0 +25 33 147 25 33 0 0 0 +25 33 147 25 75 0 0 0 +25 75 147 25 33 0 0 0 +25 75 147 25 75 0 0 0 +25 33 44 25 33 130 25 33 +25 33 44 25 33 130 25 75 +25 33 44 25 75 130 25 33 +25 33 44 25 75 130 25 75 +25 75 44 25 33 130 25 33 +25 75 44 25 33 130 25 75 +25 75 44 25 75 130 25 33 +25 75 44 25 75 130 25 75 +25 33 135 25 33 25 33 0 +25 33 135 25 33 25 75 0 +25 33 135 25 75 25 33 0 +25 33 135 25 75 25 75 0 +25 75 135 25 33 25 33 0 +25 75 135 25 33 25 75 0 +25 75 135 25 75 25 33 0 +25 75 135 25 75 25 75 0 +56 148 123 0 0 0 0 0 +77 148 123 0 0 0 0 0 +22 148 124 0 0 0 0 0 +134 148 124 0 0 0 0 0 +93 148 124 0 0 0 0 0 +32 148 123 0 0 0 0 0 +56 148 11 0 0 0 0 0 +77 148 11 0 0 0 0 0 +22 148 12 0 0 0 0 0 +134 148 12 0 0 0 0 0 +93 148 12 0 0 0 0 0 +32 148 11 0 0 0 0 0 +56 148 78 0 0 0 0 0 +77 148 78 0 0 0 0 0 +22 148 79 0 0 0 0 0 +134 148 79 0 0 0 0 0 +93 148 79 0 0 0 0 0 +32 148 78 0 0 0 0 0 +56 148 48 0 0 0 0 0 +77 148 48 0 0 0 0 0 +22 148 49 0 0 0 0 0 +134 148 49 0 0 0 0 0 +93 148 49 0 0 0 0 0 +32 148 48 0 0 0 0 0 +56 148 62 0 0 0 0 0 +77 148 62 0 0 0 0 0 +22 148 63 0 0 0 0 0 +134 148 63 0 0 0 0 0 +93 148 63 0 0 0 0 0 +32 148 62 0 0 0 0 0 +56 148 99 0 0 0 0 0 +77 148 99 0 0 0 0 0 +22 148 100 0 0 0 0 0 +134 148 100 0 0 0 0 0 +93 148 100 0 0 0 0 0 +32 148 99 0 0 0 0 0 +56 148 82 0 0 0 0 0 +77 148 82 0 0 0 0 0 +22 148 118 0 0 0 0 0 +134 148 118 0 0 0 0 0 +93 148 118 0 0 0 0 0 +32 148 82 0 0 0 0 0 +56 148 136 0 0 0 0 0 +77 148 136 0 0 0 0 0 +22 148 137 0 0 0 0 0 +134 148 137 0 0 0 0 0 +93 148 137 0 0 0 0 0 +32 148 136 0 0 0 0 0 +56 148 51 0 0 0 0 0 +77 148 51 0 0 0 0 0 +22 148 52 0 0 0 0 0 +134 148 52 0 0 0 0 0 +93 148 52 0 0 0 0 0 +32 148 51 0 0 0 0 0 +56 148 40 0 0 0 0 0 +77 148 40 0 0 0 0 0 +22 148 41 0 0 0 0 0 +134 148 41 0 0 0 0 0 +93 148 41 0 0 0 0 0 +32 148 40 0 0 0 0 0 +56 148 34 0 0 0 0 0 +77 148 34 0 0 0 0 0 +22 148 35 0 0 0 0 0 +134 148 35 0 0 0 0 0 +93 148 35 0 0 0 0 0 +32 148 34 0 0 0 0 0 +56 148 69 0 0 0 0 0 +77 148 69 0 0 0 0 0 +22 148 70 0 0 0 0 0 +134 148 70 0 0 0 0 0 +93 148 70 0 0 0 0 0 +32 148 69 0 0 0 0 0 +56 148 120 0 0 0 0 0 +77 148 120 0 0 0 0 0 +22 148 121 0 0 0 0 0 +134 148 121 0 0 0 0 0 +93 148 121 0 0 0 0 0 +32 148 120 0 0 0 0 0 +56 148 109 0 0 0 0 0 +77 148 109 0 0 0 0 0 +22 148 110 0 0 0 0 0 +134 148 110 0 0 0 0 0 +93 148 110 0 0 0 0 0 +32 148 109 0 0 0 0 0 +56 4 75 0 0 0 0 0 +56 4 33 0 0 0 0 0 +77 4 75 0 0 0 0 0 +77 4 33 0 0 0 0 0 +22 4 75 0 0 0 0 0 +22 4 33 0 0 0 0 0 +134 4 75 0 0 0 0 0 +134 4 33 0 0 0 0 0 +93 4 75 0 0 0 0 0 +93 4 33 0 0 0 0 0 +32 4 75 0 0 0 0 0 +32 4 33 0 0 0 0 0 +56 119 75 0 0 0 0 0 +56 119 33 0 0 0 0 0 +77 119 75 0 0 0 0 0 +77 119 33 0 0 0 0 0 +22 119 75 0 0 0 0 0 +22 119 33 0 0 0 0 0 +134 119 75 0 0 0 0 0 +134 119 33 0 0 0 0 0 +93 119 75 0 0 0 0 0 +93 119 33 0 0 0 0 0 +32 119 75 0 0 0 0 0 +32 119 33 0 0 0 0 0 +56 54 75 0 0 0 0 0 +56 54 33 0 0 0 0 0 +77 54 75 0 0 0 0 0 +77 54 33 0 0 0 0 0 +22 54 75 0 0 0 0 0 +22 54 33 0 0 0 0 0 +134 54 75 0 0 0 0 0 +134 54 33 0 0 0 0 0 +93 54 75 0 0 0 0 0 +93 54 33 0 0 0 0 0 +32 54 75 0 0 0 0 0 +32 54 33 0 0 0 0 0 +56 67 75 0 0 0 0 0 +56 67 33 0 0 0 0 0 +77 67 75 0 0 0 0 0 +77 67 33 0 0 0 0 0 +22 67 75 0 0 0 0 0 +22 67 33 0 0 0 0 0 +134 67 75 0 0 0 0 0 +134 67 33 0 0 0 0 0 +93 67 75 0 0 0 0 0 +93 67 33 0 0 0 0 0 +32 67 75 0 0 0 0 0 +32 67 33 0 0 0 0 0 +56 55 94 75 0 0 0 0 +56 55 94 33 0 0 0 0 +77 55 94 75 0 0 0 0 +77 55 94 33 0 0 0 0 +22 55 94 75 0 0 0 0 +22 55 94 33 0 0 0 0 +134 55 94 75 0 0 0 0 +134 55 94 33 0 0 0 0 +93 55 94 75 0 0 0 0 +93 55 94 33 0 0 0 0 +32 55 94 75 0 0 0 0 +32 55 94 33 0 0 0 0 +56 27 66 75 0 0 0 0 +56 27 66 33 0 0 0 0 +56 27 90 75 0 0 0 0 +56 27 90 33 0 0 0 0 +56 27 24 75 0 0 0 0 +56 27 24 33 0 0 0 0 +56 27 95 75 0 0 0 0 +56 27 95 33 0 0 0 0 +56 27 39 75 0 0 0 0 +56 27 39 33 0 0 0 0 +56 27 26 75 0 0 0 0 +56 27 26 33 0 0 0 0 +56 27 25 33 75 0 0 0 +56 27 25 33 33 0 0 0 +56 27 25 75 75 0 0 0 +56 27 25 75 33 0 0 0 +77 27 66 75 0 0 0 0 +77 27 66 33 0 0 0 0 +77 27 90 75 0 0 0 0 +77 27 90 33 0 0 0 0 +77 27 24 75 0 0 0 0 +77 27 24 33 0 0 0 0 +77 27 95 75 0 0 0 0 +77 27 95 33 0 0 0 0 +77 27 39 75 0 0 0 0 +77 27 39 33 0 0 0 0 +77 27 26 75 0 0 0 0 +77 27 26 33 0 0 0 0 +77 27 25 33 75 0 0 0 +77 27 25 33 33 0 0 0 +77 27 25 75 75 0 0 0 +77 27 25 75 33 0 0 0 +22 27 66 75 0 0 0 0 +22 27 66 33 0 0 0 0 +22 27 90 75 0 0 0 0 +22 27 90 33 0 0 0 0 +22 27 24 75 0 0 0 0 +22 27 24 33 0 0 0 0 +22 27 95 75 0 0 0 0 +22 27 95 33 0 0 0 0 +22 27 39 75 0 0 0 0 +22 27 39 33 0 0 0 0 +22 27 26 75 0 0 0 0 +22 27 26 33 0 0 0 0 +22 27 25 33 75 0 0 0 +22 27 25 33 33 0 0 0 +22 27 25 75 75 0 0 0 +22 27 25 75 33 0 0 0 +134 27 66 75 0 0 0 0 +134 27 66 33 0 0 0 0 +134 27 90 75 0 0 0 0 +134 27 90 33 0 0 0 0 +134 27 24 75 0 0 0 0 +134 27 24 33 0 0 0 0 +134 27 95 75 0 0 0 0 +134 27 95 33 0 0 0 0 +134 27 39 75 0 0 0 0 +134 27 39 33 0 0 0 0 +134 27 26 75 0 0 0 0 +134 27 26 33 0 0 0 0 +134 27 25 33 75 0 0 0 +134 27 25 33 33 0 0 0 +134 27 25 75 75 0 0 0 +134 27 25 75 33 0 0 0 +93 27 66 75 0 0 0 0 +93 27 66 33 0 0 0 0 +93 27 90 75 0 0 0 0 +93 27 90 33 0 0 0 0 +93 27 24 75 0 0 0 0 +93 27 24 33 0 0 0 0 +93 27 95 75 0 0 0 0 +93 27 95 33 0 0 0 0 +93 27 39 75 0 0 0 0 +93 27 39 33 0 0 0 0 +93 27 26 75 0 0 0 0 +93 27 26 33 0 0 0 0 +93 27 25 33 75 0 0 0 +93 27 25 33 33 0 0 0 +93 27 25 75 75 0 0 0 +93 27 25 75 33 0 0 0 +32 27 66 75 0 0 0 0 +32 27 66 33 0 0 0 0 +32 27 90 75 0 0 0 0 +32 27 90 33 0 0 0 0 +32 27 24 75 0 0 0 0 +32 27 24 33 0 0 0 0 +32 27 95 75 0 0 0 0 +32 27 95 33 0 0 0 0 +32 27 39 75 0 0 0 0 +32 27 39 33 0 0 0 0 +32 27 26 75 0 0 0 0 +32 27 26 33 0 0 0 0 +32 27 25 33 75 0 0 0 +32 27 25 33 33 0 0 0 +32 27 25 75 75 0 0 0 +32 27 25 75 33 0 0 0 +25 33 27 66 75 0 0 0 +25 33 27 66 33 0 0 0 +25 33 27 90 75 0 0 0 +25 33 27 90 33 0 0 0 +25 33 27 24 75 0 0 0 +25 33 27 24 33 0 0 0 +25 33 27 95 75 0 0 0 +25 33 27 95 33 0 0 0 +25 33 27 39 75 0 0 0 +25 33 27 39 33 0 0 0 +25 33 27 26 75 0 0 0 +25 33 27 26 33 0 0 0 +25 75 27 66 75 0 0 0 +25 75 27 66 33 0 0 0 +25 75 27 90 75 0 0 0 +25 75 27 90 33 0 0 0 +25 75 27 24 75 0 0 0 +25 75 27 24 33 0 0 0 +25 75 27 95 75 0 0 0 +25 75 27 95 33 0 0 0 +25 75 27 39 75 0 0 0 +25 75 27 39 33 0 0 0 +25 75 27 26 75 0 0 0 +25 75 27 26 33 0 0 0 +56 149 66 75 0 0 0 0 +56 149 66 33 0 0 0 0 +56 149 90 75 0 0 0 0 +56 149 90 33 0 0 0 0 +56 149 24 75 0 0 0 0 +56 149 24 33 0 0 0 0 +56 149 95 75 0 0 0 0 +56 149 95 33 0 0 0 0 +56 149 39 75 0 0 0 0 +56 149 39 33 0 0 0 0 +56 149 26 75 0 0 0 0 +56 149 26 33 0 0 0 0 +56 149 25 33 75 0 0 0 +56 149 25 33 33 0 0 0 +56 149 25 75 75 0 0 0 +56 149 25 75 33 0 0 0 +77 149 66 75 0 0 0 0 +77 149 66 33 0 0 0 0 +77 149 90 75 0 0 0 0 +77 149 90 33 0 0 0 0 +77 149 24 75 0 0 0 0 +77 149 24 33 0 0 0 0 +77 149 95 75 0 0 0 0 +77 149 95 33 0 0 0 0 +77 149 39 75 0 0 0 0 +77 149 39 33 0 0 0 0 +77 149 26 75 0 0 0 0 +77 149 26 33 0 0 0 0 +77 149 25 33 75 0 0 0 +77 149 25 33 33 0 0 0 +77 149 25 75 75 0 0 0 +77 149 25 75 33 0 0 0 +22 149 66 75 0 0 0 0 +22 149 66 33 0 0 0 0 +22 149 90 75 0 0 0 0 +22 149 90 33 0 0 0 0 +22 149 24 75 0 0 0 0 +22 149 24 33 0 0 0 0 +22 149 95 75 0 0 0 0 +22 149 95 33 0 0 0 0 +22 149 39 75 0 0 0 0 +22 149 39 33 0 0 0 0 +22 149 26 75 0 0 0 0 +22 149 26 33 0 0 0 0 +22 149 25 33 75 0 0 0 +22 149 25 33 33 0 0 0 +22 149 25 75 75 0 0 0 +22 149 25 75 33 0 0 0 +134 149 66 75 0 0 0 0 +134 149 66 33 0 0 0 0 +134 149 90 75 0 0 0 0 +134 149 90 33 0 0 0 0 +134 149 24 75 0 0 0 0 +134 149 24 33 0 0 0 0 +134 149 95 75 0 0 0 0 +134 149 95 33 0 0 0 0 +134 149 39 75 0 0 0 0 +134 149 39 33 0 0 0 0 +134 149 26 75 0 0 0 0 +134 149 26 33 0 0 0 0 +134 149 25 33 75 0 0 0 +134 149 25 33 33 0 0 0 +134 149 25 75 75 0 0 0 +134 149 25 75 33 0 0 0 +93 149 66 75 0 0 0 0 +93 149 66 33 0 0 0 0 +93 149 90 75 0 0 0 0 +93 149 90 33 0 0 0 0 +93 149 24 75 0 0 0 0 +93 149 24 33 0 0 0 0 +93 149 95 75 0 0 0 0 +93 149 95 33 0 0 0 0 +93 149 39 75 0 0 0 0 +93 149 39 33 0 0 0 0 +93 149 26 75 0 0 0 0 +93 149 26 33 0 0 0 0 +93 149 25 33 75 0 0 0 +93 149 25 33 33 0 0 0 +93 149 25 75 75 0 0 0 +93 149 25 75 33 0 0 0 +32 149 66 75 0 0 0 0 +32 149 66 33 0 0 0 0 +32 149 90 75 0 0 0 0 +32 149 90 33 0 0 0 0 +32 149 24 75 0 0 0 0 +32 149 24 33 0 0 0 0 +32 149 95 75 0 0 0 0 +32 149 95 33 0 0 0 0 +32 149 39 75 0 0 0 0 +32 149 39 33 0 0 0 0 +32 149 26 75 0 0 0 0 +32 149 26 33 0 0 0 0 +32 149 25 33 75 0 0 0 +32 149 25 33 33 0 0 0 +32 149 25 75 75 0 0 0 +32 149 25 75 33 0 0 0 +25 33 149 66 75 0 0 0 +25 33 149 66 33 0 0 0 +25 33 149 90 75 0 0 0 +25 33 149 90 33 0 0 0 +25 33 149 24 75 0 0 0 +25 33 149 24 33 0 0 0 +25 33 149 95 75 0 0 0 +25 33 149 95 33 0 0 0 +25 33 149 39 75 0 0 0 +25 33 149 39 33 0 0 0 +25 33 149 26 75 0 0 0 +25 33 149 26 33 0 0 0 +25 75 149 66 75 0 0 0 +25 75 149 66 33 0 0 0 +25 75 149 90 75 0 0 0 +25 75 149 90 33 0 0 0 +25 75 149 24 75 0 0 0 +25 75 149 24 33 0 0 0 +25 75 149 95 75 0 0 0 +25 75 149 95 33 0 0 0 +25 75 149 39 75 0 0 0 +25 75 149 39 33 0 0 0 +25 75 149 26 75 0 0 0 +25 75 149 26 33 0 0 0 +56 57 66 75 0 0 0 0 +56 57 66 33 0 0 0 0 +56 57 90 75 0 0 0 0 +56 57 90 33 0 0 0 0 +56 57 24 75 0 0 0 0 +56 57 24 33 0 0 0 0 +56 57 95 75 0 0 0 0 +56 57 95 33 0 0 0 0 +56 57 39 75 0 0 0 0 +56 57 39 33 0 0 0 0 +56 57 26 75 0 0 0 0 +56 57 26 33 0 0 0 0 +56 57 25 33 75 0 0 0 +56 57 25 33 33 0 0 0 +56 57 25 75 75 0 0 0 +56 57 25 75 33 0 0 0 +77 57 66 75 0 0 0 0 +77 57 66 33 0 0 0 0 +77 57 90 75 0 0 0 0 +77 57 90 33 0 0 0 0 +77 57 24 75 0 0 0 0 +77 57 24 33 0 0 0 0 +77 57 95 75 0 0 0 0 +77 57 95 33 0 0 0 0 +77 57 39 75 0 0 0 0 +77 57 39 33 0 0 0 0 +77 57 26 75 0 0 0 0 +77 57 26 33 0 0 0 0 +77 57 25 33 75 0 0 0 +77 57 25 33 33 0 0 0 +77 57 25 75 75 0 0 0 +77 57 25 75 33 0 0 0 +22 57 66 75 0 0 0 0 +22 57 66 33 0 0 0 0 +22 57 90 75 0 0 0 0 +22 57 90 33 0 0 0 0 +22 57 24 75 0 0 0 0 +22 57 24 33 0 0 0 0 +22 57 95 75 0 0 0 0 +22 57 95 33 0 0 0 0 +22 57 39 75 0 0 0 0 +22 57 39 33 0 0 0 0 +22 57 26 75 0 0 0 0 +22 57 26 33 0 0 0 0 +22 57 25 33 75 0 0 0 +22 57 25 33 33 0 0 0 +22 57 25 75 75 0 0 0 +22 57 25 75 33 0 0 0 +134 57 66 75 0 0 0 0 +134 57 66 33 0 0 0 0 +134 57 90 75 0 0 0 0 +134 57 90 33 0 0 0 0 +134 57 24 75 0 0 0 0 +134 57 24 33 0 0 0 0 +134 57 95 75 0 0 0 0 +134 57 95 33 0 0 0 0 +134 57 39 75 0 0 0 0 +134 57 39 33 0 0 0 0 +134 57 26 75 0 0 0 0 +134 57 26 33 0 0 0 0 +134 57 25 33 75 0 0 0 +134 57 25 33 33 0 0 0 +134 57 25 75 75 0 0 0 +134 57 25 75 33 0 0 0 +93 57 66 75 0 0 0 0 +93 57 66 33 0 0 0 0 +93 57 90 75 0 0 0 0 +93 57 90 33 0 0 0 0 +93 57 24 75 0 0 0 0 +93 57 24 33 0 0 0 0 +93 57 95 75 0 0 0 0 +93 57 95 33 0 0 0 0 +93 57 39 75 0 0 0 0 +93 57 39 33 0 0 0 0 +93 57 26 75 0 0 0 0 +93 57 26 33 0 0 0 0 +93 57 25 33 75 0 0 0 +93 57 25 33 33 0 0 0 +93 57 25 75 75 0 0 0 +93 57 25 75 33 0 0 0 +32 57 66 75 0 0 0 0 +32 57 66 33 0 0 0 0 +32 57 90 75 0 0 0 0 +32 57 90 33 0 0 0 0 +32 57 24 75 0 0 0 0 +32 57 24 33 0 0 0 0 +32 57 95 75 0 0 0 0 +32 57 95 33 0 0 0 0 +32 57 39 75 0 0 0 0 +32 57 39 33 0 0 0 0 +32 57 26 75 0 0 0 0 +32 57 26 33 0 0 0 0 +32 57 25 33 75 0 0 0 +32 57 25 33 33 0 0 0 +32 57 25 75 75 0 0 0 +32 57 25 75 33 0 0 0 +25 33 57 66 75 0 0 0 +25 33 57 66 33 0 0 0 +25 33 57 90 75 0 0 0 +25 33 57 90 33 0 0 0 +25 33 57 24 75 0 0 0 +25 33 57 24 33 0 0 0 +25 33 57 95 75 0 0 0 +25 33 57 95 33 0 0 0 +25 33 57 39 75 0 0 0 +25 33 57 39 33 0 0 0 +25 33 57 26 75 0 0 0 +25 33 57 26 33 0 0 0 +25 75 57 66 75 0 0 0 +25 75 57 66 33 0 0 0 +25 75 57 90 75 0 0 0 +25 75 57 90 33 0 0 0 +25 75 57 24 75 0 0 0 +25 75 57 24 33 0 0 0 +25 75 57 95 75 0 0 0 +25 75 57 95 33 0 0 0 +25 75 57 39 75 0 0 0 +25 75 57 39 33 0 0 0 +25 75 57 26 75 0 0 0 +25 75 57 26 33 0 0 0 +56 105 66 75 0 0 0 0 +56 105 66 33 0 0 0 0 +56 105 90 75 0 0 0 0 +56 105 90 33 0 0 0 0 +56 105 24 75 0 0 0 0 +56 105 24 33 0 0 0 0 +56 105 95 75 0 0 0 0 +56 105 95 33 0 0 0 0 +56 105 39 75 0 0 0 0 +56 105 39 33 0 0 0 0 +56 105 26 75 0 0 0 0 +56 105 26 33 0 0 0 0 +56 105 25 33 75 0 0 0 +56 105 25 33 33 0 0 0 +56 105 25 75 75 0 0 0 +56 105 25 75 33 0 0 0 +77 105 66 75 0 0 0 0 +77 105 66 33 0 0 0 0 +77 105 90 75 0 0 0 0 +77 105 90 33 0 0 0 0 +77 105 24 75 0 0 0 0 +77 105 24 33 0 0 0 0 +77 105 95 75 0 0 0 0 +77 105 95 33 0 0 0 0 +77 105 39 75 0 0 0 0 +77 105 39 33 0 0 0 0 +77 105 26 75 0 0 0 0 +77 105 26 33 0 0 0 0 +77 105 25 33 75 0 0 0 +77 105 25 33 33 0 0 0 +77 105 25 75 75 0 0 0 +77 105 25 75 33 0 0 0 +22 105 66 75 0 0 0 0 +22 105 66 33 0 0 0 0 +22 105 90 75 0 0 0 0 +22 105 90 33 0 0 0 0 +22 105 24 75 0 0 0 0 +22 105 24 33 0 0 0 0 +22 105 95 75 0 0 0 0 +22 105 95 33 0 0 0 0 +22 105 39 75 0 0 0 0 +22 105 39 33 0 0 0 0 +22 105 26 75 0 0 0 0 +22 105 26 33 0 0 0 0 +22 105 25 33 75 0 0 0 +22 105 25 33 33 0 0 0 +22 105 25 75 75 0 0 0 +22 105 25 75 33 0 0 0 +134 105 66 75 0 0 0 0 +134 105 66 33 0 0 0 0 +134 105 90 75 0 0 0 0 +134 105 90 33 0 0 0 0 +134 105 24 75 0 0 0 0 +134 105 24 33 0 0 0 0 +134 105 95 75 0 0 0 0 +134 105 95 33 0 0 0 0 +134 105 39 75 0 0 0 0 +134 105 39 33 0 0 0 0 +134 105 26 75 0 0 0 0 +134 105 26 33 0 0 0 0 +134 105 25 33 75 0 0 0 +134 105 25 33 33 0 0 0 +134 105 25 75 75 0 0 0 +134 105 25 75 33 0 0 0 +93 105 66 75 0 0 0 0 +93 105 66 33 0 0 0 0 +93 105 90 75 0 0 0 0 +93 105 90 33 0 0 0 0 +93 105 24 75 0 0 0 0 +93 105 24 33 0 0 0 0 +93 105 95 75 0 0 0 0 +93 105 95 33 0 0 0 0 +93 105 39 75 0 0 0 0 +93 105 39 33 0 0 0 0 +93 105 26 75 0 0 0 0 +93 105 26 33 0 0 0 0 +93 105 25 33 75 0 0 0 +93 105 25 33 33 0 0 0 +93 105 25 75 75 0 0 0 +93 105 25 75 33 0 0 0 +32 105 66 75 0 0 0 0 +32 105 66 33 0 0 0 0 +32 105 90 75 0 0 0 0 +32 105 90 33 0 0 0 0 +32 105 24 75 0 0 0 0 +32 105 24 33 0 0 0 0 +32 105 95 75 0 0 0 0 +32 105 95 33 0 0 0 0 +32 105 39 75 0 0 0 0 +32 105 39 33 0 0 0 0 +32 105 26 75 0 0 0 0 +32 105 26 33 0 0 0 0 +32 105 25 33 75 0 0 0 +32 105 25 33 33 0 0 0 +32 105 25 75 75 0 0 0 +32 105 25 75 33 0 0 0 +25 33 105 66 75 0 0 0 +25 33 105 66 33 0 0 0 +25 33 105 90 75 0 0 0 +25 33 105 90 33 0 0 0 +25 33 105 24 75 0 0 0 +25 33 105 24 33 0 0 0 +25 33 105 95 75 0 0 0 +25 33 105 95 33 0 0 0 +25 33 105 39 75 0 0 0 +25 33 105 39 33 0 0 0 +25 33 105 26 75 0 0 0 +25 33 105 26 33 0 0 0 +25 75 105 66 75 0 0 0 +25 75 105 66 33 0 0 0 +25 75 105 90 75 0 0 0 +25 75 105 90 33 0 0 0 +25 75 105 24 75 0 0 0 +25 75 105 24 33 0 0 0 +25 75 105 95 75 0 0 0 +25 75 105 95 33 0 0 0 +25 75 105 39 75 0 0 0 +25 75 105 39 33 0 0 0 +25 75 105 26 75 0 0 0 +25 75 105 26 33 0 0 0 +56 102 87 66 75 0 0 0 +56 102 87 66 33 0 0 0 +56 102 87 90 75 0 0 0 +56 102 87 90 33 0 0 0 +56 102 87 24 75 0 0 0 +56 102 87 24 33 0 0 0 +56 102 87 95 75 0 0 0 +56 102 87 95 33 0 0 0 +56 102 87 39 75 0 0 0 +56 102 87 39 33 0 0 0 +56 102 87 26 75 0 0 0 +56 102 87 26 33 0 0 0 +56 102 87 25 33 75 0 0 +56 102 87 25 33 33 0 0 +56 102 87 25 75 75 0 0 +56 102 87 25 75 33 0 0 +77 102 87 66 75 0 0 0 +77 102 87 66 33 0 0 0 +77 102 87 90 75 0 0 0 +77 102 87 90 33 0 0 0 +77 102 87 24 75 0 0 0 +77 102 87 24 33 0 0 0 +77 102 87 95 75 0 0 0 +77 102 87 95 33 0 0 0 +77 102 87 39 75 0 0 0 +77 102 87 39 33 0 0 0 +77 102 87 26 75 0 0 0 +77 102 87 26 33 0 0 0 +77 102 87 25 33 75 0 0 +77 102 87 25 33 33 0 0 +77 102 87 25 75 75 0 0 +77 102 87 25 75 33 0 0 +22 102 87 66 75 0 0 0 +22 102 87 66 33 0 0 0 +22 102 87 90 75 0 0 0 +22 102 87 90 33 0 0 0 +22 102 87 24 75 0 0 0 +22 102 87 24 33 0 0 0 +22 102 87 95 75 0 0 0 +22 102 87 95 33 0 0 0 +22 102 87 39 75 0 0 0 +22 102 87 39 33 0 0 0 +22 102 87 26 75 0 0 0 +22 102 87 26 33 0 0 0 +22 102 87 25 33 75 0 0 +22 102 87 25 33 33 0 0 +22 102 87 25 75 75 0 0 +22 102 87 25 75 33 0 0 +134 102 87 66 75 0 0 0 +134 102 87 66 33 0 0 0 +134 102 87 90 75 0 0 0 +134 102 87 90 33 0 0 0 +134 102 87 24 75 0 0 0 +134 102 87 24 33 0 0 0 +134 102 87 95 75 0 0 0 +134 102 87 95 33 0 0 0 +134 102 87 39 75 0 0 0 +134 102 87 39 33 0 0 0 +134 102 87 26 75 0 0 0 +134 102 87 26 33 0 0 0 +134 102 87 25 33 75 0 0 +134 102 87 25 33 33 0 0 +134 102 87 25 75 75 0 0 +134 102 87 25 75 33 0 0 +93 102 87 66 75 0 0 0 +93 102 87 66 33 0 0 0 +93 102 87 90 75 0 0 0 +93 102 87 90 33 0 0 0 +93 102 87 24 75 0 0 0 +93 102 87 24 33 0 0 0 +93 102 87 95 75 0 0 0 +93 102 87 95 33 0 0 0 +93 102 87 39 75 0 0 0 +93 102 87 39 33 0 0 0 +93 102 87 26 75 0 0 0 +93 102 87 26 33 0 0 0 +93 102 87 25 33 75 0 0 +93 102 87 25 33 33 0 0 +93 102 87 25 75 75 0 0 +93 102 87 25 75 33 0 0 +32 102 87 66 75 0 0 0 +32 102 87 66 33 0 0 0 +32 102 87 90 75 0 0 0 +32 102 87 90 33 0 0 0 +32 102 87 24 75 0 0 0 +32 102 87 24 33 0 0 0 +32 102 87 95 75 0 0 0 +32 102 87 95 33 0 0 0 +32 102 87 39 75 0 0 0 +32 102 87 39 33 0 0 0 +32 102 87 26 75 0 0 0 +32 102 87 26 33 0 0 0 +32 102 87 25 33 75 0 0 +32 102 87 25 33 33 0 0 +32 102 87 25 75 75 0 0 +32 102 87 25 75 33 0 0 +25 33 102 87 66 75 0 0 +25 33 102 87 66 33 0 0 +25 33 102 87 90 75 0 0 +25 33 102 87 90 33 0 0 +25 33 102 87 24 75 0 0 +25 33 102 87 24 33 0 0 +25 33 102 87 95 75 0 0 +25 33 102 87 95 33 0 0 +25 33 102 87 39 75 0 0 +25 33 102 87 39 33 0 0 +25 33 102 87 26 75 0 0 +25 33 102 87 26 33 0 0 +25 75 102 87 66 75 0 0 +25 75 102 87 66 33 0 0 +25 75 102 87 90 75 0 0 +25 75 102 87 90 33 0 0 +25 75 102 87 24 75 0 0 +25 75 102 87 24 33 0 0 +25 75 102 87 95 75 0 0 +25 75 102 87 95 33 0 0 +25 75 102 87 39 75 0 0 +25 75 102 87 39 33 0 0 +25 75 102 87 26 75 0 0 +25 75 102 87 26 33 0 0 +56 116 66 75 0 0 0 0 +56 116 66 33 0 0 0 0 +56 116 90 75 0 0 0 0 +56 116 90 33 0 0 0 0 +56 116 24 75 0 0 0 0 +56 116 24 33 0 0 0 0 +56 116 95 75 0 0 0 0 +56 116 95 33 0 0 0 0 +56 116 39 75 0 0 0 0 +56 116 39 33 0 0 0 0 +56 116 26 75 0 0 0 0 +56 116 26 33 0 0 0 0 +56 116 25 33 75 0 0 0 +56 116 25 33 33 0 0 0 +56 116 25 75 75 0 0 0 +56 116 25 75 33 0 0 0 +77 116 66 75 0 0 0 0 +77 116 66 33 0 0 0 0 +77 116 90 75 0 0 0 0 +77 116 90 33 0 0 0 0 +77 116 24 75 0 0 0 0 +77 116 24 33 0 0 0 0 +77 116 95 75 0 0 0 0 +77 116 95 33 0 0 0 0 +77 116 39 75 0 0 0 0 +77 116 39 33 0 0 0 0 +77 116 26 75 0 0 0 0 +77 116 26 33 0 0 0 0 +77 116 25 33 75 0 0 0 +77 116 25 33 33 0 0 0 +77 116 25 75 75 0 0 0 +77 116 25 75 33 0 0 0 +22 116 66 75 0 0 0 0 +22 116 66 33 0 0 0 0 +22 116 90 75 0 0 0 0 +22 116 90 33 0 0 0 0 +22 116 24 75 0 0 0 0 +22 116 24 33 0 0 0 0 +22 116 95 75 0 0 0 0 +22 116 95 33 0 0 0 0 +22 116 39 75 0 0 0 0 +22 116 39 33 0 0 0 0 +22 116 26 75 0 0 0 0 +22 116 26 33 0 0 0 0 +22 116 25 33 75 0 0 0 +22 116 25 33 33 0 0 0 +22 116 25 75 75 0 0 0 +22 116 25 75 33 0 0 0 +134 116 66 75 0 0 0 0 +134 116 66 33 0 0 0 0 +134 116 90 75 0 0 0 0 +134 116 90 33 0 0 0 0 +134 116 24 75 0 0 0 0 +134 116 24 33 0 0 0 0 +134 116 95 75 0 0 0 0 +134 116 95 33 0 0 0 0 +134 116 39 75 0 0 0 0 +134 116 39 33 0 0 0 0 +134 116 26 75 0 0 0 0 +134 116 26 33 0 0 0 0 +134 116 25 33 75 0 0 0 +134 116 25 33 33 0 0 0 +134 116 25 75 75 0 0 0 +134 116 25 75 33 0 0 0 +93 116 66 75 0 0 0 0 +93 116 66 33 0 0 0 0 +93 116 90 75 0 0 0 0 +93 116 90 33 0 0 0 0 +93 116 24 75 0 0 0 0 +93 116 24 33 0 0 0 0 +93 116 95 75 0 0 0 0 +93 116 95 33 0 0 0 0 +93 116 39 75 0 0 0 0 +93 116 39 33 0 0 0 0 +93 116 26 75 0 0 0 0 +93 116 26 33 0 0 0 0 +93 116 25 33 75 0 0 0 +93 116 25 33 33 0 0 0 +93 116 25 75 75 0 0 0 +93 116 25 75 33 0 0 0 +32 116 66 75 0 0 0 0 +32 116 66 33 0 0 0 0 +32 116 90 75 0 0 0 0 +32 116 90 33 0 0 0 0 +32 116 24 75 0 0 0 0 +32 116 24 33 0 0 0 0 +32 116 95 75 0 0 0 0 +32 116 95 33 0 0 0 0 +32 116 39 75 0 0 0 0 +32 116 39 33 0 0 0 0 +32 116 26 75 0 0 0 0 +32 116 26 33 0 0 0 0 +32 116 25 33 75 0 0 0 +32 116 25 33 33 0 0 0 +32 116 25 75 75 0 0 0 +32 116 25 75 33 0 0 0 +25 33 116 66 75 0 0 0 +25 33 116 66 33 0 0 0 +25 33 116 90 75 0 0 0 +25 33 116 90 33 0 0 0 +25 33 116 24 75 0 0 0 +25 33 116 24 33 0 0 0 +25 33 116 95 75 0 0 0 +25 33 116 95 33 0 0 0 +25 33 116 39 75 0 0 0 +25 33 116 39 33 0 0 0 +25 33 116 26 75 0 0 0 +25 33 116 26 33 0 0 0 +25 75 116 66 75 0 0 0 +25 75 116 66 33 0 0 0 +25 75 116 90 75 0 0 0 +25 75 116 90 33 0 0 0 +25 75 116 24 75 0 0 0 +25 75 116 24 33 0 0 0 +25 75 116 95 75 0 0 0 +25 75 116 95 33 0 0 0 +25 75 116 39 75 0 0 0 +25 75 116 39 33 0 0 0 +25 75 116 26 75 0 0 0 +25 75 116 26 33 0 0 0 +56 6 66 75 0 0 0 0 +56 6 66 33 0 0 0 0 +56 6 90 75 0 0 0 0 +56 6 90 33 0 0 0 0 +56 6 24 75 0 0 0 0 +56 6 24 33 0 0 0 0 +56 6 95 75 0 0 0 0 +56 6 95 33 0 0 0 0 +56 6 39 75 0 0 0 0 +56 6 39 33 0 0 0 0 +56 6 26 75 0 0 0 0 +56 6 26 33 0 0 0 0 +56 6 25 33 75 0 0 0 +56 6 25 33 33 0 0 0 +56 6 25 75 75 0 0 0 +56 6 25 75 33 0 0 0 +77 6 66 75 0 0 0 0 +77 6 66 33 0 0 0 0 +77 6 90 75 0 0 0 0 +77 6 90 33 0 0 0 0 +77 6 24 75 0 0 0 0 +77 6 24 33 0 0 0 0 +77 6 95 75 0 0 0 0 +77 6 95 33 0 0 0 0 +77 6 39 75 0 0 0 0 +77 6 39 33 0 0 0 0 +77 6 26 75 0 0 0 0 +77 6 26 33 0 0 0 0 +77 6 25 33 75 0 0 0 +77 6 25 33 33 0 0 0 +77 6 25 75 75 0 0 0 +77 6 25 75 33 0 0 0 +22 6 66 75 0 0 0 0 +22 6 66 33 0 0 0 0 +22 6 90 75 0 0 0 0 +22 6 90 33 0 0 0 0 +22 6 24 75 0 0 0 0 +22 6 24 33 0 0 0 0 +22 6 95 75 0 0 0 0 +22 6 95 33 0 0 0 0 +22 6 39 75 0 0 0 0 +22 6 39 33 0 0 0 0 +22 6 26 75 0 0 0 0 +22 6 26 33 0 0 0 0 +22 6 25 33 75 0 0 0 +22 6 25 33 33 0 0 0 +22 6 25 75 75 0 0 0 +22 6 25 75 33 0 0 0 +134 6 66 75 0 0 0 0 +134 6 66 33 0 0 0 0 +134 6 90 75 0 0 0 0 +134 6 90 33 0 0 0 0 +134 6 24 75 0 0 0 0 +134 6 24 33 0 0 0 0 +134 6 95 75 0 0 0 0 +134 6 95 33 0 0 0 0 +134 6 39 75 0 0 0 0 +134 6 39 33 0 0 0 0 +134 6 26 75 0 0 0 0 +134 6 26 33 0 0 0 0 +134 6 25 33 75 0 0 0 +134 6 25 33 33 0 0 0 +134 6 25 75 75 0 0 0 +134 6 25 75 33 0 0 0 +93 6 66 75 0 0 0 0 +93 6 66 33 0 0 0 0 +93 6 90 75 0 0 0 0 +93 6 90 33 0 0 0 0 +93 6 24 75 0 0 0 0 +93 6 24 33 0 0 0 0 +93 6 95 75 0 0 0 0 +93 6 95 33 0 0 0 0 +93 6 39 75 0 0 0 0 +93 6 39 33 0 0 0 0 +93 6 26 75 0 0 0 0 +93 6 26 33 0 0 0 0 +93 6 25 33 75 0 0 0 +93 6 25 33 33 0 0 0 +93 6 25 75 75 0 0 0 +93 6 25 75 33 0 0 0 +32 6 66 75 0 0 0 0 +32 6 66 33 0 0 0 0 +32 6 90 75 0 0 0 0 +32 6 90 33 0 0 0 0 +32 6 24 75 0 0 0 0 +32 6 24 33 0 0 0 0 +32 6 95 75 0 0 0 0 +32 6 95 33 0 0 0 0 +32 6 39 75 0 0 0 0 +32 6 39 33 0 0 0 0 +32 6 26 75 0 0 0 0 +32 6 26 33 0 0 0 0 +32 6 25 33 75 0 0 0 +32 6 25 33 33 0 0 0 +32 6 25 75 75 0 0 0 +32 6 25 75 33 0 0 0 +25 33 6 66 75 0 0 0 +25 33 6 66 33 0 0 0 +25 33 6 90 75 0 0 0 +25 33 6 90 33 0 0 0 +25 33 6 24 75 0 0 0 +25 33 6 24 33 0 0 0 +25 33 6 95 75 0 0 0 +25 33 6 95 33 0 0 0 +25 33 6 39 75 0 0 0 +25 33 6 39 33 0 0 0 +25 33 6 26 75 0 0 0 +25 33 6 26 33 0 0 0 +25 75 6 66 75 0 0 0 +25 75 6 66 33 0 0 0 +25 75 6 90 75 0 0 0 +25 75 6 90 33 0 0 0 +25 75 6 24 75 0 0 0 +25 75 6 24 33 0 0 0 +25 75 6 95 75 0 0 0 +25 75 6 95 33 0 0 0 +25 75 6 39 75 0 0 0 +25 75 6 39 33 0 0 0 +25 75 6 26 75 0 0 0 +25 75 6 26 33 0 0 0 +56 147 66 75 0 0 0 0 +56 147 66 33 0 0 0 0 +56 147 90 75 0 0 0 0 +56 147 90 33 0 0 0 0 +56 147 24 75 0 0 0 0 +56 147 24 33 0 0 0 0 +56 147 95 75 0 0 0 0 +56 147 95 33 0 0 0 0 +56 147 39 75 0 0 0 0 +56 147 39 33 0 0 0 0 +56 147 26 75 0 0 0 0 +56 147 26 33 0 0 0 0 +56 147 25 33 75 0 0 0 +56 147 25 33 33 0 0 0 +56 147 25 75 75 0 0 0 +56 147 25 75 33 0 0 0 +77 147 66 75 0 0 0 0 +77 147 66 33 0 0 0 0 +77 147 90 75 0 0 0 0 +77 147 90 33 0 0 0 0 +77 147 24 75 0 0 0 0 +77 147 24 33 0 0 0 0 +77 147 95 75 0 0 0 0 +77 147 95 33 0 0 0 0 +77 147 39 75 0 0 0 0 +77 147 39 33 0 0 0 0 +77 147 26 75 0 0 0 0 +77 147 26 33 0 0 0 0 +77 147 25 33 75 0 0 0 +77 147 25 33 33 0 0 0 +77 147 25 75 75 0 0 0 +77 147 25 75 33 0 0 0 +22 147 66 75 0 0 0 0 +22 147 66 33 0 0 0 0 +22 147 90 75 0 0 0 0 +22 147 90 33 0 0 0 0 +22 147 24 75 0 0 0 0 +22 147 24 33 0 0 0 0 +22 147 95 75 0 0 0 0 +22 147 95 33 0 0 0 0 +22 147 39 75 0 0 0 0 +22 147 39 33 0 0 0 0 +22 147 26 75 0 0 0 0 +22 147 26 33 0 0 0 0 +22 147 25 33 75 0 0 0 +22 147 25 33 33 0 0 0 +22 147 25 75 75 0 0 0 +22 147 25 75 33 0 0 0 +134 147 66 75 0 0 0 0 +134 147 66 33 0 0 0 0 +134 147 90 75 0 0 0 0 +134 147 90 33 0 0 0 0 +134 147 24 75 0 0 0 0 +134 147 24 33 0 0 0 0 +134 147 95 75 0 0 0 0 +134 147 95 33 0 0 0 0 +134 147 39 75 0 0 0 0 +134 147 39 33 0 0 0 0 +134 147 26 75 0 0 0 0 +134 147 26 33 0 0 0 0 +134 147 25 33 75 0 0 0 +134 147 25 33 33 0 0 0 +134 147 25 75 75 0 0 0 +134 147 25 75 33 0 0 0 +93 147 66 75 0 0 0 0 +93 147 66 33 0 0 0 0 +93 147 90 75 0 0 0 0 +93 147 90 33 0 0 0 0 +93 147 24 75 0 0 0 0 +93 147 24 33 0 0 0 0 +93 147 95 75 0 0 0 0 +93 147 95 33 0 0 0 0 +93 147 39 75 0 0 0 0 +93 147 39 33 0 0 0 0 +93 147 26 75 0 0 0 0 +93 147 26 33 0 0 0 0 +93 147 25 33 75 0 0 0 +93 147 25 33 33 0 0 0 +93 147 25 75 75 0 0 0 +93 147 25 75 33 0 0 0 +32 147 66 75 0 0 0 0 +32 147 66 33 0 0 0 0 +32 147 90 75 0 0 0 0 +32 147 90 33 0 0 0 0 +32 147 24 75 0 0 0 0 +32 147 24 33 0 0 0 0 +32 147 95 75 0 0 0 0 +32 147 95 33 0 0 0 0 +32 147 39 75 0 0 0 0 +32 147 39 33 0 0 0 0 +32 147 26 75 0 0 0 0 +32 147 26 33 0 0 0 0 +32 147 25 33 75 0 0 0 +32 147 25 33 33 0 0 0 +32 147 25 75 75 0 0 0 +32 147 25 75 33 0 0 0 +25 33 147 66 75 0 0 0 +25 33 147 66 33 0 0 0 +25 33 147 90 75 0 0 0 +25 33 147 90 33 0 0 0 +25 33 147 24 75 0 0 0 +25 33 147 24 33 0 0 0 +25 33 147 95 75 0 0 0 +25 33 147 95 33 0 0 0 +25 33 147 39 75 0 0 0 +25 33 147 39 33 0 0 0 +25 33 147 26 75 0 0 0 +25 33 147 26 33 0 0 0 +25 75 147 66 75 0 0 0 +25 75 147 66 33 0 0 0 +25 75 147 90 75 0 0 0 +25 75 147 90 33 0 0 0 +25 75 147 24 75 0 0 0 +25 75 147 24 33 0 0 0 +25 75 147 95 75 0 0 0 +25 75 147 95 33 0 0 0 +25 75 147 39 75 0 0 0 +25 75 147 39 33 0 0 0 +25 75 147 26 75 0 0 0 +25 75 147 26 33 0 0 0 +56 148 66 0 0 0 0 0 +77 148 66 0 0 0 0 0 +22 148 66 0 0 0 0 0 +134 148 66 0 0 0 0 0 +93 148 66 0 0 0 0 0 +32 148 66 0 0 0 0 0 +25 33 148 66 0 0 0 0 +25 75 148 66 0 0 0 0 +56 148 90 0 0 0 0 0 +77 148 90 0 0 0 0 0 +22 148 90 0 0 0 0 0 +134 148 90 0 0 0 0 0 +93 148 90 0 0 0 0 0 +32 148 90 0 0 0 0 0 +25 33 148 90 0 0 0 0 +25 75 148 90 0 0 0 0 +56 148 24 0 0 0 0 0 +77 148 24 0 0 0 0 0 +22 148 24 0 0 0 0 0 +134 148 24 0 0 0 0 0 +93 148 24 0 0 0 0 0 +32 148 24 0 0 0 0 0 +25 33 148 24 0 0 0 0 +25 75 148 24 0 0 0 0 +56 148 95 0 0 0 0 0 +77 148 95 0 0 0 0 0 +22 148 95 0 0 0 0 0 +134 148 95 0 0 0 0 0 +93 148 95 0 0 0 0 0 +32 148 95 0 0 0 0 0 +25 33 148 95 0 0 0 0 +25 75 148 95 0 0 0 0 +56 148 39 0 0 0 0 0 +77 148 39 0 0 0 0 0 +22 148 39 0 0 0 0 0 +134 148 39 0 0 0 0 0 +93 148 39 0 0 0 0 0 +32 148 39 0 0 0 0 0 +25 33 148 39 0 0 0 0 +25 75 148 39 0 0 0 0 +56 148 26 0 0 0 0 0 +77 148 26 0 0 0 0 0 +22 148 26 0 0 0 0 0 +134 148 26 0 0 0 0 0 +93 148 26 0 0 0 0 0 +32 148 26 0 0 0 0 0 +25 33 148 26 0 0 0 0 +25 75 148 26 0 0 0 0 +56 148 25 33 0 0 0 0 +77 148 25 33 0 0 0 0 +22 148 25 33 0 0 0 0 +134 148 25 33 0 0 0 0 +93 148 25 33 0 0 0 0 +32 148 25 33 0 0 0 0 +56 148 25 75 0 0 0 0 +77 148 25 75 0 0 0 0 +22 148 25 75 0 0 0 0 +134 148 25 75 0 0 0 0 +93 148 25 75 0 0 0 0 +32 148 25 75 0 0 0 0 +56 4 0 0 0 0 0 0 +77 4 0 0 0 0 0 0 +22 4 0 0 0 0 0 0 +134 4 0 0 0 0 0 0 +93 4 0 0 0 0 0 0 +32 4 0 0 0 0 0 0 +56 119 0 0 0 0 0 0 +77 119 0 0 0 0 0 0 +22 119 0 0 0 0 0 0 +134 119 0 0 0 0 0 0 +93 119 0 0 0 0 0 0 +32 119 0 0 0 0 0 0 +56 54 0 0 0 0 0 0 +77 54 0 0 0 0 0 0 +22 54 0 0 0 0 0 0 +134 54 0 0 0 0 0 0 +93 54 0 0 0 0 0 0 +32 54 0 0 0 0 0 0 +56 67 0 0 0 0 0 0 +77 67 0 0 0 0 0 0 +22 67 0 0 0 0 0 0 +134 67 0 0 0 0 0 0 +93 67 0 0 0 0 0 0 +32 67 0 0 0 0 0 0 +56 55 94 0 0 0 0 0 +77 55 94 0 0 0 0 0 +22 55 94 0 0 0 0 0 +134 55 94 0 0 0 0 0 +93 55 94 0 0 0 0 0 +32 55 94 0 0 0 0 0 +56 27 66 0 0 0 0 0 +56 27 90 0 0 0 0 0 +56 27 24 0 0 0 0 0 +56 27 95 0 0 0 0 0 +56 27 39 0 0 0 0 0 +56 27 26 0 0 0 0 0 +56 27 25 33 0 0 0 0 +56 27 25 75 0 0 0 0 +77 27 66 0 0 0 0 0 +77 27 90 0 0 0 0 0 +77 27 24 0 0 0 0 0 +77 27 95 0 0 0 0 0 +77 27 39 0 0 0 0 0 +77 27 26 0 0 0 0 0 +77 27 25 33 0 0 0 0 +77 27 25 75 0 0 0 0 +22 27 66 0 0 0 0 0 +22 27 90 0 0 0 0 0 +22 27 24 0 0 0 0 0 +22 27 95 0 0 0 0 0 +22 27 39 0 0 0 0 0 +22 27 26 0 0 0 0 0 +22 27 25 33 0 0 0 0 +22 27 25 75 0 0 0 0 +134 27 66 0 0 0 0 0 +134 27 90 0 0 0 0 0 +134 27 24 0 0 0 0 0 +134 27 95 0 0 0 0 0 +134 27 39 0 0 0 0 0 +134 27 26 0 0 0 0 0 +134 27 25 33 0 0 0 0 +134 27 25 75 0 0 0 0 +93 27 66 0 0 0 0 0 +93 27 90 0 0 0 0 0 +93 27 24 0 0 0 0 0 +93 27 95 0 0 0 0 0 +93 27 39 0 0 0 0 0 +93 27 26 0 0 0 0 0 +93 27 25 33 0 0 0 0 +93 27 25 75 0 0 0 0 +32 27 66 0 0 0 0 0 +32 27 90 0 0 0 0 0 +32 27 24 0 0 0 0 0 +32 27 95 0 0 0 0 0 +32 27 39 0 0 0 0 0 +32 27 26 0 0 0 0 0 +32 27 25 33 0 0 0 0 +32 27 25 75 0 0 0 0 +25 33 27 66 0 0 0 0 +25 33 27 90 0 0 0 0 +25 33 27 24 0 0 0 0 +25 33 27 95 0 0 0 0 +25 33 27 39 0 0 0 0 +25 33 27 26 0 0 0 0 +25 75 27 66 0 0 0 0 +25 75 27 90 0 0 0 0 +25 75 27 24 0 0 0 0 +25 75 27 95 0 0 0 0 +25 75 27 39 0 0 0 0 +25 75 27 26 0 0 0 0 +56 149 66 0 0 0 0 0 +56 149 90 0 0 0 0 0 +56 149 24 0 0 0 0 0 +56 149 95 0 0 0 0 0 +56 149 39 0 0 0 0 0 +56 149 26 0 0 0 0 0 +56 149 25 33 0 0 0 0 +56 149 25 75 0 0 0 0 +77 149 66 0 0 0 0 0 +77 149 90 0 0 0 0 0 +77 149 24 0 0 0 0 0 +77 149 95 0 0 0 0 0 +77 149 39 0 0 0 0 0 +77 149 26 0 0 0 0 0 +77 149 25 33 0 0 0 0 +77 149 25 75 0 0 0 0 +22 149 66 0 0 0 0 0 +22 149 90 0 0 0 0 0 +22 149 24 0 0 0 0 0 +22 149 95 0 0 0 0 0 +22 149 39 0 0 0 0 0 +22 149 26 0 0 0 0 0 +22 149 25 33 0 0 0 0 +22 149 25 75 0 0 0 0 +134 149 66 0 0 0 0 0 +134 149 90 0 0 0 0 0 +134 149 24 0 0 0 0 0 +134 149 95 0 0 0 0 0 +134 149 39 0 0 0 0 0 +134 149 26 0 0 0 0 0 +134 149 25 33 0 0 0 0 +134 149 25 75 0 0 0 0 +93 149 66 0 0 0 0 0 +93 149 90 0 0 0 0 0 +93 149 24 0 0 0 0 0 +93 149 95 0 0 0 0 0 +93 149 39 0 0 0 0 0 +93 149 26 0 0 0 0 0 +93 149 25 33 0 0 0 0 +93 149 25 75 0 0 0 0 +32 149 66 0 0 0 0 0 +32 149 90 0 0 0 0 0 +32 149 24 0 0 0 0 0 +32 149 95 0 0 0 0 0 +32 149 39 0 0 0 0 0 +32 149 26 0 0 0 0 0 +32 149 25 33 0 0 0 0 +32 149 25 75 0 0 0 0 +25 33 149 66 0 0 0 0 +25 33 149 90 0 0 0 0 +25 33 149 24 0 0 0 0 +25 33 149 95 0 0 0 0 +25 33 149 39 0 0 0 0 +25 33 149 26 0 0 0 0 +25 75 149 66 0 0 0 0 +25 75 149 90 0 0 0 0 +25 75 149 24 0 0 0 0 +25 75 149 95 0 0 0 0 +25 75 149 39 0 0 0 0 +25 75 149 26 0 0 0 0 +56 57 66 0 0 0 0 0 +56 57 90 0 0 0 0 0 +56 57 24 0 0 0 0 0 +56 57 95 0 0 0 0 0 +56 57 39 0 0 0 0 0 +56 57 26 0 0 0 0 0 +56 57 25 33 0 0 0 0 +56 57 25 75 0 0 0 0 +77 57 66 0 0 0 0 0 +77 57 90 0 0 0 0 0 +77 57 24 0 0 0 0 0 +77 57 95 0 0 0 0 0 +77 57 39 0 0 0 0 0 +77 57 26 0 0 0 0 0 +77 57 25 33 0 0 0 0 +77 57 25 75 0 0 0 0 +22 57 66 0 0 0 0 0 +22 57 90 0 0 0 0 0 +22 57 24 0 0 0 0 0 +22 57 95 0 0 0 0 0 +22 57 39 0 0 0 0 0 +22 57 26 0 0 0 0 0 +22 57 25 33 0 0 0 0 +22 57 25 75 0 0 0 0 +134 57 66 0 0 0 0 0 +134 57 90 0 0 0 0 0 +134 57 24 0 0 0 0 0 +134 57 95 0 0 0 0 0 +134 57 39 0 0 0 0 0 +134 57 26 0 0 0 0 0 +134 57 25 33 0 0 0 0 +134 57 25 75 0 0 0 0 +93 57 66 0 0 0 0 0 +93 57 90 0 0 0 0 0 +93 57 24 0 0 0 0 0 +93 57 95 0 0 0 0 0 +93 57 39 0 0 0 0 0 +93 57 26 0 0 0 0 0 +93 57 25 33 0 0 0 0 +93 57 25 75 0 0 0 0 +32 57 66 0 0 0 0 0 +32 57 90 0 0 0 0 0 +32 57 24 0 0 0 0 0 +32 57 95 0 0 0 0 0 +32 57 39 0 0 0 0 0 +32 57 26 0 0 0 0 0 +32 57 25 33 0 0 0 0 +32 57 25 75 0 0 0 0 +25 33 57 66 0 0 0 0 +25 33 57 90 0 0 0 0 +25 33 57 24 0 0 0 0 +25 33 57 95 0 0 0 0 +25 33 57 39 0 0 0 0 +25 33 57 26 0 0 0 0 +25 75 57 66 0 0 0 0 +25 75 57 90 0 0 0 0 +25 75 57 24 0 0 0 0 +25 75 57 95 0 0 0 0 +25 75 57 39 0 0 0 0 +25 75 57 26 0 0 0 0 +56 105 66 0 0 0 0 0 +56 105 90 0 0 0 0 0 +56 105 24 0 0 0 0 0 +56 105 95 0 0 0 0 0 +56 105 39 0 0 0 0 0 +56 105 26 0 0 0 0 0 +56 105 25 33 0 0 0 0 +56 105 25 75 0 0 0 0 +77 105 66 0 0 0 0 0 +77 105 90 0 0 0 0 0 +77 105 24 0 0 0 0 0 +77 105 95 0 0 0 0 0 +77 105 39 0 0 0 0 0 +77 105 26 0 0 0 0 0 +77 105 25 33 0 0 0 0 +77 105 25 75 0 0 0 0 +22 105 66 0 0 0 0 0 +22 105 90 0 0 0 0 0 +22 105 24 0 0 0 0 0 +22 105 95 0 0 0 0 0 +22 105 39 0 0 0 0 0 +22 105 26 0 0 0 0 0 +22 105 25 33 0 0 0 0 +22 105 25 75 0 0 0 0 +134 105 66 0 0 0 0 0 +134 105 90 0 0 0 0 0 +134 105 24 0 0 0 0 0 +134 105 95 0 0 0 0 0 +134 105 39 0 0 0 0 0 +134 105 26 0 0 0 0 0 +134 105 25 33 0 0 0 0 +134 105 25 75 0 0 0 0 +93 105 66 0 0 0 0 0 +93 105 90 0 0 0 0 0 +93 105 24 0 0 0 0 0 +93 105 95 0 0 0 0 0 +93 105 39 0 0 0 0 0 +93 105 26 0 0 0 0 0 +93 105 25 33 0 0 0 0 +93 105 25 75 0 0 0 0 +32 105 66 0 0 0 0 0 +32 105 90 0 0 0 0 0 +32 105 24 0 0 0 0 0 +32 105 95 0 0 0 0 0 +32 105 39 0 0 0 0 0 +32 105 26 0 0 0 0 0 +32 105 25 33 0 0 0 0 +32 105 25 75 0 0 0 0 +25 33 105 66 0 0 0 0 +25 33 105 90 0 0 0 0 +25 33 105 24 0 0 0 0 +25 33 105 95 0 0 0 0 +25 33 105 39 0 0 0 0 +25 33 105 26 0 0 0 0 +25 75 105 66 0 0 0 0 +25 75 105 90 0 0 0 0 +25 75 105 24 0 0 0 0 +25 75 105 95 0 0 0 0 +25 75 105 39 0 0 0 0 +25 75 105 26 0 0 0 0 +56 102 87 66 0 0 0 0 +56 102 87 90 0 0 0 0 +56 102 87 24 0 0 0 0 +56 102 87 95 0 0 0 0 +56 102 87 39 0 0 0 0 +56 102 87 26 0 0 0 0 +56 102 87 25 33 0 0 0 +56 102 87 25 75 0 0 0 +77 102 87 66 0 0 0 0 +77 102 87 90 0 0 0 0 +77 102 87 24 0 0 0 0 +77 102 87 95 0 0 0 0 +77 102 87 39 0 0 0 0 +77 102 87 26 0 0 0 0 +77 102 87 25 33 0 0 0 +77 102 87 25 75 0 0 0 +22 102 87 66 0 0 0 0 +22 102 87 90 0 0 0 0 +22 102 87 24 0 0 0 0 +22 102 87 95 0 0 0 0 +22 102 87 39 0 0 0 0 +22 102 87 26 0 0 0 0 +22 102 87 25 33 0 0 0 +22 102 87 25 75 0 0 0 +134 102 87 66 0 0 0 0 +134 102 87 90 0 0 0 0 +134 102 87 24 0 0 0 0 +134 102 87 95 0 0 0 0 +134 102 87 39 0 0 0 0 +134 102 87 26 0 0 0 0 +134 102 87 25 33 0 0 0 +134 102 87 25 75 0 0 0 +93 102 87 66 0 0 0 0 +93 102 87 90 0 0 0 0 +93 102 87 24 0 0 0 0 +93 102 87 95 0 0 0 0 +93 102 87 39 0 0 0 0 +93 102 87 26 0 0 0 0 +93 102 87 25 33 0 0 0 +93 102 87 25 75 0 0 0 +32 102 87 66 0 0 0 0 +32 102 87 90 0 0 0 0 +32 102 87 24 0 0 0 0 +32 102 87 95 0 0 0 0 +32 102 87 39 0 0 0 0 +32 102 87 26 0 0 0 0 +32 102 87 25 33 0 0 0 +32 102 87 25 75 0 0 0 +25 33 102 87 66 0 0 0 +25 33 102 87 90 0 0 0 +25 33 102 87 24 0 0 0 +25 33 102 87 95 0 0 0 +25 33 102 87 39 0 0 0 +25 33 102 87 26 0 0 0 +25 75 102 87 66 0 0 0 +25 75 102 87 90 0 0 0 +25 75 102 87 24 0 0 0 +25 75 102 87 95 0 0 0 +25 75 102 87 39 0 0 0 +25 75 102 87 26 0 0 0 +56 116 66 0 0 0 0 0 +56 116 90 0 0 0 0 0 +56 116 24 0 0 0 0 0 +56 116 95 0 0 0 0 0 +56 116 39 0 0 0 0 0 +56 116 26 0 0 0 0 0 +56 116 25 33 0 0 0 0 +56 116 25 75 0 0 0 0 +77 116 66 0 0 0 0 0 +77 116 90 0 0 0 0 0 +77 116 24 0 0 0 0 0 +77 116 95 0 0 0 0 0 +77 116 39 0 0 0 0 0 +77 116 26 0 0 0 0 0 +77 116 25 33 0 0 0 0 +77 116 25 75 0 0 0 0 +22 116 66 0 0 0 0 0 +22 116 90 0 0 0 0 0 +22 116 24 0 0 0 0 0 +22 116 95 0 0 0 0 0 +22 116 39 0 0 0 0 0 +22 116 26 0 0 0 0 0 +22 116 25 33 0 0 0 0 +22 116 25 75 0 0 0 0 +134 116 66 0 0 0 0 0 +134 116 90 0 0 0 0 0 +134 116 24 0 0 0 0 0 +134 116 95 0 0 0 0 0 +134 116 39 0 0 0 0 0 +134 116 26 0 0 0 0 0 +134 116 25 33 0 0 0 0 +134 116 25 75 0 0 0 0 +93 116 66 0 0 0 0 0 +93 116 90 0 0 0 0 0 +93 116 24 0 0 0 0 0 +93 116 95 0 0 0 0 0 +93 116 39 0 0 0 0 0 +93 116 26 0 0 0 0 0 +93 116 25 33 0 0 0 0 +93 116 25 75 0 0 0 0 +32 116 66 0 0 0 0 0 +32 116 90 0 0 0 0 0 +32 116 24 0 0 0 0 0 +32 116 95 0 0 0 0 0 +32 116 39 0 0 0 0 0 +32 116 26 0 0 0 0 0 +32 116 25 33 0 0 0 0 +32 116 25 75 0 0 0 0 +25 33 116 66 0 0 0 0 +25 33 116 90 0 0 0 0 +25 33 116 24 0 0 0 0 +25 33 116 95 0 0 0 0 +25 33 116 39 0 0 0 0 +25 33 116 26 0 0 0 0 +25 75 116 66 0 0 0 0 +25 75 116 90 0 0 0 0 +25 75 116 24 0 0 0 0 +25 75 116 95 0 0 0 0 +25 75 116 39 0 0 0 0 +25 75 116 26 0 0 0 0 +56 6 66 0 0 0 0 0 +56 6 90 0 0 0 0 0 +56 6 24 0 0 0 0 0 +56 6 95 0 0 0 0 0 +56 6 39 0 0 0 0 0 +56 6 26 0 0 0 0 0 +56 6 25 33 0 0 0 0 +56 6 25 75 0 0 0 0 +77 6 66 0 0 0 0 0 +77 6 90 0 0 0 0 0 +77 6 24 0 0 0 0 0 +77 6 95 0 0 0 0 0 +77 6 39 0 0 0 0 0 +77 6 26 0 0 0 0 0 +77 6 25 33 0 0 0 0 +77 6 25 75 0 0 0 0 +22 6 66 0 0 0 0 0 +22 6 90 0 0 0 0 0 +22 6 24 0 0 0 0 0 +22 6 95 0 0 0 0 0 +22 6 39 0 0 0 0 0 +22 6 26 0 0 0 0 0 +22 6 25 33 0 0 0 0 +22 6 25 75 0 0 0 0 +134 6 66 0 0 0 0 0 +134 6 90 0 0 0 0 0 +134 6 24 0 0 0 0 0 +134 6 95 0 0 0 0 0 +134 6 39 0 0 0 0 0 +134 6 26 0 0 0 0 0 +134 6 25 33 0 0 0 0 +134 6 25 75 0 0 0 0 +93 6 66 0 0 0 0 0 +93 6 90 0 0 0 0 0 +93 6 24 0 0 0 0 0 +93 6 95 0 0 0 0 0 +93 6 39 0 0 0 0 0 +93 6 26 0 0 0 0 0 +93 6 25 33 0 0 0 0 +93 6 25 75 0 0 0 0 +32 6 66 0 0 0 0 0 +32 6 90 0 0 0 0 0 +32 6 24 0 0 0 0 0 +32 6 95 0 0 0 0 0 +32 6 39 0 0 0 0 0 +32 6 26 0 0 0 0 0 +32 6 25 33 0 0 0 0 +32 6 25 75 0 0 0 0 +25 33 6 66 0 0 0 0 +25 33 6 90 0 0 0 0 +25 33 6 24 0 0 0 0 +25 33 6 95 0 0 0 0 +25 33 6 39 0 0 0 0 +25 33 6 26 0 0 0 0 +25 75 6 66 0 0 0 0 +25 75 6 90 0 0 0 0 +25 75 6 24 0 0 0 0 +25 75 6 95 0 0 0 0 +25 75 6 39 0 0 0 0 +25 75 6 26 0 0 0 0 +56 147 66 0 0 0 0 0 +56 147 90 0 0 0 0 0 +56 147 24 0 0 0 0 0 +56 147 95 0 0 0 0 0 +56 147 39 0 0 0 0 0 +56 147 26 0 0 0 0 0 +56 147 25 33 0 0 0 0 +56 147 25 75 0 0 0 0 +77 147 66 0 0 0 0 0 +77 147 90 0 0 0 0 0 +77 147 24 0 0 0 0 0 +77 147 95 0 0 0 0 0 +77 147 39 0 0 0 0 0 +77 147 26 0 0 0 0 0 +77 147 25 33 0 0 0 0 +77 147 25 75 0 0 0 0 +22 147 66 0 0 0 0 0 +22 147 90 0 0 0 0 0 +22 147 24 0 0 0 0 0 +22 147 95 0 0 0 0 0 +22 147 39 0 0 0 0 0 +22 147 26 0 0 0 0 0 +22 147 25 33 0 0 0 0 +22 147 25 75 0 0 0 0 +134 147 66 0 0 0 0 0 +134 147 90 0 0 0 0 0 +134 147 24 0 0 0 0 0 +134 147 95 0 0 0 0 0 +134 147 39 0 0 0 0 0 +134 147 26 0 0 0 0 0 +134 147 25 33 0 0 0 0 +134 147 25 75 0 0 0 0 +93 147 66 0 0 0 0 0 +93 147 90 0 0 0 0 0 +93 147 24 0 0 0 0 0 +93 147 95 0 0 0 0 0 +93 147 39 0 0 0 0 0 +93 147 26 0 0 0 0 0 +93 147 25 33 0 0 0 0 +93 147 25 75 0 0 0 0 +32 147 66 0 0 0 0 0 +32 147 90 0 0 0 0 0 +32 147 24 0 0 0 0 0 +32 147 95 0 0 0 0 0 +32 147 39 0 0 0 0 0 +32 147 26 0 0 0 0 0 +32 147 25 33 0 0 0 0 +32 147 25 75 0 0 0 0 +25 33 147 66 0 0 0 0 +25 33 147 90 0 0 0 0 +25 33 147 24 0 0 0 0 +25 33 147 95 0 0 0 0 +25 33 147 39 0 0 0 0 +25 33 147 26 0 0 0 0 +25 75 147 66 0 0 0 0 +25 75 147 90 0 0 0 0 +25 75 147 24 0 0 0 0 +25 75 147 95 0 0 0 0 +25 75 147 39 0 0 0 0 +25 75 147 26 0 0 0 0 +56 27 8 0 0 0 0 0 +56 27 133 0 0 0 0 0 +56 27 84 0 0 0 0 0 +56 27 85 0 0 0 0 0 +56 27 88 0 0 0 0 0 +56 27 113 0 0 0 0 0 +77 27 8 0 0 0 0 0 +77 27 133 0 0 0 0 0 +77 27 84 0 0 0 0 0 +77 27 85 0 0 0 0 0 +77 27 88 0 0 0 0 0 +77 27 113 0 0 0 0 0 +22 27 8 0 0 0 0 0 +22 27 133 0 0 0 0 0 +22 27 84 0 0 0 0 0 +22 27 85 0 0 0 0 0 +22 27 88 0 0 0 0 0 +22 27 113 0 0 0 0 0 +134 27 8 0 0 0 0 0 +134 27 133 0 0 0 0 0 +134 27 84 0 0 0 0 0 +134 27 85 0 0 0 0 0 +134 27 88 0 0 0 0 0 +134 27 113 0 0 0 0 0 +93 27 8 0 0 0 0 0 +93 27 133 0 0 0 0 0 +93 27 84 0 0 0 0 0 +93 27 85 0 0 0 0 0 +93 27 88 0 0 0 0 0 +93 27 113 0 0 0 0 0 +32 27 8 0 0 0 0 0 +32 27 133 0 0 0 0 0 +32 27 84 0 0 0 0 0 +32 27 85 0 0 0 0 0 +32 27 88 0 0 0 0 0 +32 27 113 0 0 0 0 0 +25 33 27 8 0 0 0 0 +25 33 27 133 0 0 0 0 +25 33 27 84 0 0 0 0 +25 33 27 85 0 0 0 0 +25 33 27 88 0 0 0 0 +25 33 27 113 0 0 0 0 +25 75 27 8 0 0 0 0 +25 75 27 133 0 0 0 0 +25 75 27 84 0 0 0 0 +25 75 27 85 0 0 0 0 +25 75 27 88 0 0 0 0 +25 75 27 113 0 0 0 0 +56 149 8 0 0 0 0 0 +56 149 133 0 0 0 0 0 +56 149 84 0 0 0 0 0 +56 149 85 0 0 0 0 0 +56 149 88 0 0 0 0 0 +56 149 113 0 0 0 0 0 +77 149 8 0 0 0 0 0 +77 149 133 0 0 0 0 0 +77 149 84 0 0 0 0 0 +77 149 85 0 0 0 0 0 +77 149 88 0 0 0 0 0 +77 149 113 0 0 0 0 0 +22 149 8 0 0 0 0 0 +22 149 133 0 0 0 0 0 +22 149 84 0 0 0 0 0 +22 149 85 0 0 0 0 0 +22 149 88 0 0 0 0 0 +22 149 113 0 0 0 0 0 +134 149 8 0 0 0 0 0 +134 149 133 0 0 0 0 0 +134 149 84 0 0 0 0 0 +134 149 85 0 0 0 0 0 +134 149 88 0 0 0 0 0 +134 149 113 0 0 0 0 0 +93 149 8 0 0 0 0 0 +93 149 133 0 0 0 0 0 +93 149 84 0 0 0 0 0 +93 149 85 0 0 0 0 0 +93 149 88 0 0 0 0 0 +93 149 113 0 0 0 0 0 +32 149 8 0 0 0 0 0 +32 149 133 0 0 0 0 0 +32 149 84 0 0 0 0 0 +32 149 85 0 0 0 0 0 +32 149 88 0 0 0 0 0 +32 149 113 0 0 0 0 0 +25 33 149 8 0 0 0 0 +25 33 149 133 0 0 0 0 +25 33 149 84 0 0 0 0 +25 33 149 85 0 0 0 0 +25 33 149 88 0 0 0 0 +25 33 149 113 0 0 0 0 +25 75 149 8 0 0 0 0 +25 75 149 133 0 0 0 0 +25 75 149 84 0 0 0 0 +25 75 149 85 0 0 0 0 +25 75 149 88 0 0 0 0 +25 75 149 113 0 0 0 0 +56 57 8 0 0 0 0 0 +56 57 133 0 0 0 0 0 +56 57 84 0 0 0 0 0 +56 57 85 0 0 0 0 0 +56 57 88 0 0 0 0 0 +56 57 113 0 0 0 0 0 +77 57 8 0 0 0 0 0 +77 57 133 0 0 0 0 0 +77 57 84 0 0 0 0 0 +77 57 85 0 0 0 0 0 +77 57 88 0 0 0 0 0 +77 57 113 0 0 0 0 0 +22 57 8 0 0 0 0 0 +22 57 133 0 0 0 0 0 +22 57 84 0 0 0 0 0 +22 57 85 0 0 0 0 0 +22 57 88 0 0 0 0 0 +22 57 113 0 0 0 0 0 +134 57 8 0 0 0 0 0 +134 57 133 0 0 0 0 0 +134 57 84 0 0 0 0 0 +134 57 85 0 0 0 0 0 +134 57 88 0 0 0 0 0 +134 57 113 0 0 0 0 0 +93 57 8 0 0 0 0 0 +93 57 133 0 0 0 0 0 +93 57 84 0 0 0 0 0 +93 57 85 0 0 0 0 0 +93 57 88 0 0 0 0 0 +93 57 113 0 0 0 0 0 +32 57 8 0 0 0 0 0 +32 57 133 0 0 0 0 0 +32 57 84 0 0 0 0 0 +32 57 85 0 0 0 0 0 +32 57 88 0 0 0 0 0 +32 57 113 0 0 0 0 0 +25 33 57 8 0 0 0 0 +25 33 57 133 0 0 0 0 +25 33 57 84 0 0 0 0 +25 33 57 85 0 0 0 0 +25 33 57 88 0 0 0 0 +25 33 57 113 0 0 0 0 +25 75 57 8 0 0 0 0 +25 75 57 133 0 0 0 0 +25 75 57 84 0 0 0 0 +25 75 57 85 0 0 0 0 +25 75 57 88 0 0 0 0 +25 75 57 113 0 0 0 0 +56 105 8 0 0 0 0 0 +56 105 133 0 0 0 0 0 +56 105 84 0 0 0 0 0 +56 105 85 0 0 0 0 0 +56 105 88 0 0 0 0 0 +56 105 113 0 0 0 0 0 +77 105 8 0 0 0 0 0 +77 105 133 0 0 0 0 0 +77 105 84 0 0 0 0 0 +77 105 85 0 0 0 0 0 +77 105 88 0 0 0 0 0 +77 105 113 0 0 0 0 0 +22 105 8 0 0 0 0 0 +22 105 133 0 0 0 0 0 +22 105 84 0 0 0 0 0 +22 105 85 0 0 0 0 0 +22 105 88 0 0 0 0 0 +22 105 113 0 0 0 0 0 +134 105 8 0 0 0 0 0 +134 105 133 0 0 0 0 0 +134 105 84 0 0 0 0 0 +134 105 85 0 0 0 0 0 +134 105 88 0 0 0 0 0 +134 105 113 0 0 0 0 0 +93 105 8 0 0 0 0 0 +93 105 133 0 0 0 0 0 +93 105 84 0 0 0 0 0 +93 105 85 0 0 0 0 0 +93 105 88 0 0 0 0 0 +93 105 113 0 0 0 0 0 +32 105 8 0 0 0 0 0 +32 105 133 0 0 0 0 0 +32 105 84 0 0 0 0 0 +32 105 85 0 0 0 0 0 +32 105 88 0 0 0 0 0 +32 105 113 0 0 0 0 0 +25 33 105 8 0 0 0 0 +25 33 105 133 0 0 0 0 +25 33 105 84 0 0 0 0 +25 33 105 85 0 0 0 0 +25 33 105 88 0 0 0 0 +25 33 105 113 0 0 0 0 +25 75 105 8 0 0 0 0 +25 75 105 133 0 0 0 0 +25 75 105 84 0 0 0 0 +25 75 105 85 0 0 0 0 +25 75 105 88 0 0 0 0 +25 75 105 113 0 0 0 0 +56 102 87 8 0 0 0 0 +56 102 87 133 0 0 0 0 +56 102 87 84 0 0 0 0 +56 102 87 85 0 0 0 0 +56 102 87 88 0 0 0 0 +56 102 87 113 0 0 0 0 +77 102 87 8 0 0 0 0 +77 102 87 133 0 0 0 0 +77 102 87 84 0 0 0 0 +77 102 87 85 0 0 0 0 +77 102 87 88 0 0 0 0 +77 102 87 113 0 0 0 0 +22 102 87 8 0 0 0 0 +22 102 87 133 0 0 0 0 +22 102 87 84 0 0 0 0 +22 102 87 85 0 0 0 0 +22 102 87 88 0 0 0 0 +22 102 87 113 0 0 0 0 +134 102 87 8 0 0 0 0 +134 102 87 133 0 0 0 0 +134 102 87 84 0 0 0 0 +134 102 87 85 0 0 0 0 +134 102 87 88 0 0 0 0 +134 102 87 113 0 0 0 0 +93 102 87 8 0 0 0 0 +93 102 87 133 0 0 0 0 +93 102 87 84 0 0 0 0 +93 102 87 85 0 0 0 0 +93 102 87 88 0 0 0 0 +93 102 87 113 0 0 0 0 +32 102 87 8 0 0 0 0 +32 102 87 133 0 0 0 0 +32 102 87 84 0 0 0 0 +32 102 87 85 0 0 0 0 +32 102 87 88 0 0 0 0 +32 102 87 113 0 0 0 0 +25 33 102 87 8 0 0 0 +25 33 102 87 133 0 0 0 +25 33 102 87 84 0 0 0 +25 33 102 87 85 0 0 0 +25 33 102 87 88 0 0 0 +25 33 102 87 113 0 0 0 +25 75 102 87 8 0 0 0 +25 75 102 87 133 0 0 0 +25 75 102 87 84 0 0 0 +25 75 102 87 85 0 0 0 +25 75 102 87 88 0 0 0 +25 75 102 87 113 0 0 0 +56 116 8 0 0 0 0 0 +56 116 133 0 0 0 0 0 +56 116 84 0 0 0 0 0 +56 116 85 0 0 0 0 0 +56 116 88 0 0 0 0 0 +56 116 113 0 0 0 0 0 +77 116 8 0 0 0 0 0 +77 116 133 0 0 0 0 0 +77 116 84 0 0 0 0 0 +77 116 85 0 0 0 0 0 +77 116 88 0 0 0 0 0 +77 116 113 0 0 0 0 0 +22 116 8 0 0 0 0 0 +22 116 133 0 0 0 0 0 +22 116 84 0 0 0 0 0 +22 116 85 0 0 0 0 0 +22 116 88 0 0 0 0 0 +22 116 113 0 0 0 0 0 +134 116 8 0 0 0 0 0 +134 116 133 0 0 0 0 0 +134 116 84 0 0 0 0 0 +134 116 85 0 0 0 0 0 +134 116 88 0 0 0 0 0 +134 116 113 0 0 0 0 0 +93 116 8 0 0 0 0 0 +93 116 133 0 0 0 0 0 +93 116 84 0 0 0 0 0 +93 116 85 0 0 0 0 0 +93 116 88 0 0 0 0 0 +93 116 113 0 0 0 0 0 +32 116 8 0 0 0 0 0 +32 116 133 0 0 0 0 0 +32 116 84 0 0 0 0 0 +32 116 85 0 0 0 0 0 +32 116 88 0 0 0 0 0 +32 116 113 0 0 0 0 0 +25 33 116 8 0 0 0 0 +25 33 116 133 0 0 0 0 +25 33 116 84 0 0 0 0 +25 33 116 85 0 0 0 0 +25 33 116 88 0 0 0 0 +25 33 116 113 0 0 0 0 +25 75 116 8 0 0 0 0 +25 75 116 133 0 0 0 0 +25 75 116 84 0 0 0 0 +25 75 116 85 0 0 0 0 +25 75 116 88 0 0 0 0 +25 75 116 113 0 0 0 0 +56 6 8 0 0 0 0 0 +56 6 133 0 0 0 0 0 +56 6 84 0 0 0 0 0 +56 6 85 0 0 0 0 0 +56 6 88 0 0 0 0 0 +56 6 113 0 0 0 0 0 +77 6 8 0 0 0 0 0 +77 6 133 0 0 0 0 0 +77 6 84 0 0 0 0 0 +77 6 85 0 0 0 0 0 +77 6 88 0 0 0 0 0 +77 6 113 0 0 0 0 0 +22 6 8 0 0 0 0 0 +22 6 133 0 0 0 0 0 +22 6 84 0 0 0 0 0 +22 6 85 0 0 0 0 0 +22 6 88 0 0 0 0 0 +22 6 113 0 0 0 0 0 +134 6 8 0 0 0 0 0 +134 6 133 0 0 0 0 0 +134 6 84 0 0 0 0 0 +134 6 85 0 0 0 0 0 +134 6 88 0 0 0 0 0 +134 6 113 0 0 0 0 0 +93 6 8 0 0 0 0 0 +93 6 133 0 0 0 0 0 +93 6 84 0 0 0 0 0 +93 6 85 0 0 0 0 0 +93 6 88 0 0 0 0 0 +93 6 113 0 0 0 0 0 +32 6 8 0 0 0 0 0 +32 6 133 0 0 0 0 0 +32 6 84 0 0 0 0 0 +32 6 85 0 0 0 0 0 +32 6 88 0 0 0 0 0 +32 6 113 0 0 0 0 0 +25 33 6 8 0 0 0 0 +25 33 6 133 0 0 0 0 +25 33 6 84 0 0 0 0 +25 33 6 85 0 0 0 0 +25 33 6 88 0 0 0 0 +25 33 6 113 0 0 0 0 +25 75 6 8 0 0 0 0 +25 75 6 133 0 0 0 0 +25 75 6 84 0 0 0 0 +25 75 6 85 0 0 0 0 +25 75 6 88 0 0 0 0 +25 75 6 113 0 0 0 0 +56 147 8 0 0 0 0 0 +56 147 133 0 0 0 0 0 +56 147 84 0 0 0 0 0 +56 147 85 0 0 0 0 0 +56 147 88 0 0 0 0 0 +56 147 113 0 0 0 0 0 +77 147 8 0 0 0 0 0 +77 147 133 0 0 0 0 0 +77 147 84 0 0 0 0 0 +77 147 85 0 0 0 0 0 +77 147 88 0 0 0 0 0 +77 147 113 0 0 0 0 0 +22 147 8 0 0 0 0 0 +22 147 133 0 0 0 0 0 +22 147 84 0 0 0 0 0 +22 147 85 0 0 0 0 0 +22 147 88 0 0 0 0 0 +22 147 113 0 0 0 0 0 +134 147 8 0 0 0 0 0 +134 147 133 0 0 0 0 0 +134 147 84 0 0 0 0 0 +134 147 85 0 0 0 0 0 +134 147 88 0 0 0 0 0 +134 147 113 0 0 0 0 0 +93 147 8 0 0 0 0 0 +93 147 133 0 0 0 0 0 +93 147 84 0 0 0 0 0 +93 147 85 0 0 0 0 0 +93 147 88 0 0 0 0 0 +93 147 113 0 0 0 0 0 +32 147 8 0 0 0 0 0 +32 147 133 0 0 0 0 0 +32 147 84 0 0 0 0 0 +32 147 85 0 0 0 0 0 +32 147 88 0 0 0 0 0 +32 147 113 0 0 0 0 0 +25 33 147 8 0 0 0 0 +25 33 147 133 0 0 0 0 +25 33 147 84 0 0 0 0 +25 33 147 85 0 0 0 0 +25 33 147 88 0 0 0 0 +25 33 147 113 0 0 0 0 +25 75 147 8 0 0 0 0 +25 75 147 133 0 0 0 0 +25 75 147 84 0 0 0 0 +25 75 147 85 0 0 0 0 +25 75 147 88 0 0 0 0 +25 75 147 113 0 0 0 0 +56 44 66 130 66 0 0 0 +56 44 66 130 90 0 0 0 +56 44 66 130 24 0 0 0 +56 44 66 130 95 0 0 0 +56 44 66 130 39 0 0 0 +56 44 66 130 26 0 0 0 +56 44 66 130 25 33 0 0 +56 44 66 130 25 75 0 0 +56 44 90 130 66 0 0 0 +56 44 90 130 90 0 0 0 +56 44 90 130 24 0 0 0 +56 44 90 130 95 0 0 0 +56 44 90 130 39 0 0 0 +56 44 90 130 26 0 0 0 +56 44 90 130 25 33 0 0 +56 44 90 130 25 75 0 0 +56 44 24 130 66 0 0 0 +56 44 24 130 90 0 0 0 +56 44 24 130 24 0 0 0 +56 44 24 130 95 0 0 0 +56 44 24 130 39 0 0 0 +56 44 24 130 26 0 0 0 +56 44 24 130 25 33 0 0 +56 44 24 130 25 75 0 0 +56 44 95 130 66 0 0 0 +56 44 95 130 90 0 0 0 +56 44 95 130 24 0 0 0 +56 44 95 130 95 0 0 0 +56 44 95 130 39 0 0 0 +56 44 95 130 26 0 0 0 +56 44 95 130 25 33 0 0 +56 44 95 130 25 75 0 0 +56 44 39 130 66 0 0 0 +56 44 39 130 90 0 0 0 +56 44 39 130 24 0 0 0 +56 44 39 130 95 0 0 0 +56 44 39 130 39 0 0 0 +56 44 39 130 26 0 0 0 +56 44 39 130 25 33 0 0 +56 44 39 130 25 75 0 0 +56 44 26 130 66 0 0 0 +56 44 26 130 90 0 0 0 +56 44 26 130 24 0 0 0 +56 44 26 130 95 0 0 0 +56 44 26 130 39 0 0 0 +56 44 26 130 26 0 0 0 +56 44 26 130 25 33 0 0 +56 44 26 130 25 75 0 0 +56 44 25 33 130 66 0 0 +56 44 25 33 130 90 0 0 +56 44 25 33 130 24 0 0 +56 44 25 33 130 95 0 0 +56 44 25 33 130 39 0 0 +56 44 25 33 130 26 0 0 +56 44 25 33 130 25 33 0 +56 44 25 33 130 25 75 0 +56 44 25 75 130 66 0 0 +56 44 25 75 130 90 0 0 +56 44 25 75 130 24 0 0 +56 44 25 75 130 95 0 0 +56 44 25 75 130 39 0 0 +56 44 25 75 130 26 0 0 +56 44 25 75 130 25 33 0 +56 44 25 75 130 25 75 0 +77 44 66 130 66 0 0 0 +77 44 66 130 90 0 0 0 +77 44 66 130 24 0 0 0 +77 44 66 130 95 0 0 0 +77 44 66 130 39 0 0 0 +77 44 66 130 26 0 0 0 +77 44 66 130 25 33 0 0 +77 44 66 130 25 75 0 0 +77 44 90 130 66 0 0 0 +77 44 90 130 90 0 0 0 +77 44 90 130 24 0 0 0 +77 44 90 130 95 0 0 0 +77 44 90 130 39 0 0 0 +77 44 90 130 26 0 0 0 +77 44 90 130 25 33 0 0 +77 44 90 130 25 75 0 0 +77 44 24 130 66 0 0 0 +77 44 24 130 90 0 0 0 +77 44 24 130 24 0 0 0 +77 44 24 130 95 0 0 0 +77 44 24 130 39 0 0 0 +77 44 24 130 26 0 0 0 +77 44 24 130 25 33 0 0 +77 44 24 130 25 75 0 0 +77 44 95 130 66 0 0 0 +77 44 95 130 90 0 0 0 +77 44 95 130 24 0 0 0 +77 44 95 130 95 0 0 0 +77 44 95 130 39 0 0 0 +77 44 95 130 26 0 0 0 +77 44 95 130 25 33 0 0 +77 44 95 130 25 75 0 0 +77 44 39 130 66 0 0 0 +77 44 39 130 90 0 0 0 +77 44 39 130 24 0 0 0 +77 44 39 130 95 0 0 0 +77 44 39 130 39 0 0 0 +77 44 39 130 26 0 0 0 +77 44 39 130 25 33 0 0 +77 44 39 130 25 75 0 0 +77 44 26 130 66 0 0 0 +77 44 26 130 90 0 0 0 +77 44 26 130 24 0 0 0 +77 44 26 130 95 0 0 0 +77 44 26 130 39 0 0 0 +77 44 26 130 26 0 0 0 +77 44 26 130 25 33 0 0 +77 44 26 130 25 75 0 0 +77 44 25 33 130 66 0 0 +77 44 25 33 130 90 0 0 +77 44 25 33 130 24 0 0 +77 44 25 33 130 95 0 0 +77 44 25 33 130 39 0 0 +77 44 25 33 130 26 0 0 +77 44 25 33 130 25 33 0 +77 44 25 33 130 25 75 0 +77 44 25 75 130 66 0 0 +77 44 25 75 130 90 0 0 +77 44 25 75 130 24 0 0 +77 44 25 75 130 95 0 0 +77 44 25 75 130 39 0 0 +77 44 25 75 130 26 0 0 +77 44 25 75 130 25 33 0 +77 44 25 75 130 25 75 0 +22 44 66 130 66 0 0 0 +22 44 66 130 90 0 0 0 +22 44 66 130 24 0 0 0 +22 44 66 130 95 0 0 0 +22 44 66 130 39 0 0 0 +22 44 66 130 26 0 0 0 +22 44 66 130 25 33 0 0 +22 44 66 130 25 75 0 0 +22 44 90 130 66 0 0 0 +22 44 90 130 90 0 0 0 +22 44 90 130 24 0 0 0 +22 44 90 130 95 0 0 0 +22 44 90 130 39 0 0 0 +22 44 90 130 26 0 0 0 +22 44 90 130 25 33 0 0 +22 44 90 130 25 75 0 0 +22 44 24 130 66 0 0 0 +22 44 24 130 90 0 0 0 +22 44 24 130 24 0 0 0 +22 44 24 130 95 0 0 0 +22 44 24 130 39 0 0 0 +22 44 24 130 26 0 0 0 +22 44 24 130 25 33 0 0 +22 44 24 130 25 75 0 0 +22 44 95 130 66 0 0 0 +22 44 95 130 90 0 0 0 +22 44 95 130 24 0 0 0 +22 44 95 130 95 0 0 0 +22 44 95 130 39 0 0 0 +22 44 95 130 26 0 0 0 +22 44 95 130 25 33 0 0 +22 44 95 130 25 75 0 0 +22 44 39 130 66 0 0 0 +22 44 39 130 90 0 0 0 +22 44 39 130 24 0 0 0 +22 44 39 130 95 0 0 0 +22 44 39 130 39 0 0 0 +22 44 39 130 26 0 0 0 +22 44 39 130 25 33 0 0 +22 44 39 130 25 75 0 0 +22 44 26 130 66 0 0 0 +22 44 26 130 90 0 0 0 +22 44 26 130 24 0 0 0 +22 44 26 130 95 0 0 0 +22 44 26 130 39 0 0 0 +22 44 26 130 26 0 0 0 +22 44 26 130 25 33 0 0 +22 44 26 130 25 75 0 0 +22 44 25 33 130 66 0 0 +22 44 25 33 130 90 0 0 +22 44 25 33 130 24 0 0 +22 44 25 33 130 95 0 0 +22 44 25 33 130 39 0 0 +22 44 25 33 130 26 0 0 +22 44 25 33 130 25 33 0 +22 44 25 33 130 25 75 0 +22 44 25 75 130 66 0 0 +22 44 25 75 130 90 0 0 +22 44 25 75 130 24 0 0 +22 44 25 75 130 95 0 0 +22 44 25 75 130 39 0 0 +22 44 25 75 130 26 0 0 +22 44 25 75 130 25 33 0 +22 44 25 75 130 25 75 0 +134 44 66 130 66 0 0 0 +134 44 66 130 90 0 0 0 +134 44 66 130 24 0 0 0 +134 44 66 130 95 0 0 0 +134 44 66 130 39 0 0 0 +134 44 66 130 26 0 0 0 +134 44 66 130 25 33 0 0 +134 44 66 130 25 75 0 0 +134 44 90 130 66 0 0 0 +134 44 90 130 90 0 0 0 +134 44 90 130 24 0 0 0 +134 44 90 130 95 0 0 0 +134 44 90 130 39 0 0 0 +134 44 90 130 26 0 0 0 +134 44 90 130 25 33 0 0 +134 44 90 130 25 75 0 0 +134 44 24 130 66 0 0 0 +134 44 24 130 90 0 0 0 +134 44 24 130 24 0 0 0 +134 44 24 130 95 0 0 0 +134 44 24 130 39 0 0 0 +134 44 24 130 26 0 0 0 +134 44 24 130 25 33 0 0 +134 44 24 130 25 75 0 0 +134 44 95 130 66 0 0 0 +134 44 95 130 90 0 0 0 +134 44 95 130 24 0 0 0 +134 44 95 130 95 0 0 0 +134 44 95 130 39 0 0 0 +134 44 95 130 26 0 0 0 +134 44 95 130 25 33 0 0 +134 44 95 130 25 75 0 0 +134 44 39 130 66 0 0 0 +134 44 39 130 90 0 0 0 +134 44 39 130 24 0 0 0 +134 44 39 130 95 0 0 0 +134 44 39 130 39 0 0 0 +134 44 39 130 26 0 0 0 +134 44 39 130 25 33 0 0 +134 44 39 130 25 75 0 0 +134 44 26 130 66 0 0 0 +134 44 26 130 90 0 0 0 +134 44 26 130 24 0 0 0 +134 44 26 130 95 0 0 0 +134 44 26 130 39 0 0 0 +134 44 26 130 26 0 0 0 +134 44 26 130 25 33 0 0 +134 44 26 130 25 75 0 0 +134 44 25 33 130 66 0 0 +134 44 25 33 130 90 0 0 +134 44 25 33 130 24 0 0 +134 44 25 33 130 95 0 0 +134 44 25 33 130 39 0 0 +134 44 25 33 130 26 0 0 +134 44 25 33 130 25 33 0 +134 44 25 33 130 25 75 0 +134 44 25 75 130 66 0 0 +134 44 25 75 130 90 0 0 +134 44 25 75 130 24 0 0 +134 44 25 75 130 95 0 0 +134 44 25 75 130 39 0 0 +134 44 25 75 130 26 0 0 +134 44 25 75 130 25 33 0 +134 44 25 75 130 25 75 0 +93 44 66 130 66 0 0 0 +93 44 66 130 90 0 0 0 +93 44 66 130 24 0 0 0 +93 44 66 130 95 0 0 0 +93 44 66 130 39 0 0 0 +93 44 66 130 26 0 0 0 +93 44 66 130 25 33 0 0 +93 44 66 130 25 75 0 0 +93 44 90 130 66 0 0 0 +93 44 90 130 90 0 0 0 +93 44 90 130 24 0 0 0 +93 44 90 130 95 0 0 0 +93 44 90 130 39 0 0 0 +93 44 90 130 26 0 0 0 +93 44 90 130 25 33 0 0 +93 44 90 130 25 75 0 0 +93 44 24 130 66 0 0 0 +93 44 24 130 90 0 0 0 +93 44 24 130 24 0 0 0 +93 44 24 130 95 0 0 0 +93 44 24 130 39 0 0 0 +93 44 24 130 26 0 0 0 +93 44 24 130 25 33 0 0 +93 44 24 130 25 75 0 0 +93 44 95 130 66 0 0 0 +93 44 95 130 90 0 0 0 +93 44 95 130 24 0 0 0 +93 44 95 130 95 0 0 0 +93 44 95 130 39 0 0 0 +93 44 95 130 26 0 0 0 +93 44 95 130 25 33 0 0 +93 44 95 130 25 75 0 0 +93 44 39 130 66 0 0 0 +93 44 39 130 90 0 0 0 +93 44 39 130 24 0 0 0 +93 44 39 130 95 0 0 0 +93 44 39 130 39 0 0 0 +93 44 39 130 26 0 0 0 +93 44 39 130 25 33 0 0 +93 44 39 130 25 75 0 0 +93 44 26 130 66 0 0 0 +93 44 26 130 90 0 0 0 +93 44 26 130 24 0 0 0 +93 44 26 130 95 0 0 0 +93 44 26 130 39 0 0 0 +93 44 26 130 26 0 0 0 +93 44 26 130 25 33 0 0 +93 44 26 130 25 75 0 0 +93 44 25 33 130 66 0 0 +93 44 25 33 130 90 0 0 +93 44 25 33 130 24 0 0 +93 44 25 33 130 95 0 0 +93 44 25 33 130 39 0 0 +93 44 25 33 130 26 0 0 +93 44 25 33 130 25 33 0 +93 44 25 33 130 25 75 0 +93 44 25 75 130 66 0 0 +93 44 25 75 130 90 0 0 +93 44 25 75 130 24 0 0 +93 44 25 75 130 95 0 0 +93 44 25 75 130 39 0 0 +93 44 25 75 130 26 0 0 +93 44 25 75 130 25 33 0 +93 44 25 75 130 25 75 0 +32 44 66 130 66 0 0 0 +32 44 66 130 90 0 0 0 +32 44 66 130 24 0 0 0 +32 44 66 130 95 0 0 0 +32 44 66 130 39 0 0 0 +32 44 66 130 26 0 0 0 +32 44 66 130 25 33 0 0 +32 44 66 130 25 75 0 0 +32 44 90 130 66 0 0 0 +32 44 90 130 90 0 0 0 +32 44 90 130 24 0 0 0 +32 44 90 130 95 0 0 0 +32 44 90 130 39 0 0 0 +32 44 90 130 26 0 0 0 +32 44 90 130 25 33 0 0 +32 44 90 130 25 75 0 0 +32 44 24 130 66 0 0 0 +32 44 24 130 90 0 0 0 +32 44 24 130 24 0 0 0 +32 44 24 130 95 0 0 0 +32 44 24 130 39 0 0 0 +32 44 24 130 26 0 0 0 +32 44 24 130 25 33 0 0 +32 44 24 130 25 75 0 0 +32 44 95 130 66 0 0 0 +32 44 95 130 90 0 0 0 +32 44 95 130 24 0 0 0 +32 44 95 130 95 0 0 0 +32 44 95 130 39 0 0 0 +32 44 95 130 26 0 0 0 +32 44 95 130 25 33 0 0 +32 44 95 130 25 75 0 0 +32 44 39 130 66 0 0 0 +32 44 39 130 90 0 0 0 +32 44 39 130 24 0 0 0 +32 44 39 130 95 0 0 0 +32 44 39 130 39 0 0 0 +32 44 39 130 26 0 0 0 +32 44 39 130 25 33 0 0 +32 44 39 130 25 75 0 0 +32 44 26 130 66 0 0 0 +32 44 26 130 90 0 0 0 +32 44 26 130 24 0 0 0 +32 44 26 130 95 0 0 0 +32 44 26 130 39 0 0 0 +32 44 26 130 26 0 0 0 +32 44 26 130 25 33 0 0 +32 44 26 130 25 75 0 0 +32 44 25 33 130 66 0 0 +32 44 25 33 130 90 0 0 +32 44 25 33 130 24 0 0 +32 44 25 33 130 95 0 0 +32 44 25 33 130 39 0 0 +32 44 25 33 130 26 0 0 +32 44 25 33 130 25 33 0 +32 44 25 33 130 25 75 0 +32 44 25 75 130 66 0 0 +32 44 25 75 130 90 0 0 +32 44 25 75 130 24 0 0 +32 44 25 75 130 95 0 0 +32 44 25 75 130 39 0 0 +32 44 25 75 130 26 0 0 +32 44 25 75 130 25 33 0 +32 44 25 75 130 25 75 0 +25 33 44 66 130 66 0 0 +25 33 44 66 130 90 0 0 +25 33 44 66 130 24 0 0 +25 33 44 66 130 95 0 0 +25 33 44 66 130 39 0 0 +25 33 44 66 130 26 0 0 +25 33 44 66 130 25 33 0 +25 33 44 66 130 25 75 0 +25 33 44 90 130 66 0 0 +25 33 44 90 130 90 0 0 +25 33 44 90 130 24 0 0 +25 33 44 90 130 95 0 0 +25 33 44 90 130 39 0 0 +25 33 44 90 130 26 0 0 +25 33 44 90 130 25 33 0 +25 33 44 90 130 25 75 0 +25 33 44 24 130 66 0 0 +25 33 44 24 130 90 0 0 +25 33 44 24 130 24 0 0 +25 33 44 24 130 95 0 0 +25 33 44 24 130 39 0 0 +25 33 44 24 130 26 0 0 +25 33 44 24 130 25 33 0 +25 33 44 24 130 25 75 0 +25 33 44 95 130 66 0 0 +25 33 44 95 130 90 0 0 +25 33 44 95 130 24 0 0 +25 33 44 95 130 95 0 0 +25 33 44 95 130 39 0 0 +25 33 44 95 130 26 0 0 +25 33 44 95 130 25 33 0 +25 33 44 95 130 25 75 0 +25 33 44 39 130 66 0 0 +25 33 44 39 130 90 0 0 +25 33 44 39 130 24 0 0 +25 33 44 39 130 95 0 0 +25 33 44 39 130 39 0 0 +25 33 44 39 130 26 0 0 +25 33 44 39 130 25 33 0 +25 33 44 39 130 25 75 0 +25 33 44 26 130 66 0 0 +25 33 44 26 130 90 0 0 +25 33 44 26 130 24 0 0 +25 33 44 26 130 95 0 0 +25 33 44 26 130 39 0 0 +25 33 44 26 130 26 0 0 +25 33 44 26 130 25 33 0 +25 33 44 26 130 25 75 0 +25 33 44 25 33 130 66 0 +25 33 44 25 33 130 90 0 +25 33 44 25 33 130 24 0 +25 33 44 25 33 130 95 0 +25 33 44 25 33 130 39 0 +25 33 44 25 33 130 26 0 +25 33 44 25 75 130 66 0 +25 33 44 25 75 130 90 0 +25 33 44 25 75 130 24 0 +25 33 44 25 75 130 95 0 +25 33 44 25 75 130 39 0 +25 33 44 25 75 130 26 0 +25 75 44 66 130 66 0 0 +25 75 44 66 130 90 0 0 +25 75 44 66 130 24 0 0 +25 75 44 66 130 95 0 0 +25 75 44 66 130 39 0 0 +25 75 44 66 130 26 0 0 +25 75 44 66 130 25 33 0 +25 75 44 66 130 25 75 0 +25 75 44 90 130 66 0 0 +25 75 44 90 130 90 0 0 +25 75 44 90 130 24 0 0 +25 75 44 90 130 95 0 0 +25 75 44 90 130 39 0 0 +25 75 44 90 130 26 0 0 +25 75 44 90 130 25 33 0 +25 75 44 90 130 25 75 0 +25 75 44 24 130 66 0 0 +25 75 44 24 130 90 0 0 +25 75 44 24 130 24 0 0 +25 75 44 24 130 95 0 0 +25 75 44 24 130 39 0 0 +25 75 44 24 130 26 0 0 +25 75 44 24 130 25 33 0 +25 75 44 24 130 25 75 0 +25 75 44 95 130 66 0 0 +25 75 44 95 130 90 0 0 +25 75 44 95 130 24 0 0 +25 75 44 95 130 95 0 0 +25 75 44 95 130 39 0 0 +25 75 44 95 130 26 0 0 +25 75 44 95 130 25 33 0 +25 75 44 95 130 25 75 0 +25 75 44 39 130 66 0 0 +25 75 44 39 130 90 0 0 +25 75 44 39 130 24 0 0 +25 75 44 39 130 95 0 0 +25 75 44 39 130 39 0 0 +25 75 44 39 130 26 0 0 +25 75 44 39 130 25 33 0 +25 75 44 39 130 25 75 0 +25 75 44 26 130 66 0 0 +25 75 44 26 130 90 0 0 +25 75 44 26 130 24 0 0 +25 75 44 26 130 95 0 0 +25 75 44 26 130 39 0 0 +25 75 44 26 130 26 0 0 +25 75 44 26 130 25 33 0 +25 75 44 26 130 25 75 0 +25 75 44 25 33 130 66 0 +25 75 44 25 33 130 90 0 +25 75 44 25 33 130 24 0 +25 75 44 25 33 130 95 0 +25 75 44 25 33 130 39 0 +25 75 44 25 33 130 26 0 +25 75 44 25 75 130 66 0 +25 75 44 25 75 130 90 0 +25 75 44 25 75 130 24 0 +25 75 44 25 75 130 95 0 +25 75 44 25 75 130 39 0 +25 75 44 25 75 130 26 0 +56 135 66 66 0 0 0 0 +56 135 66 90 0 0 0 0 +56 135 66 24 0 0 0 0 +56 135 66 95 0 0 0 0 +56 135 66 39 0 0 0 0 +56 135 66 26 0 0 0 0 +56 135 66 25 33 0 0 0 +56 135 66 25 75 0 0 0 +56 135 90 66 0 0 0 0 +56 135 90 90 0 0 0 0 +56 135 90 24 0 0 0 0 +56 135 90 95 0 0 0 0 +56 135 90 39 0 0 0 0 +56 135 90 26 0 0 0 0 +56 135 90 25 33 0 0 0 +56 135 90 25 75 0 0 0 +56 135 24 66 0 0 0 0 +56 135 24 90 0 0 0 0 +56 135 24 24 0 0 0 0 +56 135 24 95 0 0 0 0 +56 135 24 39 0 0 0 0 +56 135 24 26 0 0 0 0 +56 135 24 25 33 0 0 0 +56 135 24 25 75 0 0 0 +56 135 95 66 0 0 0 0 +56 135 95 90 0 0 0 0 +56 135 95 24 0 0 0 0 +56 135 95 95 0 0 0 0 +56 135 95 39 0 0 0 0 +56 135 95 26 0 0 0 0 +56 135 95 25 33 0 0 0 +56 135 95 25 75 0 0 0 +56 135 39 66 0 0 0 0 +56 135 39 90 0 0 0 0 +56 135 39 24 0 0 0 0 +56 135 39 95 0 0 0 0 +56 135 39 39 0 0 0 0 +56 135 39 26 0 0 0 0 +56 135 39 25 33 0 0 0 +56 135 39 25 75 0 0 0 +56 135 26 66 0 0 0 0 +56 135 26 90 0 0 0 0 +56 135 26 24 0 0 0 0 +56 135 26 95 0 0 0 0 +56 135 26 39 0 0 0 0 +56 135 26 26 0 0 0 0 +56 135 26 25 33 0 0 0 +56 135 26 25 75 0 0 0 +56 135 25 33 66 0 0 0 +56 135 25 33 90 0 0 0 +56 135 25 33 24 0 0 0 +56 135 25 33 95 0 0 0 +56 135 25 33 39 0 0 0 +56 135 25 33 26 0 0 0 +56 135 25 33 25 33 0 0 +56 135 25 33 25 75 0 0 +56 135 25 75 66 0 0 0 +56 135 25 75 90 0 0 0 +56 135 25 75 24 0 0 0 +56 135 25 75 95 0 0 0 +56 135 25 75 39 0 0 0 +56 135 25 75 26 0 0 0 +56 135 25 75 25 33 0 0 +56 135 25 75 25 75 0 0 +77 135 66 66 0 0 0 0 +77 135 66 90 0 0 0 0 +77 135 66 24 0 0 0 0 +77 135 66 95 0 0 0 0 +77 135 66 39 0 0 0 0 +77 135 66 26 0 0 0 0 +77 135 66 25 33 0 0 0 +77 135 66 25 75 0 0 0 +77 135 90 66 0 0 0 0 +77 135 90 90 0 0 0 0 +77 135 90 24 0 0 0 0 +77 135 90 95 0 0 0 0 +77 135 90 39 0 0 0 0 +77 135 90 26 0 0 0 0 +77 135 90 25 33 0 0 0 +77 135 90 25 75 0 0 0 +77 135 24 66 0 0 0 0 +77 135 24 90 0 0 0 0 +77 135 24 24 0 0 0 0 +77 135 24 95 0 0 0 0 +77 135 24 39 0 0 0 0 +77 135 24 26 0 0 0 0 +77 135 24 25 33 0 0 0 +77 135 24 25 75 0 0 0 +77 135 95 66 0 0 0 0 +77 135 95 90 0 0 0 0 +77 135 95 24 0 0 0 0 +77 135 95 95 0 0 0 0 +77 135 95 39 0 0 0 0 +77 135 95 26 0 0 0 0 +77 135 95 25 33 0 0 0 +77 135 95 25 75 0 0 0 +77 135 39 66 0 0 0 0 +77 135 39 90 0 0 0 0 +77 135 39 24 0 0 0 0 +77 135 39 95 0 0 0 0 +77 135 39 39 0 0 0 0 +77 135 39 26 0 0 0 0 +77 135 39 25 33 0 0 0 +77 135 39 25 75 0 0 0 +77 135 26 66 0 0 0 0 +77 135 26 90 0 0 0 0 +77 135 26 24 0 0 0 0 +77 135 26 95 0 0 0 0 +77 135 26 39 0 0 0 0 +77 135 26 26 0 0 0 0 +77 135 26 25 33 0 0 0 +77 135 26 25 75 0 0 0 +77 135 25 33 66 0 0 0 +77 135 25 33 90 0 0 0 +77 135 25 33 24 0 0 0 +77 135 25 33 95 0 0 0 +77 135 25 33 39 0 0 0 +77 135 25 33 26 0 0 0 +77 135 25 33 25 33 0 0 +77 135 25 33 25 75 0 0 +77 135 25 75 66 0 0 0 +77 135 25 75 90 0 0 0 +77 135 25 75 24 0 0 0 +77 135 25 75 95 0 0 0 +77 135 25 75 39 0 0 0 +77 135 25 75 26 0 0 0 +77 135 25 75 25 33 0 0 +77 135 25 75 25 75 0 0 +22 135 66 66 0 0 0 0 +22 135 66 90 0 0 0 0 +22 135 66 24 0 0 0 0 +22 135 66 95 0 0 0 0 +22 135 66 39 0 0 0 0 +22 135 66 26 0 0 0 0 +22 135 66 25 33 0 0 0 +22 135 66 25 75 0 0 0 +22 135 90 66 0 0 0 0 +22 135 90 90 0 0 0 0 +22 135 90 24 0 0 0 0 +22 135 90 95 0 0 0 0 +22 135 90 39 0 0 0 0 +22 135 90 26 0 0 0 0 +22 135 90 25 33 0 0 0 +22 135 90 25 75 0 0 0 +22 135 24 66 0 0 0 0 +22 135 24 90 0 0 0 0 +22 135 24 24 0 0 0 0 +22 135 24 95 0 0 0 0 +22 135 24 39 0 0 0 0 +22 135 24 26 0 0 0 0 +22 135 24 25 33 0 0 0 +22 135 24 25 75 0 0 0 +22 135 95 66 0 0 0 0 +22 135 95 90 0 0 0 0 +22 135 95 24 0 0 0 0 +22 135 95 95 0 0 0 0 +22 135 95 39 0 0 0 0 +22 135 95 26 0 0 0 0 +22 135 95 25 33 0 0 0 +22 135 95 25 75 0 0 0 +22 135 39 66 0 0 0 0 +22 135 39 90 0 0 0 0 +22 135 39 24 0 0 0 0 +22 135 39 95 0 0 0 0 +22 135 39 39 0 0 0 0 +22 135 39 26 0 0 0 0 +22 135 39 25 33 0 0 0 +22 135 39 25 75 0 0 0 +22 135 26 66 0 0 0 0 +22 135 26 90 0 0 0 0 +22 135 26 24 0 0 0 0 +22 135 26 95 0 0 0 0 +22 135 26 39 0 0 0 0 +22 135 26 26 0 0 0 0 +22 135 26 25 33 0 0 0 +22 135 26 25 75 0 0 0 +22 135 25 33 66 0 0 0 +22 135 25 33 90 0 0 0 +22 135 25 33 24 0 0 0 +22 135 25 33 95 0 0 0 +22 135 25 33 39 0 0 0 +22 135 25 33 26 0 0 0 +22 135 25 33 25 33 0 0 +22 135 25 33 25 75 0 0 +22 135 25 75 66 0 0 0 +22 135 25 75 90 0 0 0 +22 135 25 75 24 0 0 0 +22 135 25 75 95 0 0 0 +22 135 25 75 39 0 0 0 +22 135 25 75 26 0 0 0 +22 135 25 75 25 33 0 0 +22 135 25 75 25 75 0 0 +134 135 66 66 0 0 0 0 +134 135 66 90 0 0 0 0 +134 135 66 24 0 0 0 0 +134 135 66 95 0 0 0 0 +134 135 66 39 0 0 0 0 +134 135 66 26 0 0 0 0 +134 135 66 25 33 0 0 0 +134 135 66 25 75 0 0 0 +134 135 90 66 0 0 0 0 +134 135 90 90 0 0 0 0 +134 135 90 24 0 0 0 0 +134 135 90 95 0 0 0 0 +134 135 90 39 0 0 0 0 +134 135 90 26 0 0 0 0 +134 135 90 25 33 0 0 0 +134 135 90 25 75 0 0 0 +134 135 24 66 0 0 0 0 +134 135 24 90 0 0 0 0 +134 135 24 24 0 0 0 0 +134 135 24 95 0 0 0 0 +134 135 24 39 0 0 0 0 +134 135 24 26 0 0 0 0 +134 135 24 25 33 0 0 0 +134 135 24 25 75 0 0 0 +134 135 95 66 0 0 0 0 +134 135 95 90 0 0 0 0 +134 135 95 24 0 0 0 0 +134 135 95 95 0 0 0 0 +134 135 95 39 0 0 0 0 +134 135 95 26 0 0 0 0 +134 135 95 25 33 0 0 0 +134 135 95 25 75 0 0 0 +134 135 39 66 0 0 0 0 +134 135 39 90 0 0 0 0 +134 135 39 24 0 0 0 0 +134 135 39 95 0 0 0 0 +134 135 39 39 0 0 0 0 +134 135 39 26 0 0 0 0 +134 135 39 25 33 0 0 0 +134 135 39 25 75 0 0 0 +134 135 26 66 0 0 0 0 +134 135 26 90 0 0 0 0 +134 135 26 24 0 0 0 0 +134 135 26 95 0 0 0 0 +134 135 26 39 0 0 0 0 +134 135 26 26 0 0 0 0 +134 135 26 25 33 0 0 0 +134 135 26 25 75 0 0 0 +134 135 25 33 66 0 0 0 +134 135 25 33 90 0 0 0 +134 135 25 33 24 0 0 0 +134 135 25 33 95 0 0 0 +134 135 25 33 39 0 0 0 +134 135 25 33 26 0 0 0 +134 135 25 33 25 33 0 0 +134 135 25 33 25 75 0 0 +134 135 25 75 66 0 0 0 +134 135 25 75 90 0 0 0 +134 135 25 75 24 0 0 0 +134 135 25 75 95 0 0 0 +134 135 25 75 39 0 0 0 +134 135 25 75 26 0 0 0 +134 135 25 75 25 33 0 0 +134 135 25 75 25 75 0 0 +93 135 66 66 0 0 0 0 +93 135 66 90 0 0 0 0 +93 135 66 24 0 0 0 0 +93 135 66 95 0 0 0 0 +93 135 66 39 0 0 0 0 +93 135 66 26 0 0 0 0 +93 135 66 25 33 0 0 0 +93 135 66 25 75 0 0 0 +93 135 90 66 0 0 0 0 +93 135 90 90 0 0 0 0 +93 135 90 24 0 0 0 0 +93 135 90 95 0 0 0 0 +93 135 90 39 0 0 0 0 +93 135 90 26 0 0 0 0 +93 135 90 25 33 0 0 0 +93 135 90 25 75 0 0 0 +93 135 24 66 0 0 0 0 +93 135 24 90 0 0 0 0 +93 135 24 24 0 0 0 0 +93 135 24 95 0 0 0 0 +93 135 24 39 0 0 0 0 +93 135 24 26 0 0 0 0 +93 135 24 25 33 0 0 0 +93 135 24 25 75 0 0 0 +93 135 95 66 0 0 0 0 +93 135 95 90 0 0 0 0 +93 135 95 24 0 0 0 0 +93 135 95 95 0 0 0 0 +93 135 95 39 0 0 0 0 +93 135 95 26 0 0 0 0 +93 135 95 25 33 0 0 0 +93 135 95 25 75 0 0 0 +93 135 39 66 0 0 0 0 +93 135 39 90 0 0 0 0 +93 135 39 24 0 0 0 0 +93 135 39 95 0 0 0 0 +93 135 39 39 0 0 0 0 +93 135 39 26 0 0 0 0 +93 135 39 25 33 0 0 0 +93 135 39 25 75 0 0 0 +93 135 26 66 0 0 0 0 +93 135 26 90 0 0 0 0 +93 135 26 24 0 0 0 0 +93 135 26 95 0 0 0 0 +93 135 26 39 0 0 0 0 +93 135 26 26 0 0 0 0 +93 135 26 25 33 0 0 0 +93 135 26 25 75 0 0 0 +93 135 25 33 66 0 0 0 +93 135 25 33 90 0 0 0 +93 135 25 33 24 0 0 0 +93 135 25 33 95 0 0 0 +93 135 25 33 39 0 0 0 +93 135 25 33 26 0 0 0 +93 135 25 33 25 33 0 0 +93 135 25 33 25 75 0 0 +93 135 25 75 66 0 0 0 +93 135 25 75 90 0 0 0 +93 135 25 75 24 0 0 0 +93 135 25 75 95 0 0 0 +93 135 25 75 39 0 0 0 +93 135 25 75 26 0 0 0 +93 135 25 75 25 33 0 0 +93 135 25 75 25 75 0 0 +32 135 66 66 0 0 0 0 +32 135 66 90 0 0 0 0 +32 135 66 24 0 0 0 0 +32 135 66 95 0 0 0 0 +32 135 66 39 0 0 0 0 +32 135 66 26 0 0 0 0 +32 135 66 25 33 0 0 0 +32 135 66 25 75 0 0 0 +32 135 90 66 0 0 0 0 +32 135 90 90 0 0 0 0 +32 135 90 24 0 0 0 0 +32 135 90 95 0 0 0 0 +32 135 90 39 0 0 0 0 +32 135 90 26 0 0 0 0 +32 135 90 25 33 0 0 0 +32 135 90 25 75 0 0 0 +32 135 24 66 0 0 0 0 +32 135 24 90 0 0 0 0 +32 135 24 24 0 0 0 0 +32 135 24 95 0 0 0 0 +32 135 24 39 0 0 0 0 +32 135 24 26 0 0 0 0 +32 135 24 25 33 0 0 0 +32 135 24 25 75 0 0 0 +32 135 95 66 0 0 0 0 +32 135 95 90 0 0 0 0 +32 135 95 24 0 0 0 0 +32 135 95 95 0 0 0 0 +32 135 95 39 0 0 0 0 +32 135 95 26 0 0 0 0 +32 135 95 25 33 0 0 0 +32 135 95 25 75 0 0 0 +32 135 39 66 0 0 0 0 +32 135 39 90 0 0 0 0 +32 135 39 24 0 0 0 0 +32 135 39 95 0 0 0 0 +32 135 39 39 0 0 0 0 +32 135 39 26 0 0 0 0 +32 135 39 25 33 0 0 0 +32 135 39 25 75 0 0 0 +32 135 26 66 0 0 0 0 +32 135 26 90 0 0 0 0 +32 135 26 24 0 0 0 0 +32 135 26 95 0 0 0 0 +32 135 26 39 0 0 0 0 +32 135 26 26 0 0 0 0 +32 135 26 25 33 0 0 0 +32 135 26 25 75 0 0 0 +32 135 25 33 66 0 0 0 +32 135 25 33 90 0 0 0 +32 135 25 33 24 0 0 0 +32 135 25 33 95 0 0 0 +32 135 25 33 39 0 0 0 +32 135 25 33 26 0 0 0 +32 135 25 33 25 33 0 0 +32 135 25 33 25 75 0 0 +32 135 25 75 66 0 0 0 +32 135 25 75 90 0 0 0 +32 135 25 75 24 0 0 0 +32 135 25 75 95 0 0 0 +32 135 25 75 39 0 0 0 +32 135 25 75 26 0 0 0 +32 135 25 75 25 33 0 0 +32 135 25 75 25 75 0 0 +25 33 135 66 66 0 0 0 +25 33 135 66 90 0 0 0 +25 33 135 66 24 0 0 0 +25 33 135 66 95 0 0 0 +25 33 135 66 39 0 0 0 +25 33 135 66 26 0 0 0 +25 33 135 66 25 33 0 0 +25 33 135 66 25 75 0 0 +25 33 135 90 66 0 0 0 +25 33 135 90 90 0 0 0 +25 33 135 90 24 0 0 0 +25 33 135 90 95 0 0 0 +25 33 135 90 39 0 0 0 +25 33 135 90 26 0 0 0 +25 33 135 90 25 33 0 0 +25 33 135 90 25 75 0 0 +25 33 135 24 66 0 0 0 +25 33 135 24 90 0 0 0 +25 33 135 24 24 0 0 0 +25 33 135 24 95 0 0 0 +25 33 135 24 39 0 0 0 +25 33 135 24 26 0 0 0 +25 33 135 24 25 33 0 0 +25 33 135 24 25 75 0 0 +25 33 135 95 66 0 0 0 +25 33 135 95 90 0 0 0 +25 33 135 95 24 0 0 0 +25 33 135 95 95 0 0 0 +25 33 135 95 39 0 0 0 +25 33 135 95 26 0 0 0 +25 33 135 95 25 33 0 0 +25 33 135 95 25 75 0 0 +25 33 135 39 66 0 0 0 +25 33 135 39 90 0 0 0 +25 33 135 39 24 0 0 0 +25 33 135 39 95 0 0 0 +25 33 135 39 39 0 0 0 +25 33 135 39 26 0 0 0 +25 33 135 39 25 33 0 0 +25 33 135 39 25 75 0 0 +25 33 135 26 66 0 0 0 +25 33 135 26 90 0 0 0 +25 33 135 26 24 0 0 0 +25 33 135 26 95 0 0 0 +25 33 135 26 39 0 0 0 +25 33 135 26 26 0 0 0 +25 33 135 26 25 33 0 0 +25 33 135 26 25 75 0 0 +25 33 135 25 33 66 0 0 +25 33 135 25 33 90 0 0 +25 33 135 25 33 24 0 0 +25 33 135 25 33 95 0 0 +25 33 135 25 33 39 0 0 +25 33 135 25 33 26 0 0 +25 33 135 25 75 66 0 0 +25 33 135 25 75 90 0 0 +25 33 135 25 75 24 0 0 +25 33 135 25 75 95 0 0 +25 33 135 25 75 39 0 0 +25 33 135 25 75 26 0 0 +25 75 135 66 66 0 0 0 +25 75 135 66 90 0 0 0 +25 75 135 66 24 0 0 0 +25 75 135 66 95 0 0 0 +25 75 135 66 39 0 0 0 +25 75 135 66 26 0 0 0 +25 75 135 66 25 33 0 0 +25 75 135 66 25 75 0 0 +25 75 135 90 66 0 0 0 +25 75 135 90 90 0 0 0 +25 75 135 90 24 0 0 0 +25 75 135 90 95 0 0 0 +25 75 135 90 39 0 0 0 +25 75 135 90 26 0 0 0 +25 75 135 90 25 33 0 0 +25 75 135 90 25 75 0 0 +25 75 135 24 66 0 0 0 +25 75 135 24 90 0 0 0 +25 75 135 24 24 0 0 0 +25 75 135 24 95 0 0 0 +25 75 135 24 39 0 0 0 +25 75 135 24 26 0 0 0 +25 75 135 24 25 33 0 0 +25 75 135 24 25 75 0 0 +25 75 135 95 66 0 0 0 +25 75 135 95 90 0 0 0 +25 75 135 95 24 0 0 0 +25 75 135 95 95 0 0 0 +25 75 135 95 39 0 0 0 +25 75 135 95 26 0 0 0 +25 75 135 95 25 33 0 0 +25 75 135 95 25 75 0 0 +25 75 135 39 66 0 0 0 +25 75 135 39 90 0 0 0 +25 75 135 39 24 0 0 0 +25 75 135 39 95 0 0 0 +25 75 135 39 39 0 0 0 +25 75 135 39 26 0 0 0 +25 75 135 39 25 33 0 0 +25 75 135 39 25 75 0 0 +25 75 135 26 66 0 0 0 +25 75 135 26 90 0 0 0 +25 75 135 26 24 0 0 0 +25 75 135 26 95 0 0 0 +25 75 135 26 39 0 0 0 +25 75 135 26 26 0 0 0 +25 75 135 26 25 33 0 0 +25 75 135 26 25 75 0 0 +25 75 135 25 33 66 0 0 +25 75 135 25 33 90 0 0 +25 75 135 25 33 24 0 0 +25 75 135 25 33 95 0 0 +25 75 135 25 33 39 0 0 +25 75 135 25 33 26 0 0 +25 75 135 25 75 66 0 0 +25 75 135 25 75 90 0 0 +25 75 135 25 75 24 0 0 +25 75 135 25 75 95 0 0 +25 75 135 25 75 39 0 0 +25 75 135 25 75 26 0 0 +56 44 8 130 66 0 0 0 +56 44 8 130 90 0 0 0 +56 44 8 130 24 0 0 0 +56 44 8 130 95 0 0 0 +56 44 8 130 39 0 0 0 +56 44 8 130 26 0 0 0 +56 44 8 130 25 33 0 0 +56 44 8 130 25 75 0 0 +56 44 133 130 66 0 0 0 +56 44 133 130 90 0 0 0 +56 44 133 130 24 0 0 0 +56 44 133 130 95 0 0 0 +56 44 133 130 39 0 0 0 +56 44 133 130 26 0 0 0 +56 44 133 130 25 33 0 0 +56 44 133 130 25 75 0 0 +56 44 84 130 66 0 0 0 +56 44 84 130 90 0 0 0 +56 44 84 130 24 0 0 0 +56 44 84 130 95 0 0 0 +56 44 84 130 39 0 0 0 +56 44 84 130 26 0 0 0 +56 44 84 130 25 33 0 0 +56 44 84 130 25 75 0 0 +56 44 85 130 66 0 0 0 +56 44 85 130 90 0 0 0 +56 44 85 130 24 0 0 0 +56 44 85 130 95 0 0 0 +56 44 85 130 39 0 0 0 +56 44 85 130 26 0 0 0 +56 44 85 130 25 33 0 0 +56 44 85 130 25 75 0 0 +56 44 88 130 66 0 0 0 +56 44 88 130 90 0 0 0 +56 44 88 130 24 0 0 0 +56 44 88 130 95 0 0 0 +56 44 88 130 39 0 0 0 +56 44 88 130 26 0 0 0 +56 44 88 130 25 33 0 0 +56 44 88 130 25 75 0 0 +56 44 113 130 66 0 0 0 +56 44 113 130 90 0 0 0 +56 44 113 130 24 0 0 0 +56 44 113 130 95 0 0 0 +56 44 113 130 39 0 0 0 +56 44 113 130 26 0 0 0 +56 44 113 130 25 33 0 0 +56 44 113 130 25 75 0 0 +77 44 8 130 66 0 0 0 +77 44 8 130 90 0 0 0 +77 44 8 130 24 0 0 0 +77 44 8 130 95 0 0 0 +77 44 8 130 39 0 0 0 +77 44 8 130 26 0 0 0 +77 44 8 130 25 33 0 0 +77 44 8 130 25 75 0 0 +77 44 133 130 66 0 0 0 +77 44 133 130 90 0 0 0 +77 44 133 130 24 0 0 0 +77 44 133 130 95 0 0 0 +77 44 133 130 39 0 0 0 +77 44 133 130 26 0 0 0 +77 44 133 130 25 33 0 0 +77 44 133 130 25 75 0 0 +77 44 84 130 66 0 0 0 +77 44 84 130 90 0 0 0 +77 44 84 130 24 0 0 0 +77 44 84 130 95 0 0 0 +77 44 84 130 39 0 0 0 +77 44 84 130 26 0 0 0 +77 44 84 130 25 33 0 0 +77 44 84 130 25 75 0 0 +77 44 85 130 66 0 0 0 +77 44 85 130 90 0 0 0 +77 44 85 130 24 0 0 0 +77 44 85 130 95 0 0 0 +77 44 85 130 39 0 0 0 +77 44 85 130 26 0 0 0 +77 44 85 130 25 33 0 0 +77 44 85 130 25 75 0 0 +77 44 88 130 66 0 0 0 +77 44 88 130 90 0 0 0 +77 44 88 130 24 0 0 0 +77 44 88 130 95 0 0 0 +77 44 88 130 39 0 0 0 +77 44 88 130 26 0 0 0 +77 44 88 130 25 33 0 0 +77 44 88 130 25 75 0 0 +77 44 113 130 66 0 0 0 +77 44 113 130 90 0 0 0 +77 44 113 130 24 0 0 0 +77 44 113 130 95 0 0 0 +77 44 113 130 39 0 0 0 +77 44 113 130 26 0 0 0 +77 44 113 130 25 33 0 0 +77 44 113 130 25 75 0 0 +22 44 8 130 66 0 0 0 +22 44 8 130 90 0 0 0 +22 44 8 130 24 0 0 0 +22 44 8 130 95 0 0 0 +22 44 8 130 39 0 0 0 +22 44 8 130 26 0 0 0 +22 44 8 130 25 33 0 0 +22 44 8 130 25 75 0 0 +22 44 133 130 66 0 0 0 +22 44 133 130 90 0 0 0 +22 44 133 130 24 0 0 0 +22 44 133 130 95 0 0 0 +22 44 133 130 39 0 0 0 +22 44 133 130 26 0 0 0 +22 44 133 130 25 33 0 0 +22 44 133 130 25 75 0 0 +22 44 84 130 66 0 0 0 +22 44 84 130 90 0 0 0 +22 44 84 130 24 0 0 0 +22 44 84 130 95 0 0 0 +22 44 84 130 39 0 0 0 +22 44 84 130 26 0 0 0 +22 44 84 130 25 33 0 0 +22 44 84 130 25 75 0 0 +22 44 85 130 66 0 0 0 +22 44 85 130 90 0 0 0 +22 44 85 130 24 0 0 0 +22 44 85 130 95 0 0 0 +22 44 85 130 39 0 0 0 +22 44 85 130 26 0 0 0 +22 44 85 130 25 33 0 0 +22 44 85 130 25 75 0 0 +22 44 88 130 66 0 0 0 +22 44 88 130 90 0 0 0 +22 44 88 130 24 0 0 0 +22 44 88 130 95 0 0 0 +22 44 88 130 39 0 0 0 +22 44 88 130 26 0 0 0 +22 44 88 130 25 33 0 0 +22 44 88 130 25 75 0 0 +22 44 113 130 66 0 0 0 +22 44 113 130 90 0 0 0 +22 44 113 130 24 0 0 0 +22 44 113 130 95 0 0 0 +22 44 113 130 39 0 0 0 +22 44 113 130 26 0 0 0 +22 44 113 130 25 33 0 0 +22 44 113 130 25 75 0 0 +134 44 8 130 66 0 0 0 +134 44 8 130 90 0 0 0 +134 44 8 130 24 0 0 0 +134 44 8 130 95 0 0 0 +134 44 8 130 39 0 0 0 +134 44 8 130 26 0 0 0 +134 44 8 130 25 33 0 0 +134 44 8 130 25 75 0 0 +134 44 133 130 66 0 0 0 +134 44 133 130 90 0 0 0 +134 44 133 130 24 0 0 0 +134 44 133 130 95 0 0 0 +134 44 133 130 39 0 0 0 +134 44 133 130 26 0 0 0 +134 44 133 130 25 33 0 0 +134 44 133 130 25 75 0 0 +134 44 84 130 66 0 0 0 +134 44 84 130 90 0 0 0 +134 44 84 130 24 0 0 0 +134 44 84 130 95 0 0 0 +134 44 84 130 39 0 0 0 +134 44 84 130 26 0 0 0 +134 44 84 130 25 33 0 0 +134 44 84 130 25 75 0 0 +134 44 85 130 66 0 0 0 +134 44 85 130 90 0 0 0 +134 44 85 130 24 0 0 0 +134 44 85 130 95 0 0 0 +134 44 85 130 39 0 0 0 +134 44 85 130 26 0 0 0 +134 44 85 130 25 33 0 0 +134 44 85 130 25 75 0 0 +134 44 88 130 66 0 0 0 +134 44 88 130 90 0 0 0 +134 44 88 130 24 0 0 0 +134 44 88 130 95 0 0 0 +134 44 88 130 39 0 0 0 +134 44 88 130 26 0 0 0 +134 44 88 130 25 33 0 0 +134 44 88 130 25 75 0 0 +134 44 113 130 66 0 0 0 +134 44 113 130 90 0 0 0 +134 44 113 130 24 0 0 0 +134 44 113 130 95 0 0 0 +134 44 113 130 39 0 0 0 +134 44 113 130 26 0 0 0 +134 44 113 130 25 33 0 0 +134 44 113 130 25 75 0 0 +93 44 8 130 66 0 0 0 +93 44 8 130 90 0 0 0 +93 44 8 130 24 0 0 0 +93 44 8 130 95 0 0 0 +93 44 8 130 39 0 0 0 +93 44 8 130 26 0 0 0 +93 44 8 130 25 33 0 0 +93 44 8 130 25 75 0 0 +93 44 133 130 66 0 0 0 +93 44 133 130 90 0 0 0 +93 44 133 130 24 0 0 0 +93 44 133 130 95 0 0 0 +93 44 133 130 39 0 0 0 +93 44 133 130 26 0 0 0 +93 44 133 130 25 33 0 0 +93 44 133 130 25 75 0 0 +93 44 84 130 66 0 0 0 +93 44 84 130 90 0 0 0 +93 44 84 130 24 0 0 0 +93 44 84 130 95 0 0 0 +93 44 84 130 39 0 0 0 +93 44 84 130 26 0 0 0 +93 44 84 130 25 33 0 0 +93 44 84 130 25 75 0 0 +93 44 85 130 66 0 0 0 +93 44 85 130 90 0 0 0 +93 44 85 130 24 0 0 0 +93 44 85 130 95 0 0 0 +93 44 85 130 39 0 0 0 +93 44 85 130 26 0 0 0 +93 44 85 130 25 33 0 0 +93 44 85 130 25 75 0 0 +93 44 88 130 66 0 0 0 +93 44 88 130 90 0 0 0 +93 44 88 130 24 0 0 0 +93 44 88 130 95 0 0 0 +93 44 88 130 39 0 0 0 +93 44 88 130 26 0 0 0 +93 44 88 130 25 33 0 0 +93 44 88 130 25 75 0 0 +93 44 113 130 66 0 0 0 +93 44 113 130 90 0 0 0 +93 44 113 130 24 0 0 0 +93 44 113 130 95 0 0 0 +93 44 113 130 39 0 0 0 +93 44 113 130 26 0 0 0 +93 44 113 130 25 33 0 0 +93 44 113 130 25 75 0 0 +32 44 8 130 66 0 0 0 +32 44 8 130 90 0 0 0 +32 44 8 130 24 0 0 0 +32 44 8 130 95 0 0 0 +32 44 8 130 39 0 0 0 +32 44 8 130 26 0 0 0 +32 44 8 130 25 33 0 0 +32 44 8 130 25 75 0 0 +32 44 133 130 66 0 0 0 +32 44 133 130 90 0 0 0 +32 44 133 130 24 0 0 0 +32 44 133 130 95 0 0 0 +32 44 133 130 39 0 0 0 +32 44 133 130 26 0 0 0 +32 44 133 130 25 33 0 0 +32 44 133 130 25 75 0 0 +32 44 84 130 66 0 0 0 +32 44 84 130 90 0 0 0 +32 44 84 130 24 0 0 0 +32 44 84 130 95 0 0 0 +32 44 84 130 39 0 0 0 +32 44 84 130 26 0 0 0 +32 44 84 130 25 33 0 0 +32 44 84 130 25 75 0 0 +32 44 85 130 66 0 0 0 +32 44 85 130 90 0 0 0 +32 44 85 130 24 0 0 0 +32 44 85 130 95 0 0 0 +32 44 85 130 39 0 0 0 +32 44 85 130 26 0 0 0 +32 44 85 130 25 33 0 0 +32 44 85 130 25 75 0 0 +32 44 88 130 66 0 0 0 +32 44 88 130 90 0 0 0 +32 44 88 130 24 0 0 0 +32 44 88 130 95 0 0 0 +32 44 88 130 39 0 0 0 +32 44 88 130 26 0 0 0 +32 44 88 130 25 33 0 0 +32 44 88 130 25 75 0 0 +32 44 113 130 66 0 0 0 +32 44 113 130 90 0 0 0 +32 44 113 130 24 0 0 0 +32 44 113 130 95 0 0 0 +32 44 113 130 39 0 0 0 +32 44 113 130 26 0 0 0 +32 44 113 130 25 33 0 0 +32 44 113 130 25 75 0 0 +25 33 44 8 130 66 0 0 +25 33 44 8 130 90 0 0 +25 33 44 8 130 24 0 0 +25 33 44 8 130 95 0 0 +25 33 44 8 130 39 0 0 +25 33 44 8 130 26 0 0 +25 33 44 8 130 25 33 0 +25 33 44 8 130 25 75 0 +25 33 44 133 130 66 0 0 +25 33 44 133 130 90 0 0 +25 33 44 133 130 24 0 0 +25 33 44 133 130 95 0 0 +25 33 44 133 130 39 0 0 +25 33 44 133 130 26 0 0 +25 33 44 133 130 25 33 0 +25 33 44 133 130 25 75 0 +25 33 44 84 130 66 0 0 +25 33 44 84 130 90 0 0 +25 33 44 84 130 24 0 0 +25 33 44 84 130 95 0 0 +25 33 44 84 130 39 0 0 +25 33 44 84 130 26 0 0 +25 33 44 84 130 25 33 0 +25 33 44 84 130 25 75 0 +25 33 44 85 130 66 0 0 +25 33 44 85 130 90 0 0 +25 33 44 85 130 24 0 0 +25 33 44 85 130 95 0 0 +25 33 44 85 130 39 0 0 +25 33 44 85 130 26 0 0 +25 33 44 85 130 25 33 0 +25 33 44 85 130 25 75 0 +25 33 44 88 130 66 0 0 +25 33 44 88 130 90 0 0 +25 33 44 88 130 24 0 0 +25 33 44 88 130 95 0 0 +25 33 44 88 130 39 0 0 +25 33 44 88 130 26 0 0 +25 33 44 88 130 25 33 0 +25 33 44 88 130 25 75 0 +25 33 44 113 130 66 0 0 +25 33 44 113 130 90 0 0 +25 33 44 113 130 24 0 0 +25 33 44 113 130 95 0 0 +25 33 44 113 130 39 0 0 +25 33 44 113 130 26 0 0 +25 33 44 113 130 25 33 0 +25 33 44 113 130 25 75 0 +25 75 44 8 130 66 0 0 +25 75 44 8 130 90 0 0 +25 75 44 8 130 24 0 0 +25 75 44 8 130 95 0 0 +25 75 44 8 130 39 0 0 +25 75 44 8 130 26 0 0 +25 75 44 8 130 25 33 0 +25 75 44 8 130 25 75 0 +25 75 44 133 130 66 0 0 +25 75 44 133 130 90 0 0 +25 75 44 133 130 24 0 0 +25 75 44 133 130 95 0 0 +25 75 44 133 130 39 0 0 +25 75 44 133 130 26 0 0 +25 75 44 133 130 25 33 0 +25 75 44 133 130 25 75 0 +25 75 44 84 130 66 0 0 +25 75 44 84 130 90 0 0 +25 75 44 84 130 24 0 0 +25 75 44 84 130 95 0 0 +25 75 44 84 130 39 0 0 +25 75 44 84 130 26 0 0 +25 75 44 84 130 25 33 0 +25 75 44 84 130 25 75 0 +25 75 44 85 130 66 0 0 +25 75 44 85 130 90 0 0 +25 75 44 85 130 24 0 0 +25 75 44 85 130 95 0 0 +25 75 44 85 130 39 0 0 +25 75 44 85 130 26 0 0 +25 75 44 85 130 25 33 0 +25 75 44 85 130 25 75 0 +25 75 44 88 130 66 0 0 +25 75 44 88 130 90 0 0 +25 75 44 88 130 24 0 0 +25 75 44 88 130 95 0 0 +25 75 44 88 130 39 0 0 +25 75 44 88 130 26 0 0 +25 75 44 88 130 25 33 0 +25 75 44 88 130 25 75 0 +25 75 44 113 130 66 0 0 +25 75 44 113 130 90 0 0 +25 75 44 113 130 24 0 0 +25 75 44 113 130 95 0 0 +25 75 44 113 130 39 0 0 +25 75 44 113 130 26 0 0 +25 75 44 113 130 25 33 0 +25 75 44 113 130 25 75 0 +56 135 8 66 0 0 0 0 +56 135 8 90 0 0 0 0 +56 135 8 24 0 0 0 0 +56 135 8 95 0 0 0 0 +56 135 8 39 0 0 0 0 +56 135 8 26 0 0 0 0 +56 135 8 25 33 0 0 0 +56 135 8 25 75 0 0 0 +56 135 133 66 0 0 0 0 +56 135 133 90 0 0 0 0 +56 135 133 24 0 0 0 0 +56 135 133 95 0 0 0 0 +56 135 133 39 0 0 0 0 +56 135 133 26 0 0 0 0 +56 135 133 25 33 0 0 0 +56 135 133 25 75 0 0 0 +56 135 84 66 0 0 0 0 +56 135 84 90 0 0 0 0 +56 135 84 24 0 0 0 0 +56 135 84 95 0 0 0 0 +56 135 84 39 0 0 0 0 +56 135 84 26 0 0 0 0 +56 135 84 25 33 0 0 0 +56 135 84 25 75 0 0 0 +56 135 85 66 0 0 0 0 +56 135 85 90 0 0 0 0 +56 135 85 24 0 0 0 0 +56 135 85 95 0 0 0 0 +56 135 85 39 0 0 0 0 +56 135 85 26 0 0 0 0 +56 135 85 25 33 0 0 0 +56 135 85 25 75 0 0 0 +56 135 88 66 0 0 0 0 +56 135 88 90 0 0 0 0 +56 135 88 24 0 0 0 0 +56 135 88 95 0 0 0 0 +56 135 88 39 0 0 0 0 +56 135 88 26 0 0 0 0 +56 135 88 25 33 0 0 0 +56 135 88 25 75 0 0 0 +56 135 113 66 0 0 0 0 +56 135 113 90 0 0 0 0 +56 135 113 24 0 0 0 0 +56 135 113 95 0 0 0 0 +56 135 113 39 0 0 0 0 +56 135 113 26 0 0 0 0 +56 135 113 25 33 0 0 0 +56 135 113 25 75 0 0 0 +77 135 8 66 0 0 0 0 +77 135 8 90 0 0 0 0 +77 135 8 24 0 0 0 0 +77 135 8 95 0 0 0 0 +77 135 8 39 0 0 0 0 +77 135 8 26 0 0 0 0 +77 135 8 25 33 0 0 0 +77 135 8 25 75 0 0 0 +77 135 133 66 0 0 0 0 +77 135 133 90 0 0 0 0 +77 135 133 24 0 0 0 0 +77 135 133 95 0 0 0 0 +77 135 133 39 0 0 0 0 +77 135 133 26 0 0 0 0 +77 135 133 25 33 0 0 0 +77 135 133 25 75 0 0 0 +77 135 84 66 0 0 0 0 +77 135 84 90 0 0 0 0 +77 135 84 24 0 0 0 0 +77 135 84 95 0 0 0 0 +77 135 84 39 0 0 0 0 +77 135 84 26 0 0 0 0 +77 135 84 25 33 0 0 0 +77 135 84 25 75 0 0 0 +77 135 85 66 0 0 0 0 +77 135 85 90 0 0 0 0 +77 135 85 24 0 0 0 0 +77 135 85 95 0 0 0 0 +77 135 85 39 0 0 0 0 +77 135 85 26 0 0 0 0 +77 135 85 25 33 0 0 0 +77 135 85 25 75 0 0 0 +77 135 88 66 0 0 0 0 +77 135 88 90 0 0 0 0 +77 135 88 24 0 0 0 0 +77 135 88 95 0 0 0 0 +77 135 88 39 0 0 0 0 +77 135 88 26 0 0 0 0 +77 135 88 25 33 0 0 0 +77 135 88 25 75 0 0 0 +77 135 113 66 0 0 0 0 +77 135 113 90 0 0 0 0 +77 135 113 24 0 0 0 0 +77 135 113 95 0 0 0 0 +77 135 113 39 0 0 0 0 +77 135 113 26 0 0 0 0 +77 135 113 25 33 0 0 0 +77 135 113 25 75 0 0 0 +22 135 8 66 0 0 0 0 +22 135 8 90 0 0 0 0 +22 135 8 24 0 0 0 0 +22 135 8 95 0 0 0 0 +22 135 8 39 0 0 0 0 +22 135 8 26 0 0 0 0 +22 135 8 25 33 0 0 0 +22 135 8 25 75 0 0 0 +22 135 133 66 0 0 0 0 +22 135 133 90 0 0 0 0 +22 135 133 24 0 0 0 0 +22 135 133 95 0 0 0 0 +22 135 133 39 0 0 0 0 +22 135 133 26 0 0 0 0 +22 135 133 25 33 0 0 0 +22 135 133 25 75 0 0 0 +22 135 84 66 0 0 0 0 +22 135 84 90 0 0 0 0 +22 135 84 24 0 0 0 0 +22 135 84 95 0 0 0 0 +22 135 84 39 0 0 0 0 +22 135 84 26 0 0 0 0 +22 135 84 25 33 0 0 0 +22 135 84 25 75 0 0 0 +22 135 85 66 0 0 0 0 +22 135 85 90 0 0 0 0 +22 135 85 24 0 0 0 0 +22 135 85 95 0 0 0 0 +22 135 85 39 0 0 0 0 +22 135 85 26 0 0 0 0 +22 135 85 25 33 0 0 0 +22 135 85 25 75 0 0 0 +22 135 88 66 0 0 0 0 +22 135 88 90 0 0 0 0 +22 135 88 24 0 0 0 0 +22 135 88 95 0 0 0 0 +22 135 88 39 0 0 0 0 +22 135 88 26 0 0 0 0 +22 135 88 25 33 0 0 0 +22 135 88 25 75 0 0 0 +22 135 113 66 0 0 0 0 +22 135 113 90 0 0 0 0 +22 135 113 24 0 0 0 0 +22 135 113 95 0 0 0 0 +22 135 113 39 0 0 0 0 +22 135 113 26 0 0 0 0 +22 135 113 25 33 0 0 0 +22 135 113 25 75 0 0 0 +134 135 8 66 0 0 0 0 +134 135 8 90 0 0 0 0 +134 135 8 24 0 0 0 0 +134 135 8 95 0 0 0 0 +134 135 8 39 0 0 0 0 +134 135 8 26 0 0 0 0 +134 135 8 25 33 0 0 0 +134 135 8 25 75 0 0 0 +134 135 133 66 0 0 0 0 +134 135 133 90 0 0 0 0 +134 135 133 24 0 0 0 0 +134 135 133 95 0 0 0 0 +134 135 133 39 0 0 0 0 +134 135 133 26 0 0 0 0 +134 135 133 25 33 0 0 0 +134 135 133 25 75 0 0 0 +134 135 84 66 0 0 0 0 +134 135 84 90 0 0 0 0 +134 135 84 24 0 0 0 0 +134 135 84 95 0 0 0 0 +134 135 84 39 0 0 0 0 +134 135 84 26 0 0 0 0 +134 135 84 25 33 0 0 0 +134 135 84 25 75 0 0 0 +134 135 85 66 0 0 0 0 +134 135 85 90 0 0 0 0 +134 135 85 24 0 0 0 0 +134 135 85 95 0 0 0 0 +134 135 85 39 0 0 0 0 +134 135 85 26 0 0 0 0 +134 135 85 25 33 0 0 0 +134 135 85 25 75 0 0 0 +134 135 88 66 0 0 0 0 +134 135 88 90 0 0 0 0 +134 135 88 24 0 0 0 0 +134 135 88 95 0 0 0 0 +134 135 88 39 0 0 0 0 +134 135 88 26 0 0 0 0 +134 135 88 25 33 0 0 0 +134 135 88 25 75 0 0 0 +134 135 113 66 0 0 0 0 +134 135 113 90 0 0 0 0 +134 135 113 24 0 0 0 0 +134 135 113 95 0 0 0 0 +134 135 113 39 0 0 0 0 +134 135 113 26 0 0 0 0 +134 135 113 25 33 0 0 0 +134 135 113 25 75 0 0 0 +93 135 8 66 0 0 0 0 +93 135 8 90 0 0 0 0 +93 135 8 24 0 0 0 0 +93 135 8 95 0 0 0 0 +93 135 8 39 0 0 0 0 +93 135 8 26 0 0 0 0 +93 135 8 25 33 0 0 0 +93 135 8 25 75 0 0 0 +93 135 133 66 0 0 0 0 +93 135 133 90 0 0 0 0 +93 135 133 24 0 0 0 0 +93 135 133 95 0 0 0 0 +93 135 133 39 0 0 0 0 +93 135 133 26 0 0 0 0 +93 135 133 25 33 0 0 0 +93 135 133 25 75 0 0 0 +93 135 84 66 0 0 0 0 +93 135 84 90 0 0 0 0 +93 135 84 24 0 0 0 0 +93 135 84 95 0 0 0 0 +93 135 84 39 0 0 0 0 +93 135 84 26 0 0 0 0 +93 135 84 25 33 0 0 0 +93 135 84 25 75 0 0 0 +93 135 85 66 0 0 0 0 +93 135 85 90 0 0 0 0 +93 135 85 24 0 0 0 0 +93 135 85 95 0 0 0 0 +93 135 85 39 0 0 0 0 +93 135 85 26 0 0 0 0 +93 135 85 25 33 0 0 0 +93 135 85 25 75 0 0 0 +93 135 88 66 0 0 0 0 +93 135 88 90 0 0 0 0 +93 135 88 24 0 0 0 0 +93 135 88 95 0 0 0 0 +93 135 88 39 0 0 0 0 +93 135 88 26 0 0 0 0 +93 135 88 25 33 0 0 0 +93 135 88 25 75 0 0 0 +93 135 113 66 0 0 0 0 +93 135 113 90 0 0 0 0 +93 135 113 24 0 0 0 0 +93 135 113 95 0 0 0 0 +93 135 113 39 0 0 0 0 +93 135 113 26 0 0 0 0 +93 135 113 25 33 0 0 0 +93 135 113 25 75 0 0 0 +32 135 8 66 0 0 0 0 +32 135 8 90 0 0 0 0 +32 135 8 24 0 0 0 0 +32 135 8 95 0 0 0 0 +32 135 8 39 0 0 0 0 +32 135 8 26 0 0 0 0 +32 135 8 25 33 0 0 0 +32 135 8 25 75 0 0 0 +32 135 133 66 0 0 0 0 +32 135 133 90 0 0 0 0 +32 135 133 24 0 0 0 0 +32 135 133 95 0 0 0 0 +32 135 133 39 0 0 0 0 +32 135 133 26 0 0 0 0 +32 135 133 25 33 0 0 0 +32 135 133 25 75 0 0 0 +32 135 84 66 0 0 0 0 +32 135 84 90 0 0 0 0 +32 135 84 24 0 0 0 0 +32 135 84 95 0 0 0 0 +32 135 84 39 0 0 0 0 +32 135 84 26 0 0 0 0 +32 135 84 25 33 0 0 0 +32 135 84 25 75 0 0 0 +32 135 85 66 0 0 0 0 +32 135 85 90 0 0 0 0 +32 135 85 24 0 0 0 0 +32 135 85 95 0 0 0 0 +32 135 85 39 0 0 0 0 +32 135 85 26 0 0 0 0 +32 135 85 25 33 0 0 0 +32 135 85 25 75 0 0 0 +32 135 88 66 0 0 0 0 +32 135 88 90 0 0 0 0 +32 135 88 24 0 0 0 0 +32 135 88 95 0 0 0 0 +32 135 88 39 0 0 0 0 +32 135 88 26 0 0 0 0 +32 135 88 25 33 0 0 0 +32 135 88 25 75 0 0 0 +32 135 113 66 0 0 0 0 +32 135 113 90 0 0 0 0 +32 135 113 24 0 0 0 0 +32 135 113 95 0 0 0 0 +32 135 113 39 0 0 0 0 +32 135 113 26 0 0 0 0 +32 135 113 25 33 0 0 0 +32 135 113 25 75 0 0 0 +25 33 135 8 66 0 0 0 +25 33 135 8 90 0 0 0 +25 33 135 8 24 0 0 0 +25 33 135 8 95 0 0 0 +25 33 135 8 39 0 0 0 +25 33 135 8 26 0 0 0 +25 33 135 8 25 33 0 0 +25 33 135 8 25 75 0 0 +25 33 135 133 66 0 0 0 +25 33 135 133 90 0 0 0 +25 33 135 133 24 0 0 0 +25 33 135 133 95 0 0 0 +25 33 135 133 39 0 0 0 +25 33 135 133 26 0 0 0 +25 33 135 133 25 33 0 0 +25 33 135 133 25 75 0 0 +25 33 135 84 66 0 0 0 +25 33 135 84 90 0 0 0 +25 33 135 84 24 0 0 0 +25 33 135 84 95 0 0 0 +25 33 135 84 39 0 0 0 +25 33 135 84 26 0 0 0 +25 33 135 84 25 33 0 0 +25 33 135 84 25 75 0 0 +25 33 135 85 66 0 0 0 +25 33 135 85 90 0 0 0 +25 33 135 85 24 0 0 0 +25 33 135 85 95 0 0 0 +25 33 135 85 39 0 0 0 +25 33 135 85 26 0 0 0 +25 33 135 85 25 33 0 0 +25 33 135 85 25 75 0 0 +25 33 135 88 66 0 0 0 +25 33 135 88 90 0 0 0 +25 33 135 88 24 0 0 0 +25 33 135 88 95 0 0 0 +25 33 135 88 39 0 0 0 +25 33 135 88 26 0 0 0 +25 33 135 88 25 33 0 0 +25 33 135 88 25 75 0 0 +25 33 135 113 66 0 0 0 +25 33 135 113 90 0 0 0 +25 33 135 113 24 0 0 0 +25 33 135 113 95 0 0 0 +25 33 135 113 39 0 0 0 +25 33 135 113 26 0 0 0 +25 33 135 113 25 33 0 0 +25 33 135 113 25 75 0 0 +25 75 135 8 66 0 0 0 +25 75 135 8 90 0 0 0 +25 75 135 8 24 0 0 0 +25 75 135 8 95 0 0 0 +25 75 135 8 39 0 0 0 +25 75 135 8 26 0 0 0 +25 75 135 8 25 33 0 0 +25 75 135 8 25 75 0 0 +25 75 135 133 66 0 0 0 +25 75 135 133 90 0 0 0 +25 75 135 133 24 0 0 0 +25 75 135 133 95 0 0 0 +25 75 135 133 39 0 0 0 +25 75 135 133 26 0 0 0 +25 75 135 133 25 33 0 0 +25 75 135 133 25 75 0 0 +25 75 135 84 66 0 0 0 +25 75 135 84 90 0 0 0 +25 75 135 84 24 0 0 0 +25 75 135 84 95 0 0 0 +25 75 135 84 39 0 0 0 +25 75 135 84 26 0 0 0 +25 75 135 84 25 33 0 0 +25 75 135 84 25 75 0 0 +25 75 135 85 66 0 0 0 +25 75 135 85 90 0 0 0 +25 75 135 85 24 0 0 0 +25 75 135 85 95 0 0 0 +25 75 135 85 39 0 0 0 +25 75 135 85 26 0 0 0 +25 75 135 85 25 33 0 0 +25 75 135 85 25 75 0 0 +25 75 135 88 66 0 0 0 +25 75 135 88 90 0 0 0 +25 75 135 88 24 0 0 0 +25 75 135 88 95 0 0 0 +25 75 135 88 39 0 0 0 +25 75 135 88 26 0 0 0 +25 75 135 88 25 33 0 0 +25 75 135 88 25 75 0 0 +25 75 135 113 66 0 0 0 +25 75 135 113 90 0 0 0 +25 75 135 113 24 0 0 0 +25 75 135 113 95 0 0 0 +25 75 135 113 39 0 0 0 +25 75 135 113 26 0 0 0 +25 75 135 113 25 33 0 0 +25 75 135 113 25 75 0 0 +125 76 7 0 0 0 0 0 +129 76 7 0 0 0 0 0 +125 76 10 0 0 0 0 0 +129 76 10 0 0 0 0 0 +125 76 16 0 0 0 0 0 +129 76 16 0 0 0 0 0 +125 76 47 0 0 0 0 0 +129 76 47 0 0 0 0 0 +125 76 68 0 0 0 0 0 +129 76 68 0 0 0 0 0 +125 76 98 0 0 0 0 0 +129 76 98 0 0 0 0 0 +125 76 117 0 0 0 0 0 +129 76 117 0 0 0 0 0 +125 76 143 0 0 0 0 0 +129 76 143 0 0 0 0 0 +125 76 145 0 0 0 0 0 +129 76 145 0 0 0 0 0 +125 76 21 0 0 0 0 0 +129 76 21 0 0 0 0 0 +125 76 23 0 0 0 0 0 +129 76 23 0 0 0 0 0 +125 76 72 0 0 0 0 0 +129 76 72 0 0 0 0 0 +125 76 81 0 0 0 0 0 +129 76 81 0 0 0 0 0 +125 76 108 0 0 0 0 0 +129 76 108 0 0 0 0 0 +125 15 61 0 0 0 0 0 +125 15 127 0 0 0 0 0 +129 15 61 0 0 0 0 0 +129 15 127 0 0 0 0 0 +125 115 61 0 0 0 0 0 +125 115 127 0 0 0 0 0 +129 115 61 0 0 0 0 0 +129 115 127 0 0 0 0 0 +125 140 61 0 0 0 0 0 +125 140 127 0 0 0 0 0 +129 140 61 0 0 0 0 0 +129 140 127 0 0 0 0 0 +125 20 61 0 0 0 0 0 +125 20 127 0 0 0 0 0 +129 20 61 0 0 0 0 0 +129 20 127 0 0 0 0 0 +125 74 61 0 0 0 0 0 +125 74 127 0 0 0 0 0 +129 74 61 0 0 0 0 0 +129 74 127 0 0 0 0 0 +125 29 125 61 0 0 0 0 +125 29 125 127 0 0 0 0 +125 29 129 61 0 0 0 0 +125 29 129 127 0 0 0 0 +129 29 125 61 0 0 0 0 +129 29 125 127 0 0 0 0 +129 29 129 61 0 0 0 0 +129 29 129 127 0 0 0 0 +125 38 125 61 0 0 0 0 +125 38 125 127 0 0 0 0 +125 38 129 61 0 0 0 0 +125 38 129 127 0 0 0 0 +129 38 125 61 0 0 0 0 +129 38 125 127 0 0 0 0 +129 38 129 61 0 0 0 0 +129 38 129 127 0 0 0 0 +125 58 125 61 0 0 0 0 +125 58 125 127 0 0 0 0 +125 58 129 61 0 0 0 0 +125 58 129 127 0 0 0 0 +129 58 125 61 0 0 0 0 +129 58 125 127 0 0 0 0 +129 58 129 61 0 0 0 0 +129 58 129 127 0 0 0 0 +125 104 125 61 0 0 0 0 +125 104 125 127 0 0 0 0 +125 104 129 61 0 0 0 0 +125 104 129 127 0 0 0 0 +129 104 125 61 0 0 0 0 +129 104 125 127 0 0 0 0 +129 104 129 61 0 0 0 0 +129 104 129 127 0 0 0 0 +125 18 144 125 61 0 0 0 +125 18 144 125 127 0 0 0 +125 18 144 129 61 0 0 0 +125 18 144 129 127 0 0 0 +129 18 144 125 61 0 0 0 +129 18 144 125 127 0 0 0 +129 18 144 129 61 0 0 0 +129 18 144 129 127 0 0 0 +125 31 125 61 0 0 0 0 +125 31 125 127 0 0 0 0 +125 31 129 61 0 0 0 0 +125 31 129 127 0 0 0 0 +129 31 125 61 0 0 0 0 +129 31 125 127 0 0 0 0 +129 31 129 61 0 0 0 0 +129 31 129 127 0 0 0 0 +125 92 125 61 0 0 0 0 +125 92 125 127 0 0 0 0 +125 92 129 61 0 0 0 0 +125 92 129 127 0 0 0 0 +129 92 125 61 0 0 0 0 +129 92 125 127 0 0 0 0 +129 92 129 61 0 0 0 0 +129 92 129 127 0 0 0 0 +125 97 125 61 0 0 0 0 +125 97 125 127 0 0 0 0 +125 97 129 61 0 0 0 0 +125 97 129 127 0 0 0 0 +129 97 125 61 0 0 0 0 +129 97 125 127 0 0 0 0 +129 97 129 61 0 0 0 0 +129 97 129 127 0 0 0 0 +125 76 125 0 0 0 0 0 +129 76 125 0 0 0 0 0 +125 76 129 0 0 0 0 0 +129 76 129 0 0 0 0 0 +125 15 0 0 0 0 0 0 +129 15 0 0 0 0 0 0 +125 115 0 0 0 0 0 0 +129 115 0 0 0 0 0 0 +125 140 0 0 0 0 0 0 +129 140 0 0 0 0 0 0 +125 20 0 0 0 0 0 0 +129 20 0 0 0 0 0 0 +125 74 0 0 0 0 0 0 +129 74 0 0 0 0 0 0 +125 29 125 0 0 0 0 0 +125 29 129 0 0 0 0 0 +129 29 125 0 0 0 0 0 +129 29 129 0 0 0 0 0 +125 38 125 0 0 0 0 0 +125 38 129 0 0 0 0 0 +129 38 125 0 0 0 0 0 +129 38 129 0 0 0 0 0 +125 58 125 0 0 0 0 0 +125 58 129 0 0 0 0 0 +129 58 125 0 0 0 0 0 +129 58 129 0 0 0 0 0 +125 104 125 0 0 0 0 0 +125 104 129 0 0 0 0 0 +129 104 125 0 0 0 0 0 +129 104 129 0 0 0 0 0 +125 18 144 125 0 0 0 0 +125 18 144 129 0 0 0 0 +129 18 144 125 0 0 0 0 +129 18 144 129 0 0 0 0 +125 31 125 0 0 0 0 0 +125 31 129 0 0 0 0 0 +129 31 125 0 0 0 0 0 +129 31 129 0 0 0 0 0 +125 92 125 0 0 0 0 0 +125 92 129 0 0 0 0 0 +129 92 125 0 0 0 0 0 +129 92 129 0 0 0 0 0 +125 97 125 0 0 0 0 0 +125 97 129 0 0 0 0 0 +129 97 125 0 0 0 0 0 +129 97 129 0 0 0 0 0 +125 46 125 131 125 0 0 0 +125 46 125 131 129 0 0 0 +125 46 129 131 125 0 0 0 +125 46 129 131 129 0 0 0 +129 46 125 131 125 0 0 0 +129 46 125 131 129 0 0 0 +129 46 129 131 125 0 0 0 +129 46 129 131 129 0 0 0 +125 107 125 125 0 0 0 0 +125 107 125 129 0 0 0 0 +125 107 129 125 0 0 0 0 +125 107 129 129 0 0 0 0 +129 107 125 125 0 0 0 0 +129 107 125 129 0 0 0 0 +129 107 129 125 0 0 0 0 +129 107 129 129 0 0 0 0 +60 76 7 0 0 0 0 0 +1 3 7 0 0 0 0 0 +128 5 7 0 0 0 0 0 +142 5 7 0 0 0 0 0 +146 5 7 0 0 0 0 0 +146 5 7 0 0 0 0 0 +60 76 10 0 0 0 0 0 +1 3 10 0 0 0 0 0 +128 5 10 0 0 0 0 0 +142 5 10 0 0 0 0 0 +146 5 10 0 0 0 0 0 +146 5 10 0 0 0 0 0 +60 76 16 0 0 0 0 0 +1 3 16 0 0 0 0 0 +128 5 16 0 0 0 0 0 +142 5 16 0 0 0 0 0 +146 5 16 0 0 0 0 0 +146 5 16 0 0 0 0 0 +60 76 47 0 0 0 0 0 +1 3 47 0 0 0 0 0 +128 5 47 0 0 0 0 0 +142 5 47 0 0 0 0 0 +146 5 47 0 0 0 0 0 +146 5 47 0 0 0 0 0 +60 76 68 0 0 0 0 0 +1 3 68 0 0 0 0 0 +128 5 68 0 0 0 0 0 +142 5 68 0 0 0 0 0 +146 5 68 0 0 0 0 0 +146 5 68 0 0 0 0 0 +60 76 98 0 0 0 0 0 +1 3 98 0 0 0 0 0 +128 5 98 0 0 0 0 0 +142 5 98 0 0 0 0 0 +146 5 98 0 0 0 0 0 +146 5 98 0 0 0 0 0 +60 76 117 0 0 0 0 0 +1 3 117 0 0 0 0 0 +128 5 117 0 0 0 0 0 +142 5 117 0 0 0 0 0 +146 5 117 0 0 0 0 0 +146 5 117 0 0 0 0 0 +60 76 143 0 0 0 0 0 +1 3 143 0 0 0 0 0 +128 5 143 0 0 0 0 0 +142 5 143 0 0 0 0 0 +146 5 143 0 0 0 0 0 +146 5 143 0 0 0 0 0 +60 76 145 0 0 0 0 0 +1 3 145 0 0 0 0 0 +128 5 145 0 0 0 0 0 +142 5 145 0 0 0 0 0 +146 5 145 0 0 0 0 0 +146 5 145 0 0 0 0 0 +60 76 21 0 0 0 0 0 +1 3 21 0 0 0 0 0 +128 5 21 0 0 0 0 0 +142 5 21 0 0 0 0 0 +146 5 21 0 0 0 0 0 +146 5 21 0 0 0 0 0 +60 76 23 0 0 0 0 0 +1 3 23 0 0 0 0 0 +128 5 23 0 0 0 0 0 +142 5 23 0 0 0 0 0 +146 5 23 0 0 0 0 0 +146 5 23 0 0 0 0 0 +60 76 72 0 0 0 0 0 +1 3 72 0 0 0 0 0 +128 5 72 0 0 0 0 0 +142 5 72 0 0 0 0 0 +146 5 72 0 0 0 0 0 +146 5 72 0 0 0 0 0 +60 76 81 0 0 0 0 0 +1 3 81 0 0 0 0 0 +128 5 81 0 0 0 0 0 +142 5 81 0 0 0 0 0 +146 5 81 0 0 0 0 0 +146 5 81 0 0 0 0 0 +60 76 108 0 0 0 0 0 +1 3 108 0 0 0 0 0 +128 5 108 0 0 0 0 0 +142 5 108 0 0 0 0 0 +146 5 108 0 0 0 0 0 +146 5 108 0 0 0 0 0 +60 15 61 0 0 0 0 0 +60 15 127 0 0 0 0 0 +1 14 61 0 0 0 0 0 +1 14 127 0 0 0 0 0 +128 14 61 0 0 0 0 0 +128 14 127 0 0 0 0 0 +142 14 61 0 0 0 0 0 +142 14 127 0 0 0 0 0 +146 14 61 0 0 0 0 0 +146 14 127 0 0 0 0 0 +146 14 61 0 0 0 0 0 +146 14 127 0 0 0 0 0 +60 115 61 0 0 0 0 0 +60 115 127 0 0 0 0 0 +1 114 61 0 0 0 0 0 +1 114 127 0 0 0 0 0 +128 114 61 0 0 0 0 0 +128 114 127 0 0 0 0 0 +142 114 61 0 0 0 0 0 +142 114 127 0 0 0 0 0 +146 114 61 0 0 0 0 0 +146 114 127 0 0 0 0 0 +146 114 61 0 0 0 0 0 +146 114 127 0 0 0 0 0 +60 140 61 0 0 0 0 0 +60 140 127 0 0 0 0 0 +1 139 61 0 0 0 0 0 +1 139 127 0 0 0 0 0 +128 139 61 0 0 0 0 0 +128 139 127 0 0 0 0 0 +142 139 61 0 0 0 0 0 +142 139 127 0 0 0 0 0 +146 139 61 0 0 0 0 0 +146 139 127 0 0 0 0 0 +146 139 61 0 0 0 0 0 +146 139 127 0 0 0 0 0 +60 20 61 0 0 0 0 0 +60 20 127 0 0 0 0 0 +1 19 61 0 0 0 0 0 +1 19 127 0 0 0 0 0 +128 19 61 0 0 0 0 0 +128 19 127 0 0 0 0 0 +142 19 61 0 0 0 0 0 +142 19 127 0 0 0 0 0 +146 19 61 0 0 0 0 0 +146 19 127 0 0 0 0 0 +146 19 61 0 0 0 0 0 +146 19 127 0 0 0 0 0 +60 74 61 0 0 0 0 0 +60 74 127 0 0 0 0 0 +1 73 61 0 0 0 0 0 +1 73 127 0 0 0 0 0 +128 73 61 0 0 0 0 0 +128 73 127 0 0 0 0 0 +142 73 61 0 0 0 0 0 +142 73 127 0 0 0 0 0 +146 73 61 0 0 0 0 0 +146 73 127 0 0 0 0 0 +146 73 61 0 0 0 0 0 +146 73 127 0 0 0 0 0 +60 29 65 61 0 0 0 0 +60 29 65 127 0 0 0 0 +60 29 86 61 0 0 0 0 +60 29 86 127 0 0 0 0 +60 29 126 61 0 0 0 0 +60 29 126 127 0 0 0 0 +60 29 132 61 0 0 0 0 +60 29 132 127 0 0 0 0 +60 29 146 61 0 0 0 0 +60 29 146 127 0 0 0 0 +60 29 146 61 0 0 0 0 +60 29 146 127 0 0 0 0 +60 29 125 61 0 0 0 0 +60 29 125 127 0 0 0 0 +60 29 129 61 0 0 0 0 +60 29 129 127 0 0 0 0 +1 28 65 61 0 0 0 0 +1 28 65 127 0 0 0 0 +1 28 86 61 0 0 0 0 +1 28 86 127 0 0 0 0 +1 28 126 61 0 0 0 0 +1 28 126 127 0 0 0 0 +1 28 132 61 0 0 0 0 +1 28 132 127 0 0 0 0 +1 28 146 61 0 0 0 0 +1 28 146 127 0 0 0 0 +1 28 146 61 0 0 0 0 +1 28 146 127 0 0 0 0 +1 28 125 61 0 0 0 0 +1 28 125 127 0 0 0 0 +1 28 129 61 0 0 0 0 +1 28 129 127 0 0 0 0 +128 28 65 61 0 0 0 0 +128 28 65 127 0 0 0 0 +128 28 86 61 0 0 0 0 +128 28 86 127 0 0 0 0 +128 28 126 61 0 0 0 0 +128 28 126 127 0 0 0 0 +128 28 132 61 0 0 0 0 +128 28 132 127 0 0 0 0 +128 28 146 61 0 0 0 0 +128 28 146 127 0 0 0 0 +128 28 146 61 0 0 0 0 +128 28 146 127 0 0 0 0 +128 28 125 61 0 0 0 0 +128 28 125 127 0 0 0 0 +128 28 129 61 0 0 0 0 +128 28 129 127 0 0 0 0 +142 28 65 61 0 0 0 0 +142 28 65 127 0 0 0 0 +142 28 86 61 0 0 0 0 +142 28 86 127 0 0 0 0 +142 28 126 61 0 0 0 0 +142 28 126 127 0 0 0 0 +142 28 132 61 0 0 0 0 +142 28 132 127 0 0 0 0 +142 28 146 61 0 0 0 0 +142 28 146 127 0 0 0 0 +142 28 146 61 0 0 0 0 +142 28 146 127 0 0 0 0 +142 28 125 61 0 0 0 0 +142 28 125 127 0 0 0 0 +142 28 129 61 0 0 0 0 +142 28 129 127 0 0 0 0 +146 28 65 61 0 0 0 0 +146 28 65 127 0 0 0 0 +146 28 86 61 0 0 0 0 +146 28 86 127 0 0 0 0 +146 28 126 61 0 0 0 0 +146 28 126 127 0 0 0 0 +146 28 132 61 0 0 0 0 +146 28 132 127 0 0 0 0 +146 28 146 61 0 0 0 0 +146 28 146 127 0 0 0 0 +146 28 146 61 0 0 0 0 +146 28 146 127 0 0 0 0 +146 28 125 61 0 0 0 0 +146 28 125 127 0 0 0 0 +146 28 129 61 0 0 0 0 +146 28 129 127 0 0 0 0 +146 28 65 61 0 0 0 0 +146 28 65 127 0 0 0 0 +146 28 86 61 0 0 0 0 +146 28 86 127 0 0 0 0 +146 28 126 61 0 0 0 0 +146 28 126 127 0 0 0 0 +146 28 132 61 0 0 0 0 +146 28 132 127 0 0 0 0 +146 28 146 61 0 0 0 0 +146 28 146 127 0 0 0 0 +146 28 146 61 0 0 0 0 +146 28 146 127 0 0 0 0 +146 28 125 61 0 0 0 0 +146 28 125 127 0 0 0 0 +146 28 129 61 0 0 0 0 +146 28 129 127 0 0 0 0 +125 29 65 61 0 0 0 0 +125 29 65 127 0 0 0 0 +125 29 86 61 0 0 0 0 +125 29 86 127 0 0 0 0 +125 29 126 61 0 0 0 0 +125 29 126 127 0 0 0 0 +125 29 132 61 0 0 0 0 +125 29 132 127 0 0 0 0 +125 29 146 61 0 0 0 0 +125 29 146 127 0 0 0 0 +125 29 146 61 0 0 0 0 +125 29 146 127 0 0 0 0 +129 29 65 61 0 0 0 0 +129 29 65 127 0 0 0 0 +129 29 86 61 0 0 0 0 +129 29 86 127 0 0 0 0 +129 29 126 61 0 0 0 0 +129 29 126 127 0 0 0 0 +129 29 132 61 0 0 0 0 +129 29 132 127 0 0 0 0 +129 29 146 61 0 0 0 0 +129 29 146 127 0 0 0 0 +129 29 146 61 0 0 0 0 +129 29 146 127 0 0 0 0 +60 38 65 61 0 0 0 0 +60 38 65 127 0 0 0 0 +60 38 86 61 0 0 0 0 +60 38 86 127 0 0 0 0 +60 38 126 61 0 0 0 0 +60 38 126 127 0 0 0 0 +60 38 132 61 0 0 0 0 +60 38 132 127 0 0 0 0 +60 38 146 61 0 0 0 0 +60 38 146 127 0 0 0 0 +60 38 146 61 0 0 0 0 +60 38 146 127 0 0 0 0 +60 38 125 61 0 0 0 0 +60 38 125 127 0 0 0 0 +60 38 129 61 0 0 0 0 +60 38 129 127 0 0 0 0 +1 37 65 61 0 0 0 0 +1 37 65 127 0 0 0 0 +1 37 86 61 0 0 0 0 +1 37 86 127 0 0 0 0 +1 37 126 61 0 0 0 0 +1 37 126 127 0 0 0 0 +1 37 132 61 0 0 0 0 +1 37 132 127 0 0 0 0 +1 37 146 61 0 0 0 0 +1 37 146 127 0 0 0 0 +1 37 146 61 0 0 0 0 +1 37 146 127 0 0 0 0 +1 37 125 61 0 0 0 0 +1 37 125 127 0 0 0 0 +1 37 129 61 0 0 0 0 +1 37 129 127 0 0 0 0 +128 37 65 61 0 0 0 0 +128 37 65 127 0 0 0 0 +128 37 86 61 0 0 0 0 +128 37 86 127 0 0 0 0 +128 37 126 61 0 0 0 0 +128 37 126 127 0 0 0 0 +128 37 132 61 0 0 0 0 +128 37 132 127 0 0 0 0 +128 37 146 61 0 0 0 0 +128 37 146 127 0 0 0 0 +128 37 146 61 0 0 0 0 +128 37 146 127 0 0 0 0 +128 37 125 61 0 0 0 0 +128 37 125 127 0 0 0 0 +128 37 129 61 0 0 0 0 +128 37 129 127 0 0 0 0 +142 37 65 61 0 0 0 0 +142 37 65 127 0 0 0 0 +142 37 86 61 0 0 0 0 +142 37 86 127 0 0 0 0 +142 37 126 61 0 0 0 0 +142 37 126 127 0 0 0 0 +142 37 132 61 0 0 0 0 +142 37 132 127 0 0 0 0 +142 37 146 61 0 0 0 0 +142 37 146 127 0 0 0 0 +142 37 146 61 0 0 0 0 +142 37 146 127 0 0 0 0 +142 37 125 61 0 0 0 0 +142 37 125 127 0 0 0 0 +142 37 129 61 0 0 0 0 +142 37 129 127 0 0 0 0 +146 37 65 61 0 0 0 0 +146 37 65 127 0 0 0 0 +146 37 86 61 0 0 0 0 +146 37 86 127 0 0 0 0 +146 37 126 61 0 0 0 0 +146 37 126 127 0 0 0 0 +146 37 132 61 0 0 0 0 +146 37 132 127 0 0 0 0 +146 37 146 61 0 0 0 0 +146 37 146 127 0 0 0 0 +146 37 146 61 0 0 0 0 +146 37 146 127 0 0 0 0 +146 37 125 61 0 0 0 0 +146 37 125 127 0 0 0 0 +146 37 129 61 0 0 0 0 +146 37 129 127 0 0 0 0 +146 37 65 61 0 0 0 0 +146 37 65 127 0 0 0 0 +146 37 86 61 0 0 0 0 +146 37 86 127 0 0 0 0 +146 37 126 61 0 0 0 0 +146 37 126 127 0 0 0 0 +146 37 132 61 0 0 0 0 +146 37 132 127 0 0 0 0 +146 37 146 61 0 0 0 0 +146 37 146 127 0 0 0 0 +146 37 146 61 0 0 0 0 +146 37 146 127 0 0 0 0 +146 37 125 61 0 0 0 0 +146 37 125 127 0 0 0 0 +146 37 129 61 0 0 0 0 +146 37 129 127 0 0 0 0 +125 38 65 61 0 0 0 0 +125 38 65 127 0 0 0 0 +125 38 86 61 0 0 0 0 +125 38 86 127 0 0 0 0 +125 38 126 61 0 0 0 0 +125 38 126 127 0 0 0 0 +125 38 132 61 0 0 0 0 +125 38 132 127 0 0 0 0 +125 38 146 61 0 0 0 0 +125 38 146 127 0 0 0 0 +125 38 146 61 0 0 0 0 +125 38 146 127 0 0 0 0 +129 38 65 61 0 0 0 0 +129 38 65 127 0 0 0 0 +129 38 86 61 0 0 0 0 +129 38 86 127 0 0 0 0 +129 38 126 61 0 0 0 0 +129 38 126 127 0 0 0 0 +129 38 132 61 0 0 0 0 +129 38 132 127 0 0 0 0 +129 38 146 61 0 0 0 0 +129 38 146 127 0 0 0 0 +129 38 146 61 0 0 0 0 +129 38 146 127 0 0 0 0 +60 58 65 61 0 0 0 0 +60 58 65 127 0 0 0 0 +60 58 86 61 0 0 0 0 +60 58 86 127 0 0 0 0 +60 58 126 61 0 0 0 0 +60 58 126 127 0 0 0 0 +60 58 132 61 0 0 0 0 +60 58 132 127 0 0 0 0 +60 58 146 61 0 0 0 0 +60 58 146 127 0 0 0 0 +60 58 146 61 0 0 0 0 +60 58 146 127 0 0 0 0 +60 58 125 61 0 0 0 0 +60 58 125 127 0 0 0 0 +60 58 129 61 0 0 0 0 +60 58 129 127 0 0 0 0 +1 59 65 61 0 0 0 0 +1 59 65 127 0 0 0 0 +1 59 86 61 0 0 0 0 +1 59 86 127 0 0 0 0 +1 59 126 61 0 0 0 0 +1 59 126 127 0 0 0 0 +1 59 132 61 0 0 0 0 +1 59 132 127 0 0 0 0 +1 59 146 61 0 0 0 0 +1 59 146 127 0 0 0 0 +1 59 146 61 0 0 0 0 +1 59 146 127 0 0 0 0 +1 59 125 61 0 0 0 0 +1 59 125 127 0 0 0 0 +1 59 129 61 0 0 0 0 +1 59 129 127 0 0 0 0 +128 59 65 61 0 0 0 0 +128 59 65 127 0 0 0 0 +128 59 86 61 0 0 0 0 +128 59 86 127 0 0 0 0 +128 59 126 61 0 0 0 0 +128 59 126 127 0 0 0 0 +128 59 132 61 0 0 0 0 +128 59 132 127 0 0 0 0 +128 59 146 61 0 0 0 0 +128 59 146 127 0 0 0 0 +128 59 146 61 0 0 0 0 +128 59 146 127 0 0 0 0 +128 59 125 61 0 0 0 0 +128 59 125 127 0 0 0 0 +128 59 129 61 0 0 0 0 +128 59 129 127 0 0 0 0 +142 59 65 61 0 0 0 0 +142 59 65 127 0 0 0 0 +142 59 86 61 0 0 0 0 +142 59 86 127 0 0 0 0 +142 59 126 61 0 0 0 0 +142 59 126 127 0 0 0 0 +142 59 132 61 0 0 0 0 +142 59 132 127 0 0 0 0 +142 59 146 61 0 0 0 0 +142 59 146 127 0 0 0 0 +142 59 146 61 0 0 0 0 +142 59 146 127 0 0 0 0 +142 59 125 61 0 0 0 0 +142 59 125 127 0 0 0 0 +142 59 129 61 0 0 0 0 +142 59 129 127 0 0 0 0 +146 59 65 61 0 0 0 0 +146 59 65 127 0 0 0 0 +146 59 86 61 0 0 0 0 +146 59 86 127 0 0 0 0 +146 59 126 61 0 0 0 0 +146 59 126 127 0 0 0 0 +146 59 132 61 0 0 0 0 +146 59 132 127 0 0 0 0 +146 59 146 61 0 0 0 0 +146 59 146 127 0 0 0 0 +146 59 146 61 0 0 0 0 +146 59 146 127 0 0 0 0 +146 59 125 61 0 0 0 0 +146 59 125 127 0 0 0 0 +146 59 129 61 0 0 0 0 +146 59 129 127 0 0 0 0 +146 59 65 61 0 0 0 0 +146 59 65 127 0 0 0 0 +146 59 86 61 0 0 0 0 +146 59 86 127 0 0 0 0 +146 59 126 61 0 0 0 0 +146 59 126 127 0 0 0 0 +146 59 132 61 0 0 0 0 +146 59 132 127 0 0 0 0 +146 59 146 61 0 0 0 0 +146 59 146 127 0 0 0 0 +146 59 146 61 0 0 0 0 +146 59 146 127 0 0 0 0 +146 59 125 61 0 0 0 0 +146 59 125 127 0 0 0 0 +146 59 129 61 0 0 0 0 +146 59 129 127 0 0 0 0 +125 58 65 61 0 0 0 0 +125 58 65 127 0 0 0 0 +125 58 86 61 0 0 0 0 +125 58 86 127 0 0 0 0 +125 58 126 61 0 0 0 0 +125 58 126 127 0 0 0 0 +125 58 132 61 0 0 0 0 +125 58 132 127 0 0 0 0 +125 58 146 61 0 0 0 0 +125 58 146 127 0 0 0 0 +125 58 146 61 0 0 0 0 +125 58 146 127 0 0 0 0 +129 58 65 61 0 0 0 0 +129 58 65 127 0 0 0 0 +129 58 86 61 0 0 0 0 +129 58 86 127 0 0 0 0 +129 58 126 61 0 0 0 0 +129 58 126 127 0 0 0 0 +129 58 132 61 0 0 0 0 +129 58 132 127 0 0 0 0 +129 58 146 61 0 0 0 0 +129 58 146 127 0 0 0 0 +129 58 146 61 0 0 0 0 +129 58 146 127 0 0 0 0 +60 104 65 61 0 0 0 0 +60 104 65 127 0 0 0 0 +60 104 86 61 0 0 0 0 +60 104 86 127 0 0 0 0 +60 104 126 61 0 0 0 0 +60 104 126 127 0 0 0 0 +60 104 132 61 0 0 0 0 +60 104 132 127 0 0 0 0 +60 104 146 61 0 0 0 0 +60 104 146 127 0 0 0 0 +60 104 146 61 0 0 0 0 +60 104 146 127 0 0 0 0 +60 104 125 61 0 0 0 0 +60 104 125 127 0 0 0 0 +60 104 129 61 0 0 0 0 +60 104 129 127 0 0 0 0 +1 103 65 61 0 0 0 0 +1 103 65 127 0 0 0 0 +1 103 86 61 0 0 0 0 +1 103 86 127 0 0 0 0 +1 103 126 61 0 0 0 0 +1 103 126 127 0 0 0 0 +1 103 132 61 0 0 0 0 +1 103 132 127 0 0 0 0 +1 103 146 61 0 0 0 0 +1 103 146 127 0 0 0 0 +1 103 146 61 0 0 0 0 +1 103 146 127 0 0 0 0 +1 103 125 61 0 0 0 0 +1 103 125 127 0 0 0 0 +1 103 129 61 0 0 0 0 +1 103 129 127 0 0 0 0 +128 103 65 61 0 0 0 0 +128 103 65 127 0 0 0 0 +128 103 86 61 0 0 0 0 +128 103 86 127 0 0 0 0 +128 103 126 61 0 0 0 0 +128 103 126 127 0 0 0 0 +128 103 132 61 0 0 0 0 +128 103 132 127 0 0 0 0 +128 103 146 61 0 0 0 0 +128 103 146 127 0 0 0 0 +128 103 146 61 0 0 0 0 +128 103 146 127 0 0 0 0 +128 103 125 61 0 0 0 0 +128 103 125 127 0 0 0 0 +128 103 129 61 0 0 0 0 +128 103 129 127 0 0 0 0 +142 103 65 61 0 0 0 0 +142 103 65 127 0 0 0 0 +142 103 86 61 0 0 0 0 +142 103 86 127 0 0 0 0 +142 103 126 61 0 0 0 0 +142 103 126 127 0 0 0 0 +142 103 132 61 0 0 0 0 +142 103 132 127 0 0 0 0 +142 103 146 61 0 0 0 0 +142 103 146 127 0 0 0 0 +142 103 146 61 0 0 0 0 +142 103 146 127 0 0 0 0 +142 103 125 61 0 0 0 0 +142 103 125 127 0 0 0 0 +142 103 129 61 0 0 0 0 +142 103 129 127 0 0 0 0 +146 103 65 61 0 0 0 0 +146 103 65 127 0 0 0 0 +146 103 86 61 0 0 0 0 +146 103 86 127 0 0 0 0 +146 103 126 61 0 0 0 0 +146 103 126 127 0 0 0 0 +146 103 132 61 0 0 0 0 +146 103 132 127 0 0 0 0 +146 103 146 61 0 0 0 0 +146 103 146 127 0 0 0 0 +146 103 146 61 0 0 0 0 +146 103 146 127 0 0 0 0 +146 103 125 61 0 0 0 0 +146 103 125 127 0 0 0 0 +146 103 129 61 0 0 0 0 +146 103 129 127 0 0 0 0 +146 103 65 61 0 0 0 0 +146 103 65 127 0 0 0 0 +146 103 86 61 0 0 0 0 +146 103 86 127 0 0 0 0 +146 103 126 61 0 0 0 0 +146 103 126 127 0 0 0 0 +146 103 132 61 0 0 0 0 +146 103 132 127 0 0 0 0 +146 103 146 61 0 0 0 0 +146 103 146 127 0 0 0 0 +146 103 146 61 0 0 0 0 +146 103 146 127 0 0 0 0 +146 103 125 61 0 0 0 0 +146 103 125 127 0 0 0 0 +146 103 129 61 0 0 0 0 +146 103 129 127 0 0 0 0 +125 104 65 61 0 0 0 0 +125 104 65 127 0 0 0 0 +125 104 86 61 0 0 0 0 +125 104 86 127 0 0 0 0 +125 104 126 61 0 0 0 0 +125 104 126 127 0 0 0 0 +125 104 132 61 0 0 0 0 +125 104 132 127 0 0 0 0 +125 104 146 61 0 0 0 0 +125 104 146 127 0 0 0 0 +125 104 146 61 0 0 0 0 +125 104 146 127 0 0 0 0 +129 104 65 61 0 0 0 0 +129 104 65 127 0 0 0 0 +129 104 86 61 0 0 0 0 +129 104 86 127 0 0 0 0 +129 104 126 61 0 0 0 0 +129 104 126 127 0 0 0 0 +129 104 132 61 0 0 0 0 +129 104 132 127 0 0 0 0 +129 104 146 61 0 0 0 0 +129 104 146 127 0 0 0 0 +129 104 146 61 0 0 0 0 +129 104 146 127 0 0 0 0 +60 18 144 65 61 0 0 0 +60 18 144 65 127 0 0 0 +60 18 144 86 61 0 0 0 +60 18 144 86 127 0 0 0 +60 18 144 126 61 0 0 0 +60 18 144 126 127 0 0 0 +60 18 144 132 61 0 0 0 +60 18 144 132 127 0 0 0 +60 18 144 146 61 0 0 0 +60 18 144 146 127 0 0 0 +60 18 144 146 61 0 0 0 +60 18 144 146 127 0 0 0 +60 18 144 125 61 0 0 0 +60 18 144 125 127 0 0 0 +60 18 144 129 61 0 0 0 +60 18 144 129 127 0 0 0 +1 17 144 65 61 0 0 0 +1 17 144 65 127 0 0 0 +1 17 144 86 61 0 0 0 +1 17 144 86 127 0 0 0 +1 17 144 126 61 0 0 0 +1 17 144 126 127 0 0 0 +1 17 144 132 61 0 0 0 +1 17 144 132 127 0 0 0 +1 17 144 146 61 0 0 0 +1 17 144 146 127 0 0 0 +1 17 144 146 61 0 0 0 +1 17 144 146 127 0 0 0 +1 17 144 125 61 0 0 0 +1 17 144 125 127 0 0 0 +1 17 144 129 61 0 0 0 +1 17 144 129 127 0 0 0 +128 17 144 65 61 0 0 0 +128 17 144 65 127 0 0 0 +128 17 144 86 61 0 0 0 +128 17 144 86 127 0 0 0 +128 17 144 126 61 0 0 0 +128 17 144 126 127 0 0 0 +128 17 144 132 61 0 0 0 +128 17 144 132 127 0 0 0 +128 17 144 146 61 0 0 0 +128 17 144 146 127 0 0 0 +128 17 144 146 61 0 0 0 +128 17 144 146 127 0 0 0 +128 17 144 125 61 0 0 0 +128 17 144 125 127 0 0 0 +128 17 144 129 61 0 0 0 +128 17 144 129 127 0 0 0 +142 17 144 65 61 0 0 0 +142 17 144 65 127 0 0 0 +142 17 144 86 61 0 0 0 +142 17 144 86 127 0 0 0 +142 17 144 126 61 0 0 0 +142 17 144 126 127 0 0 0 +142 17 144 132 61 0 0 0 +142 17 144 132 127 0 0 0 +142 17 144 146 61 0 0 0 +142 17 144 146 127 0 0 0 +142 17 144 146 61 0 0 0 +142 17 144 146 127 0 0 0 +142 17 144 125 61 0 0 0 +142 17 144 125 127 0 0 0 +142 17 144 129 61 0 0 0 +142 17 144 129 127 0 0 0 +146 17 144 65 61 0 0 0 +146 17 144 65 127 0 0 0 +146 17 144 86 61 0 0 0 +146 17 144 86 127 0 0 0 +146 17 144 126 61 0 0 0 +146 17 144 126 127 0 0 0 +146 17 144 132 61 0 0 0 +146 17 144 132 127 0 0 0 +146 17 144 146 61 0 0 0 +146 17 144 146 127 0 0 0 +146 17 144 146 61 0 0 0 +146 17 144 146 127 0 0 0 +146 17 144 125 61 0 0 0 +146 17 144 125 127 0 0 0 +146 17 144 129 61 0 0 0 +146 17 144 129 127 0 0 0 +146 17 144 65 61 0 0 0 +146 17 144 65 127 0 0 0 +146 17 144 86 61 0 0 0 +146 17 144 86 127 0 0 0 +146 17 144 126 61 0 0 0 +146 17 144 126 127 0 0 0 +146 17 144 132 61 0 0 0 +146 17 144 132 127 0 0 0 +146 17 144 146 61 0 0 0 +146 17 144 146 127 0 0 0 +146 17 144 146 61 0 0 0 +146 17 144 146 127 0 0 0 +146 17 144 125 61 0 0 0 +146 17 144 125 127 0 0 0 +146 17 144 129 61 0 0 0 +146 17 144 129 127 0 0 0 +125 18 144 65 61 0 0 0 +125 18 144 65 127 0 0 0 +125 18 144 86 61 0 0 0 +125 18 144 86 127 0 0 0 +125 18 144 126 61 0 0 0 +125 18 144 126 127 0 0 0 +125 18 144 132 61 0 0 0 +125 18 144 132 127 0 0 0 +125 18 144 146 61 0 0 0 +125 18 144 146 127 0 0 0 +125 18 144 146 61 0 0 0 +125 18 144 146 127 0 0 0 +129 18 144 65 61 0 0 0 +129 18 144 65 127 0 0 0 +129 18 144 86 61 0 0 0 +129 18 144 86 127 0 0 0 +129 18 144 126 61 0 0 0 +129 18 144 126 127 0 0 0 +129 18 144 132 61 0 0 0 +129 18 144 132 127 0 0 0 +129 18 144 146 61 0 0 0 +129 18 144 146 127 0 0 0 +129 18 144 146 61 0 0 0 +129 18 144 146 127 0 0 0 +60 31 65 61 0 0 0 0 +60 31 65 127 0 0 0 0 +60 31 86 61 0 0 0 0 +60 31 86 127 0 0 0 0 +60 31 126 61 0 0 0 0 +60 31 126 127 0 0 0 0 +60 31 132 61 0 0 0 0 +60 31 132 127 0 0 0 0 +60 31 146 61 0 0 0 0 +60 31 146 127 0 0 0 0 +60 31 146 61 0 0 0 0 +60 31 146 127 0 0 0 0 +60 31 125 61 0 0 0 0 +60 31 125 127 0 0 0 0 +60 31 129 61 0 0 0 0 +60 31 129 127 0 0 0 0 +1 30 65 61 0 0 0 0 +1 30 65 127 0 0 0 0 +1 30 86 61 0 0 0 0 +1 30 86 127 0 0 0 0 +1 30 126 61 0 0 0 0 +1 30 126 127 0 0 0 0 +1 30 132 61 0 0 0 0 +1 30 132 127 0 0 0 0 +1 30 146 61 0 0 0 0 +1 30 146 127 0 0 0 0 +1 30 146 61 0 0 0 0 +1 30 146 127 0 0 0 0 +1 30 125 61 0 0 0 0 +1 30 125 127 0 0 0 0 +1 30 129 61 0 0 0 0 +1 30 129 127 0 0 0 0 +128 30 65 61 0 0 0 0 +128 30 65 127 0 0 0 0 +128 30 86 61 0 0 0 0 +128 30 86 127 0 0 0 0 +128 30 126 61 0 0 0 0 +128 30 126 127 0 0 0 0 +128 30 132 61 0 0 0 0 +128 30 132 127 0 0 0 0 +128 30 146 61 0 0 0 0 +128 30 146 127 0 0 0 0 +128 30 146 61 0 0 0 0 +128 30 146 127 0 0 0 0 +128 30 125 61 0 0 0 0 +128 30 125 127 0 0 0 0 +128 30 129 61 0 0 0 0 +128 30 129 127 0 0 0 0 +142 30 65 61 0 0 0 0 +142 30 65 127 0 0 0 0 +142 30 86 61 0 0 0 0 +142 30 86 127 0 0 0 0 +142 30 126 61 0 0 0 0 +142 30 126 127 0 0 0 0 +142 30 132 61 0 0 0 0 +142 30 132 127 0 0 0 0 +142 30 146 61 0 0 0 0 +142 30 146 127 0 0 0 0 +142 30 146 61 0 0 0 0 +142 30 146 127 0 0 0 0 +142 30 125 61 0 0 0 0 +142 30 125 127 0 0 0 0 +142 30 129 61 0 0 0 0 +142 30 129 127 0 0 0 0 +146 30 65 61 0 0 0 0 +146 30 65 127 0 0 0 0 +146 30 86 61 0 0 0 0 +146 30 86 127 0 0 0 0 +146 30 126 61 0 0 0 0 +146 30 126 127 0 0 0 0 +146 30 132 61 0 0 0 0 +146 30 132 127 0 0 0 0 +146 30 146 61 0 0 0 0 +146 30 146 127 0 0 0 0 +146 30 146 61 0 0 0 0 +146 30 146 127 0 0 0 0 +146 30 125 61 0 0 0 0 +146 30 125 127 0 0 0 0 +146 30 129 61 0 0 0 0 +146 30 129 127 0 0 0 0 +146 30 65 61 0 0 0 0 +146 30 65 127 0 0 0 0 +146 30 86 61 0 0 0 0 +146 30 86 127 0 0 0 0 +146 30 126 61 0 0 0 0 +146 30 126 127 0 0 0 0 +146 30 132 61 0 0 0 0 +146 30 132 127 0 0 0 0 +146 30 146 61 0 0 0 0 +146 30 146 127 0 0 0 0 +146 30 146 61 0 0 0 0 +146 30 146 127 0 0 0 0 +146 30 125 61 0 0 0 0 +146 30 125 127 0 0 0 0 +146 30 129 61 0 0 0 0 +146 30 129 127 0 0 0 0 +125 31 65 61 0 0 0 0 +125 31 65 127 0 0 0 0 +125 31 86 61 0 0 0 0 +125 31 86 127 0 0 0 0 +125 31 126 61 0 0 0 0 +125 31 126 127 0 0 0 0 +125 31 132 61 0 0 0 0 +125 31 132 127 0 0 0 0 +125 31 146 61 0 0 0 0 +125 31 146 127 0 0 0 0 +125 31 146 61 0 0 0 0 +125 31 146 127 0 0 0 0 +129 31 65 61 0 0 0 0 +129 31 65 127 0 0 0 0 +129 31 86 61 0 0 0 0 +129 31 86 127 0 0 0 0 +129 31 126 61 0 0 0 0 +129 31 126 127 0 0 0 0 +129 31 132 61 0 0 0 0 +129 31 132 127 0 0 0 0 +129 31 146 61 0 0 0 0 +129 31 146 127 0 0 0 0 +129 31 146 61 0 0 0 0 +129 31 146 127 0 0 0 0 +60 92 65 61 0 0 0 0 +60 92 65 127 0 0 0 0 +60 92 86 61 0 0 0 0 +60 92 86 127 0 0 0 0 +60 92 126 61 0 0 0 0 +60 92 126 127 0 0 0 0 +60 92 132 61 0 0 0 0 +60 92 132 127 0 0 0 0 +60 92 146 61 0 0 0 0 +60 92 146 127 0 0 0 0 +60 92 146 61 0 0 0 0 +60 92 146 127 0 0 0 0 +60 92 125 61 0 0 0 0 +60 92 125 127 0 0 0 0 +60 92 129 61 0 0 0 0 +60 92 129 127 0 0 0 0 +1 91 65 61 0 0 0 0 +1 91 65 127 0 0 0 0 +1 91 86 61 0 0 0 0 +1 91 86 127 0 0 0 0 +1 91 126 61 0 0 0 0 +1 91 126 127 0 0 0 0 +1 91 132 61 0 0 0 0 +1 91 132 127 0 0 0 0 +1 91 146 61 0 0 0 0 +1 91 146 127 0 0 0 0 +1 91 146 61 0 0 0 0 +1 91 146 127 0 0 0 0 +1 91 125 61 0 0 0 0 +1 91 125 127 0 0 0 0 +1 91 129 61 0 0 0 0 +1 91 129 127 0 0 0 0 +128 91 65 61 0 0 0 0 +128 91 65 127 0 0 0 0 +128 91 86 61 0 0 0 0 +128 91 86 127 0 0 0 0 +128 91 126 61 0 0 0 0 +128 91 126 127 0 0 0 0 +128 91 132 61 0 0 0 0 +128 91 132 127 0 0 0 0 +128 91 146 61 0 0 0 0 +128 91 146 127 0 0 0 0 +128 91 146 61 0 0 0 0 +128 91 146 127 0 0 0 0 +128 91 125 61 0 0 0 0 +128 91 125 127 0 0 0 0 +128 91 129 61 0 0 0 0 +128 91 129 127 0 0 0 0 +142 91 65 61 0 0 0 0 +142 91 65 127 0 0 0 0 +142 91 86 61 0 0 0 0 +142 91 86 127 0 0 0 0 +142 91 126 61 0 0 0 0 +142 91 126 127 0 0 0 0 +142 91 132 61 0 0 0 0 +142 91 132 127 0 0 0 0 +142 91 146 61 0 0 0 0 +142 91 146 127 0 0 0 0 +142 91 146 61 0 0 0 0 +142 91 146 127 0 0 0 0 +142 91 125 61 0 0 0 0 +142 91 125 127 0 0 0 0 +142 91 129 61 0 0 0 0 +142 91 129 127 0 0 0 0 +146 91 65 61 0 0 0 0 +146 91 65 127 0 0 0 0 +146 91 86 61 0 0 0 0 +146 91 86 127 0 0 0 0 +146 91 126 61 0 0 0 0 +146 91 126 127 0 0 0 0 +146 91 132 61 0 0 0 0 +146 91 132 127 0 0 0 0 +146 91 146 61 0 0 0 0 +146 91 146 127 0 0 0 0 +146 91 146 61 0 0 0 0 +146 91 146 127 0 0 0 0 +146 91 125 61 0 0 0 0 +146 91 125 127 0 0 0 0 +146 91 129 61 0 0 0 0 +146 91 129 127 0 0 0 0 +146 91 65 61 0 0 0 0 +146 91 65 127 0 0 0 0 +146 91 86 61 0 0 0 0 +146 91 86 127 0 0 0 0 +146 91 126 61 0 0 0 0 +146 91 126 127 0 0 0 0 +146 91 132 61 0 0 0 0 +146 91 132 127 0 0 0 0 +146 91 146 61 0 0 0 0 +146 91 146 127 0 0 0 0 +146 91 146 61 0 0 0 0 +146 91 146 127 0 0 0 0 +146 91 125 61 0 0 0 0 +146 91 125 127 0 0 0 0 +146 91 129 61 0 0 0 0 +146 91 129 127 0 0 0 0 +125 92 65 61 0 0 0 0 +125 92 65 127 0 0 0 0 +125 92 86 61 0 0 0 0 +125 92 86 127 0 0 0 0 +125 92 126 61 0 0 0 0 +125 92 126 127 0 0 0 0 +125 92 132 61 0 0 0 0 +125 92 132 127 0 0 0 0 +125 92 146 61 0 0 0 0 +125 92 146 127 0 0 0 0 +125 92 146 61 0 0 0 0 +125 92 146 127 0 0 0 0 +129 92 65 61 0 0 0 0 +129 92 65 127 0 0 0 0 +129 92 86 61 0 0 0 0 +129 92 86 127 0 0 0 0 +129 92 126 61 0 0 0 0 +129 92 126 127 0 0 0 0 +129 92 132 61 0 0 0 0 +129 92 132 127 0 0 0 0 +129 92 146 61 0 0 0 0 +129 92 146 127 0 0 0 0 +129 92 146 61 0 0 0 0 +129 92 146 127 0 0 0 0 +60 97 65 61 0 0 0 0 +60 97 65 127 0 0 0 0 +60 97 86 61 0 0 0 0 +60 97 86 127 0 0 0 0 +60 97 126 61 0 0 0 0 +60 97 126 127 0 0 0 0 +60 97 132 61 0 0 0 0 +60 97 132 127 0 0 0 0 +60 97 146 61 0 0 0 0 +60 97 146 127 0 0 0 0 +60 97 146 61 0 0 0 0 +60 97 146 127 0 0 0 0 +60 97 125 61 0 0 0 0 +60 97 125 127 0 0 0 0 +60 97 129 61 0 0 0 0 +60 97 129 127 0 0 0 0 +1 96 65 61 0 0 0 0 +1 96 65 127 0 0 0 0 +1 96 86 61 0 0 0 0 +1 96 86 127 0 0 0 0 +1 96 126 61 0 0 0 0 +1 96 126 127 0 0 0 0 +1 96 132 61 0 0 0 0 +1 96 132 127 0 0 0 0 +1 96 146 61 0 0 0 0 +1 96 146 127 0 0 0 0 +1 96 146 61 0 0 0 0 +1 96 146 127 0 0 0 0 +1 96 125 61 0 0 0 0 +1 96 125 127 0 0 0 0 +1 96 129 61 0 0 0 0 +1 96 129 127 0 0 0 0 +128 96 65 61 0 0 0 0 +128 96 65 127 0 0 0 0 +128 96 86 61 0 0 0 0 +128 96 86 127 0 0 0 0 +128 96 126 61 0 0 0 0 +128 96 126 127 0 0 0 0 +128 96 132 61 0 0 0 0 +128 96 132 127 0 0 0 0 +128 96 146 61 0 0 0 0 +128 96 146 127 0 0 0 0 +128 96 146 61 0 0 0 0 +128 96 146 127 0 0 0 0 +128 96 125 61 0 0 0 0 +128 96 125 127 0 0 0 0 +128 96 129 61 0 0 0 0 +128 96 129 127 0 0 0 0 +142 96 65 61 0 0 0 0 +142 96 65 127 0 0 0 0 +142 96 86 61 0 0 0 0 +142 96 86 127 0 0 0 0 +142 96 126 61 0 0 0 0 +142 96 126 127 0 0 0 0 +142 96 132 61 0 0 0 0 +142 96 132 127 0 0 0 0 +142 96 146 61 0 0 0 0 +142 96 146 127 0 0 0 0 +142 96 146 61 0 0 0 0 +142 96 146 127 0 0 0 0 +142 96 125 61 0 0 0 0 +142 96 125 127 0 0 0 0 +142 96 129 61 0 0 0 0 +142 96 129 127 0 0 0 0 +146 96 65 61 0 0 0 0 +146 96 65 127 0 0 0 0 +146 96 86 61 0 0 0 0 +146 96 86 127 0 0 0 0 +146 96 126 61 0 0 0 0 +146 96 126 127 0 0 0 0 +146 96 132 61 0 0 0 0 +146 96 132 127 0 0 0 0 +146 96 146 61 0 0 0 0 +146 96 146 127 0 0 0 0 +146 96 146 61 0 0 0 0 +146 96 146 127 0 0 0 0 +146 96 125 61 0 0 0 0 +146 96 125 127 0 0 0 0 +146 96 129 61 0 0 0 0 +146 96 129 127 0 0 0 0 +146 96 65 61 0 0 0 0 +146 96 65 127 0 0 0 0 +146 96 86 61 0 0 0 0 +146 96 86 127 0 0 0 0 +146 96 126 61 0 0 0 0 +146 96 126 127 0 0 0 0 +146 96 132 61 0 0 0 0 +146 96 132 127 0 0 0 0 +146 96 146 61 0 0 0 0 +146 96 146 127 0 0 0 0 +146 96 146 61 0 0 0 0 +146 96 146 127 0 0 0 0 +146 96 125 61 0 0 0 0 +146 96 125 127 0 0 0 0 +146 96 129 61 0 0 0 0 +146 96 129 127 0 0 0 0 +125 97 65 61 0 0 0 0 +125 97 65 127 0 0 0 0 +125 97 86 61 0 0 0 0 +125 97 86 127 0 0 0 0 +125 97 126 61 0 0 0 0 +125 97 126 127 0 0 0 0 +125 97 132 61 0 0 0 0 +125 97 132 127 0 0 0 0 +125 97 146 61 0 0 0 0 +125 97 146 127 0 0 0 0 +125 97 146 61 0 0 0 0 +125 97 146 127 0 0 0 0 +129 97 65 61 0 0 0 0 +129 97 65 127 0 0 0 0 +129 97 86 61 0 0 0 0 +129 97 86 127 0 0 0 0 +129 97 126 61 0 0 0 0 +129 97 126 127 0 0 0 0 +129 97 132 61 0 0 0 0 +129 97 132 127 0 0 0 0 +129 97 146 61 0 0 0 0 +129 97 146 127 0 0 0 0 +129 97 146 61 0 0 0 0 +129 97 146 127 0 0 0 0 +60 76 65 0 0 0 0 0 +1 3 65 0 0 0 0 0 +128 5 65 0 0 0 0 0 +142 5 65 0 0 0 0 0 +146 5 65 0 0 0 0 0 +146 5 65 0 0 0 0 0 +125 76 65 0 0 0 0 0 +129 76 65 0 0 0 0 0 +60 76 86 0 0 0 0 0 +1 3 86 0 0 0 0 0 +128 5 86 0 0 0 0 0 +142 5 86 0 0 0 0 0 +146 5 86 0 0 0 0 0 +146 5 86 0 0 0 0 0 +125 76 86 0 0 0 0 0 +129 76 86 0 0 0 0 0 +60 76 126 0 0 0 0 0 +1 3 126 0 0 0 0 0 +128 5 126 0 0 0 0 0 +142 5 126 0 0 0 0 0 +146 5 126 0 0 0 0 0 +146 5 126 0 0 0 0 0 +125 76 126 0 0 0 0 0 +129 76 126 0 0 0 0 0 +60 76 132 0 0 0 0 0 +1 3 132 0 0 0 0 0 +128 5 132 0 0 0 0 0 +142 5 132 0 0 0 0 0 +146 5 132 0 0 0 0 0 +146 5 132 0 0 0 0 0 +125 76 132 0 0 0 0 0 +129 76 132 0 0 0 0 0 +60 76 146 0 0 0 0 0 +1 3 146 0 0 0 0 0 +128 5 146 0 0 0 0 0 +142 5 146 0 0 0 0 0 +146 5 146 0 0 0 0 0 +146 5 146 0 0 0 0 0 +125 76 146 0 0 0 0 0 +129 76 146 0 0 0 0 0 +60 76 146 0 0 0 0 0 +1 3 146 0 0 0 0 0 +128 5 146 0 0 0 0 0 +142 5 146 0 0 0 0 0 +146 5 146 0 0 0 0 0 +146 5 146 0 0 0 0 0 +125 76 146 0 0 0 0 0 +129 76 146 0 0 0 0 0 +60 76 125 0 0 0 0 0 +1 3 125 0 0 0 0 0 +128 5 125 0 0 0 0 0 +142 5 125 0 0 0 0 0 +146 5 125 0 0 0 0 0 +146 5 125 0 0 0 0 0 +60 76 129 0 0 0 0 0 +1 3 129 0 0 0 0 0 +128 5 129 0 0 0 0 0 +142 5 129 0 0 0 0 0 +146 5 129 0 0 0 0 0 +146 5 129 0 0 0 0 0 +60 15 0 0 0 0 0 0 +1 14 0 0 0 0 0 0 +128 14 0 0 0 0 0 0 +142 14 0 0 0 0 0 0 +146 14 0 0 0 0 0 0 +146 14 0 0 0 0 0 0 +60 115 0 0 0 0 0 0 +1 114 0 0 0 0 0 0 +128 114 0 0 0 0 0 0 +142 114 0 0 0 0 0 0 +146 114 0 0 0 0 0 0 +146 114 0 0 0 0 0 0 +60 140 0 0 0 0 0 0 +1 139 0 0 0 0 0 0 +128 139 0 0 0 0 0 0 +142 139 0 0 0 0 0 0 +146 139 0 0 0 0 0 0 +146 139 0 0 0 0 0 0 +60 20 0 0 0 0 0 0 +1 19 0 0 0 0 0 0 +128 19 0 0 0 0 0 0 +142 19 0 0 0 0 0 0 +146 19 0 0 0 0 0 0 +146 19 0 0 0 0 0 0 +60 74 0 0 0 0 0 0 +1 73 0 0 0 0 0 0 +128 73 0 0 0 0 0 0 +142 73 0 0 0 0 0 0 +146 73 0 0 0 0 0 0 +146 73 0 0 0 0 0 0 +60 29 65 0 0 0 0 0 +60 29 86 0 0 0 0 0 +60 29 126 0 0 0 0 0 +60 29 132 0 0 0 0 0 +60 29 146 0 0 0 0 0 +60 29 146 0 0 0 0 0 +60 29 125 0 0 0 0 0 +60 29 129 0 0 0 0 0 +1 28 65 0 0 0 0 0 +1 28 86 0 0 0 0 0 +1 28 126 0 0 0 0 0 +1 28 132 0 0 0 0 0 +1 28 146 0 0 0 0 0 +1 28 146 0 0 0 0 0 +1 28 125 0 0 0 0 0 +1 28 129 0 0 0 0 0 +128 28 65 0 0 0 0 0 +128 28 86 0 0 0 0 0 +128 28 126 0 0 0 0 0 +128 28 132 0 0 0 0 0 +128 28 146 0 0 0 0 0 +128 28 146 0 0 0 0 0 +128 28 125 0 0 0 0 0 +128 28 129 0 0 0 0 0 +142 28 65 0 0 0 0 0 +142 28 86 0 0 0 0 0 +142 28 126 0 0 0 0 0 +142 28 132 0 0 0 0 0 +142 28 146 0 0 0 0 0 +142 28 146 0 0 0 0 0 +142 28 125 0 0 0 0 0 +142 28 129 0 0 0 0 0 +146 28 65 0 0 0 0 0 +146 28 86 0 0 0 0 0 +146 28 126 0 0 0 0 0 +146 28 132 0 0 0 0 0 +146 28 146 0 0 0 0 0 +146 28 146 0 0 0 0 0 +146 28 125 0 0 0 0 0 +146 28 129 0 0 0 0 0 +146 28 65 0 0 0 0 0 +146 28 86 0 0 0 0 0 +146 28 126 0 0 0 0 0 +146 28 132 0 0 0 0 0 +146 28 146 0 0 0 0 0 +146 28 146 0 0 0 0 0 +146 28 125 0 0 0 0 0 +146 28 129 0 0 0 0 0 +125 29 65 0 0 0 0 0 +125 29 86 0 0 0 0 0 +125 29 126 0 0 0 0 0 +125 29 132 0 0 0 0 0 +125 29 146 0 0 0 0 0 +125 29 146 0 0 0 0 0 +129 29 65 0 0 0 0 0 +129 29 86 0 0 0 0 0 +129 29 126 0 0 0 0 0 +129 29 132 0 0 0 0 0 +129 29 146 0 0 0 0 0 +129 29 146 0 0 0 0 0 +60 38 65 0 0 0 0 0 +60 38 86 0 0 0 0 0 +60 38 126 0 0 0 0 0 +60 38 132 0 0 0 0 0 +60 38 146 0 0 0 0 0 +60 38 146 0 0 0 0 0 +60 38 125 0 0 0 0 0 +60 38 129 0 0 0 0 0 +1 37 65 0 0 0 0 0 +1 37 86 0 0 0 0 0 +1 37 126 0 0 0 0 0 +1 37 132 0 0 0 0 0 +1 37 146 0 0 0 0 0 +1 37 146 0 0 0 0 0 +1 37 125 0 0 0 0 0 +1 37 129 0 0 0 0 0 +128 37 65 0 0 0 0 0 +128 37 86 0 0 0 0 0 +128 37 126 0 0 0 0 0 +128 37 132 0 0 0 0 0 +128 37 146 0 0 0 0 0 +128 37 146 0 0 0 0 0 +128 37 125 0 0 0 0 0 +128 37 129 0 0 0 0 0 +142 37 65 0 0 0 0 0 +142 37 86 0 0 0 0 0 +142 37 126 0 0 0 0 0 +142 37 132 0 0 0 0 0 +142 37 146 0 0 0 0 0 +142 37 146 0 0 0 0 0 +142 37 125 0 0 0 0 0 +142 37 129 0 0 0 0 0 +146 37 65 0 0 0 0 0 +146 37 86 0 0 0 0 0 +146 37 126 0 0 0 0 0 +146 37 132 0 0 0 0 0 +146 37 146 0 0 0 0 0 +146 37 146 0 0 0 0 0 +146 37 125 0 0 0 0 0 +146 37 129 0 0 0 0 0 +146 37 65 0 0 0 0 0 +146 37 86 0 0 0 0 0 +146 37 126 0 0 0 0 0 +146 37 132 0 0 0 0 0 +146 37 146 0 0 0 0 0 +146 37 146 0 0 0 0 0 +146 37 125 0 0 0 0 0 +146 37 129 0 0 0 0 0 +125 38 65 0 0 0 0 0 +125 38 86 0 0 0 0 0 +125 38 126 0 0 0 0 0 +125 38 132 0 0 0 0 0 +125 38 146 0 0 0 0 0 +125 38 146 0 0 0 0 0 +129 38 65 0 0 0 0 0 +129 38 86 0 0 0 0 0 +129 38 126 0 0 0 0 0 +129 38 132 0 0 0 0 0 +129 38 146 0 0 0 0 0 +129 38 146 0 0 0 0 0 +60 58 65 0 0 0 0 0 +60 58 86 0 0 0 0 0 +60 58 126 0 0 0 0 0 +60 58 132 0 0 0 0 0 +60 58 146 0 0 0 0 0 +60 58 146 0 0 0 0 0 +60 58 125 0 0 0 0 0 +60 58 129 0 0 0 0 0 +1 59 65 0 0 0 0 0 +1 59 86 0 0 0 0 0 +1 59 126 0 0 0 0 0 +1 59 132 0 0 0 0 0 +1 59 146 0 0 0 0 0 +1 59 146 0 0 0 0 0 +1 59 125 0 0 0 0 0 +1 59 129 0 0 0 0 0 +128 59 65 0 0 0 0 0 +128 59 86 0 0 0 0 0 +128 59 126 0 0 0 0 0 +128 59 132 0 0 0 0 0 +128 59 146 0 0 0 0 0 +128 59 146 0 0 0 0 0 +128 59 125 0 0 0 0 0 +128 59 129 0 0 0 0 0 +142 59 65 0 0 0 0 0 +142 59 86 0 0 0 0 0 +142 59 126 0 0 0 0 0 +142 59 132 0 0 0 0 0 +142 59 146 0 0 0 0 0 +142 59 146 0 0 0 0 0 +142 59 125 0 0 0 0 0 +142 59 129 0 0 0 0 0 +146 59 65 0 0 0 0 0 +146 59 86 0 0 0 0 0 +146 59 126 0 0 0 0 0 +146 59 132 0 0 0 0 0 +146 59 146 0 0 0 0 0 +146 59 146 0 0 0 0 0 +146 59 125 0 0 0 0 0 +146 59 129 0 0 0 0 0 +146 59 65 0 0 0 0 0 +146 59 86 0 0 0 0 0 +146 59 126 0 0 0 0 0 +146 59 132 0 0 0 0 0 +146 59 146 0 0 0 0 0 +146 59 146 0 0 0 0 0 +146 59 125 0 0 0 0 0 +146 59 129 0 0 0 0 0 +125 58 65 0 0 0 0 0 +125 58 86 0 0 0 0 0 +125 58 126 0 0 0 0 0 +125 58 132 0 0 0 0 0 +125 58 146 0 0 0 0 0 +125 58 146 0 0 0 0 0 +129 58 65 0 0 0 0 0 +129 58 86 0 0 0 0 0 +129 58 126 0 0 0 0 0 +129 58 132 0 0 0 0 0 +129 58 146 0 0 0 0 0 +129 58 146 0 0 0 0 0 +60 104 65 0 0 0 0 0 +60 104 86 0 0 0 0 0 +60 104 126 0 0 0 0 0 +60 104 132 0 0 0 0 0 +60 104 146 0 0 0 0 0 +60 104 146 0 0 0 0 0 +60 104 125 0 0 0 0 0 +60 104 129 0 0 0 0 0 +1 103 65 0 0 0 0 0 +1 103 86 0 0 0 0 0 +1 103 126 0 0 0 0 0 +1 103 132 0 0 0 0 0 +1 103 146 0 0 0 0 0 +1 103 146 0 0 0 0 0 +1 103 125 0 0 0 0 0 +1 103 129 0 0 0 0 0 +128 103 65 0 0 0 0 0 +128 103 86 0 0 0 0 0 +128 103 126 0 0 0 0 0 +128 103 132 0 0 0 0 0 +128 103 146 0 0 0 0 0 +128 103 146 0 0 0 0 0 +128 103 125 0 0 0 0 0 +128 103 129 0 0 0 0 0 +142 103 65 0 0 0 0 0 +142 103 86 0 0 0 0 0 +142 103 126 0 0 0 0 0 +142 103 132 0 0 0 0 0 +142 103 146 0 0 0 0 0 +142 103 146 0 0 0 0 0 +142 103 125 0 0 0 0 0 +142 103 129 0 0 0 0 0 +146 103 65 0 0 0 0 0 +146 103 86 0 0 0 0 0 +146 103 126 0 0 0 0 0 +146 103 132 0 0 0 0 0 +146 103 146 0 0 0 0 0 +146 103 146 0 0 0 0 0 +146 103 125 0 0 0 0 0 +146 103 129 0 0 0 0 0 +146 103 65 0 0 0 0 0 +146 103 86 0 0 0 0 0 +146 103 126 0 0 0 0 0 +146 103 132 0 0 0 0 0 +146 103 146 0 0 0 0 0 +146 103 146 0 0 0 0 0 +146 103 125 0 0 0 0 0 +146 103 129 0 0 0 0 0 +125 104 65 0 0 0 0 0 +125 104 86 0 0 0 0 0 +125 104 126 0 0 0 0 0 +125 104 132 0 0 0 0 0 +125 104 146 0 0 0 0 0 +125 104 146 0 0 0 0 0 +129 104 65 0 0 0 0 0 +129 104 86 0 0 0 0 0 +129 104 126 0 0 0 0 0 +129 104 132 0 0 0 0 0 +129 104 146 0 0 0 0 0 +129 104 146 0 0 0 0 0 +60 18 144 65 0 0 0 0 +60 18 144 86 0 0 0 0 +60 18 144 126 0 0 0 0 +60 18 144 132 0 0 0 0 +60 18 144 146 0 0 0 0 +60 18 144 146 0 0 0 0 +60 18 144 125 0 0 0 0 +60 18 144 129 0 0 0 0 +1 17 144 65 0 0 0 0 +1 17 144 86 0 0 0 0 +1 17 144 126 0 0 0 0 +1 17 144 132 0 0 0 0 +1 17 144 146 0 0 0 0 +1 17 144 146 0 0 0 0 +1 17 144 125 0 0 0 0 +1 17 144 129 0 0 0 0 +128 17 144 65 0 0 0 0 +128 17 144 86 0 0 0 0 +128 17 144 126 0 0 0 0 +128 17 144 132 0 0 0 0 +128 17 144 146 0 0 0 0 +128 17 144 146 0 0 0 0 +128 17 144 125 0 0 0 0 +128 17 144 129 0 0 0 0 +142 17 144 65 0 0 0 0 +142 17 144 86 0 0 0 0 +142 17 144 126 0 0 0 0 +142 17 144 132 0 0 0 0 +142 17 144 146 0 0 0 0 +142 17 144 146 0 0 0 0 +142 17 144 125 0 0 0 0 +142 17 144 129 0 0 0 0 +146 17 144 65 0 0 0 0 +146 17 144 86 0 0 0 0 +146 17 144 126 0 0 0 0 +146 17 144 132 0 0 0 0 +146 17 144 146 0 0 0 0 +146 17 144 146 0 0 0 0 +146 17 144 125 0 0 0 0 +146 17 144 129 0 0 0 0 +146 17 144 65 0 0 0 0 +146 17 144 86 0 0 0 0 +146 17 144 126 0 0 0 0 +146 17 144 132 0 0 0 0 +146 17 144 146 0 0 0 0 +146 17 144 146 0 0 0 0 +146 17 144 125 0 0 0 0 +146 17 144 129 0 0 0 0 +125 18 144 65 0 0 0 0 +125 18 144 86 0 0 0 0 +125 18 144 126 0 0 0 0 +125 18 144 132 0 0 0 0 +125 18 144 146 0 0 0 0 +125 18 144 146 0 0 0 0 +129 18 144 65 0 0 0 0 +129 18 144 86 0 0 0 0 +129 18 144 126 0 0 0 0 +129 18 144 132 0 0 0 0 +129 18 144 146 0 0 0 0 +129 18 144 146 0 0 0 0 +60 31 65 0 0 0 0 0 +60 31 86 0 0 0 0 0 +60 31 126 0 0 0 0 0 +60 31 132 0 0 0 0 0 +60 31 146 0 0 0 0 0 +60 31 146 0 0 0 0 0 +60 31 125 0 0 0 0 0 +60 31 129 0 0 0 0 0 +1 30 65 0 0 0 0 0 +1 30 86 0 0 0 0 0 +1 30 126 0 0 0 0 0 +1 30 132 0 0 0 0 0 +1 30 146 0 0 0 0 0 +1 30 146 0 0 0 0 0 +1 30 125 0 0 0 0 0 +1 30 129 0 0 0 0 0 +128 30 65 0 0 0 0 0 +128 30 86 0 0 0 0 0 +128 30 126 0 0 0 0 0 +128 30 132 0 0 0 0 0 +128 30 146 0 0 0 0 0 +128 30 146 0 0 0 0 0 +128 30 125 0 0 0 0 0 +128 30 129 0 0 0 0 0 +142 30 65 0 0 0 0 0 +142 30 86 0 0 0 0 0 +142 30 126 0 0 0 0 0 +142 30 132 0 0 0 0 0 +142 30 146 0 0 0 0 0 +142 30 146 0 0 0 0 0 +142 30 125 0 0 0 0 0 +142 30 129 0 0 0 0 0 +146 30 65 0 0 0 0 0 +146 30 86 0 0 0 0 0 +146 30 126 0 0 0 0 0 +146 30 132 0 0 0 0 0 +146 30 146 0 0 0 0 0 +146 30 146 0 0 0 0 0 +146 30 125 0 0 0 0 0 +146 30 129 0 0 0 0 0 +146 30 65 0 0 0 0 0 +146 30 86 0 0 0 0 0 +146 30 126 0 0 0 0 0 +146 30 132 0 0 0 0 0 +146 30 146 0 0 0 0 0 +146 30 146 0 0 0 0 0 +146 30 125 0 0 0 0 0 +146 30 129 0 0 0 0 0 +125 31 65 0 0 0 0 0 +125 31 86 0 0 0 0 0 +125 31 126 0 0 0 0 0 +125 31 132 0 0 0 0 0 +125 31 146 0 0 0 0 0 +125 31 146 0 0 0 0 0 +129 31 65 0 0 0 0 0 +129 31 86 0 0 0 0 0 +129 31 126 0 0 0 0 0 +129 31 132 0 0 0 0 0 +129 31 146 0 0 0 0 0 +129 31 146 0 0 0 0 0 +60 92 65 0 0 0 0 0 +60 92 86 0 0 0 0 0 +60 92 126 0 0 0 0 0 +60 92 132 0 0 0 0 0 +60 92 146 0 0 0 0 0 +60 92 146 0 0 0 0 0 +60 92 125 0 0 0 0 0 +60 92 129 0 0 0 0 0 +1 91 65 0 0 0 0 0 +1 91 86 0 0 0 0 0 +1 91 126 0 0 0 0 0 +1 91 132 0 0 0 0 0 +1 91 146 0 0 0 0 0 +1 91 146 0 0 0 0 0 +1 91 125 0 0 0 0 0 +1 91 129 0 0 0 0 0 +128 91 65 0 0 0 0 0 +128 91 86 0 0 0 0 0 +128 91 126 0 0 0 0 0 +128 91 132 0 0 0 0 0 +128 91 146 0 0 0 0 0 +128 91 146 0 0 0 0 0 +128 91 125 0 0 0 0 0 +128 91 129 0 0 0 0 0 +142 91 65 0 0 0 0 0 +142 91 86 0 0 0 0 0 +142 91 126 0 0 0 0 0 +142 91 132 0 0 0 0 0 +142 91 146 0 0 0 0 0 +142 91 146 0 0 0 0 0 +142 91 125 0 0 0 0 0 +142 91 129 0 0 0 0 0 +146 91 65 0 0 0 0 0 +146 91 86 0 0 0 0 0 +146 91 126 0 0 0 0 0 +146 91 132 0 0 0 0 0 +146 91 146 0 0 0 0 0 +146 91 146 0 0 0 0 0 +146 91 125 0 0 0 0 0 +146 91 129 0 0 0 0 0 +146 91 65 0 0 0 0 0 +146 91 86 0 0 0 0 0 +146 91 126 0 0 0 0 0 +146 91 132 0 0 0 0 0 +146 91 146 0 0 0 0 0 +146 91 146 0 0 0 0 0 +146 91 125 0 0 0 0 0 +146 91 129 0 0 0 0 0 +125 92 65 0 0 0 0 0 +125 92 86 0 0 0 0 0 +125 92 126 0 0 0 0 0 +125 92 132 0 0 0 0 0 +125 92 146 0 0 0 0 0 +125 92 146 0 0 0 0 0 +129 92 65 0 0 0 0 0 +129 92 86 0 0 0 0 0 +129 92 126 0 0 0 0 0 +129 92 132 0 0 0 0 0 +129 92 146 0 0 0 0 0 +129 92 146 0 0 0 0 0 +60 97 65 0 0 0 0 0 +60 97 86 0 0 0 0 0 +60 97 126 0 0 0 0 0 +60 97 132 0 0 0 0 0 +60 97 146 0 0 0 0 0 +60 97 146 0 0 0 0 0 +60 97 125 0 0 0 0 0 +60 97 129 0 0 0 0 0 +1 96 65 0 0 0 0 0 +1 96 86 0 0 0 0 0 +1 96 126 0 0 0 0 0 +1 96 132 0 0 0 0 0 +1 96 146 0 0 0 0 0 +1 96 146 0 0 0 0 0 +1 96 125 0 0 0 0 0 +1 96 129 0 0 0 0 0 +128 96 65 0 0 0 0 0 +128 96 86 0 0 0 0 0 +128 96 126 0 0 0 0 0 +128 96 132 0 0 0 0 0 +128 96 146 0 0 0 0 0 +128 96 146 0 0 0 0 0 +128 96 125 0 0 0 0 0 +128 96 129 0 0 0 0 0 +142 96 65 0 0 0 0 0 +142 96 86 0 0 0 0 0 +142 96 126 0 0 0 0 0 +142 96 132 0 0 0 0 0 +142 96 146 0 0 0 0 0 +142 96 146 0 0 0 0 0 +142 96 125 0 0 0 0 0 +142 96 129 0 0 0 0 0 +146 96 65 0 0 0 0 0 +146 96 86 0 0 0 0 0 +146 96 126 0 0 0 0 0 +146 96 132 0 0 0 0 0 +146 96 146 0 0 0 0 0 +146 96 146 0 0 0 0 0 +146 96 125 0 0 0 0 0 +146 96 129 0 0 0 0 0 +146 96 65 0 0 0 0 0 +146 96 86 0 0 0 0 0 +146 96 126 0 0 0 0 0 +146 96 132 0 0 0 0 0 +146 96 146 0 0 0 0 0 +146 96 146 0 0 0 0 0 +146 96 125 0 0 0 0 0 +146 96 129 0 0 0 0 0 +125 97 65 0 0 0 0 0 +125 97 86 0 0 0 0 0 +125 97 126 0 0 0 0 0 +125 97 132 0 0 0 0 0 +125 97 146 0 0 0 0 0 +125 97 146 0 0 0 0 0 +129 97 65 0 0 0 0 0 +129 97 86 0 0 0 0 0 +129 97 126 0 0 0 0 0 +129 97 132 0 0 0 0 0 +129 97 146 0 0 0 0 0 +129 97 146 0 0 0 0 0 +60 29 9 0 0 0 0 0 +60 29 141 0 0 0 0 0 +60 29 2 0 0 0 0 0 +60 29 43 0 0 0 0 0 +60 29 89 0 0 0 0 0 +60 29 112 0 0 0 0 0 +1 28 9 0 0 0 0 0 +1 28 141 0 0 0 0 0 +1 28 2 0 0 0 0 0 +1 28 43 0 0 0 0 0 +1 28 89 0 0 0 0 0 +1 28 112 0 0 0 0 0 +128 28 9 0 0 0 0 0 +128 28 141 0 0 0 0 0 +128 28 2 0 0 0 0 0 +128 28 43 0 0 0 0 0 +128 28 89 0 0 0 0 0 +128 28 112 0 0 0 0 0 +142 28 9 0 0 0 0 0 +142 28 141 0 0 0 0 0 +142 28 2 0 0 0 0 0 +142 28 43 0 0 0 0 0 +142 28 89 0 0 0 0 0 +142 28 112 0 0 0 0 0 +146 28 9 0 0 0 0 0 +146 28 141 0 0 0 0 0 +146 28 2 0 0 0 0 0 +146 28 43 0 0 0 0 0 +146 28 89 0 0 0 0 0 +146 28 112 0 0 0 0 0 +146 28 9 0 0 0 0 0 +146 28 141 0 0 0 0 0 +146 28 2 0 0 0 0 0 +146 28 43 0 0 0 0 0 +146 28 89 0 0 0 0 0 +146 28 112 0 0 0 0 0 +125 29 9 0 0 0 0 0 +125 29 141 0 0 0 0 0 +125 29 2 0 0 0 0 0 +125 29 43 0 0 0 0 0 +125 29 89 0 0 0 0 0 +125 29 112 0 0 0 0 0 +129 29 9 0 0 0 0 0 +129 29 141 0 0 0 0 0 +129 29 2 0 0 0 0 0 +129 29 43 0 0 0 0 0 +129 29 89 0 0 0 0 0 +129 29 112 0 0 0 0 0 +60 38 9 0 0 0 0 0 +60 38 141 0 0 0 0 0 +60 38 2 0 0 0 0 0 +60 38 43 0 0 0 0 0 +60 38 89 0 0 0 0 0 +60 38 112 0 0 0 0 0 +1 37 9 0 0 0 0 0 +1 37 141 0 0 0 0 0 +1 37 2 0 0 0 0 0 +1 37 43 0 0 0 0 0 +1 37 89 0 0 0 0 0 +1 37 112 0 0 0 0 0 +128 37 9 0 0 0 0 0 +128 37 141 0 0 0 0 0 +128 37 2 0 0 0 0 0 +128 37 43 0 0 0 0 0 +128 37 89 0 0 0 0 0 +128 37 112 0 0 0 0 0 +142 37 9 0 0 0 0 0 +142 37 141 0 0 0 0 0 +142 37 2 0 0 0 0 0 +142 37 43 0 0 0 0 0 +142 37 89 0 0 0 0 0 +142 37 112 0 0 0 0 0 +146 37 9 0 0 0 0 0 +146 37 141 0 0 0 0 0 +146 37 2 0 0 0 0 0 +146 37 43 0 0 0 0 0 +146 37 89 0 0 0 0 0 +146 37 112 0 0 0 0 0 +146 37 9 0 0 0 0 0 +146 37 141 0 0 0 0 0 +146 37 2 0 0 0 0 0 +146 37 43 0 0 0 0 0 +146 37 89 0 0 0 0 0 +146 37 112 0 0 0 0 0 +125 38 9 0 0 0 0 0 +125 38 141 0 0 0 0 0 +125 38 2 0 0 0 0 0 +125 38 43 0 0 0 0 0 +125 38 89 0 0 0 0 0 +125 38 112 0 0 0 0 0 +129 38 9 0 0 0 0 0 +129 38 141 0 0 0 0 0 +129 38 2 0 0 0 0 0 +129 38 43 0 0 0 0 0 +129 38 89 0 0 0 0 0 +129 38 112 0 0 0 0 0 +60 58 9 0 0 0 0 0 +60 58 141 0 0 0 0 0 +60 58 2 0 0 0 0 0 +60 58 43 0 0 0 0 0 +60 58 89 0 0 0 0 0 +60 58 112 0 0 0 0 0 +1 59 9 0 0 0 0 0 +1 59 141 0 0 0 0 0 +1 59 2 0 0 0 0 0 +1 59 43 0 0 0 0 0 +1 59 89 0 0 0 0 0 +1 59 112 0 0 0 0 0 +128 59 9 0 0 0 0 0 +128 59 141 0 0 0 0 0 +128 59 2 0 0 0 0 0 +128 59 43 0 0 0 0 0 +128 59 89 0 0 0 0 0 +128 59 112 0 0 0 0 0 +142 59 9 0 0 0 0 0 +142 59 141 0 0 0 0 0 +142 59 2 0 0 0 0 0 +142 59 43 0 0 0 0 0 +142 59 89 0 0 0 0 0 +142 59 112 0 0 0 0 0 +146 59 9 0 0 0 0 0 +146 59 141 0 0 0 0 0 +146 59 2 0 0 0 0 0 +146 59 43 0 0 0 0 0 +146 59 89 0 0 0 0 0 +146 59 112 0 0 0 0 0 +146 59 9 0 0 0 0 0 +146 59 141 0 0 0 0 0 +146 59 2 0 0 0 0 0 +146 59 43 0 0 0 0 0 +146 59 89 0 0 0 0 0 +146 59 112 0 0 0 0 0 +125 58 9 0 0 0 0 0 +125 58 141 0 0 0 0 0 +125 58 2 0 0 0 0 0 +125 58 43 0 0 0 0 0 +125 58 89 0 0 0 0 0 +125 58 112 0 0 0 0 0 +129 58 9 0 0 0 0 0 +129 58 141 0 0 0 0 0 +129 58 2 0 0 0 0 0 +129 58 43 0 0 0 0 0 +129 58 89 0 0 0 0 0 +129 58 112 0 0 0 0 0 +60 104 9 0 0 0 0 0 +60 104 141 0 0 0 0 0 +60 104 2 0 0 0 0 0 +60 104 43 0 0 0 0 0 +60 104 89 0 0 0 0 0 +60 104 112 0 0 0 0 0 +1 103 9 0 0 0 0 0 +1 103 141 0 0 0 0 0 +1 103 2 0 0 0 0 0 +1 103 43 0 0 0 0 0 +1 103 89 0 0 0 0 0 +1 103 112 0 0 0 0 0 +128 103 9 0 0 0 0 0 +128 103 141 0 0 0 0 0 +128 103 2 0 0 0 0 0 +128 103 43 0 0 0 0 0 +128 103 89 0 0 0 0 0 +128 103 112 0 0 0 0 0 +142 103 9 0 0 0 0 0 +142 103 141 0 0 0 0 0 +142 103 2 0 0 0 0 0 +142 103 43 0 0 0 0 0 +142 103 89 0 0 0 0 0 +142 103 112 0 0 0 0 0 +146 103 9 0 0 0 0 0 +146 103 141 0 0 0 0 0 +146 103 2 0 0 0 0 0 +146 103 43 0 0 0 0 0 +146 103 89 0 0 0 0 0 +146 103 112 0 0 0 0 0 +146 103 9 0 0 0 0 0 +146 103 141 0 0 0 0 0 +146 103 2 0 0 0 0 0 +146 103 43 0 0 0 0 0 +146 103 89 0 0 0 0 0 +146 103 112 0 0 0 0 0 +125 104 9 0 0 0 0 0 +125 104 141 0 0 0 0 0 +125 104 2 0 0 0 0 0 +125 104 43 0 0 0 0 0 +125 104 89 0 0 0 0 0 +125 104 112 0 0 0 0 0 +129 104 9 0 0 0 0 0 +129 104 141 0 0 0 0 0 +129 104 2 0 0 0 0 0 +129 104 43 0 0 0 0 0 +129 104 89 0 0 0 0 0 +129 104 112 0 0 0 0 0 +60 18 144 9 0 0 0 0 +60 18 144 141 0 0 0 0 +60 18 144 2 0 0 0 0 +60 18 144 43 0 0 0 0 +60 18 144 89 0 0 0 0 +60 18 144 112 0 0 0 0 +1 17 144 9 0 0 0 0 +1 17 144 141 0 0 0 0 +1 17 144 2 0 0 0 0 +1 17 144 43 0 0 0 0 +1 17 144 89 0 0 0 0 +1 17 144 112 0 0 0 0 +128 17 144 9 0 0 0 0 +128 17 144 141 0 0 0 0 +128 17 144 2 0 0 0 0 +128 17 144 43 0 0 0 0 +128 17 144 89 0 0 0 0 +128 17 144 112 0 0 0 0 +142 17 144 9 0 0 0 0 +142 17 144 141 0 0 0 0 +142 17 144 2 0 0 0 0 +142 17 144 43 0 0 0 0 +142 17 144 89 0 0 0 0 +142 17 144 112 0 0 0 0 +146 17 144 9 0 0 0 0 +146 17 144 141 0 0 0 0 +146 17 144 2 0 0 0 0 +146 17 144 43 0 0 0 0 +146 17 144 89 0 0 0 0 +146 17 144 112 0 0 0 0 +146 17 144 9 0 0 0 0 +146 17 144 141 0 0 0 0 +146 17 144 2 0 0 0 0 +146 17 144 43 0 0 0 0 +146 17 144 89 0 0 0 0 +146 17 144 112 0 0 0 0 +125 18 144 9 0 0 0 0 +125 18 144 141 0 0 0 0 +125 18 144 2 0 0 0 0 +125 18 144 43 0 0 0 0 +125 18 144 89 0 0 0 0 +125 18 144 112 0 0 0 0 +129 18 144 9 0 0 0 0 +129 18 144 141 0 0 0 0 +129 18 144 2 0 0 0 0 +129 18 144 43 0 0 0 0 +129 18 144 89 0 0 0 0 +129 18 144 112 0 0 0 0 +60 31 9 0 0 0 0 0 +60 31 141 0 0 0 0 0 +60 31 2 0 0 0 0 0 +60 31 43 0 0 0 0 0 +60 31 89 0 0 0 0 0 +60 31 112 0 0 0 0 0 +1 30 9 0 0 0 0 0 +1 30 141 0 0 0 0 0 +1 30 2 0 0 0 0 0 +1 30 43 0 0 0 0 0 +1 30 89 0 0 0 0 0 +1 30 112 0 0 0 0 0 +128 30 9 0 0 0 0 0 +128 30 141 0 0 0 0 0 +128 30 2 0 0 0 0 0 +128 30 43 0 0 0 0 0 +128 30 89 0 0 0 0 0 +128 30 112 0 0 0 0 0 +142 30 9 0 0 0 0 0 +142 30 141 0 0 0 0 0 +142 30 2 0 0 0 0 0 +142 30 43 0 0 0 0 0 +142 30 89 0 0 0 0 0 +142 30 112 0 0 0 0 0 +146 30 9 0 0 0 0 0 +146 30 141 0 0 0 0 0 +146 30 2 0 0 0 0 0 +146 30 43 0 0 0 0 0 +146 30 89 0 0 0 0 0 +146 30 112 0 0 0 0 0 +146 30 9 0 0 0 0 0 +146 30 141 0 0 0 0 0 +146 30 2 0 0 0 0 0 +146 30 43 0 0 0 0 0 +146 30 89 0 0 0 0 0 +146 30 112 0 0 0 0 0 +125 31 9 0 0 0 0 0 +125 31 141 0 0 0 0 0 +125 31 2 0 0 0 0 0 +125 31 43 0 0 0 0 0 +125 31 89 0 0 0 0 0 +125 31 112 0 0 0 0 0 +129 31 9 0 0 0 0 0 +129 31 141 0 0 0 0 0 +129 31 2 0 0 0 0 0 +129 31 43 0 0 0 0 0 +129 31 89 0 0 0 0 0 +129 31 112 0 0 0 0 0 +60 92 9 0 0 0 0 0 +60 92 141 0 0 0 0 0 +60 92 2 0 0 0 0 0 +60 92 43 0 0 0 0 0 +60 92 89 0 0 0 0 0 +60 92 112 0 0 0 0 0 +1 91 9 0 0 0 0 0 +1 91 141 0 0 0 0 0 +1 91 2 0 0 0 0 0 +1 91 43 0 0 0 0 0 +1 91 89 0 0 0 0 0 +1 91 112 0 0 0 0 0 +128 91 9 0 0 0 0 0 +128 91 141 0 0 0 0 0 +128 91 2 0 0 0 0 0 +128 91 43 0 0 0 0 0 +128 91 89 0 0 0 0 0 +128 91 112 0 0 0 0 0 +142 91 9 0 0 0 0 0 +142 91 141 0 0 0 0 0 +142 91 2 0 0 0 0 0 +142 91 43 0 0 0 0 0 +142 91 89 0 0 0 0 0 +142 91 112 0 0 0 0 0 +146 91 9 0 0 0 0 0 +146 91 141 0 0 0 0 0 +146 91 2 0 0 0 0 0 +146 91 43 0 0 0 0 0 +146 91 89 0 0 0 0 0 +146 91 112 0 0 0 0 0 +146 91 9 0 0 0 0 0 +146 91 141 0 0 0 0 0 +146 91 2 0 0 0 0 0 +146 91 43 0 0 0 0 0 +146 91 89 0 0 0 0 0 +146 91 112 0 0 0 0 0 +125 92 9 0 0 0 0 0 +125 92 141 0 0 0 0 0 +125 92 2 0 0 0 0 0 +125 92 43 0 0 0 0 0 +125 92 89 0 0 0 0 0 +125 92 112 0 0 0 0 0 +129 92 9 0 0 0 0 0 +129 92 141 0 0 0 0 0 +129 92 2 0 0 0 0 0 +129 92 43 0 0 0 0 0 +129 92 89 0 0 0 0 0 +129 92 112 0 0 0 0 0 +60 97 9 0 0 0 0 0 +60 97 141 0 0 0 0 0 +60 97 2 0 0 0 0 0 +60 97 43 0 0 0 0 0 +60 97 89 0 0 0 0 0 +60 97 112 0 0 0 0 0 +1 96 9 0 0 0 0 0 +1 96 141 0 0 0 0 0 +1 96 2 0 0 0 0 0 +1 96 43 0 0 0 0 0 +1 96 89 0 0 0 0 0 +1 96 112 0 0 0 0 0 +128 96 9 0 0 0 0 0 +128 96 141 0 0 0 0 0 +128 96 2 0 0 0 0 0 +128 96 43 0 0 0 0 0 +128 96 89 0 0 0 0 0 +128 96 112 0 0 0 0 0 +142 96 9 0 0 0 0 0 +142 96 141 0 0 0 0 0 +142 96 2 0 0 0 0 0 +142 96 43 0 0 0 0 0 +142 96 89 0 0 0 0 0 +142 96 112 0 0 0 0 0 +146 96 9 0 0 0 0 0 +146 96 141 0 0 0 0 0 +146 96 2 0 0 0 0 0 +146 96 43 0 0 0 0 0 +146 96 89 0 0 0 0 0 +146 96 112 0 0 0 0 0 +146 96 9 0 0 0 0 0 +146 96 141 0 0 0 0 0 +146 96 2 0 0 0 0 0 +146 96 43 0 0 0 0 0 +146 96 89 0 0 0 0 0 +146 96 112 0 0 0 0 0 +125 97 9 0 0 0 0 0 +125 97 141 0 0 0 0 0 +125 97 2 0 0 0 0 0 +125 97 43 0 0 0 0 0 +125 97 89 0 0 0 0 0 +125 97 112 0 0 0 0 0 +129 97 9 0 0 0 0 0 +129 97 141 0 0 0 0 0 +129 97 2 0 0 0 0 0 +129 97 43 0 0 0 0 0 +129 97 89 0 0 0 0 0 +129 97 112 0 0 0 0 0 +60 46 65 131 65 0 0 0 +60 46 65 131 86 0 0 0 +60 46 65 131 126 0 0 0 +60 46 65 131 132 0 0 0 +60 46 65 131 146 0 0 0 +60 46 65 131 146 0 0 0 +60 46 65 131 125 0 0 0 +60 46 65 131 129 0 0 0 +60 46 86 131 65 0 0 0 +60 46 86 131 86 0 0 0 +60 46 86 131 126 0 0 0 +60 46 86 131 132 0 0 0 +60 46 86 131 146 0 0 0 +60 46 86 131 146 0 0 0 +60 46 86 131 125 0 0 0 +60 46 86 131 129 0 0 0 +60 46 126 131 65 0 0 0 +60 46 126 131 86 0 0 0 +60 46 126 131 126 0 0 0 +60 46 126 131 132 0 0 0 +60 46 126 131 146 0 0 0 +60 46 126 131 146 0 0 0 +60 46 126 131 125 0 0 0 +60 46 126 131 129 0 0 0 +60 46 132 131 65 0 0 0 +60 46 132 131 86 0 0 0 +60 46 132 131 126 0 0 0 +60 46 132 131 132 0 0 0 +60 46 132 131 146 0 0 0 +60 46 132 131 146 0 0 0 +60 46 132 131 125 0 0 0 +60 46 132 131 129 0 0 0 +60 46 146 131 65 0 0 0 +60 46 146 131 86 0 0 0 +60 46 146 131 126 0 0 0 +60 46 146 131 132 0 0 0 +60 46 146 131 146 0 0 0 +60 46 146 131 146 0 0 0 +60 46 146 131 125 0 0 0 +60 46 146 131 129 0 0 0 +60 46 146 131 65 0 0 0 +60 46 146 131 86 0 0 0 +60 46 146 131 126 0 0 0 +60 46 146 131 132 0 0 0 +60 46 146 131 146 0 0 0 +60 46 146 131 146 0 0 0 +60 46 146 131 125 0 0 0 +60 46 146 131 129 0 0 0 +60 46 125 131 65 0 0 0 +60 46 125 131 86 0 0 0 +60 46 125 131 126 0 0 0 +60 46 125 131 132 0 0 0 +60 46 125 131 146 0 0 0 +60 46 125 131 146 0 0 0 +60 46 125 131 125 0 0 0 +60 46 125 131 129 0 0 0 +60 46 129 131 65 0 0 0 +60 46 129 131 86 0 0 0 +60 46 129 131 126 0 0 0 +60 46 129 131 132 0 0 0 +60 46 129 131 146 0 0 0 +60 46 129 131 146 0 0 0 +60 46 129 131 125 0 0 0 +60 46 129 131 129 0 0 0 +1 45 65 131 65 0 0 0 +1 45 65 131 86 0 0 0 +1 45 65 131 126 0 0 0 +1 45 65 131 132 0 0 0 +1 45 65 131 146 0 0 0 +1 45 65 131 146 0 0 0 +1 45 65 131 125 0 0 0 +1 45 65 131 129 0 0 0 +1 45 86 131 65 0 0 0 +1 45 86 131 86 0 0 0 +1 45 86 131 126 0 0 0 +1 45 86 131 132 0 0 0 +1 45 86 131 146 0 0 0 +1 45 86 131 146 0 0 0 +1 45 86 131 125 0 0 0 +1 45 86 131 129 0 0 0 +1 45 126 131 65 0 0 0 +1 45 126 131 86 0 0 0 +1 45 126 131 126 0 0 0 +1 45 126 131 132 0 0 0 +1 45 126 131 146 0 0 0 +1 45 126 131 146 0 0 0 +1 45 126 131 125 0 0 0 +1 45 126 131 129 0 0 0 +1 45 132 131 65 0 0 0 +1 45 132 131 86 0 0 0 +1 45 132 131 126 0 0 0 +1 45 132 131 132 0 0 0 +1 45 132 131 146 0 0 0 +1 45 132 131 146 0 0 0 +1 45 132 131 125 0 0 0 +1 45 132 131 129 0 0 0 +1 45 146 131 65 0 0 0 +1 45 146 131 86 0 0 0 +1 45 146 131 126 0 0 0 +1 45 146 131 132 0 0 0 +1 45 146 131 146 0 0 0 +1 45 146 131 146 0 0 0 +1 45 146 131 125 0 0 0 +1 45 146 131 129 0 0 0 +1 45 146 131 65 0 0 0 +1 45 146 131 86 0 0 0 +1 45 146 131 126 0 0 0 +1 45 146 131 132 0 0 0 +1 45 146 131 146 0 0 0 +1 45 146 131 146 0 0 0 +1 45 146 131 125 0 0 0 +1 45 146 131 129 0 0 0 +1 45 125 131 65 0 0 0 +1 45 125 131 86 0 0 0 +1 45 125 131 126 0 0 0 +1 45 125 131 132 0 0 0 +1 45 125 131 146 0 0 0 +1 45 125 131 146 0 0 0 +1 45 125 131 125 0 0 0 +1 45 125 131 129 0 0 0 +1 45 129 131 65 0 0 0 +1 45 129 131 86 0 0 0 +1 45 129 131 126 0 0 0 +1 45 129 131 132 0 0 0 +1 45 129 131 146 0 0 0 +1 45 129 131 146 0 0 0 +1 45 129 131 125 0 0 0 +1 45 129 131 129 0 0 0 +128 45 65 131 65 0 0 0 +128 45 65 131 86 0 0 0 +128 45 65 131 126 0 0 0 +128 45 65 131 132 0 0 0 +128 45 65 131 146 0 0 0 +128 45 65 131 146 0 0 0 +128 45 65 131 125 0 0 0 +128 45 65 131 129 0 0 0 +128 45 86 131 65 0 0 0 +128 45 86 131 86 0 0 0 +128 45 86 131 126 0 0 0 +128 45 86 131 132 0 0 0 +128 45 86 131 146 0 0 0 +128 45 86 131 146 0 0 0 +128 45 86 131 125 0 0 0 +128 45 86 131 129 0 0 0 +128 45 126 131 65 0 0 0 +128 45 126 131 86 0 0 0 +128 45 126 131 126 0 0 0 +128 45 126 131 132 0 0 0 +128 45 126 131 146 0 0 0 +128 45 126 131 146 0 0 0 +128 45 126 131 125 0 0 0 +128 45 126 131 129 0 0 0 +128 45 132 131 65 0 0 0 +128 45 132 131 86 0 0 0 +128 45 132 131 126 0 0 0 +128 45 132 131 132 0 0 0 +128 45 132 131 146 0 0 0 +128 45 132 131 146 0 0 0 +128 45 132 131 125 0 0 0 +128 45 132 131 129 0 0 0 +128 45 146 131 65 0 0 0 +128 45 146 131 86 0 0 0 +128 45 146 131 126 0 0 0 +128 45 146 131 132 0 0 0 +128 45 146 131 146 0 0 0 +128 45 146 131 146 0 0 0 +128 45 146 131 125 0 0 0 +128 45 146 131 129 0 0 0 +128 45 146 131 65 0 0 0 +128 45 146 131 86 0 0 0 +128 45 146 131 126 0 0 0 +128 45 146 131 132 0 0 0 +128 45 146 131 146 0 0 0 +128 45 146 131 146 0 0 0 +128 45 146 131 125 0 0 0 +128 45 146 131 129 0 0 0 +128 45 125 131 65 0 0 0 +128 45 125 131 86 0 0 0 +128 45 125 131 126 0 0 0 +128 45 125 131 132 0 0 0 +128 45 125 131 146 0 0 0 +128 45 125 131 146 0 0 0 +128 45 125 131 125 0 0 0 +128 45 125 131 129 0 0 0 +128 45 129 131 65 0 0 0 +128 45 129 131 86 0 0 0 +128 45 129 131 126 0 0 0 +128 45 129 131 132 0 0 0 +128 45 129 131 146 0 0 0 +128 45 129 131 146 0 0 0 +128 45 129 131 125 0 0 0 +128 45 129 131 129 0 0 0 +142 45 65 131 65 0 0 0 +142 45 65 131 86 0 0 0 +142 45 65 131 126 0 0 0 +142 45 65 131 132 0 0 0 +142 45 65 131 146 0 0 0 +142 45 65 131 146 0 0 0 +142 45 65 131 125 0 0 0 +142 45 65 131 129 0 0 0 +142 45 86 131 65 0 0 0 +142 45 86 131 86 0 0 0 +142 45 86 131 126 0 0 0 +142 45 86 131 132 0 0 0 +142 45 86 131 146 0 0 0 +142 45 86 131 146 0 0 0 +142 45 86 131 125 0 0 0 +142 45 86 131 129 0 0 0 +142 45 126 131 65 0 0 0 +142 45 126 131 86 0 0 0 +142 45 126 131 126 0 0 0 +142 45 126 131 132 0 0 0 +142 45 126 131 146 0 0 0 +142 45 126 131 146 0 0 0 +142 45 126 131 125 0 0 0 +142 45 126 131 129 0 0 0 +142 45 132 131 65 0 0 0 +142 45 132 131 86 0 0 0 +142 45 132 131 126 0 0 0 +142 45 132 131 132 0 0 0 +142 45 132 131 146 0 0 0 +142 45 132 131 146 0 0 0 +142 45 132 131 125 0 0 0 +142 45 132 131 129 0 0 0 +142 45 146 131 65 0 0 0 +142 45 146 131 86 0 0 0 +142 45 146 131 126 0 0 0 +142 45 146 131 132 0 0 0 +142 45 146 131 146 0 0 0 +142 45 146 131 146 0 0 0 +142 45 146 131 125 0 0 0 +142 45 146 131 129 0 0 0 +142 45 146 131 65 0 0 0 +142 45 146 131 86 0 0 0 +142 45 146 131 126 0 0 0 +142 45 146 131 132 0 0 0 +142 45 146 131 146 0 0 0 +142 45 146 131 146 0 0 0 +142 45 146 131 125 0 0 0 +142 45 146 131 129 0 0 0 +142 45 125 131 65 0 0 0 +142 45 125 131 86 0 0 0 +142 45 125 131 126 0 0 0 +142 45 125 131 132 0 0 0 +142 45 125 131 146 0 0 0 +142 45 125 131 146 0 0 0 +142 45 125 131 125 0 0 0 +142 45 125 131 129 0 0 0 +142 45 129 131 65 0 0 0 +142 45 129 131 86 0 0 0 +142 45 129 131 126 0 0 0 +142 45 129 131 132 0 0 0 +142 45 129 131 146 0 0 0 +142 45 129 131 146 0 0 0 +142 45 129 131 125 0 0 0 +142 45 129 131 129 0 0 0 +146 45 65 131 65 0 0 0 +146 45 65 131 86 0 0 0 +146 45 65 131 126 0 0 0 +146 45 65 131 132 0 0 0 +146 45 65 131 146 0 0 0 +146 45 65 131 146 0 0 0 +146 45 65 131 125 0 0 0 +146 45 65 131 129 0 0 0 +146 45 86 131 65 0 0 0 +146 45 86 131 86 0 0 0 +146 45 86 131 126 0 0 0 +146 45 86 131 132 0 0 0 +146 45 86 131 146 0 0 0 +146 45 86 131 146 0 0 0 +146 45 86 131 125 0 0 0 +146 45 86 131 129 0 0 0 +146 45 126 131 65 0 0 0 +146 45 126 131 86 0 0 0 +146 45 126 131 126 0 0 0 +146 45 126 131 132 0 0 0 +146 45 126 131 146 0 0 0 +146 45 126 131 146 0 0 0 +146 45 126 131 125 0 0 0 +146 45 126 131 129 0 0 0 +146 45 132 131 65 0 0 0 +146 45 132 131 86 0 0 0 +146 45 132 131 126 0 0 0 +146 45 132 131 132 0 0 0 +146 45 132 131 146 0 0 0 +146 45 132 131 146 0 0 0 +146 45 132 131 125 0 0 0 +146 45 132 131 129 0 0 0 +146 45 146 131 65 0 0 0 +146 45 146 131 86 0 0 0 +146 45 146 131 126 0 0 0 +146 45 146 131 132 0 0 0 +146 45 146 131 146 0 0 0 +146 45 146 131 146 0 0 0 +146 45 146 131 125 0 0 0 +146 45 146 131 129 0 0 0 +146 45 146 131 65 0 0 0 +146 45 146 131 86 0 0 0 +146 45 146 131 126 0 0 0 +146 45 146 131 132 0 0 0 +146 45 146 131 146 0 0 0 +146 45 146 131 146 0 0 0 +146 45 146 131 125 0 0 0 +146 45 146 131 129 0 0 0 +146 45 125 131 65 0 0 0 +146 45 125 131 86 0 0 0 +146 45 125 131 126 0 0 0 +146 45 125 131 132 0 0 0 +146 45 125 131 146 0 0 0 +146 45 125 131 146 0 0 0 +146 45 125 131 125 0 0 0 +146 45 125 131 129 0 0 0 +146 45 129 131 65 0 0 0 +146 45 129 131 86 0 0 0 +146 45 129 131 126 0 0 0 +146 45 129 131 132 0 0 0 +146 45 129 131 146 0 0 0 +146 45 129 131 146 0 0 0 +146 45 129 131 125 0 0 0 +146 45 129 131 129 0 0 0 +146 45 65 131 65 0 0 0 +146 45 65 131 86 0 0 0 +146 45 65 131 126 0 0 0 +146 45 65 131 132 0 0 0 +146 45 65 131 146 0 0 0 +146 45 65 131 146 0 0 0 +146 45 65 131 125 0 0 0 +146 45 65 131 129 0 0 0 +146 45 86 131 65 0 0 0 +146 45 86 131 86 0 0 0 +146 45 86 131 126 0 0 0 +146 45 86 131 132 0 0 0 +146 45 86 131 146 0 0 0 +146 45 86 131 146 0 0 0 +146 45 86 131 125 0 0 0 +146 45 86 131 129 0 0 0 +146 45 126 131 65 0 0 0 +146 45 126 131 86 0 0 0 +146 45 126 131 126 0 0 0 +146 45 126 131 132 0 0 0 +146 45 126 131 146 0 0 0 +146 45 126 131 146 0 0 0 +146 45 126 131 125 0 0 0 +146 45 126 131 129 0 0 0 +146 45 132 131 65 0 0 0 +146 45 132 131 86 0 0 0 +146 45 132 131 126 0 0 0 +146 45 132 131 132 0 0 0 +146 45 132 131 146 0 0 0 +146 45 132 131 146 0 0 0 +146 45 132 131 125 0 0 0 +146 45 132 131 129 0 0 0 +146 45 146 131 65 0 0 0 +146 45 146 131 86 0 0 0 +146 45 146 131 126 0 0 0 +146 45 146 131 132 0 0 0 +146 45 146 131 146 0 0 0 +146 45 146 131 146 0 0 0 +146 45 146 131 125 0 0 0 +146 45 146 131 129 0 0 0 +146 45 146 131 65 0 0 0 +146 45 146 131 86 0 0 0 +146 45 146 131 126 0 0 0 +146 45 146 131 132 0 0 0 +146 45 146 131 146 0 0 0 +146 45 146 131 146 0 0 0 +146 45 146 131 125 0 0 0 +146 45 146 131 129 0 0 0 +146 45 125 131 65 0 0 0 +146 45 125 131 86 0 0 0 +146 45 125 131 126 0 0 0 +146 45 125 131 132 0 0 0 +146 45 125 131 146 0 0 0 +146 45 125 131 146 0 0 0 +146 45 125 131 125 0 0 0 +146 45 125 131 129 0 0 0 +146 45 129 131 65 0 0 0 +146 45 129 131 86 0 0 0 +146 45 129 131 126 0 0 0 +146 45 129 131 132 0 0 0 +146 45 129 131 146 0 0 0 +146 45 129 131 146 0 0 0 +146 45 129 131 125 0 0 0 +146 45 129 131 129 0 0 0 +125 46 65 131 65 0 0 0 +125 46 65 131 86 0 0 0 +125 46 65 131 126 0 0 0 +125 46 65 131 132 0 0 0 +125 46 65 131 146 0 0 0 +125 46 65 131 146 0 0 0 +125 46 65 131 125 0 0 0 +125 46 65 131 129 0 0 0 +125 46 86 131 65 0 0 0 +125 46 86 131 86 0 0 0 +125 46 86 131 126 0 0 0 +125 46 86 131 132 0 0 0 +125 46 86 131 146 0 0 0 +125 46 86 131 146 0 0 0 +125 46 86 131 125 0 0 0 +125 46 86 131 129 0 0 0 +125 46 126 131 65 0 0 0 +125 46 126 131 86 0 0 0 +125 46 126 131 126 0 0 0 +125 46 126 131 132 0 0 0 +125 46 126 131 146 0 0 0 +125 46 126 131 146 0 0 0 +125 46 126 131 125 0 0 0 +125 46 126 131 129 0 0 0 +125 46 132 131 65 0 0 0 +125 46 132 131 86 0 0 0 +125 46 132 131 126 0 0 0 +125 46 132 131 132 0 0 0 +125 46 132 131 146 0 0 0 +125 46 132 131 146 0 0 0 +125 46 132 131 125 0 0 0 +125 46 132 131 129 0 0 0 +125 46 146 131 65 0 0 0 +125 46 146 131 86 0 0 0 +125 46 146 131 126 0 0 0 +125 46 146 131 132 0 0 0 +125 46 146 131 146 0 0 0 +125 46 146 131 146 0 0 0 +125 46 146 131 125 0 0 0 +125 46 146 131 129 0 0 0 +125 46 146 131 65 0 0 0 +125 46 146 131 86 0 0 0 +125 46 146 131 126 0 0 0 +125 46 146 131 132 0 0 0 +125 46 146 131 146 0 0 0 +125 46 146 131 146 0 0 0 +125 46 146 131 125 0 0 0 +125 46 146 131 129 0 0 0 +125 46 125 131 65 0 0 0 +125 46 125 131 86 0 0 0 +125 46 125 131 126 0 0 0 +125 46 125 131 132 0 0 0 +125 46 125 131 146 0 0 0 +125 46 125 131 146 0 0 0 +125 46 129 131 65 0 0 0 +125 46 129 131 86 0 0 0 +125 46 129 131 126 0 0 0 +125 46 129 131 132 0 0 0 +125 46 129 131 146 0 0 0 +125 46 129 131 146 0 0 0 +129 46 65 131 65 0 0 0 +129 46 65 131 86 0 0 0 +129 46 65 131 126 0 0 0 +129 46 65 131 132 0 0 0 +129 46 65 131 146 0 0 0 +129 46 65 131 146 0 0 0 +129 46 65 131 125 0 0 0 +129 46 65 131 129 0 0 0 +129 46 86 131 65 0 0 0 +129 46 86 131 86 0 0 0 +129 46 86 131 126 0 0 0 +129 46 86 131 132 0 0 0 +129 46 86 131 146 0 0 0 +129 46 86 131 146 0 0 0 +129 46 86 131 125 0 0 0 +129 46 86 131 129 0 0 0 +129 46 126 131 65 0 0 0 +129 46 126 131 86 0 0 0 +129 46 126 131 126 0 0 0 +129 46 126 131 132 0 0 0 +129 46 126 131 146 0 0 0 +129 46 126 131 146 0 0 0 +129 46 126 131 125 0 0 0 +129 46 126 131 129 0 0 0 +129 46 132 131 65 0 0 0 +129 46 132 131 86 0 0 0 +129 46 132 131 126 0 0 0 +129 46 132 131 132 0 0 0 +129 46 132 131 146 0 0 0 +129 46 132 131 146 0 0 0 +129 46 132 131 125 0 0 0 +129 46 132 131 129 0 0 0 +129 46 146 131 65 0 0 0 +129 46 146 131 86 0 0 0 +129 46 146 131 126 0 0 0 +129 46 146 131 132 0 0 0 +129 46 146 131 146 0 0 0 +129 46 146 131 146 0 0 0 +129 46 146 131 125 0 0 0 +129 46 146 131 129 0 0 0 +129 46 146 131 65 0 0 0 +129 46 146 131 86 0 0 0 +129 46 146 131 126 0 0 0 +129 46 146 131 132 0 0 0 +129 46 146 131 146 0 0 0 +129 46 146 131 146 0 0 0 +129 46 146 131 125 0 0 0 +129 46 146 131 129 0 0 0 +129 46 125 131 65 0 0 0 +129 46 125 131 86 0 0 0 +129 46 125 131 126 0 0 0 +129 46 125 131 132 0 0 0 +129 46 125 131 146 0 0 0 +129 46 125 131 146 0 0 0 +129 46 129 131 65 0 0 0 +129 46 129 131 86 0 0 0 +129 46 129 131 126 0 0 0 +129 46 129 131 132 0 0 0 +129 46 129 131 146 0 0 0 +129 46 129 131 146 0 0 0 +60 107 65 65 0 0 0 0 +60 107 65 86 0 0 0 0 +60 107 65 126 0 0 0 0 +60 107 65 132 0 0 0 0 +60 107 65 146 0 0 0 0 +60 107 65 146 0 0 0 0 +60 107 65 125 0 0 0 0 +60 107 65 129 0 0 0 0 +60 107 86 65 0 0 0 0 +60 107 86 86 0 0 0 0 +60 107 86 126 0 0 0 0 +60 107 86 132 0 0 0 0 +60 107 86 146 0 0 0 0 +60 107 86 146 0 0 0 0 +60 107 86 125 0 0 0 0 +60 107 86 129 0 0 0 0 +60 107 126 65 0 0 0 0 +60 107 126 86 0 0 0 0 +60 107 126 126 0 0 0 0 +60 107 126 132 0 0 0 0 +60 107 126 146 0 0 0 0 +60 107 126 146 0 0 0 0 +60 107 126 125 0 0 0 0 +60 107 126 129 0 0 0 0 +60 107 132 65 0 0 0 0 +60 107 132 86 0 0 0 0 +60 107 132 126 0 0 0 0 +60 107 132 132 0 0 0 0 +60 107 132 146 0 0 0 0 +60 107 132 146 0 0 0 0 +60 107 132 125 0 0 0 0 +60 107 132 129 0 0 0 0 +60 107 146 65 0 0 0 0 +60 107 146 86 0 0 0 0 +60 107 146 126 0 0 0 0 +60 107 146 132 0 0 0 0 +60 107 146 146 0 0 0 0 +60 107 146 146 0 0 0 0 +60 107 146 125 0 0 0 0 +60 107 146 129 0 0 0 0 +60 107 146 65 0 0 0 0 +60 107 146 86 0 0 0 0 +60 107 146 126 0 0 0 0 +60 107 146 132 0 0 0 0 +60 107 146 146 0 0 0 0 +60 107 146 146 0 0 0 0 +60 107 146 125 0 0 0 0 +60 107 146 129 0 0 0 0 +60 107 125 65 0 0 0 0 +60 107 125 86 0 0 0 0 +60 107 125 126 0 0 0 0 +60 107 125 132 0 0 0 0 +60 107 125 146 0 0 0 0 +60 107 125 146 0 0 0 0 +60 107 125 125 0 0 0 0 +60 107 125 129 0 0 0 0 +60 107 129 65 0 0 0 0 +60 107 129 86 0 0 0 0 +60 107 129 126 0 0 0 0 +60 107 129 132 0 0 0 0 +60 107 129 146 0 0 0 0 +60 107 129 146 0 0 0 0 +60 107 129 125 0 0 0 0 +60 107 129 129 0 0 0 0 +1 106 65 65 0 0 0 0 +1 106 65 86 0 0 0 0 +1 106 65 126 0 0 0 0 +1 106 65 132 0 0 0 0 +1 106 65 146 0 0 0 0 +1 106 65 146 0 0 0 0 +1 106 65 125 0 0 0 0 +1 106 65 129 0 0 0 0 +1 106 86 65 0 0 0 0 +1 106 86 86 0 0 0 0 +1 106 86 126 0 0 0 0 +1 106 86 132 0 0 0 0 +1 106 86 146 0 0 0 0 +1 106 86 146 0 0 0 0 +1 106 86 125 0 0 0 0 +1 106 86 129 0 0 0 0 +1 106 126 65 0 0 0 0 +1 106 126 86 0 0 0 0 +1 106 126 126 0 0 0 0 +1 106 126 132 0 0 0 0 +1 106 126 146 0 0 0 0 +1 106 126 146 0 0 0 0 +1 106 126 125 0 0 0 0 +1 106 126 129 0 0 0 0 +1 106 132 65 0 0 0 0 +1 106 132 86 0 0 0 0 +1 106 132 126 0 0 0 0 +1 106 132 132 0 0 0 0 +1 106 132 146 0 0 0 0 +1 106 132 146 0 0 0 0 +1 106 132 125 0 0 0 0 +1 106 132 129 0 0 0 0 +1 106 146 65 0 0 0 0 +1 106 146 86 0 0 0 0 +1 106 146 126 0 0 0 0 +1 106 146 132 0 0 0 0 +1 106 146 146 0 0 0 0 +1 106 146 146 0 0 0 0 +1 106 146 125 0 0 0 0 +1 106 146 129 0 0 0 0 +1 106 146 65 0 0 0 0 +1 106 146 86 0 0 0 0 +1 106 146 126 0 0 0 0 +1 106 146 132 0 0 0 0 +1 106 146 146 0 0 0 0 +1 106 146 146 0 0 0 0 +1 106 146 125 0 0 0 0 +1 106 146 129 0 0 0 0 +1 106 125 65 0 0 0 0 +1 106 125 86 0 0 0 0 +1 106 125 126 0 0 0 0 +1 106 125 132 0 0 0 0 +1 106 125 146 0 0 0 0 +1 106 125 146 0 0 0 0 +1 106 125 125 0 0 0 0 +1 106 125 129 0 0 0 0 +1 106 129 65 0 0 0 0 +1 106 129 86 0 0 0 0 +1 106 129 126 0 0 0 0 +1 106 129 132 0 0 0 0 +1 106 129 146 0 0 0 0 +1 106 129 146 0 0 0 0 +1 106 129 125 0 0 0 0 +1 106 129 129 0 0 0 0 +128 106 65 65 0 0 0 0 +128 106 65 86 0 0 0 0 +128 106 65 126 0 0 0 0 +128 106 65 132 0 0 0 0 +128 106 65 146 0 0 0 0 +128 106 65 146 0 0 0 0 +128 106 65 125 0 0 0 0 +128 106 65 129 0 0 0 0 +128 106 86 65 0 0 0 0 +128 106 86 86 0 0 0 0 +128 106 86 126 0 0 0 0 +128 106 86 132 0 0 0 0 +128 106 86 146 0 0 0 0 +128 106 86 146 0 0 0 0 +128 106 86 125 0 0 0 0 +128 106 86 129 0 0 0 0 +128 106 126 65 0 0 0 0 +128 106 126 86 0 0 0 0 +128 106 126 126 0 0 0 0 +128 106 126 132 0 0 0 0 +128 106 126 146 0 0 0 0 +128 106 126 146 0 0 0 0 +128 106 126 125 0 0 0 0 +128 106 126 129 0 0 0 0 +128 106 132 65 0 0 0 0 +128 106 132 86 0 0 0 0 +128 106 132 126 0 0 0 0 +128 106 132 132 0 0 0 0 +128 106 132 146 0 0 0 0 +128 106 132 146 0 0 0 0 +128 106 132 125 0 0 0 0 +128 106 132 129 0 0 0 0 +128 106 146 65 0 0 0 0 +128 106 146 86 0 0 0 0 +128 106 146 126 0 0 0 0 +128 106 146 132 0 0 0 0 +128 106 146 146 0 0 0 0 +128 106 146 146 0 0 0 0 +128 106 146 125 0 0 0 0 +128 106 146 129 0 0 0 0 +128 106 146 65 0 0 0 0 +128 106 146 86 0 0 0 0 +128 106 146 126 0 0 0 0 +128 106 146 132 0 0 0 0 +128 106 146 146 0 0 0 0 +128 106 146 146 0 0 0 0 +128 106 146 125 0 0 0 0 +128 106 146 129 0 0 0 0 +128 106 125 65 0 0 0 0 +128 106 125 86 0 0 0 0 +128 106 125 126 0 0 0 0 +128 106 125 132 0 0 0 0 +128 106 125 146 0 0 0 0 +128 106 125 146 0 0 0 0 +128 106 125 125 0 0 0 0 +128 106 125 129 0 0 0 0 +128 106 129 65 0 0 0 0 +128 106 129 86 0 0 0 0 +128 106 129 126 0 0 0 0 +128 106 129 132 0 0 0 0 +128 106 129 146 0 0 0 0 +128 106 129 146 0 0 0 0 +128 106 129 125 0 0 0 0 +128 106 129 129 0 0 0 0 +142 106 65 65 0 0 0 0 +142 106 65 86 0 0 0 0 +142 106 65 126 0 0 0 0 +142 106 65 132 0 0 0 0 +142 106 65 146 0 0 0 0 +142 106 65 146 0 0 0 0 +142 106 65 125 0 0 0 0 +142 106 65 129 0 0 0 0 +142 106 86 65 0 0 0 0 +142 106 86 86 0 0 0 0 +142 106 86 126 0 0 0 0 +142 106 86 132 0 0 0 0 +142 106 86 146 0 0 0 0 +142 106 86 146 0 0 0 0 +142 106 86 125 0 0 0 0 +142 106 86 129 0 0 0 0 +142 106 126 65 0 0 0 0 +142 106 126 86 0 0 0 0 +142 106 126 126 0 0 0 0 +142 106 126 132 0 0 0 0 +142 106 126 146 0 0 0 0 +142 106 126 146 0 0 0 0 +142 106 126 125 0 0 0 0 +142 106 126 129 0 0 0 0 +142 106 132 65 0 0 0 0 +142 106 132 86 0 0 0 0 +142 106 132 126 0 0 0 0 +142 106 132 132 0 0 0 0 +142 106 132 146 0 0 0 0 +142 106 132 146 0 0 0 0 +142 106 132 125 0 0 0 0 +142 106 132 129 0 0 0 0 +142 106 146 65 0 0 0 0 +142 106 146 86 0 0 0 0 +142 106 146 126 0 0 0 0 +142 106 146 132 0 0 0 0 +142 106 146 146 0 0 0 0 +142 106 146 146 0 0 0 0 +142 106 146 125 0 0 0 0 +142 106 146 129 0 0 0 0 +142 106 146 65 0 0 0 0 +142 106 146 86 0 0 0 0 +142 106 146 126 0 0 0 0 +142 106 146 132 0 0 0 0 +142 106 146 146 0 0 0 0 +142 106 146 146 0 0 0 0 +142 106 146 125 0 0 0 0 +142 106 146 129 0 0 0 0 +142 106 125 65 0 0 0 0 +142 106 125 86 0 0 0 0 +142 106 125 126 0 0 0 0 +142 106 125 132 0 0 0 0 +142 106 125 146 0 0 0 0 +142 106 125 146 0 0 0 0 +142 106 125 125 0 0 0 0 +142 106 125 129 0 0 0 0 +142 106 129 65 0 0 0 0 +142 106 129 86 0 0 0 0 +142 106 129 126 0 0 0 0 +142 106 129 132 0 0 0 0 +142 106 129 146 0 0 0 0 +142 106 129 146 0 0 0 0 +142 106 129 125 0 0 0 0 +142 106 129 129 0 0 0 0 +146 106 65 65 0 0 0 0 +146 106 65 86 0 0 0 0 +146 106 65 126 0 0 0 0 +146 106 65 132 0 0 0 0 +146 106 65 146 0 0 0 0 +146 106 65 146 0 0 0 0 +146 106 65 125 0 0 0 0 +146 106 65 129 0 0 0 0 +146 106 86 65 0 0 0 0 +146 106 86 86 0 0 0 0 +146 106 86 126 0 0 0 0 +146 106 86 132 0 0 0 0 +146 106 86 146 0 0 0 0 +146 106 86 146 0 0 0 0 +146 106 86 125 0 0 0 0 +146 106 86 129 0 0 0 0 +146 106 126 65 0 0 0 0 +146 106 126 86 0 0 0 0 +146 106 126 126 0 0 0 0 +146 106 126 132 0 0 0 0 +146 106 126 146 0 0 0 0 +146 106 126 146 0 0 0 0 +146 106 126 125 0 0 0 0 +146 106 126 129 0 0 0 0 +146 106 132 65 0 0 0 0 +146 106 132 86 0 0 0 0 +146 106 132 126 0 0 0 0 +146 106 132 132 0 0 0 0 +146 106 132 146 0 0 0 0 +146 106 132 146 0 0 0 0 +146 106 132 125 0 0 0 0 +146 106 132 129 0 0 0 0 +146 106 146 65 0 0 0 0 +146 106 146 86 0 0 0 0 +146 106 146 126 0 0 0 0 +146 106 146 132 0 0 0 0 +146 106 146 146 0 0 0 0 +146 106 146 146 0 0 0 0 +146 106 146 125 0 0 0 0 +146 106 146 129 0 0 0 0 +146 106 146 65 0 0 0 0 +146 106 146 86 0 0 0 0 +146 106 146 126 0 0 0 0 +146 106 146 132 0 0 0 0 +146 106 146 146 0 0 0 0 +146 106 146 146 0 0 0 0 +146 106 146 125 0 0 0 0 +146 106 146 129 0 0 0 0 +146 106 125 65 0 0 0 0 +146 106 125 86 0 0 0 0 +146 106 125 126 0 0 0 0 +146 106 125 132 0 0 0 0 +146 106 125 146 0 0 0 0 +146 106 125 146 0 0 0 0 +146 106 125 125 0 0 0 0 +146 106 125 129 0 0 0 0 +146 106 129 65 0 0 0 0 +146 106 129 86 0 0 0 0 +146 106 129 126 0 0 0 0 +146 106 129 132 0 0 0 0 +146 106 129 146 0 0 0 0 +146 106 129 146 0 0 0 0 +146 106 129 125 0 0 0 0 +146 106 129 129 0 0 0 0 +146 106 65 65 0 0 0 0 +146 106 65 86 0 0 0 0 +146 106 65 126 0 0 0 0 +146 106 65 132 0 0 0 0 +146 106 65 146 0 0 0 0 +146 106 65 146 0 0 0 0 +146 106 65 125 0 0 0 0 +146 106 65 129 0 0 0 0 +146 106 86 65 0 0 0 0 +146 106 86 86 0 0 0 0 +146 106 86 126 0 0 0 0 +146 106 86 132 0 0 0 0 +146 106 86 146 0 0 0 0 +146 106 86 146 0 0 0 0 +146 106 86 125 0 0 0 0 +146 106 86 129 0 0 0 0 +146 106 126 65 0 0 0 0 +146 106 126 86 0 0 0 0 +146 106 126 126 0 0 0 0 +146 106 126 132 0 0 0 0 +146 106 126 146 0 0 0 0 +146 106 126 146 0 0 0 0 +146 106 126 125 0 0 0 0 +146 106 126 129 0 0 0 0 +146 106 132 65 0 0 0 0 +146 106 132 86 0 0 0 0 +146 106 132 126 0 0 0 0 +146 106 132 132 0 0 0 0 +146 106 132 146 0 0 0 0 +146 106 132 146 0 0 0 0 +146 106 132 125 0 0 0 0 +146 106 132 129 0 0 0 0 +146 106 146 65 0 0 0 0 +146 106 146 86 0 0 0 0 +146 106 146 126 0 0 0 0 +146 106 146 132 0 0 0 0 +146 106 146 146 0 0 0 0 +146 106 146 146 0 0 0 0 +146 106 146 125 0 0 0 0 +146 106 146 129 0 0 0 0 +146 106 146 65 0 0 0 0 +146 106 146 86 0 0 0 0 +146 106 146 126 0 0 0 0 +146 106 146 132 0 0 0 0 +146 106 146 146 0 0 0 0 +146 106 146 146 0 0 0 0 +146 106 146 125 0 0 0 0 +146 106 146 129 0 0 0 0 +146 106 125 65 0 0 0 0 +146 106 125 86 0 0 0 0 +146 106 125 126 0 0 0 0 +146 106 125 132 0 0 0 0 +146 106 125 146 0 0 0 0 +146 106 125 146 0 0 0 0 +146 106 125 125 0 0 0 0 +146 106 125 129 0 0 0 0 +146 106 129 65 0 0 0 0 +146 106 129 86 0 0 0 0 +146 106 129 126 0 0 0 0 +146 106 129 132 0 0 0 0 +146 106 129 146 0 0 0 0 +146 106 129 146 0 0 0 0 +146 106 129 125 0 0 0 0 +146 106 129 129 0 0 0 0 +125 107 65 65 0 0 0 0 +125 107 65 86 0 0 0 0 +125 107 65 126 0 0 0 0 +125 107 65 132 0 0 0 0 +125 107 65 146 0 0 0 0 +125 107 65 146 0 0 0 0 +125 107 65 125 0 0 0 0 +125 107 65 129 0 0 0 0 +125 107 86 65 0 0 0 0 +125 107 86 86 0 0 0 0 +125 107 86 126 0 0 0 0 +125 107 86 132 0 0 0 0 +125 107 86 146 0 0 0 0 +125 107 86 146 0 0 0 0 +125 107 86 125 0 0 0 0 +125 107 86 129 0 0 0 0 +125 107 126 65 0 0 0 0 +125 107 126 86 0 0 0 0 +125 107 126 126 0 0 0 0 +125 107 126 132 0 0 0 0 +125 107 126 146 0 0 0 0 +125 107 126 146 0 0 0 0 +125 107 126 125 0 0 0 0 +125 107 126 129 0 0 0 0 +125 107 132 65 0 0 0 0 +125 107 132 86 0 0 0 0 +125 107 132 126 0 0 0 0 +125 107 132 132 0 0 0 0 +125 107 132 146 0 0 0 0 +125 107 132 146 0 0 0 0 +125 107 132 125 0 0 0 0 +125 107 132 129 0 0 0 0 +125 107 146 65 0 0 0 0 +125 107 146 86 0 0 0 0 +125 107 146 126 0 0 0 0 +125 107 146 132 0 0 0 0 +125 107 146 146 0 0 0 0 +125 107 146 146 0 0 0 0 +125 107 146 125 0 0 0 0 +125 107 146 129 0 0 0 0 +125 107 146 65 0 0 0 0 +125 107 146 86 0 0 0 0 +125 107 146 126 0 0 0 0 +125 107 146 132 0 0 0 0 +125 107 146 146 0 0 0 0 +125 107 146 146 0 0 0 0 +125 107 146 125 0 0 0 0 +125 107 146 129 0 0 0 0 +125 107 125 65 0 0 0 0 +125 107 125 86 0 0 0 0 +125 107 125 126 0 0 0 0 +125 107 125 132 0 0 0 0 +125 107 125 146 0 0 0 0 +125 107 125 146 0 0 0 0 +125 107 129 65 0 0 0 0 +125 107 129 86 0 0 0 0 +125 107 129 126 0 0 0 0 +125 107 129 132 0 0 0 0 +125 107 129 146 0 0 0 0 +125 107 129 146 0 0 0 0 +129 107 65 65 0 0 0 0 +129 107 65 86 0 0 0 0 +129 107 65 126 0 0 0 0 +129 107 65 132 0 0 0 0 +129 107 65 146 0 0 0 0 +129 107 65 146 0 0 0 0 +129 107 65 125 0 0 0 0 +129 107 65 129 0 0 0 0 +129 107 86 65 0 0 0 0 +129 107 86 86 0 0 0 0 +129 107 86 126 0 0 0 0 +129 107 86 132 0 0 0 0 +129 107 86 146 0 0 0 0 +129 107 86 146 0 0 0 0 +129 107 86 125 0 0 0 0 +129 107 86 129 0 0 0 0 +129 107 126 65 0 0 0 0 +129 107 126 86 0 0 0 0 +129 107 126 126 0 0 0 0 +129 107 126 132 0 0 0 0 +129 107 126 146 0 0 0 0 +129 107 126 146 0 0 0 0 +129 107 126 125 0 0 0 0 +129 107 126 129 0 0 0 0 +129 107 132 65 0 0 0 0 +129 107 132 86 0 0 0 0 +129 107 132 126 0 0 0 0 +129 107 132 132 0 0 0 0 +129 107 132 146 0 0 0 0 +129 107 132 146 0 0 0 0 +129 107 132 125 0 0 0 0 +129 107 132 129 0 0 0 0 +129 107 146 65 0 0 0 0 +129 107 146 86 0 0 0 0 +129 107 146 126 0 0 0 0 +129 107 146 132 0 0 0 0 +129 107 146 146 0 0 0 0 +129 107 146 146 0 0 0 0 +129 107 146 125 0 0 0 0 +129 107 146 129 0 0 0 0 +129 107 146 65 0 0 0 0 +129 107 146 86 0 0 0 0 +129 107 146 126 0 0 0 0 +129 107 146 132 0 0 0 0 +129 107 146 146 0 0 0 0 +129 107 146 146 0 0 0 0 +129 107 146 125 0 0 0 0 +129 107 146 129 0 0 0 0 +129 107 125 65 0 0 0 0 +129 107 125 86 0 0 0 0 +129 107 125 126 0 0 0 0 +129 107 125 132 0 0 0 0 +129 107 125 146 0 0 0 0 +129 107 125 146 0 0 0 0 +129 107 129 65 0 0 0 0 +129 107 129 86 0 0 0 0 +129 107 129 126 0 0 0 0 +129 107 129 132 0 0 0 0 +129 107 129 146 0 0 0 0 +129 107 129 146 0 0 0 0 +60 46 9 131 65 0 0 0 +60 46 9 131 86 0 0 0 +60 46 9 131 126 0 0 0 +60 46 9 131 132 0 0 0 +60 46 9 131 146 0 0 0 +60 46 9 131 146 0 0 0 +60 46 9 131 125 0 0 0 +60 46 9 131 129 0 0 0 +60 46 141 131 65 0 0 0 +60 46 141 131 86 0 0 0 +60 46 141 131 126 0 0 0 +60 46 141 131 132 0 0 0 +60 46 141 131 146 0 0 0 +60 46 141 131 146 0 0 0 +60 46 141 131 125 0 0 0 +60 46 141 131 129 0 0 0 +60 46 2 131 65 0 0 0 +60 46 2 131 86 0 0 0 +60 46 2 131 126 0 0 0 +60 46 2 131 132 0 0 0 +60 46 2 131 146 0 0 0 +60 46 2 131 146 0 0 0 +60 46 2 131 125 0 0 0 +60 46 2 131 129 0 0 0 +60 46 43 131 65 0 0 0 +60 46 43 131 86 0 0 0 +60 46 43 131 126 0 0 0 +60 46 43 131 132 0 0 0 +60 46 43 131 146 0 0 0 +60 46 43 131 146 0 0 0 +60 46 43 131 125 0 0 0 +60 46 43 131 129 0 0 0 +60 46 89 131 65 0 0 0 +60 46 89 131 86 0 0 0 +60 46 89 131 126 0 0 0 +60 46 89 131 132 0 0 0 +60 46 89 131 146 0 0 0 +60 46 89 131 146 0 0 0 +60 46 89 131 125 0 0 0 +60 46 89 131 129 0 0 0 +60 46 112 131 65 0 0 0 +60 46 112 131 86 0 0 0 +60 46 112 131 126 0 0 0 +60 46 112 131 132 0 0 0 +60 46 112 131 146 0 0 0 +60 46 112 131 146 0 0 0 +60 46 112 131 125 0 0 0 +60 46 112 131 129 0 0 0 +1 45 9 131 65 0 0 0 +1 45 9 131 86 0 0 0 +1 45 9 131 126 0 0 0 +1 45 9 131 132 0 0 0 +1 45 9 131 146 0 0 0 +1 45 9 131 146 0 0 0 +1 45 9 131 125 0 0 0 +1 45 9 131 129 0 0 0 +1 45 141 131 65 0 0 0 +1 45 141 131 86 0 0 0 +1 45 141 131 126 0 0 0 +1 45 141 131 132 0 0 0 +1 45 141 131 146 0 0 0 +1 45 141 131 146 0 0 0 +1 45 141 131 125 0 0 0 +1 45 141 131 129 0 0 0 +1 45 2 131 65 0 0 0 +1 45 2 131 86 0 0 0 +1 45 2 131 126 0 0 0 +1 45 2 131 132 0 0 0 +1 45 2 131 146 0 0 0 +1 45 2 131 146 0 0 0 +1 45 2 131 125 0 0 0 +1 45 2 131 129 0 0 0 +1 45 43 131 65 0 0 0 +1 45 43 131 86 0 0 0 +1 45 43 131 126 0 0 0 +1 45 43 131 132 0 0 0 +1 45 43 131 146 0 0 0 +1 45 43 131 146 0 0 0 +1 45 43 131 125 0 0 0 +1 45 43 131 129 0 0 0 +1 45 89 131 65 0 0 0 +1 45 89 131 86 0 0 0 +1 45 89 131 126 0 0 0 +1 45 89 131 132 0 0 0 +1 45 89 131 146 0 0 0 +1 45 89 131 146 0 0 0 +1 45 89 131 125 0 0 0 +1 45 89 131 129 0 0 0 +1 45 112 131 65 0 0 0 +1 45 112 131 86 0 0 0 +1 45 112 131 126 0 0 0 +1 45 112 131 132 0 0 0 +1 45 112 131 146 0 0 0 +1 45 112 131 146 0 0 0 +1 45 112 131 125 0 0 0 +1 45 112 131 129 0 0 0 +128 45 9 131 65 0 0 0 +128 45 9 131 86 0 0 0 +128 45 9 131 126 0 0 0 +128 45 9 131 132 0 0 0 +128 45 9 131 146 0 0 0 +128 45 9 131 146 0 0 0 +128 45 9 131 125 0 0 0 +128 45 9 131 129 0 0 0 +128 45 141 131 65 0 0 0 +128 45 141 131 86 0 0 0 +128 45 141 131 126 0 0 0 +128 45 141 131 132 0 0 0 +128 45 141 131 146 0 0 0 +128 45 141 131 146 0 0 0 +128 45 141 131 125 0 0 0 +128 45 141 131 129 0 0 0 +128 45 2 131 65 0 0 0 +128 45 2 131 86 0 0 0 +128 45 2 131 126 0 0 0 +128 45 2 131 132 0 0 0 +128 45 2 131 146 0 0 0 +128 45 2 131 146 0 0 0 +128 45 2 131 125 0 0 0 +128 45 2 131 129 0 0 0 +128 45 43 131 65 0 0 0 +128 45 43 131 86 0 0 0 +128 45 43 131 126 0 0 0 +128 45 43 131 132 0 0 0 +128 45 43 131 146 0 0 0 +128 45 43 131 146 0 0 0 +128 45 43 131 125 0 0 0 +128 45 43 131 129 0 0 0 +128 45 89 131 65 0 0 0 +128 45 89 131 86 0 0 0 +128 45 89 131 126 0 0 0 +128 45 89 131 132 0 0 0 +128 45 89 131 146 0 0 0 +128 45 89 131 146 0 0 0 +128 45 89 131 125 0 0 0 +128 45 89 131 129 0 0 0 +128 45 112 131 65 0 0 0 +128 45 112 131 86 0 0 0 +128 45 112 131 126 0 0 0 +128 45 112 131 132 0 0 0 +128 45 112 131 146 0 0 0 +128 45 112 131 146 0 0 0 +128 45 112 131 125 0 0 0 +128 45 112 131 129 0 0 0 +142 45 9 131 65 0 0 0 +142 45 9 131 86 0 0 0 +142 45 9 131 126 0 0 0 +142 45 9 131 132 0 0 0 +142 45 9 131 146 0 0 0 +142 45 9 131 146 0 0 0 +142 45 9 131 125 0 0 0 +142 45 9 131 129 0 0 0 +142 45 141 131 65 0 0 0 +142 45 141 131 86 0 0 0 +142 45 141 131 126 0 0 0 +142 45 141 131 132 0 0 0 +142 45 141 131 146 0 0 0 +142 45 141 131 146 0 0 0 +142 45 141 131 125 0 0 0 +142 45 141 131 129 0 0 0 +142 45 2 131 65 0 0 0 +142 45 2 131 86 0 0 0 +142 45 2 131 126 0 0 0 +142 45 2 131 132 0 0 0 +142 45 2 131 146 0 0 0 +142 45 2 131 146 0 0 0 +142 45 2 131 125 0 0 0 +142 45 2 131 129 0 0 0 +142 45 43 131 65 0 0 0 +142 45 43 131 86 0 0 0 +142 45 43 131 126 0 0 0 +142 45 43 131 132 0 0 0 +142 45 43 131 146 0 0 0 +142 45 43 131 146 0 0 0 +142 45 43 131 125 0 0 0 +142 45 43 131 129 0 0 0 +142 45 89 131 65 0 0 0 +142 45 89 131 86 0 0 0 +142 45 89 131 126 0 0 0 +142 45 89 131 132 0 0 0 +142 45 89 131 146 0 0 0 +142 45 89 131 146 0 0 0 +142 45 89 131 125 0 0 0 +142 45 89 131 129 0 0 0 +142 45 112 131 65 0 0 0 +142 45 112 131 86 0 0 0 +142 45 112 131 126 0 0 0 +142 45 112 131 132 0 0 0 +142 45 112 131 146 0 0 0 +142 45 112 131 146 0 0 0 +142 45 112 131 125 0 0 0 +142 45 112 131 129 0 0 0 +146 45 9 131 65 0 0 0 +146 45 9 131 86 0 0 0 +146 45 9 131 126 0 0 0 +146 45 9 131 132 0 0 0 +146 45 9 131 146 0 0 0 +146 45 9 131 146 0 0 0 +146 45 9 131 125 0 0 0 +146 45 9 131 129 0 0 0 +146 45 141 131 65 0 0 0 +146 45 141 131 86 0 0 0 +146 45 141 131 126 0 0 0 +146 45 141 131 132 0 0 0 +146 45 141 131 146 0 0 0 +146 45 141 131 146 0 0 0 +146 45 141 131 125 0 0 0 +146 45 141 131 129 0 0 0 +146 45 2 131 65 0 0 0 +146 45 2 131 86 0 0 0 +146 45 2 131 126 0 0 0 +146 45 2 131 132 0 0 0 +146 45 2 131 146 0 0 0 +146 45 2 131 146 0 0 0 +146 45 2 131 125 0 0 0 +146 45 2 131 129 0 0 0 +146 45 43 131 65 0 0 0 +146 45 43 131 86 0 0 0 +146 45 43 131 126 0 0 0 +146 45 43 131 132 0 0 0 +146 45 43 131 146 0 0 0 +146 45 43 131 146 0 0 0 +146 45 43 131 125 0 0 0 +146 45 43 131 129 0 0 0 +146 45 89 131 65 0 0 0 +146 45 89 131 86 0 0 0 +146 45 89 131 126 0 0 0 +146 45 89 131 132 0 0 0 +146 45 89 131 146 0 0 0 +146 45 89 131 146 0 0 0 +146 45 89 131 125 0 0 0 +146 45 89 131 129 0 0 0 +146 45 112 131 65 0 0 0 +146 45 112 131 86 0 0 0 +146 45 112 131 126 0 0 0 +146 45 112 131 132 0 0 0 +146 45 112 131 146 0 0 0 +146 45 112 131 146 0 0 0 +146 45 112 131 125 0 0 0 +146 45 112 131 129 0 0 0 +146 45 9 131 65 0 0 0 +146 45 9 131 86 0 0 0 +146 45 9 131 126 0 0 0 +146 45 9 131 132 0 0 0 +146 45 9 131 146 0 0 0 +146 45 9 131 146 0 0 0 +146 45 9 131 125 0 0 0 +146 45 9 131 129 0 0 0 +146 45 141 131 65 0 0 0 +146 45 141 131 86 0 0 0 +146 45 141 131 126 0 0 0 +146 45 141 131 132 0 0 0 +146 45 141 131 146 0 0 0 +146 45 141 131 146 0 0 0 +146 45 141 131 125 0 0 0 +146 45 141 131 129 0 0 0 +146 45 2 131 65 0 0 0 +146 45 2 131 86 0 0 0 +146 45 2 131 126 0 0 0 +146 45 2 131 132 0 0 0 +146 45 2 131 146 0 0 0 +146 45 2 131 146 0 0 0 +146 45 2 131 125 0 0 0 +146 45 2 131 129 0 0 0 +146 45 43 131 65 0 0 0 +146 45 43 131 86 0 0 0 +146 45 43 131 126 0 0 0 +146 45 43 131 132 0 0 0 +146 45 43 131 146 0 0 0 +146 45 43 131 146 0 0 0 +146 45 43 131 125 0 0 0 +146 45 43 131 129 0 0 0 +146 45 89 131 65 0 0 0 +146 45 89 131 86 0 0 0 +146 45 89 131 126 0 0 0 +146 45 89 131 132 0 0 0 +146 45 89 131 146 0 0 0 +146 45 89 131 146 0 0 0 +146 45 89 131 125 0 0 0 +146 45 89 131 129 0 0 0 +146 45 112 131 65 0 0 0 +146 45 112 131 86 0 0 0 +146 45 112 131 126 0 0 0 +146 45 112 131 132 0 0 0 +146 45 112 131 146 0 0 0 +146 45 112 131 146 0 0 0 +146 45 112 131 125 0 0 0 +146 45 112 131 129 0 0 0 +125 46 9 131 65 0 0 0 +125 46 9 131 86 0 0 0 +125 46 9 131 126 0 0 0 +125 46 9 131 132 0 0 0 +125 46 9 131 146 0 0 0 +125 46 9 131 146 0 0 0 +125 46 9 131 125 0 0 0 +125 46 9 131 129 0 0 0 +125 46 141 131 65 0 0 0 +125 46 141 131 86 0 0 0 +125 46 141 131 126 0 0 0 +125 46 141 131 132 0 0 0 +125 46 141 131 146 0 0 0 +125 46 141 131 146 0 0 0 +125 46 141 131 125 0 0 0 +125 46 141 131 129 0 0 0 +125 46 2 131 65 0 0 0 +125 46 2 131 86 0 0 0 +125 46 2 131 126 0 0 0 +125 46 2 131 132 0 0 0 +125 46 2 131 146 0 0 0 +125 46 2 131 146 0 0 0 +125 46 2 131 125 0 0 0 +125 46 2 131 129 0 0 0 +125 46 43 131 65 0 0 0 +125 46 43 131 86 0 0 0 +125 46 43 131 126 0 0 0 +125 46 43 131 132 0 0 0 +125 46 43 131 146 0 0 0 +125 46 43 131 146 0 0 0 +125 46 43 131 125 0 0 0 +125 46 43 131 129 0 0 0 +125 46 89 131 65 0 0 0 +125 46 89 131 86 0 0 0 +125 46 89 131 126 0 0 0 +125 46 89 131 132 0 0 0 +125 46 89 131 146 0 0 0 +125 46 89 131 146 0 0 0 +125 46 89 131 125 0 0 0 +125 46 89 131 129 0 0 0 +125 46 112 131 65 0 0 0 +125 46 112 131 86 0 0 0 +125 46 112 131 126 0 0 0 +125 46 112 131 132 0 0 0 +125 46 112 131 146 0 0 0 +125 46 112 131 146 0 0 0 +125 46 112 131 125 0 0 0 +125 46 112 131 129 0 0 0 +129 46 9 131 65 0 0 0 +129 46 9 131 86 0 0 0 +129 46 9 131 126 0 0 0 +129 46 9 131 132 0 0 0 +129 46 9 131 146 0 0 0 +129 46 9 131 146 0 0 0 +129 46 9 131 125 0 0 0 +129 46 9 131 129 0 0 0 +129 46 141 131 65 0 0 0 +129 46 141 131 86 0 0 0 +129 46 141 131 126 0 0 0 +129 46 141 131 132 0 0 0 +129 46 141 131 146 0 0 0 +129 46 141 131 146 0 0 0 +129 46 141 131 125 0 0 0 +129 46 141 131 129 0 0 0 +129 46 2 131 65 0 0 0 +129 46 2 131 86 0 0 0 +129 46 2 131 126 0 0 0 +129 46 2 131 132 0 0 0 +129 46 2 131 146 0 0 0 +129 46 2 131 146 0 0 0 +129 46 2 131 125 0 0 0 +129 46 2 131 129 0 0 0 +129 46 43 131 65 0 0 0 +129 46 43 131 86 0 0 0 +129 46 43 131 126 0 0 0 +129 46 43 131 132 0 0 0 +129 46 43 131 146 0 0 0 +129 46 43 131 146 0 0 0 +129 46 43 131 125 0 0 0 +129 46 43 131 129 0 0 0 +129 46 89 131 65 0 0 0 +129 46 89 131 86 0 0 0 +129 46 89 131 126 0 0 0 +129 46 89 131 132 0 0 0 +129 46 89 131 146 0 0 0 +129 46 89 131 146 0 0 0 +129 46 89 131 125 0 0 0 +129 46 89 131 129 0 0 0 +129 46 112 131 65 0 0 0 +129 46 112 131 86 0 0 0 +129 46 112 131 126 0 0 0 +129 46 112 131 132 0 0 0 +129 46 112 131 146 0 0 0 +129 46 112 131 146 0 0 0 +129 46 112 131 125 0 0 0 +129 46 112 131 129 0 0 0 +60 107 9 65 0 0 0 0 +60 107 9 86 0 0 0 0 +60 107 9 126 0 0 0 0 +60 107 9 132 0 0 0 0 +60 107 9 146 0 0 0 0 +60 107 9 146 0 0 0 0 +60 107 9 125 0 0 0 0 +60 107 9 129 0 0 0 0 +60 107 141 65 0 0 0 0 +60 107 141 86 0 0 0 0 +60 107 141 126 0 0 0 0 +60 107 141 132 0 0 0 0 +60 107 141 146 0 0 0 0 +60 107 141 146 0 0 0 0 +60 107 141 125 0 0 0 0 +60 107 141 129 0 0 0 0 +60 107 2 65 0 0 0 0 +60 107 2 86 0 0 0 0 +60 107 2 126 0 0 0 0 +60 107 2 132 0 0 0 0 +60 107 2 146 0 0 0 0 +60 107 2 146 0 0 0 0 +60 107 2 125 0 0 0 0 +60 107 2 129 0 0 0 0 +60 107 43 65 0 0 0 0 +60 107 43 86 0 0 0 0 +60 107 43 126 0 0 0 0 +60 107 43 132 0 0 0 0 +60 107 43 146 0 0 0 0 +60 107 43 146 0 0 0 0 +60 107 43 125 0 0 0 0 +60 107 43 129 0 0 0 0 +60 107 89 65 0 0 0 0 +60 107 89 86 0 0 0 0 +60 107 89 126 0 0 0 0 +60 107 89 132 0 0 0 0 +60 107 89 146 0 0 0 0 +60 107 89 146 0 0 0 0 +60 107 89 125 0 0 0 0 +60 107 89 129 0 0 0 0 +60 107 112 65 0 0 0 0 +60 107 112 86 0 0 0 0 +60 107 112 126 0 0 0 0 +60 107 112 132 0 0 0 0 +60 107 112 146 0 0 0 0 +60 107 112 146 0 0 0 0 +60 107 112 125 0 0 0 0 +60 107 112 129 0 0 0 0 +1 106 9 65 0 0 0 0 +1 106 9 86 0 0 0 0 +1 106 9 126 0 0 0 0 +1 106 9 132 0 0 0 0 +1 106 9 146 0 0 0 0 +1 106 9 146 0 0 0 0 +1 106 9 125 0 0 0 0 +1 106 9 129 0 0 0 0 +1 106 141 65 0 0 0 0 +1 106 141 86 0 0 0 0 +1 106 141 126 0 0 0 0 +1 106 141 132 0 0 0 0 +1 106 141 146 0 0 0 0 +1 106 141 146 0 0 0 0 +1 106 141 125 0 0 0 0 +1 106 141 129 0 0 0 0 +1 106 2 65 0 0 0 0 +1 106 2 86 0 0 0 0 +1 106 2 126 0 0 0 0 +1 106 2 132 0 0 0 0 +1 106 2 146 0 0 0 0 +1 106 2 146 0 0 0 0 +1 106 2 125 0 0 0 0 +1 106 2 129 0 0 0 0 +1 106 43 65 0 0 0 0 +1 106 43 86 0 0 0 0 +1 106 43 126 0 0 0 0 +1 106 43 132 0 0 0 0 +1 106 43 146 0 0 0 0 +1 106 43 146 0 0 0 0 +1 106 43 125 0 0 0 0 +1 106 43 129 0 0 0 0 +1 106 89 65 0 0 0 0 +1 106 89 86 0 0 0 0 +1 106 89 126 0 0 0 0 +1 106 89 132 0 0 0 0 +1 106 89 146 0 0 0 0 +1 106 89 146 0 0 0 0 +1 106 89 125 0 0 0 0 +1 106 89 129 0 0 0 0 +1 106 112 65 0 0 0 0 +1 106 112 86 0 0 0 0 +1 106 112 126 0 0 0 0 +1 106 112 132 0 0 0 0 +1 106 112 146 0 0 0 0 +1 106 112 146 0 0 0 0 +1 106 112 125 0 0 0 0 +1 106 112 129 0 0 0 0 +128 106 9 65 0 0 0 0 +128 106 9 86 0 0 0 0 +128 106 9 126 0 0 0 0 +128 106 9 132 0 0 0 0 +128 106 9 146 0 0 0 0 +128 106 9 146 0 0 0 0 +128 106 9 125 0 0 0 0 +128 106 9 129 0 0 0 0 +128 106 141 65 0 0 0 0 +128 106 141 86 0 0 0 0 +128 106 141 126 0 0 0 0 +128 106 141 132 0 0 0 0 +128 106 141 146 0 0 0 0 +128 106 141 146 0 0 0 0 +128 106 141 125 0 0 0 0 +128 106 141 129 0 0 0 0 +128 106 2 65 0 0 0 0 +128 106 2 86 0 0 0 0 +128 106 2 126 0 0 0 0 +128 106 2 132 0 0 0 0 +128 106 2 146 0 0 0 0 +128 106 2 146 0 0 0 0 +128 106 2 125 0 0 0 0 +128 106 2 129 0 0 0 0 +128 106 43 65 0 0 0 0 +128 106 43 86 0 0 0 0 +128 106 43 126 0 0 0 0 +128 106 43 132 0 0 0 0 +128 106 43 146 0 0 0 0 +128 106 43 146 0 0 0 0 +128 106 43 125 0 0 0 0 +128 106 43 129 0 0 0 0 +128 106 89 65 0 0 0 0 +128 106 89 86 0 0 0 0 +128 106 89 126 0 0 0 0 +128 106 89 132 0 0 0 0 +128 106 89 146 0 0 0 0 +128 106 89 146 0 0 0 0 +128 106 89 125 0 0 0 0 +128 106 89 129 0 0 0 0 +128 106 112 65 0 0 0 0 +128 106 112 86 0 0 0 0 +128 106 112 126 0 0 0 0 +128 106 112 132 0 0 0 0 +128 106 112 146 0 0 0 0 +128 106 112 146 0 0 0 0 +128 106 112 125 0 0 0 0 +128 106 112 129 0 0 0 0 +142 106 9 65 0 0 0 0 +142 106 9 86 0 0 0 0 +142 106 9 126 0 0 0 0 +142 106 9 132 0 0 0 0 +142 106 9 146 0 0 0 0 +142 106 9 146 0 0 0 0 +142 106 9 125 0 0 0 0 +142 106 9 129 0 0 0 0 +142 106 141 65 0 0 0 0 +142 106 141 86 0 0 0 0 +142 106 141 126 0 0 0 0 +142 106 141 132 0 0 0 0 +142 106 141 146 0 0 0 0 +142 106 141 146 0 0 0 0 +142 106 141 125 0 0 0 0 +142 106 141 129 0 0 0 0 +142 106 2 65 0 0 0 0 +142 106 2 86 0 0 0 0 +142 106 2 126 0 0 0 0 +142 106 2 132 0 0 0 0 +142 106 2 146 0 0 0 0 +142 106 2 146 0 0 0 0 +142 106 2 125 0 0 0 0 +142 106 2 129 0 0 0 0 +142 106 43 65 0 0 0 0 +142 106 43 86 0 0 0 0 +142 106 43 126 0 0 0 0 +142 106 43 132 0 0 0 0 +142 106 43 146 0 0 0 0 +142 106 43 146 0 0 0 0 +142 106 43 125 0 0 0 0 +142 106 43 129 0 0 0 0 +142 106 89 65 0 0 0 0 +142 106 89 86 0 0 0 0 +142 106 89 126 0 0 0 0 +142 106 89 132 0 0 0 0 +142 106 89 146 0 0 0 0 +142 106 89 146 0 0 0 0 +142 106 89 125 0 0 0 0 +142 106 89 129 0 0 0 0 +142 106 112 65 0 0 0 0 +142 106 112 86 0 0 0 0 +142 106 112 126 0 0 0 0 +142 106 112 132 0 0 0 0 +142 106 112 146 0 0 0 0 +142 106 112 146 0 0 0 0 +142 106 112 125 0 0 0 0 +142 106 112 129 0 0 0 0 +146 106 9 65 0 0 0 0 +146 106 9 86 0 0 0 0 +146 106 9 126 0 0 0 0 +146 106 9 132 0 0 0 0 +146 106 9 146 0 0 0 0 +146 106 9 146 0 0 0 0 +146 106 9 125 0 0 0 0 +146 106 9 129 0 0 0 0 +146 106 141 65 0 0 0 0 +146 106 141 86 0 0 0 0 +146 106 141 126 0 0 0 0 +146 106 141 132 0 0 0 0 +146 106 141 146 0 0 0 0 +146 106 141 146 0 0 0 0 +146 106 141 125 0 0 0 0 +146 106 141 129 0 0 0 0 +146 106 2 65 0 0 0 0 +146 106 2 86 0 0 0 0 +146 106 2 126 0 0 0 0 +146 106 2 132 0 0 0 0 +146 106 2 146 0 0 0 0 +146 106 2 146 0 0 0 0 +146 106 2 125 0 0 0 0 +146 106 2 129 0 0 0 0 +146 106 43 65 0 0 0 0 +146 106 43 86 0 0 0 0 +146 106 43 126 0 0 0 0 +146 106 43 132 0 0 0 0 +146 106 43 146 0 0 0 0 +146 106 43 146 0 0 0 0 +146 106 43 125 0 0 0 0 +146 106 43 129 0 0 0 0 +146 106 89 65 0 0 0 0 +146 106 89 86 0 0 0 0 +146 106 89 126 0 0 0 0 +146 106 89 132 0 0 0 0 +146 106 89 146 0 0 0 0 +146 106 89 146 0 0 0 0 +146 106 89 125 0 0 0 0 +146 106 89 129 0 0 0 0 +146 106 112 65 0 0 0 0 +146 106 112 86 0 0 0 0 +146 106 112 126 0 0 0 0 +146 106 112 132 0 0 0 0 +146 106 112 146 0 0 0 0 +146 106 112 146 0 0 0 0 +146 106 112 125 0 0 0 0 +146 106 112 129 0 0 0 0 +146 106 9 65 0 0 0 0 +146 106 9 86 0 0 0 0 +146 106 9 126 0 0 0 0 +146 106 9 132 0 0 0 0 +146 106 9 146 0 0 0 0 +146 106 9 146 0 0 0 0 +146 106 9 125 0 0 0 0 +146 106 9 129 0 0 0 0 +146 106 141 65 0 0 0 0 +146 106 141 86 0 0 0 0 +146 106 141 126 0 0 0 0 +146 106 141 132 0 0 0 0 +146 106 141 146 0 0 0 0 +146 106 141 146 0 0 0 0 +146 106 141 125 0 0 0 0 +146 106 141 129 0 0 0 0 +146 106 2 65 0 0 0 0 +146 106 2 86 0 0 0 0 +146 106 2 126 0 0 0 0 +146 106 2 132 0 0 0 0 +146 106 2 146 0 0 0 0 +146 106 2 146 0 0 0 0 +146 106 2 125 0 0 0 0 +146 106 2 129 0 0 0 0 +146 106 43 65 0 0 0 0 +146 106 43 86 0 0 0 0 +146 106 43 126 0 0 0 0 +146 106 43 132 0 0 0 0 +146 106 43 146 0 0 0 0 +146 106 43 146 0 0 0 0 +146 106 43 125 0 0 0 0 +146 106 43 129 0 0 0 0 +146 106 89 65 0 0 0 0 +146 106 89 86 0 0 0 0 +146 106 89 126 0 0 0 0 +146 106 89 132 0 0 0 0 +146 106 89 146 0 0 0 0 +146 106 89 146 0 0 0 0 +146 106 89 125 0 0 0 0 +146 106 89 129 0 0 0 0 +146 106 112 65 0 0 0 0 +146 106 112 86 0 0 0 0 +146 106 112 126 0 0 0 0 +146 106 112 132 0 0 0 0 +146 106 112 146 0 0 0 0 +146 106 112 146 0 0 0 0 +146 106 112 125 0 0 0 0 +146 106 112 129 0 0 0 0 +125 107 9 65 0 0 0 0 +125 107 9 86 0 0 0 0 +125 107 9 126 0 0 0 0 +125 107 9 132 0 0 0 0 +125 107 9 146 0 0 0 0 +125 107 9 146 0 0 0 0 +125 107 9 125 0 0 0 0 +125 107 9 129 0 0 0 0 +125 107 141 65 0 0 0 0 +125 107 141 86 0 0 0 0 +125 107 141 126 0 0 0 0 +125 107 141 132 0 0 0 0 +125 107 141 146 0 0 0 0 +125 107 141 146 0 0 0 0 +125 107 141 125 0 0 0 0 +125 107 141 129 0 0 0 0 +125 107 2 65 0 0 0 0 +125 107 2 86 0 0 0 0 +125 107 2 126 0 0 0 0 +125 107 2 132 0 0 0 0 +125 107 2 146 0 0 0 0 +125 107 2 146 0 0 0 0 +125 107 2 125 0 0 0 0 +125 107 2 129 0 0 0 0 +125 107 43 65 0 0 0 0 +125 107 43 86 0 0 0 0 +125 107 43 126 0 0 0 0 +125 107 43 132 0 0 0 0 +125 107 43 146 0 0 0 0 +125 107 43 146 0 0 0 0 +125 107 43 125 0 0 0 0 +125 107 43 129 0 0 0 0 +125 107 89 65 0 0 0 0 +125 107 89 86 0 0 0 0 +125 107 89 126 0 0 0 0 +125 107 89 132 0 0 0 0 +125 107 89 146 0 0 0 0 +125 107 89 146 0 0 0 0 +125 107 89 125 0 0 0 0 +125 107 89 129 0 0 0 0 +125 107 112 65 0 0 0 0 +125 107 112 86 0 0 0 0 +125 107 112 126 0 0 0 0 +125 107 112 132 0 0 0 0 +125 107 112 146 0 0 0 0 +125 107 112 146 0 0 0 0 +125 107 112 125 0 0 0 0 +125 107 112 129 0 0 0 0 +129 107 9 65 0 0 0 0 +129 107 9 86 0 0 0 0 +129 107 9 126 0 0 0 0 +129 107 9 132 0 0 0 0 +129 107 9 146 0 0 0 0 +129 107 9 146 0 0 0 0 +129 107 9 125 0 0 0 0 +129 107 9 129 0 0 0 0 +129 107 141 65 0 0 0 0 +129 107 141 86 0 0 0 0 +129 107 141 126 0 0 0 0 +129 107 141 132 0 0 0 0 +129 107 141 146 0 0 0 0 +129 107 141 146 0 0 0 0 +129 107 141 125 0 0 0 0 +129 107 141 129 0 0 0 0 +129 107 2 65 0 0 0 0 +129 107 2 86 0 0 0 0 +129 107 2 126 0 0 0 0 +129 107 2 132 0 0 0 0 +129 107 2 146 0 0 0 0 +129 107 2 146 0 0 0 0 +129 107 2 125 0 0 0 0 +129 107 2 129 0 0 0 0 +129 107 43 65 0 0 0 0 +129 107 43 86 0 0 0 0 +129 107 43 126 0 0 0 0 +129 107 43 132 0 0 0 0 +129 107 43 146 0 0 0 0 +129 107 43 146 0 0 0 0 +129 107 43 125 0 0 0 0 +129 107 43 129 0 0 0 0 +129 107 89 65 0 0 0 0 +129 107 89 86 0 0 0 0 +129 107 89 126 0 0 0 0 +129 107 89 132 0 0 0 0 +129 107 89 146 0 0 0 0 +129 107 89 146 0 0 0 0 +129 107 89 125 0 0 0 0 +129 107 89 129 0 0 0 0 +129 107 112 65 0 0 0 0 +129 107 112 86 0 0 0 0 +129 107 112 126 0 0 0 0 +129 107 112 132 0 0 0 0 +129 107 112 146 0 0 0 0 +129 107 112 146 0 0 0 0 +129 107 112 125 0 0 0 0 +129 107 112 129 0 0 0 0 diff --git a/src/tools/c/GFCC/Abs.hs b/src/tools/c/GFCC/Abs.hs new file mode 100644 index 000000000..f42447ebb --- /dev/null +++ b/src/tools/c/GFCC/Abs.hs @@ -0,0 +1,227 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} +module GFCC.Abs (Tree(..), Grammar, Header, Abstract, Concrete, AbsDef, CncDef, Type, Exp, Atom, Term, Tokn, Variant, CId, johnMajorEq, module GFCC.ComposOp) where + +import GFCC.ComposOp + +import Data.Monoid + +-- Haskell module generated by the BNF converter + +data Grammar_ +type Grammar = Tree Grammar_ +data Header_ +type Header = Tree Header_ +data Abstract_ +type Abstract = Tree Abstract_ +data Concrete_ +type Concrete = Tree Concrete_ +data AbsDef_ +type AbsDef = Tree AbsDef_ +data CncDef_ +type CncDef = Tree CncDef_ +data Type_ +type Type = Tree Type_ +data Exp_ +type Exp = Tree Exp_ +data Atom_ +type Atom = Tree Atom_ +data Term_ +type Term = Tree Term_ +data Tokn_ +type Tokn = Tree Tokn_ +data Variant_ +type Variant = Tree Variant_ +data CId_ +type CId = Tree CId_ + +data Tree :: * -> * where + Grm :: Header -> Abstract -> [Concrete] -> Tree Grammar_ + Hdr :: CId -> [CId] -> Tree Header_ + Abs :: [AbsDef] -> Tree Abstract_ + Cnc :: CId -> [CncDef] -> Tree Concrete_ + Fun :: CId -> Type -> Exp -> Tree AbsDef_ + Lin :: CId -> Term -> Tree CncDef_ + Typ :: [CId] -> CId -> Tree Type_ + Tr :: Atom -> [Exp] -> Tree Exp_ + AC :: CId -> Tree Atom_ + AS :: String -> Tree Atom_ + AI :: Integer -> Tree Atom_ + AF :: Double -> Tree Atom_ + AM :: Tree Atom_ + R :: [Term] -> Tree Term_ + P :: Term -> Term -> Tree Term_ + S :: [Term] -> Tree Term_ + K :: Tokn -> Tree Term_ + V :: Integer -> Tree Term_ + C :: Integer -> Tree Term_ + F :: CId -> Tree Term_ + FV :: [Term] -> Tree Term_ + W :: String -> Term -> Tree Term_ + RP :: Term -> Term -> Tree Term_ + TM :: Tree Term_ + L :: CId -> Term -> Tree Term_ + BV :: CId -> Tree Term_ + KS :: String -> Tree Tokn_ + KP :: [String] -> [Variant] -> Tree Tokn_ + Var :: [String] -> [String] -> Tree Variant_ + CId :: String -> Tree CId_ + +instance Compos Tree where + compos r a f t = case t of + Grm header abstract concretes -> r Grm `a` f header `a` f abstract `a` foldr (a . a (r (:)) . f) (r []) concretes + Hdr cid cids -> r Hdr `a` f cid `a` foldr (a . a (r (:)) . f) (r []) cids + Abs absdefs -> r Abs `a` foldr (a . a (r (:)) . f) (r []) absdefs + Cnc cid cncdefs -> r Cnc `a` f cid `a` foldr (a . a (r (:)) . f) (r []) cncdefs + Fun cid type' exp -> r Fun `a` f cid `a` f type' `a` f exp + Lin cid term -> r Lin `a` f cid `a` f term + Typ cids cid -> r Typ `a` foldr (a . a (r (:)) . f) (r []) cids `a` f cid + Tr atom exps -> r Tr `a` f atom `a` foldr (a . a (r (:)) . f) (r []) exps + AC cid -> r AC `a` f cid + R terms -> r R `a` foldr (a . a (r (:)) . f) (r []) terms + P term0 term1 -> r P `a` f term0 `a` f term1 + S terms -> r S `a` foldr (a . a (r (:)) . f) (r []) terms + K tokn -> r K `a` f tokn + F cid -> r F `a` f cid + FV terms -> r FV `a` foldr (a . a (r (:)) . f) (r []) terms + W str term -> r W `a` r str `a` f term + RP term0 term1 -> r RP `a` f term0 `a` f term1 + L cid term -> r L `a` f cid `a` f term + BV cid -> r BV `a` f cid + KP strs variants -> r KP `a` r strs `a` foldr (a . a (r (:)) . f) (r []) variants + _ -> r t + +instance Show (Tree c) where + showsPrec n t = case t of + Grm header abstract concretes -> opar n . showString "Grm" . showChar ' ' . showsPrec 1 header . showChar ' ' . showsPrec 1 abstract . showChar ' ' . showsPrec 1 concretes . cpar n + Hdr cid cids -> opar n . showString "Hdr" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 cids . cpar n + Abs absdefs -> opar n . showString "Abs" . showChar ' ' . showsPrec 1 absdefs . cpar n + Cnc cid cncdefs -> opar n . showString "Cnc" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 cncdefs . cpar n + Fun cid type' exp -> opar n . showString "Fun" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 type' . showChar ' ' . showsPrec 1 exp . cpar n + Lin cid term -> opar n . showString "Lin" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 term . cpar n + Typ cids cid -> opar n . showString "Typ" . showChar ' ' . showsPrec 1 cids . showChar ' ' . showsPrec 1 cid . cpar n + Tr atom exps -> opar n . showString "Tr" . showChar ' ' . showsPrec 1 atom . showChar ' ' . showsPrec 1 exps . cpar n + AC cid -> opar n . showString "AC" . showChar ' ' . showsPrec 1 cid . cpar n + AS str -> opar n . showString "AS" . showChar ' ' . showsPrec 1 str . cpar n + AI n -> opar n . showString "AI" . showChar ' ' . showsPrec 1 n . cpar n + AF d -> opar n . showString "AF" . showChar ' ' . showsPrec 1 d . cpar n + AM -> showString "AM" + R terms -> opar n . showString "R" . showChar ' ' . showsPrec 1 terms . cpar n + P term0 term1 -> opar n . showString "P" . showChar ' ' . showsPrec 1 term0 . showChar ' ' . showsPrec 1 term1 . cpar n + S terms -> opar n . showString "S" . showChar ' ' . showsPrec 1 terms . cpar n + K tokn -> opar n . showString "K" . showChar ' ' . showsPrec 1 tokn . cpar n + V n -> opar n . showString "V" . showChar ' ' . showsPrec 1 n . cpar n + C n -> opar n . showString "C" . showChar ' ' . showsPrec 1 n . cpar n + F cid -> opar n . showString "F" . showChar ' ' . showsPrec 1 cid . cpar n + FV terms -> opar n . showString "FV" . showChar ' ' . showsPrec 1 terms . cpar n + W str term -> opar n . showString "W" . showChar ' ' . showsPrec 1 str . showChar ' ' . showsPrec 1 term . cpar n + RP term0 term1 -> opar n . showString "RP" . showChar ' ' . showsPrec 1 term0 . showChar ' ' . showsPrec 1 term1 . cpar n + TM -> showString "TM" + L cid term -> opar n . showString "L" . showChar ' ' . showsPrec 1 cid . showChar ' ' . showsPrec 1 term . cpar n + BV cid -> opar n . showString "BV" . showChar ' ' . showsPrec 1 cid . cpar n + KS str -> opar n . showString "KS" . showChar ' ' . showsPrec 1 str . cpar n + KP strs variants -> opar n . showString "KP" . showChar ' ' . showsPrec 1 strs . showChar ' ' . showsPrec 1 variants . cpar n + Var strs0 strs1 -> opar n . showString "Var" . showChar ' ' . showsPrec 1 strs0 . showChar ' ' . showsPrec 1 strs1 . cpar n + CId str -> opar n . showString "CId" . showChar ' ' . showsPrec 1 str . cpar n + where opar n = if n > 0 then showChar '(' else id + cpar n = if n > 0 then showChar ')' else id + +instance Eq (Tree c) where (==) = johnMajorEq + +johnMajorEq :: Tree a -> Tree b -> Bool +johnMajorEq (Grm header abstract concretes) (Grm header_ abstract_ concretes_) = header == header_ && abstract == abstract_ && concretes == concretes_ +johnMajorEq (Hdr cid cids) (Hdr cid_ cids_) = cid == cid_ && cids == cids_ +johnMajorEq (Abs absdefs) (Abs absdefs_) = absdefs == absdefs_ +johnMajorEq (Cnc cid cncdefs) (Cnc cid_ cncdefs_) = cid == cid_ && cncdefs == cncdefs_ +johnMajorEq (Fun cid type' exp) (Fun cid_ type'_ exp_) = cid == cid_ && type' == type'_ && exp == exp_ +johnMajorEq (Lin cid term) (Lin cid_ term_) = cid == cid_ && term == term_ +johnMajorEq (Typ cids cid) (Typ cids_ cid_) = cids == cids_ && cid == cid_ +johnMajorEq (Tr atom exps) (Tr atom_ exps_) = atom == atom_ && exps == exps_ +johnMajorEq (AC cid) (AC cid_) = cid == cid_ +johnMajorEq (AS str) (AS str_) = str == str_ +johnMajorEq (AI n) (AI n_) = n == n_ +johnMajorEq (AF d) (AF d_) = d == d_ +johnMajorEq AM AM = True +johnMajorEq (R terms) (R terms_) = terms == terms_ +johnMajorEq (P term0 term1) (P term0_ term1_) = term0 == term0_ && term1 == term1_ +johnMajorEq (S terms) (S terms_) = terms == terms_ +johnMajorEq (K tokn) (K tokn_) = tokn == tokn_ +johnMajorEq (V n) (V n_) = n == n_ +johnMajorEq (C n) (C n_) = n == n_ +johnMajorEq (F cid) (F cid_) = cid == cid_ +johnMajorEq (FV terms) (FV terms_) = terms == terms_ +johnMajorEq (W str term) (W str_ term_) = str == str_ && term == term_ +johnMajorEq (RP term0 term1) (RP term0_ term1_) = term0 == term0_ && term1 == term1_ +johnMajorEq TM TM = True +johnMajorEq (L cid term) (L cid_ term_) = cid == cid_ && term == term_ +johnMajorEq (BV cid) (BV cid_) = cid == cid_ +johnMajorEq (KS str) (KS str_) = str == str_ +johnMajorEq (KP strs variants) (KP strs_ variants_) = strs == strs_ && variants == variants_ +johnMajorEq (Var strs0 strs1) (Var strs0_ strs1_) = strs0 == strs0_ && strs1 == strs1_ +johnMajorEq (CId str) (CId str_) = str == str_ +johnMajorEq _ _ = False + +instance Ord (Tree c) where + compare x y = compare (index x) (index y) `mappend` compareSame x y +index :: Tree c -> Int +index (Grm _ _ _) = 0 +index (Hdr _ _) = 1 +index (Abs _) = 2 +index (Cnc _ _) = 3 +index (Fun _ _ _) = 4 +index (Lin _ _) = 5 +index (Typ _ _) = 6 +index (Tr _ _) = 7 +index (AC _) = 8 +index (AS _) = 9 +index (AI _) = 10 +index (AF _) = 11 +index (AM ) = 12 +index (R _) = 13 +index (P _ _) = 14 +index (S _) = 15 +index (K _) = 16 +index (V _) = 17 +index (C _) = 18 +index (F _) = 19 +index (FV _) = 20 +index (W _ _) = 21 +index (RP _ _) = 22 +index (TM ) = 23 +index (L _ _) = 24 +index (BV _) = 25 +index (KS _) = 26 +index (KP _ _) = 27 +index (Var _ _) = 28 +index (CId _) = 29 +compareSame :: Tree c -> Tree c -> Ordering +compareSame (Grm header abstract concretes) (Grm header_ abstract_ concretes_) = mappend (compare header header_) (mappend (compare abstract abstract_) (compare concretes concretes_)) +compareSame (Hdr cid cids) (Hdr cid_ cids_) = mappend (compare cid cid_) (compare cids cids_) +compareSame (Abs absdefs) (Abs absdefs_) = compare absdefs absdefs_ +compareSame (Cnc cid cncdefs) (Cnc cid_ cncdefs_) = mappend (compare cid cid_) (compare cncdefs cncdefs_) +compareSame (Fun cid type' exp) (Fun cid_ type'_ exp_) = mappend (compare cid cid_) (mappend (compare type' type'_) (compare exp exp_)) +compareSame (Lin cid term) (Lin cid_ term_) = mappend (compare cid cid_) (compare term term_) +compareSame (Typ cids cid) (Typ cids_ cid_) = mappend (compare cids cids_) (compare cid cid_) +compareSame (Tr atom exps) (Tr atom_ exps_) = mappend (compare atom atom_) (compare exps exps_) +compareSame (AC cid) (AC cid_) = compare cid cid_ +compareSame (AS str) (AS str_) = compare str str_ +compareSame (AI n) (AI n_) = compare n n_ +compareSame (AF d) (AF d_) = compare d d_ +compareSame AM AM = EQ +compareSame (R terms) (R terms_) = compare terms terms_ +compareSame (P term0 term1) (P term0_ term1_) = mappend (compare term0 term0_) (compare term1 term1_) +compareSame (S terms) (S terms_) = compare terms terms_ +compareSame (K tokn) (K tokn_) = compare tokn tokn_ +compareSame (V n) (V n_) = compare n n_ +compareSame (C n) (C n_) = compare n n_ +compareSame (F cid) (F cid_) = compare cid cid_ +compareSame (FV terms) (FV terms_) = compare terms terms_ +compareSame (W str term) (W str_ term_) = mappend (compare str str_) (compare term term_) +compareSame (RP term0 term1) (RP term0_ term1_) = mappend (compare term0 term0_) (compare term1 term1_) +compareSame TM TM = EQ +compareSame (L cid term) (L cid_ term_) = mappend (compare cid cid_) (compare term term_) +compareSame (BV cid) (BV cid_) = compare cid cid_ +compareSame (KS str) (KS str_) = compare str str_ +compareSame (KP strs variants) (KP strs_ variants_) = mappend (compare strs strs_) (compare variants variants_) +compareSame (Var strs0 strs1) (Var strs0_ strs1_) = mappend (compare strs0 strs0_) (compare strs1 strs1_) +compareSame (CId str) (CId str_) = compare str str_ +compareSame x y = error "BNFC error:" compareSame diff --git a/src/tools/c/GFCC/ComposOp.hs b/src/tools/c/GFCC/ComposOp.hs new file mode 100644 index 000000000..401c1d778 --- /dev/null +++ b/src/tools/c/GFCC/ComposOp.hs @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} +module GFCC.ComposOp (Compos(..),composOp,composOpM,composOpM_,composOpMonoid, + composOpMPlus,composOpFold) where + +import Control.Monad.Identity +import Data.Monoid + +class Compos t where + compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) + -> (forall a. t a -> m (t a)) -> t c -> m (t c) + +composOp :: Compos t => (forall a. t a -> t a) -> t c -> t c +composOp f = runIdentity . composOpM (Identity . f) + +composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t c -> m (t c) +composOpM = compos return ap + +composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t c -> m () +composOpM_ = composOpFold (return ()) (>>) + +composOpMonoid :: (Compos t, Monoid m) => (forall a. t a -> m) -> t c -> m +composOpMonoid = composOpFold mempty mappend + +composOpMPlus :: (Compos t, MonadPlus m) => (forall a. t a -> m b) -> t c -> m b +composOpMPlus = composOpFold mzero mplus + +composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b +composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x y)) (C . f) + +newtype C b a = C { unC :: b } diff --git a/src/tools/c/GFCC/ErrM.hs b/src/tools/c/GFCC/ErrM.hs new file mode 100644 index 000000000..820473ccd --- /dev/null +++ b/src/tools/c/GFCC/ErrM.hs @@ -0,0 +1,16 @@ +-- BNF Converter: Error Monad +-- Copyright (C) 2004 Author: Aarne Ranta + +-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE. +module GFCC.ErrM where + +-- the Error monad: like Maybe type with error msgs + +data Err a = Ok a | Bad String + deriving (Read, Show, Eq) + +instance Monad Err where + return = Ok + fail = Bad + Ok a >>= f = f a + Bad s >>= f = Bad s diff --git a/src/tools/c/GFCC/Lex.hs b/src/tools/c/GFCC/Lex.hs new file mode 100644 index 000000000..f12c824cd --- /dev/null +++ b/src/tools/c/GFCC/Lex.hs @@ -0,0 +1,340 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +{-# LINE 3 "GFCC/Lex.x" #-} +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module GFCC.Lex where + + + +#if __GLASGOW_HASKELL__ >= 603 +#include "ghcconfig.h" +#else +#include "config.h" +#endif +#if __GLASGOW_HASKELL__ >= 503 +import Data.Array +import Data.Char (ord) +import Data.Array.Base (unsafeAt) +#else +import Array +import Char (ord) +#endif +#if __GLASGOW_HASKELL__ >= 503 +import GHC.Exts +#else +import GlaExts +#endif +alex_base :: AlexAddr +alex_base = AlexA# "\x01\x00\x00\x00\x39\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\xcb\xff\xff\xff\x0a\x00\x00\x00\xec\xff\xff\xff\x9a\x00\x00\x00\x6a\x01\x00\x00\x00\x00\x00\x00\x15\x01\x00\x00\xd3\x00\x00\x00\x35\x00\x00\x00\xe5\x00\x00\x00\x3f\x00\x00\x00\xf0\x00\x00\x00\x1b\x01\x00\x00\xb8\x01\x00\x00"# + +alex_table :: AlexAddr +alex_table = AlexA# "\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x02\x00\x02\x00\x02\x00\x02\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\x02\x00\x03\x00\x0a\x00\x03\x00\x03\x00\xff\xff\xff\xff\xff\xff\x03\x00\x03\x00\xff\xff\x03\x00\x03\x00\x05\x00\xff\xff\x03\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x03\x00\x03\x00\xff\xff\x03\x00\xff\xff\x03\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x03\x00\x03\x00\x03\x00\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x04\x00\xff\xff\x03\x00\xff\xff\x07\x00\xff\xff\x02\x00\x0f\x00\x00\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x03\x00\x06\x00\x03\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\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\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0a\x00\x00\x00\x00\x00\xff\xff\x07\x00\x0a\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\xff\xff\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x11\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0b\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x08\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x10\x00\x00\x00\x00\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +alex_check :: AlexAddr +alex_check = AlexA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\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\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x7c\x00\x3e\x00\x5d\x00\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x20\x00\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd7\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\x22\x00\xff\xff\xff\xff\xf7\x00\x5f\x00\x27\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\x65\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x5c\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\x27\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\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\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\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\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\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\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\xff\xff\xff\xff"# + +alex_deflt :: AlexAddr +alex_deflt = AlexA# "\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +alex_accept = listArray (0::Int,17) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_1))],[],[],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_4))],[],[],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_6))],[],[],[]] +{-# LINE 33 "GFCC/Lex.x" #-} + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + | T_CId !String + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" + +posLineCol (Pn _ l c) = (l,c) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken t = case t of + PT _ (TS s) -> s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + PT _ (T_CId s) -> s + + _ -> show t + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords = b "grammar" (b "concrete" (b "abstract" N N) N) (b "pre" N N) + where b s = B s (TS s) + +unescapeInitTail :: String -> String +unescapeInitTail = unesc . tail where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type AlexInput = (Posn, -- current position, + Char, -- previous char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', str) + where + go :: (Posn, Char, String) -> [Token] + go inp@(pos, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _) -> [Err pos] + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p, c, []) = Nothing +alexGetChar (p, _, (c:s)) = + let p' = alexMove p c + in p' `seq` Just (c, (p', c, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, s) = c + +alex_action_1 = tok (\p s -> PT p (TS $ share s)) +alex_action_2 = tok (\p s -> PT p (eitherResIdent (T_CId . share) s)) +alex_action_3 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) +alex_action_4 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) +alex_action_5 = tok (\p s -> PT p (TI $ share s)) +alex_action_6 = tok (\p s -> PT p (TD $ share s)) +{-# LINE 1 "GenericTemplate.hs" #-} +{-# LINE 1 "<built-in>" #-} +{-# LINE 1 "<command line>" #-} +{-# LINE 1 "GenericTemplate.hs" #-} +-- ----------------------------------------------------------------------------- +-- ALEX TEMPLATE +-- +-- This code is in the PUBLIC DOMAIN; you may copy it freely and use +-- it for any purpose whatsoever. + +-- ----------------------------------------------------------------------------- +-- INTERNALS and main scanner engine + +{-# LINE 35 "GenericTemplate.hs" #-} + +{-# LINE 45 "GenericTemplate.hs" #-} + + +data AlexAddr = AlexA# Addr# + +#if __GLASGOW_HASKELL__ < 503 +uncheckedShiftL# = shiftL# +#endif + +{-# INLINE alexIndexInt16OffAddr #-} +alexIndexInt16OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow16Int# i + where + i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) + high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + low = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 2# +#else + indexInt16OffAddr# arr off +#endif + + + + + +{-# INLINE alexIndexInt32OffAddr #-} +alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN + narrow32Int# i + where + i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` + (b2 `uncheckedShiftL#` 16#) `or#` + (b1 `uncheckedShiftL#` 8#) `or#` b0) + b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) + b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) + b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) + b0 = int2Word# (ord# (indexCharOffAddr# arr off')) + off' = off *# 4# +#else + indexInt32OffAddr# arr off +#endif + + + + + +#if __GLASGOW_HASKELL__ < 503 +quickIndex arr i = arr ! i +#else +-- GHC >= 503, unsafeAt is available from Data.Array.Base. +quickIndex = unsafeAt +#endif + + + + +-- ----------------------------------------------------------------------------- +-- Main lexing routines + +data AlexReturn a + = AlexEOF + | AlexError !AlexInput + | AlexSkip !AlexInput !Int + | AlexToken !AlexInput !Int a + +-- alexScan :: AlexInput -> StartCode -> Maybe (AlexInput,Int,act) +alexScan input (I# (sc)) + = alexScanUser undefined input (I# (sc)) + +alexScanUser user input (I# (sc)) + = case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, input') -> + case alexGetChar input of + Nothing -> + + + + AlexEOF + Just _ -> + + + + AlexError input' + + (AlexLastSkip input len, _) -> + + + + AlexSkip input len + + (AlexLastAcc k input len, _) -> + + + + AlexToken input len k + + +-- Push the input through the DFA, remembering the most recent accepting +-- state it encountered. + +alex_scan_tkn user orig_input len input s last_acc = + input `seq` -- strict in the input + case s of + -1# -> (last_acc, input) + _ -> alex_scan_tkn' user orig_input len input s last_acc + +alex_scan_tkn' user orig_input len input s last_acc = + let + new_acc = check_accs (alex_accept `quickIndex` (I# (s))) + in + new_acc `seq` + case alexGetChar input of + Nothing -> (new_acc, input) + Just (c, new_input) -> + + + + let + base = alexIndexInt32OffAddr alex_base s + (I# (ord_c)) = ord c + offset = (base +# ord_c) + check = alexIndexInt16OffAddr alex_check offset + + new_s = if (offset >=# 0#) && (check ==# ord_c) + then alexIndexInt16OffAddr alex_table offset + else alexIndexInt16OffAddr alex_deflt s + in + alex_scan_tkn user orig_input (len +# 1#) new_input new_s new_acc + + where + check_accs [] = last_acc + check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) + check_accs (AlexAccPred a pred : rest) + | pred user orig_input (I# (len)) input + = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkipPred pred : rest) + | pred user orig_input (I# (len)) input + = AlexLastSkip input (I# (len)) + check_accs (_ : rest) = check_accs rest + +data AlexLastAcc a + = AlexNone + | AlexLastAcc a !AlexInput !Int + | AlexLastSkip !AlexInput !Int + +data AlexAcc a user + = AlexAcc a + | AlexAccSkip + | AlexAccPred a (AlexAccPred user) + | AlexAccSkipPred (AlexAccPred user) + +type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool + +-- ----------------------------------------------------------------------------- +-- Predicates on a rule + +alexAndPred p1 p2 user in1 len in2 + = p1 user in1 len in2 && p2 user in1 len in2 + +--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input + +--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input + +--alexRightContext :: Int -> AlexAccPred _ +alexRightContext (I# (sc)) user _ _ input = + case alex_scan_tkn user input 0# input sc AlexNone of + (AlexNone, _) -> False + _ -> True + -- TODO: there's no need to find the longest + -- match when checking the right context, just + -- the first match will do. + +-- used by wrappers +iUnbox (I# (i)) = i diff --git a/src/tools/c/GFCC/Lex.x b/src/tools/c/GFCC/Lex.x new file mode 100644 index 000000000..f5fda82b6 --- /dev/null +++ b/src/tools/c/GFCC/Lex.x @@ -0,0 +1,135 @@ +-- -*- haskell -*- +-- This Alex file was machine-generated by the BNF converter +{ +{-# OPTIONS -fno-warn-incomplete-patterns #-} +module GFCC.Lex where + + +} + + +$l = [a-zA-Z\192 - \255] # [\215 \247] -- isolatin1 letter FIXME +$c = [A-Z\192-\221] # [\215] -- capital isolatin1 letter FIXME +$s = [a-z\222-\255] # [\247] -- small isolatin1 letter FIXME +$d = [0-9] -- digit +$i = [$l $d _ '] -- identifier character +$u = [\0-\255] -- universal: any character + +@rsyms = -- symbols and non-identifier-like reserved words + \; | \( | \) | \{ | \} | \: | \= | \- \> | \? | \[ | \] | \! | \$ | \[ \| | \| \] | \+ | \@ | \# | \/ | \, + +:- + +$white+ ; +@rsyms { tok (\p s -> PT p (TS $ share s)) } +(\_ | $l)($l | $d | \' | \_)* { tok (\p s -> PT p (eitherResIdent (T_CId . share) s)) } + +$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) } +\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) } + +$d+ { tok (\p s -> PT p (TI $ share s)) } +$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) } + +{ + +tok f p s = f p s + +share :: String -> String +share = id + +data Tok = + TS !String -- reserved words and symbols + | TL !String -- string literals + | TI !String -- integer literals + | TV !String -- identifiers + | TD !String -- double precision float literals + | TC !String -- character literals + | T_CId !String + + deriving (Eq,Show,Ord) + +data Token = + PT Posn Tok + | Err Posn + deriving (Eq,Show,Ord) + +tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l +tokenPos (Err (Pn _ l _) :_) = "line " ++ show l +tokenPos _ = "end of file" + +posLineCol (Pn _ l c) = (l,c) +mkPosToken t@(PT p _) = (posLineCol p, prToken t) + +prToken t = case t of + PT _ (TS s) -> s + PT _ (TI s) -> s + PT _ (TV s) -> s + PT _ (TD s) -> s + PT _ (TC s) -> s + PT _ (T_CId s) -> s + + _ -> show t + +data BTree = N | B String Tok BTree BTree deriving (Show) + +eitherResIdent :: (String -> Tok) -> String -> Tok +eitherResIdent tv s = treeFind resWords + where + treeFind N = tv s + treeFind (B a t left right) | s < a = treeFind left + | s > a = treeFind right + | s == a = t + +resWords = b "grammar" (b "concrete" (b "abstract" N N) N) (b "pre" N N) + where b s = B s (TS s) + +unescapeInitTail :: String -> String +unescapeInitTail = unesc . tail where + unesc s = case s of + '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs + '\\':'n':cs -> '\n' : unesc cs + '\\':'t':cs -> '\t' : unesc cs + '"':[] -> [] + c:cs -> c : unesc cs + _ -> [] + +------------------------------------------------------------------- +-- Alex wrapper code. +-- A modified "posn" wrapper. +------------------------------------------------------------------- + +data Posn = Pn !Int !Int !Int + deriving (Eq, Show,Ord) + +alexStartPos :: Posn +alexStartPos = Pn 0 1 1 + +alexMove :: Posn -> Char -> Posn +alexMove (Pn a l c) '\t' = Pn (a+1) l (((c+7) `div` 8)*8+1) +alexMove (Pn a l c) '\n' = Pn (a+1) (l+1) 1 +alexMove (Pn a l c) _ = Pn (a+1) l (c+1) + +type AlexInput = (Posn, -- current position, + Char, -- previous char + String) -- current input string + +tokens :: String -> [Token] +tokens str = go (alexStartPos, '\n', str) + where + go :: (Posn, Char, String) -> [Token] + go inp@(pos, _, str) = + case alexScan inp 0 of + AlexEOF -> [] + AlexError (pos, _, _) -> [Err pos] + AlexSkip inp' len -> go inp' + AlexToken inp' len act -> act pos (take len str) : (go inp') + +alexGetChar :: AlexInput -> Maybe (Char,AlexInput) +alexGetChar (p, c, []) = Nothing +alexGetChar (p, _, (c:s)) = + let p' = alexMove p c + in p' `seq` Just (c, (p', c, s)) + +alexInputPrevChar :: AlexInput -> Char +alexInputPrevChar (p, c, s) = c +} diff --git a/src/tools/c/GFCC/Par.hs b/src/tools/c/GFCC/Par.hs new file mode 100644 index 000000000..1f5479e64 --- /dev/null +++ b/src/tools/c/GFCC/Par.hs @@ -0,0 +1,1096 @@ +{-# OPTIONS -fglasgow-exts -cpp #-} +{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module GFCC.Par where +import GFCC.Abs +import GFCC.Lex +import GFCC.ErrM +#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.16 + +newtype HappyAbsSyn = HappyAbsSyn (() -> ()) +happyIn23 :: (String) -> (HappyAbsSyn ) +happyIn23 x = unsafeCoerce# x +{-# INLINE happyIn23 #-} +happyOut23 :: (HappyAbsSyn ) -> (String) +happyOut23 x = unsafeCoerce# x +{-# INLINE happyOut23 #-} +happyIn24 :: (Integer) -> (HappyAbsSyn ) +happyIn24 x = unsafeCoerce# x +{-# INLINE happyIn24 #-} +happyOut24 :: (HappyAbsSyn ) -> (Integer) +happyOut24 x = unsafeCoerce# x +{-# INLINE happyOut24 #-} +happyIn25 :: (Double) -> (HappyAbsSyn ) +happyIn25 x = unsafeCoerce# x +{-# INLINE happyIn25 #-} +happyOut25 :: (HappyAbsSyn ) -> (Double) +happyOut25 x = unsafeCoerce# x +{-# INLINE happyOut25 #-} +happyIn26 :: (CId) -> (HappyAbsSyn ) +happyIn26 x = unsafeCoerce# x +{-# INLINE happyIn26 #-} +happyOut26 :: (HappyAbsSyn ) -> (CId) +happyOut26 x = unsafeCoerce# x +{-# INLINE happyOut26 #-} +happyIn27 :: (Grammar) -> (HappyAbsSyn ) +happyIn27 x = unsafeCoerce# x +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn ) -> (Grammar) +happyOut27 x = unsafeCoerce# x +{-# INLINE happyOut27 #-} +happyIn28 :: (Header) -> (HappyAbsSyn ) +happyIn28 x = unsafeCoerce# x +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn ) -> (Header) +happyOut28 x = unsafeCoerce# x +{-# INLINE happyOut28 #-} +happyIn29 :: (Abstract) -> (HappyAbsSyn ) +happyIn29 x = unsafeCoerce# x +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn ) -> (Abstract) +happyOut29 x = unsafeCoerce# x +{-# INLINE happyOut29 #-} +happyIn30 :: (Concrete) -> (HappyAbsSyn ) +happyIn30 x = unsafeCoerce# x +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn ) -> (Concrete) +happyOut30 x = unsafeCoerce# x +{-# INLINE happyOut30 #-} +happyIn31 :: (AbsDef) -> (HappyAbsSyn ) +happyIn31 x = unsafeCoerce# x +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn ) -> (AbsDef) +happyOut31 x = unsafeCoerce# x +{-# INLINE happyOut31 #-} +happyIn32 :: (CncDef) -> (HappyAbsSyn ) +happyIn32 x = unsafeCoerce# x +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn ) -> (CncDef) +happyOut32 x = unsafeCoerce# x +{-# INLINE happyOut32 #-} +happyIn33 :: (Type) -> (HappyAbsSyn ) +happyIn33 x = unsafeCoerce# x +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn ) -> (Type) +happyOut33 x = unsafeCoerce# x +{-# INLINE happyOut33 #-} +happyIn34 :: (Exp) -> (HappyAbsSyn ) +happyIn34 x = unsafeCoerce# x +{-# INLINE happyIn34 #-} +happyOut34 :: (HappyAbsSyn ) -> (Exp) +happyOut34 x = unsafeCoerce# x +{-# INLINE happyOut34 #-} +happyIn35 :: (Atom) -> (HappyAbsSyn ) +happyIn35 x = unsafeCoerce# x +{-# INLINE happyIn35 #-} +happyOut35 :: (HappyAbsSyn ) -> (Atom) +happyOut35 x = unsafeCoerce# x +{-# INLINE happyOut35 #-} +happyIn36 :: (Term) -> (HappyAbsSyn ) +happyIn36 x = unsafeCoerce# x +{-# INLINE happyIn36 #-} +happyOut36 :: (HappyAbsSyn ) -> (Term) +happyOut36 x = unsafeCoerce# x +{-# INLINE happyOut36 #-} +happyIn37 :: (Tokn) -> (HappyAbsSyn ) +happyIn37 x = unsafeCoerce# x +{-# INLINE happyIn37 #-} +happyOut37 :: (HappyAbsSyn ) -> (Tokn) +happyOut37 x = unsafeCoerce# x +{-# INLINE happyOut37 #-} +happyIn38 :: (Variant) -> (HappyAbsSyn ) +happyIn38 x = unsafeCoerce# x +{-# INLINE happyIn38 #-} +happyOut38 :: (HappyAbsSyn ) -> (Variant) +happyOut38 x = unsafeCoerce# x +{-# INLINE happyOut38 #-} +happyIn39 :: ([Concrete]) -> (HappyAbsSyn ) +happyIn39 x = unsafeCoerce# x +{-# INLINE happyIn39 #-} +happyOut39 :: (HappyAbsSyn ) -> ([Concrete]) +happyOut39 x = unsafeCoerce# x +{-# INLINE happyOut39 #-} +happyIn40 :: ([AbsDef]) -> (HappyAbsSyn ) +happyIn40 x = unsafeCoerce# x +{-# INLINE happyIn40 #-} +happyOut40 :: (HappyAbsSyn ) -> ([AbsDef]) +happyOut40 x = unsafeCoerce# x +{-# INLINE happyOut40 #-} +happyIn41 :: ([CncDef]) -> (HappyAbsSyn ) +happyIn41 x = unsafeCoerce# x +{-# INLINE happyIn41 #-} +happyOut41 :: (HappyAbsSyn ) -> ([CncDef]) +happyOut41 x = unsafeCoerce# x +{-# INLINE happyOut41 #-} +happyIn42 :: ([CId]) -> (HappyAbsSyn ) +happyIn42 x = unsafeCoerce# x +{-# INLINE happyIn42 #-} +happyOut42 :: (HappyAbsSyn ) -> ([CId]) +happyOut42 x = unsafeCoerce# x +{-# INLINE happyOut42 #-} +happyIn43 :: ([Term]) -> (HappyAbsSyn ) +happyIn43 x = unsafeCoerce# x +{-# INLINE happyIn43 #-} +happyOut43 :: (HappyAbsSyn ) -> ([Term]) +happyOut43 x = unsafeCoerce# x +{-# INLINE happyOut43 #-} +happyIn44 :: ([Exp]) -> (HappyAbsSyn ) +happyIn44 x = unsafeCoerce# x +{-# INLINE happyIn44 #-} +happyOut44 :: (HappyAbsSyn ) -> ([Exp]) +happyOut44 x = unsafeCoerce# x +{-# INLINE happyOut44 #-} +happyIn45 :: ([String]) -> (HappyAbsSyn ) +happyIn45 x = unsafeCoerce# x +{-# INLINE happyIn45 #-} +happyOut45 :: (HappyAbsSyn ) -> ([String]) +happyOut45 x = unsafeCoerce# x +{-# INLINE happyOut45 #-} +happyIn46 :: ([Variant]) -> (HappyAbsSyn ) +happyIn46 x = unsafeCoerce# x +{-# INLINE happyIn46 #-} +happyOut46 :: (HappyAbsSyn ) -> ([Variant]) +happyOut46 x = unsafeCoerce# x +{-# INLINE happyOut46 #-} +happyInTok :: Token -> (HappyAbsSyn ) +happyInTok x = unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> Token +happyOutTok x = unsafeCoerce# x +{-# INLINE happyOutTok #-} + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\xff\x00\xff\x00\xfc\x00\xfe\x00\xfb\x00\xfb\x00\xfb\x00\x37\x00\x4d\x00\x29\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x29\x00\x00\x00\x00\x00\xfa\x00\xf9\x00\x00\x00\xf8\x00\xa8\x00\xf7\x00\xae\x00\xff\xff\x00\x00\x00\x00\x00\x00\xf6\x00\x00\x00\xf5\x00\x29\x00\x00\x00\x15\x00\xf3\x00\x29\x00\xf4\x00\x00\x00\x00\x00\xf2\x00\xf1\x00\xad\x00\xad\x00\x76\x00\xf1\x00\xf1\x00\xf0\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x4d\x00\xe9\x00\xef\x00\xeb\x00\xe3\x00\xee\x00\xe2\x00\xe2\x00\xe8\x00\xe1\x00\xed\x00\xe0\x00\xd4\x00\xd1\x00\xec\x00\xd3\x00\xea\x00\x00\x00\xe7\x00\xce\x00\x29\x00\xce\x00\x00\x00\x00\x00\xe6\x00\xe5\x00\xe4\x00\xc8\x00\x00\x00\xdf\x00\x00\x00\xde\x00\xd2\x00\xdb\x00\xbc\x00\xdd\x00\x29\x00\x00\x00\x00\x00\x00\x00\xa7\x00\x00\x00\xc6\x00\x00\x00\x00\x00\x29\x00\x29\x00\x29\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xff\x23\x00\x00\x00\x00\x00\xda\x00\x00\x00\x05\x00\xc2\x00\xdc\x00\x00\x00\xd9\x00\x00\x00\x04\x00\x37\x00\x00\x00\xa7\x00\xd8\x00\xd7\x00\xd6\x00\xd5\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\x00\x00\x00\x00\x00\x00\x00\xc0\x00\xca\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x95\x00\xcf\x00\xcd\x00\xcb\x00\x54\x00\xa6\x00\x09\x00\xb2\x00\xc3\x00\x92\x00\x41\x00\xf8\xff\xc1\x00\xbd\x00\xaa\x00\x27\x00\x61\x00\x96\x00\xb4\x00\x87\x00\x00\x00\x00\x00\x00\x00\xbf\x00\x00\x00\xbf\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x4b\x00\xa9\x00\x47\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x0a\x00\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x5f\x00\x00\x00\x01\x00\x8e\x00\x60\x00\x38\x00\x44\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x33\x00\x70\x00\x00\x00\x11\x00\x00\x00\x00\x00\x8a\x00\x7b\x00\x77\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x34\x00\x0a\x00\x21\x00\x00\x00\x20\x00\x00\x00\x00\x00\x7a\x00\xa1\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\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"# + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc3\xff\x00\x00\x00\x00\x00\x00\x00\x00\xbb\xff\xc9\xff\xc7\xff\xc5\xff\xc3\xff\xc0\xff\xbd\xff\xbb\xff\xbb\xff\x00\x00\xeb\xff\xb8\xff\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xff\xd4\xff\xd3\xff\xbf\xff\xd6\xff\x00\x00\xc0\xff\xcf\xff\xc0\xff\x00\x00\xc0\xff\x00\x00\xea\xff\xe8\xff\xc2\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\xff\xdc\xff\xdb\xff\xde\xff\x00\x00\xda\xff\xe9\xff\x00\x00\xdf\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\xc7\xff\x00\x00\xc3\xff\x00\x00\x00\x00\xbd\xff\xbb\xff\x00\x00\x00\x00\x00\x00\xc3\xff\xcd\xff\x00\x00\xd5\xff\x00\x00\xcc\xff\xd3\xff\xbf\xff\x00\x00\xc0\xff\xbc\xff\xba\xff\xbb\xff\xb9\xff\xb7\xff\xca\xff\xbe\xff\xd7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd9\xff\xd2\xff\xc1\xff\xc4\xff\xc6\xff\xc8\xff\x00\x00\x00\x00\xe1\xff\xe2\xff\x00\x00\xc5\xff\x00\x00\xc3\xff\x00\x00\xc9\xff\x00\x00\xe5\xff\x00\x00\x00\x00\xe0\xff\xb9\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd8\xff\xd0\xff\xce\xff\xd1\xff\x00\x00\xe3\xff\xe4\xff\xe6\xff\xe7\xff\x00\x00\xcb\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x02\x00\x00\x00\x01\x00\x03\x00\x03\x00\x0a\x00\x0f\x00\x09\x00\x05\x00\x05\x00\x0a\x00\x03\x00\x03\x00\x16\x00\x0d\x00\x0e\x00\x00\x00\x08\x00\x0a\x00\x13\x00\x19\x00\x14\x00\x02\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x13\x00\x1e\x00\x09\x00\x0a\x00\x1c\x00\x1c\x00\x0d\x00\x0e\x00\x03\x00\x02\x00\x03\x00\x12\x00\x03\x00\x07\x00\x03\x00\x02\x00\x09\x00\x18\x00\x19\x00\x1a\x00\x10\x00\x1c\x00\x09\x00\x0a\x00\x13\x00\x0a\x00\x0d\x00\x0e\x00\x13\x00\x02\x00\x13\x00\x12\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x09\x00\x00\x00\x19\x00\x1a\x00\x19\x00\x1c\x00\x12\x00\x00\x00\x01\x00\x16\x00\x03\x00\x00\x00\x01\x00\x15\x00\x03\x00\x0e\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x0d\x00\x0e\x00\x09\x00\x03\x00\x0d\x00\x0e\x00\x16\x00\x14\x00\x08\x00\x00\x00\x01\x00\x14\x00\x03\x00\x00\x00\x01\x00\x03\x00\x03\x00\x0f\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x0d\x00\x0e\x00\x16\x00\x17\x00\x0d\x00\x0e\x00\x11\x00\x14\x00\x06\x00\x00\x00\x01\x00\x14\x00\x03\x00\x00\x00\x01\x00\x07\x00\x03\x00\x00\x00\x01\x00\x03\x00\x03\x00\x0f\x00\x0d\x00\x0e\x00\x03\x00\x09\x00\x0d\x00\x0e\x00\x16\x00\x17\x00\x0d\x00\x0e\x00\x00\x00\x01\x00\x16\x00\x03\x00\x00\x00\x01\x00\x03\x00\x03\x00\x00\x00\x01\x00\x1e\x00\x03\x00\x0f\x00\x0d\x00\x0e\x00\x04\x00\x05\x00\x0d\x00\x0e\x00\x16\x00\x17\x00\x0d\x00\x0e\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x01\x00\x15\x00\x0b\x00\x0c\x00\x03\x00\x09\x00\x0b\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x13\x00\x13\x00\x12\x00\x0b\x00\x0c\x00\x00\x00\x19\x00\x19\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x19\x00\x0c\x00\x1c\x00\x16\x00\x1e\x00\x1e\x00\x11\x00\x11\x00\x0c\x00\x14\x00\x10\x00\x07\x00\x06\x00\x05\x00\x0b\x00\x16\x00\x0b\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x01\x00\x1c\x00\x19\x00\x03\x00\x07\x00\x10\x00\x08\x00\x1c\x00\x01\x00\x01\x00\x01\x00\x15\x00\x0b\x00\x1c\x00\x04\x00\x02\x00\x01\x00\x0f\x00\x1e\x00\x1c\x00\x04\x00\x07\x00\xff\xff\x06\x00\xff\xff\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\x1e\x00\x1e\x00\x1e\x00\xff\xff\xff\xff\x1c\x00\xff\xff\x14\x00\x1e\x00\x18\x00\xff\xff\x14\x00\xff\xff\x14\x00\x1a\x00\xff\xff\x1e\x00\x1c\x00\x15\x00\x19\x00\x1e\x00\x16\x00\x1e\x00\x17\x00\x1c\x00\x1e\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"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x3c\x00\x1b\x00\x1c\x00\x29\x00\x1d\x00\x82\x00\x2e\x00\x38\x00\x8d\x00\x7e\x00\x76\x00\x29\x00\x40\x00\x17\x00\x1e\x00\x1f\x00\x61\x00\x54\x00\x3c\x00\x3d\x00\x16\x00\x66\x00\x22\x00\x16\x00\x28\x00\x39\x00\x29\x00\x3d\x00\xff\xff\x23\x00\x24\x00\x29\x00\x29\x00\x25\x00\x26\x00\x29\x00\x3c\x00\x81\x00\x27\x00\x29\x00\x53\x00\x29\x00\x22\x00\x38\x00\x53\x00\x16\x00\x28\x00\x8e\x00\x29\x00\x23\x00\x24\x00\x7c\x00\x31\x00\x25\x00\x26\x00\x6e\x00\x3c\x00\x2a\x00\x27\x00\x16\x00\x28\x00\x39\x00\x29\x00\x38\x00\x1b\x00\x16\x00\x28\x00\x16\x00\x29\x00\x7e\x00\x1b\x00\x1c\x00\x65\x00\x1d\x00\x1b\x00\x1c\x00\x73\x00\x1d\x00\x2f\x00\x16\x00\x28\x00\x39\x00\x29\x00\x1e\x00\x1f\x00\x38\x00\x40\x00\x1e\x00\x1f\x00\x72\x00\x58\x00\x41\x00\x5b\x00\x1c\x00\x5a\x00\x5c\x00\x1b\x00\x1c\x00\x74\x00\x1d\x00\x16\x00\x16\x00\x28\x00\x39\x00\x29\x00\x5d\x00\x1f\x00\x17\x00\x8a\x00\x1e\x00\x1f\x00\x78\x00\x5e\x00\x7a\x00\x1b\x00\x1c\x00\x20\x00\x1d\x00\x1b\x00\x1c\x00\x53\x00\x1d\x00\x1b\x00\x1c\x00\x3e\x00\x1d\x00\x16\x00\x82\x00\x1f\x00\x4b\x00\x55\x00\x83\x00\x1f\x00\x17\x00\x64\x00\x84\x00\x1f\x00\x1b\x00\x1c\x00\x44\x00\x1d\x00\x1b\x00\x1c\x00\x4d\x00\x1d\x00\x1b\x00\x1c\x00\xff\xff\x1d\x00\x16\x00\x85\x00\x1f\x00\x48\x00\x49\x00\x75\x00\x1f\x00\x17\x00\x18\x00\x31\x00\x1f\x00\x32\x00\x33\x00\x34\x00\x35\x00\x32\x00\x33\x00\x34\x00\x35\x00\x3e\x00\x59\x00\x1a\x00\x8b\x00\x3a\x00\x57\x00\x3f\x00\x60\x00\x3a\x00\x32\x00\x33\x00\x34\x00\x35\x00\x32\x00\x33\x00\x34\x00\x35\x00\xbb\xff\x63\x00\x2b\x00\x39\x00\x3a\x00\x61\x00\xbb\xff\x16\x00\x51\x00\x32\x00\x33\x00\x34\x00\x35\x00\x16\x00\x69\x00\x29\x00\x19\x00\xff\xff\xff\xff\x6a\x00\x2c\x00\x36\x00\x60\x00\x2d\x00\x42\x00\x44\x00\x46\x00\x91\x00\x44\x00\x90\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8e\x00\x7c\x00\x29\x00\x16\x00\x68\x00\x80\x00\x6c\x00\x6b\x00\x29\x00\x70\x00\x71\x00\x72\x00\x46\x00\x6d\x00\x29\x00\x78\x00\x7a\x00\x4b\x00\x6e\x00\xff\xff\x29\x00\x4d\x00\x50\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x51\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x29\x00\x00\x00\x57\x00\xff\xff\x53\x00\x00\x00\x60\x00\x00\x00\x64\x00\x28\x00\x00\x00\xff\xff\x29\x00\x46\x00\x16\x00\xff\xff\x44\x00\xff\xff\x48\x00\x29\x00\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"# + +happyReduceArr = array (20, 72) [ + (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) + ] + +happy_n_terms = 31 :: Int +happy_n_nonterms = 24 :: Int + +happyReduce_20 = happySpecReduce_1 0# happyReduction_20 +happyReduction_20 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> + happyIn23 + (happy_var_1 + )} + +happyReduce_21 = happySpecReduce_1 1# happyReduction_21 +happyReduction_21 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> + happyIn24 + ((read happy_var_1) :: Integer + )} + +happyReduce_22 = happySpecReduce_1 2# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> + happyIn25 + ((read happy_var_1) :: Double + )} + +happyReduce_23 = happySpecReduce_1 3# happyReduction_23 +happyReduction_23 happy_x_1 + = case happyOutTok happy_x_1 of { (PT _ (T_CId happy_var_1)) -> + happyIn26 + (CId (happy_var_1) + )} + +happyReduce_24 = happyReduce 5# 4# happyReduction_24 +happyReduction_24 (happy_x_5 `HappyStk` + 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 happyOut29 happy_x_3 of { happy_var_3 -> + case happyOut39 happy_x_5 of { happy_var_5 -> + happyIn27 + (Grm happy_var_1 happy_var_3 (reverse happy_var_5) + ) `HappyStk` happyRest}}} + +happyReduce_25 = happyReduce 5# 5# happyReduction_25 +happyReduction_25 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut42 happy_x_4 of { happy_var_4 -> + happyIn28 + (Hdr happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_26 = happyReduce 4# 6# happyReduction_26 +happyReduction_26 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut40 happy_x_3 of { happy_var_3 -> + happyIn29 + (Abs (reverse happy_var_3) + ) `HappyStk` happyRest} + +happyReduce_27 = happyReduce 5# 7# happyReduction_27 +happyReduction_27 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut41 happy_x_4 of { happy_var_4 -> + happyIn30 + (Cnc happy_var_2 (reverse happy_var_4) + ) `HappyStk` happyRest}} + +happyReduce_28 = happyReduce 5# 8# happyReduction_28 +happyReduction_28 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut33 happy_x_3 of { happy_var_3 -> + case happyOut34 happy_x_5 of { happy_var_5 -> + happyIn31 + (Fun happy_var_1 happy_var_3 happy_var_5 + ) `HappyStk` happyRest}}} + +happyReduce_29 = happySpecReduce_3 9# happyReduction_29 +happyReduction_29 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut36 happy_x_3 of { happy_var_3 -> + happyIn32 + (Lin happy_var_1 happy_var_3 + )}} + +happyReduce_30 = happySpecReduce_3 10# happyReduction_30 +happyReduction_30 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + case happyOut26 happy_x_3 of { happy_var_3 -> + happyIn33 + (Typ happy_var_1 happy_var_3 + )}} + +happyReduce_31 = happyReduce 4# 11# happyReduction_31 +happyReduction_31 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut35 happy_x_2 of { happy_var_2 -> + case happyOut44 happy_x_3 of { happy_var_3 -> + happyIn34 + (Tr happy_var_2 (reverse happy_var_3) + ) `HappyStk` happyRest}} + +happyReduce_32 = happySpecReduce_1 11# happyReduction_32 +happyReduction_32 happy_x_1 + = case happyOut35 happy_x_1 of { happy_var_1 -> + happyIn34 + (trA_ happy_var_1 + )} + +happyReduce_33 = happySpecReduce_1 12# happyReduction_33 +happyReduction_33 happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn35 + (AC happy_var_1 + )} + +happyReduce_34 = happySpecReduce_1 12# happyReduction_34 +happyReduction_34 happy_x_1 + = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn35 + (AS happy_var_1 + )} + +happyReduce_35 = happySpecReduce_1 12# happyReduction_35 +happyReduction_35 happy_x_1 + = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn35 + (AI happy_var_1 + )} + +happyReduce_36 = happySpecReduce_1 12# happyReduction_36 +happyReduction_36 happy_x_1 + = case happyOut25 happy_x_1 of { happy_var_1 -> + happyIn35 + (AF happy_var_1 + )} + +happyReduce_37 = happySpecReduce_1 12# happyReduction_37 +happyReduction_37 happy_x_1 + = happyIn35 + (AM + ) + +happyReduce_38 = happySpecReduce_3 13# happyReduction_38 +happyReduction_38 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut43 happy_x_2 of { happy_var_2 -> + happyIn36 + (R happy_var_2 + )} + +happyReduce_39 = happyReduce 5# 13# happyReduction_39 +happyReduction_39 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut36 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn36 + (P happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_40 = happySpecReduce_3 13# happyReduction_40 +happyReduction_40 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut43 happy_x_2 of { happy_var_2 -> + happyIn36 + (S happy_var_2 + )} + +happyReduce_41 = happySpecReduce_1 13# happyReduction_41 +happyReduction_41 happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn36 + (K happy_var_1 + )} + +happyReduce_42 = happySpecReduce_2 13# happyReduction_42 +happyReduction_42 happy_x_2 + happy_x_1 + = case happyOut24 happy_x_2 of { happy_var_2 -> + happyIn36 + (V happy_var_2 + )} + +happyReduce_43 = happySpecReduce_1 13# happyReduction_43 +happyReduction_43 happy_x_1 + = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn36 + (C happy_var_1 + )} + +happyReduce_44 = happySpecReduce_1 13# happyReduction_44 +happyReduction_44 happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn36 + (F happy_var_1 + )} + +happyReduce_45 = happySpecReduce_3 13# happyReduction_45 +happyReduction_45 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut43 happy_x_2 of { happy_var_2 -> + happyIn36 + (FV happy_var_2 + )} + +happyReduce_46 = happyReduce 5# 13# happyReduction_46 +happyReduction_46 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut23 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn36 + (W happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_47 = happyReduce 5# 13# happyReduction_47 +happyReduction_47 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut36 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn36 + (RP happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_48 = happySpecReduce_1 13# happyReduction_48 +happyReduction_48 happy_x_1 + = happyIn36 + (TM + ) + +happyReduce_49 = happyReduce 5# 13# happyReduction_49 +happyReduction_49 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut26 happy_x_2 of { happy_var_2 -> + case happyOut36 happy_x_4 of { happy_var_4 -> + happyIn36 + (L happy_var_2 happy_var_4 + ) `HappyStk` happyRest}} + +happyReduce_50 = happySpecReduce_2 13# happyReduction_50 +happyReduction_50 happy_x_2 + happy_x_1 + = case happyOut26 happy_x_2 of { happy_var_2 -> + happyIn36 + (BV happy_var_2 + )} + +happyReduce_51 = happySpecReduce_1 14# happyReduction_51 +happyReduction_51 happy_x_1 + = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn37 + (KS happy_var_1 + )} + +happyReduce_52 = happyReduce 7# 14# happyReduction_52 +happyReduction_52 (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 happyOut45 happy_x_3 of { happy_var_3 -> + case happyOut46 happy_x_5 of { happy_var_5 -> + happyIn37 + (KP (reverse happy_var_3) happy_var_5 + ) `HappyStk` happyRest}} + +happyReduce_53 = happySpecReduce_3 15# happyReduction_53 +happyReduction_53 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut45 happy_x_1 of { happy_var_1 -> + case happyOut45 happy_x_3 of { happy_var_3 -> + happyIn38 + (Var (reverse happy_var_1) (reverse happy_var_3) + )}} + +happyReduce_54 = happySpecReduce_0 16# happyReduction_54 +happyReduction_54 = happyIn39 + ([] + ) + +happyReduce_55 = happySpecReduce_3 16# happyReduction_55 +happyReduction_55 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + case happyOut30 happy_x_2 of { happy_var_2 -> + happyIn39 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_56 = happySpecReduce_0 17# happyReduction_56 +happyReduction_56 = happyIn40 + ([] + ) + +happyReduce_57 = happySpecReduce_3 17# happyReduction_57 +happyReduction_57 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + case happyOut31 happy_x_2 of { happy_var_2 -> + happyIn40 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_58 = happySpecReduce_0 18# happyReduction_58 +happyReduction_58 = happyIn41 + ([] + ) + +happyReduce_59 = happySpecReduce_3 18# happyReduction_59 +happyReduction_59 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + case happyOut32 happy_x_2 of { happy_var_2 -> + happyIn41 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_60 = happySpecReduce_0 19# happyReduction_60 +happyReduction_60 = happyIn42 + ([] + ) + +happyReduce_61 = happySpecReduce_1 19# happyReduction_61 +happyReduction_61 happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn42 + ((:[]) happy_var_1 + )} + +happyReduce_62 = happySpecReduce_3 19# happyReduction_62 +happyReduction_62 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut42 happy_x_3 of { happy_var_3 -> + happyIn42 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_63 = happySpecReduce_0 20# happyReduction_63 +happyReduction_63 = happyIn43 + ([] + ) + +happyReduce_64 = happySpecReduce_1 20# happyReduction_64 +happyReduction_64 happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn43 + ((:[]) happy_var_1 + )} + +happyReduce_65 = happySpecReduce_3 20# happyReduction_65 +happyReduction_65 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + case happyOut43 happy_x_3 of { happy_var_3 -> + happyIn43 + ((:) happy_var_1 happy_var_3 + )}} + +happyReduce_66 = happySpecReduce_0 21# happyReduction_66 +happyReduction_66 = happyIn44 + ([] + ) + +happyReduce_67 = happySpecReduce_2 21# happyReduction_67 +happyReduction_67 happy_x_2 + happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + case happyOut34 happy_x_2 of { happy_var_2 -> + happyIn44 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_68 = happySpecReduce_0 22# happyReduction_68 +happyReduction_68 = happyIn45 + ([] + ) + +happyReduce_69 = happySpecReduce_2 22# happyReduction_69 +happyReduction_69 happy_x_2 + happy_x_1 + = case happyOut45 happy_x_1 of { happy_var_1 -> + case happyOut23 happy_x_2 of { happy_var_2 -> + happyIn45 + (flip (:) happy_var_1 happy_var_2 + )}} + +happyReduce_70 = happySpecReduce_0 23# happyReduction_70 +happyReduction_70 = happyIn46 + ([] + ) + +happyReduce_71 = happySpecReduce_1 23# happyReduction_71 +happyReduction_71 happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + happyIn46 + ((:[]) happy_var_1 + )} + +happyReduce_72 = happySpecReduce_3 23# happyReduction_72 +happyReduction_72 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + case happyOut46 happy_x_3 of { happy_var_3 -> + happyIn46 + ((:) happy_var_1 happy_var_3 + )}} + +happyNewToken action sts stk [] = + happyDoAction 30# notHappyAtAll 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 ",") -> cont 20#; + PT _ (TS "abstract") -> cont 21#; + PT _ (TS "concrete") -> cont 22#; + PT _ (TS "grammar") -> cont 23#; + PT _ (TS "pre") -> cont 24#; + PT _ (TL happy_dollar_dollar) -> cont 25#; + PT _ (TI happy_dollar_dollar) -> cont 26#; + PT _ (TD happy_dollar_dollar) -> cont 27#; + PT _ (T_CId happy_dollar_dollar) -> cont 28#; + _ -> cont 29#; + _ -> 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 (happyOut27 x)) + +pHeader tks = happySomeParser where + happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut28 x)) + +pAbstract tks = happySomeParser where + happySomeParser = happyThen (happyParse 2# tks) (\x -> happyReturn (happyOut29 x)) + +pConcrete tks = happySomeParser where + happySomeParser = happyThen (happyParse 3# tks) (\x -> happyReturn (happyOut30 x)) + +pAbsDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 4# tks) (\x -> happyReturn (happyOut31 x)) + +pCncDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 5# tks) (\x -> happyReturn (happyOut32 x)) + +pType tks = happySomeParser where + happySomeParser = happyThen (happyParse 6# tks) (\x -> happyReturn (happyOut33 x)) + +pExp tks = happySomeParser where + happySomeParser = happyThen (happyParse 7# tks) (\x -> happyReturn (happyOut34 x)) + +pAtom tks = happySomeParser where + happySomeParser = happyThen (happyParse 8# tks) (\x -> happyReturn (happyOut35 x)) + +pTerm tks = happySomeParser where + happySomeParser = happyThen (happyParse 9# tks) (\x -> happyReturn (happyOut36 x)) + +pTokn tks = happySomeParser where + happySomeParser = happyThen (happyParse 10# tks) (\x -> happyReturn (happyOut37 x)) + +pVariant tks = happySomeParser where + happySomeParser = happyThen (happyParse 11# tks) (\x -> happyReturn (happyOut38 x)) + +pListConcrete tks = happySomeParser where + happySomeParser = happyThen (happyParse 12# tks) (\x -> happyReturn (happyOut39 x)) + +pListAbsDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 13# tks) (\x -> happyReturn (happyOut40 x)) + +pListCncDef tks = happySomeParser where + happySomeParser = happyThen (happyParse 14# tks) (\x -> happyReturn (happyOut41 x)) + +pListCId tks = happySomeParser where + happySomeParser = happyThen (happyParse 15# tks) (\x -> happyReturn (happyOut42 x)) + +pListTerm tks = happySomeParser where + happySomeParser = happyThen (happyParse 16# tks) (\x -> happyReturn (happyOut43 x)) + +pListExp tks = happySomeParser where + happySomeParser = happyThen (happyParse 17# tks) (\x -> happyReturn (happyOut44 x)) + +pListString tks = happySomeParser where + happySomeParser = happyThen (happyParse 18# tks) (\x -> happyReturn (happyOut45 x)) + +pListVariant tks = happySomeParser where + happySomeParser = happyThen (happyParse 19# tks) (\x -> happyReturn (happyOut46 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 +trA_ a_ = Tr a_ [] +{-# LINE 1 "GenericTemplate.hs" #-} +{-# LINE 1 "<built-in>" #-} +{-# LINE 1 "<command line>" #-} +{-# LINE 1 "GenericTemplate.hs" #-} +-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp + +{-# LINE 28 "GenericTemplate.hs" #-} + + +data Happy_IntList = HappyCons Int# Happy_IntList + + + + + +{-# LINE 49 "GenericTemplate.hs" #-} + +{-# LINE 59 "GenericTemplate.hs" #-} + +{-# LINE 68 "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 "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 "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. diff --git a/src/tools/c/GFCC/Par.y b/src/tools/c/GFCC/Par.y new file mode 100644 index 000000000..fa30981cb --- /dev/null +++ b/src/tools/c/GFCC/Par.y @@ -0,0 +1,204 @@ +-- This Happy file was machine-generated by the BNF converter +{ +{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} +module GFCC.Par where +import GFCC.Abs +import GFCC.Lex +import GFCC.ErrM +} + +%name pGrammar Grammar +%name pHeader Header +%name pAbstract Abstract +%name pConcrete Concrete +%name pAbsDef AbsDef +%name pCncDef CncDef +%name pType Type +%name pExp Exp +%name pAtom Atom +%name pTerm Term +%name pTokn Tokn +%name pVariant Variant +%name pListConcrete ListConcrete +%name pListAbsDef ListAbsDef +%name pListCncDef ListCncDef +%name pListCId ListCId +%name pListTerm ListTerm +%name pListExp ListExp +%name pListString ListString +%name pListVariant ListVariant + +-- no lexer declaration +%monad { Err } { thenM } { returnM } +%tokentype { Token } + +%token + ';' { PT _ (TS ";") } + '(' { PT _ (TS "(") } + ')' { PT _ (TS ")") } + '{' { PT _ (TS "{") } + '}' { PT _ (TS "}") } + ':' { PT _ (TS ":") } + '=' { PT _ (TS "=") } + '->' { PT _ (TS "->") } + '?' { PT _ (TS "?") } + '[' { PT _ (TS "[") } + ']' { PT _ (TS "]") } + '!' { PT _ (TS "!") } + '$' { PT _ (TS "$") } + '[|' { PT _ (TS "[|") } + '|]' { PT _ (TS "|]") } + '+' { PT _ (TS "+") } + '@' { PT _ (TS "@") } + '#' { PT _ (TS "#") } + '/' { PT _ (TS "/") } + ',' { PT _ (TS ",") } + 'abstract' { PT _ (TS "abstract") } + 'concrete' { PT _ (TS "concrete") } + 'grammar' { PT _ (TS "grammar") } + 'pre' { PT _ (TS "pre") } + +L_quoted { PT _ (TL $$) } +L_integ { PT _ (TI $$) } +L_doubl { PT _ (TD $$) } +L_CId { PT _ (T_CId $$) } +L_err { _ } + + +%% + +String :: { String } : L_quoted { $1 } +Integer :: { Integer } : L_integ { (read $1) :: Integer } +Double :: { Double } : L_doubl { (read $1) :: Double } +CId :: { CId} : L_CId { CId ($1)} + +Grammar :: { Grammar } +Grammar : Header ';' Abstract ';' ListConcrete { Grm $1 $3 (reverse $5) } + + +Header :: { Header } +Header : 'grammar' CId '(' ListCId ')' { Hdr $2 $4 } + + +Abstract :: { Abstract } +Abstract : 'abstract' '{' ListAbsDef '}' { Abs (reverse $3) } + + +Concrete :: { Concrete } +Concrete : 'concrete' CId '{' ListCncDef '}' { Cnc $2 (reverse $4) } + + +AbsDef :: { AbsDef } +AbsDef : CId ':' Type '=' Exp { Fun $1 $3 $5 } + + +CncDef :: { CncDef } +CncDef : CId '=' Term { Lin $1 $3 } + + +Type :: { Type } +Type : ListCId '->' CId { Typ $1 $3 } + + +Exp :: { Exp } +Exp : '(' Atom ListExp ')' { Tr $2 (reverse $3) } + | Atom { trA_ $1 } + + +Atom :: { Atom } +Atom : CId { AC $1 } + | String { AS $1 } + | Integer { AI $1 } + | Double { AF $1 } + | '?' { AM } + + +Term :: { Term } +Term : '[' ListTerm ']' { R $2 } + | '(' Term '!' Term ')' { P $2 $4 } + | '(' ListTerm ')' { S $2 } + | Tokn { K $1 } + | '$' Integer { V $2 } + | Integer { C $1 } + | CId { F $1 } + | '[|' ListTerm '|]' { FV $2 } + | '(' String '+' Term ')' { W $2 $4 } + | '(' Term '@' Term ')' { RP $2 $4 } + | '?' { TM } + | '(' CId '->' Term ')' { L $2 $4 } + | '#' CId { BV $2 } + + +Tokn :: { Tokn } +Tokn : String { KS $1 } + | '[' 'pre' ListString '[' ListVariant ']' ']' { KP (reverse $3) $5 } + + +Variant :: { Variant } +Variant : ListString '/' ListString { Var (reverse $1) (reverse $3) } + + +ListConcrete :: { [Concrete] } +ListConcrete : {- empty -} { [] } + | ListConcrete Concrete ';' { flip (:) $1 $2 } + + +ListAbsDef :: { [AbsDef] } +ListAbsDef : {- empty -} { [] } + | ListAbsDef AbsDef ';' { flip (:) $1 $2 } + + +ListCncDef :: { [CncDef] } +ListCncDef : {- empty -} { [] } + | ListCncDef CncDef ';' { flip (:) $1 $2 } + + +ListCId :: { [CId] } +ListCId : {- empty -} { [] } + | CId { (:[]) $1 } + | CId ',' ListCId { (:) $1 $3 } + + +ListTerm :: { [Term] } +ListTerm : {- empty -} { [] } + | Term { (:[]) $1 } + | Term ',' ListTerm { (:) $1 $3 } + + +ListExp :: { [Exp] } +ListExp : {- empty -} { [] } + | ListExp Exp { flip (:) $1 $2 } + + +ListString :: { [String] } +ListString : {- empty -} { [] } + | ListString String { flip (:) $1 $2 } + + +ListVariant :: { [Variant] } +ListVariant : {- empty -} { [] } + | Variant { (:[]) $1 } + | Variant ',' ListVariant { (:) $1 $3 } + + + +{ + +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 +trA_ a_ = Tr a_ [] +} + diff --git a/src/tools/c/GFCC/Print.hs b/src/tools/c/GFCC/Print.hs new file mode 100644 index 000000000..3697d8b0f --- /dev/null +++ b/src/tools/c/GFCC/Print.hs @@ -0,0 +1,148 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} +module GFCC.Print where + +-- pretty-printer generated by the BNF converter + +import GFCC.Abs +import Data.Char +import Data.List (intersperse) + +-- 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 + +unwordsD :: [Doc] -> Doc +unwordsD = concatD . intersperse (doc (showChar ' ')) + +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 + +instance Print Char where + prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'') + +instance Print String where + prt _ 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 Double where + prt _ x = doc (shows x) + + +instance Print (Tree c) where + prt _i e = case e of + Grm header abstract concretes -> prPrec _i 0 (concatD [prt 0 header , doc (showString ";") , prt 0 abstract , doc (showString ";") , prt 0 concretes]) + Hdr cid cids -> prPrec _i 0 (concatD [doc (showString "grammar") , prt 0 cid , doc (showString "(") , prt 0 cids , doc (showString ")")]) + Abs absdefs -> prPrec _i 0 (concatD [doc (showString "abstract") , doc (showString "{") , prt 0 absdefs , doc (showString "}")]) + Cnc cid cncdefs -> prPrec _i 0 (concatD [doc (showString "concrete") , prt 0 cid , doc (showString "{") , prt 0 cncdefs , doc (showString "}")]) + Fun cid type' exp -> prPrec _i 0 (concatD [prt 0 cid , doc (showString ":") , prt 0 type' , doc (showString "=") , prt 0 exp]) + Lin cid term -> prPrec _i 0 (concatD [prt 0 cid , doc (showString "=") , prt 0 term]) + Typ cids cid -> prPrec _i 0 (concatD [prt 0 cids , doc (showString "->") , prt 0 cid]) + Tr atom exps -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 atom , prt 0 exps , doc (showString ")")]) + 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 -> prPrec _i 0 (concatD [doc (showString "?")]) + R terms -> prPrec _i 0 (concatD [doc (showString "[") , prt 0 terms , doc (showString "]")]) + P term0 term1 -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 term0 , doc (showString "!") , prt 0 term1 , 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 ")")]) + RP term0 term1 -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 term0 , doc (showString "@") , prt 0 term1 , doc (showString ")")]) + TM -> prPrec _i 0 (concatD [doc (showString "?")]) + L cid term -> prPrec _i 0 (concatD [doc (showString "(") , prt 0 cid , doc (showString "->") , prt 0 term , doc (showString ")")]) + BV cid -> prPrec _i 0 (concatD [doc (showString "#") , prt 0 cid]) + 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 "]")]) + Var strs0 strs1 -> prPrec _i 0 (concatD [prt 0 strs0 , doc (showString "/") , prt 0 strs1]) + CId str -> prPrec _i 0 (doc (showString str)) + +instance Print [Concrete] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [AbsDef] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [CncDef] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs]) +instance Print [CId] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) +instance Print [Term] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) +instance Print [Exp] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) +instance Print [String] where + prt _ es = case es of + [] -> (concatD []) + x:xs -> (concatD [prt 0 x , prt 0 xs]) +instance Print [Variant] where + prt _ es = case es of + [] -> (concatD []) + [x] -> (concatD [prt 0 x]) + x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs]) diff --git a/src/tools/c/GFCC/Test.hs b/src/tools/c/GFCC/Test.hs new file mode 100644 index 000000000..e3c3bcc40 --- /dev/null +++ b/src/tools/c/GFCC/Test.hs @@ -0,0 +1,58 @@ +-- automatically generated by BNF Converter +module Main where + + +import IO ( stdin, hGetContents ) +import System ( getArgs, getProgName ) + +import GFCC.Lex +import GFCC.Par +import GFCC.Skel +import GFCC.Print +import GFCC.Abs + + + + +import GFCC.ErrM + +type ParseFun a = [Token] -> Err a + +myLLexer = myLexer + +type Verbosity = Int + +putStrV :: Verbosity -> String -> IO () +putStrV v s = if v > 1 then putStrLn s else return () + +runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO () +runFile v p f = putStrLn f >> readFile f >>= run v p + +run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO () +run v p s = let ts = myLLexer s in case p ts of + Bad s -> do putStrLn "\nParse Failed...\n" + putStrV v "Tokens:" + putStrV v $ show ts + putStrLn s + Ok tree -> do putStrLn "\nParse Successful!" + showTree v tree + + + +showTree :: (Show a, Print a) => Int -> a -> IO () +showTree v tree + = do + putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree + putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree + +main :: IO () +main = do args <- getArgs + case args of + [] -> hGetContents stdin >>= run 2 pGrammar + "-s":fs -> mapM_ (runFile 0 pGrammar) fs + fs -> mapM_ (runFile 2 pGrammar) fs + + + + + diff --git a/src/tools/c/Makefile b/src/tools/c/Makefile new file mode 100644 index 000000000..189b224e2 --- /dev/null +++ b/src/tools/c/Makefile @@ -0,0 +1,25 @@ +GHC = ghc +GHCFLAGS = + +.PHONY: all gfcc2c clean + +all: gfcc2c + +gfcc2c: + $(GHC) $(GHCFLAGS) --make -o $@ gfcc2c.hs + +bnfc: + bnfc -gadt -d ../../GF/Canon/GFCC/GFCC.cf + -rm -f GFCC/Doc.tex GFCC/Skel.hs + happy -gca GFCC/Par.y + alex -g GFCC/Lex.x + +clean: + -rm -f gfcc2c + -rm -f *.o *.hi + -rm -f GFCC/*.hi GFCC/*.o + +bnfcclean: clean + -rm -f GFCC/*.bak + -rm -f GFCC/Lex.* GFCC/Par.* GFCC/Layout.* GFCC/Skel.* GFCC/Print.* GFCC/Test.* GFCC/Abs.* GFCC/ComposOp.* GFCC/Test GFCC/ErrM.* GFCC/SharedString.* + -rmdir -p GFCC/ diff --git a/src/tools/c/examples/bronzeage/Makefile b/src/tools/c/examples/bronzeage/Makefile new file mode 100644 index 000000000..67367920a --- /dev/null +++ b/src/tools/c/examples/bronzeage/Makefile @@ -0,0 +1,47 @@ + +GFDIR=../../../../../ + +LIBGFCC_INCLUDES = $(GFDIR)/lib/c +LIBGFCC_LIBDIR = $(GFDIR)/lib/c + +GFCC2C = $(GFDIR)/bin/gfcc2c + +TEST_PROG = bronzeage-test + +GRAMMAR_DIR = $(GFDIR)/examples/bronzeage + +GRAMMAR_MODULES = Bronzeage BronzeageEng BronzeageSwe + +GRAMMAR_H_FILES = $(addsuffix .h, $(GRAMMAR_MODULES)) +GRAMMAR_C_FILES = $(addsuffix .c, $(GRAMMAR_MODULES)) +GRAMMAR_O_FILES = $(addsuffix .o, $(GRAMMAR_MODULES)) + +CFLAGS += -O2 +CPPFLAGS += -I$(LIBGFCC_INCLUDES) + +.PHONY: clean + +all: bronzeage.gfcc $(TEST_PROG) + +$(TEST_PROG): $(GRAMMAR_O_FILES) $(TEST_PROG).o $(LIBGFCC_LIBDIR)/libgfcc.a + +$(TEST_PROG).o: $(GRAMMAR_H_FILES) $(GRAMMAR_O_FILES) $(TEST_PROG).c + +$(GRAMMAR_H_FILES) $(GRAMMAR_C_FILES): $(GFCC2C) bronzeage.gfcc + $(GFCC2C) bronzeage.gfcc + +bronzeage.gfcc: + echo "i -optimize=all $(GRAMMAR_DIR)/BronzeageEng.gf" > mkBronzeage.gfs + echo "i -optimize=all $(GRAMMAR_DIR)/BronzeageSwe.gf" >> mkBronzeage.gfs + echo "s" >> mkBronzeage.gfs + echo "pm -printer=gfcc | wf bronzeage.gfcc" >> mkBronzeage.gfs + cat mkBronzeage.gfs | gf + rm -f mkBronzeage.gfs + +clean: + -rm -f $(TEST_PROG) *.o + + +distclean: clean + -rm -f $(GRAMMAR_H_FILES) $(GRAMMAR_C_FILES) + -rm -f bronzeage.gfcc diff --git a/src/tools/c/examples/bronzeage/bronzeage-test.c b/src/tools/c/examples/bronzeage/bronzeage-test.c new file mode 100644 index 000000000..c0bee93a2 --- /dev/null +++ b/src/tools/c/examples/bronzeage/bronzeage-test.c @@ -0,0 +1,31 @@ +#include "Bronzeage.h" + +#include "BronzeageEng.h" + +#include <unistd.h> + +int main() { + Tree *tree = + mk_PhrPos( + mk_SentV( + mk_lie_V(), + mk_NumCN( + mk_two_Num(), + mk_UseN(mk_wife_N()) + ) + ) + ); + + int i; + + for (i = 0; i < 1000; i++) { + Term *term; + term = BronzeageEng_lin(tree); + term_print(stdout, term); + fputs("\n", stdout); + } + + tree_free(tree); + + return 0; +} diff --git a/src/tools/c/gfcc2c.hs b/src/tools/c/gfcc2c.hs new file mode 100644 index 000000000..75eb10fb8 --- /dev/null +++ b/src/tools/c/gfcc2c.hs @@ -0,0 +1,223 @@ +import GFCC.Abs +import GFCC.ErrM +import GFCC.Lex +import GFCC.Par + +import Control.Monad +import Data.Char +import Data.List +import Numeric +import System.Environment +import System.Exit +import System.IO + +constrType :: Grammar -> String +constrType g = unlines $ + ["typedef enum { "] + ++ map (\x -> " " ++ x ++ "," ) ds + ++ ["} Fun;"] + where fs = [id2c n | (n,_) <- constructors g ] + ds = case fs of + [] -> [] + (x:xs) -> (x ++ " = ATOM_FIRST_FUN"):xs + +mkFunSigs :: Grammar -> String +mkFunSigs g = unlines [mkFunSig n ats | (n,(ats,_)) <- constructors g] + +mkFunSig :: CId -> [CId] -> String +mkFunSig n ats = + "extern Tree *mk_" ++ id2c n ++ "(" ++ commaSep adecls ++ ");" + where + adecls = map ("Tree *" ++) args + args = [ "x" ++ show x | x <- [0..c-1] ] + c = length ats + +mkFuns :: Grammar -> String +mkFuns g = unlines [mkFun n ats | (n,(ats,_)) <- constructors g] + +mkFun :: CId -> [CId] -> String +mkFun n ats = unlines $ + ["extern Tree *mk_" ++ id2c n ++ "(" ++ commaSep adecls ++ ") {", + " Tree *t = tree_fun(" ++ id2c n ++ "," ++ show c ++ ");"] + ++ [" tree_set_child(" ++ commaSep ["t",show i, args!!i] ++ ");" | i <- [0..c-1]] + ++ [" return t;", + "}"] + where + adecls = map ("Tree *" ++) args + args = [ "x" ++ show x | x <- [0..c-1] ] + c = length ats + +doDie :: String -> [String] -> [String] +doDie s args = ["fprintf(" ++ commaSep ("stderr":show s':args) ++ ");", + "exit(1);"] + where s' = "Error: " ++ s ++ "\n" + +mkLin :: Grammar -> CId -> String +mkLin g l = unlines $ + ["extern Term *" ++ langLinName_ l ++ "(Tree *t) {", + " Term **cs = NULL;", + " int n = arity(t);", + " if (n > 0) {", + " int i;", + " cs = (Term**)term_alloc(n * sizeof(Term *));", -- FIXME: handle failure + " for (i = 0; i < n; i++) {", + " cs[i] = " ++ langLinName_ l ++ "(tree_get_child(t,i));", + " }", + " }", + "", + " switch (t->type) {", + " case ATOM_STRING: return term_str(t->value.string_value);", +-- " case ATOM_INTEGER: return NULL;", -- FIXME! +-- " case ATOM_DOUBLE: return NULL;", -- FIXME! + " case ATOM_META: return term_meta();"] + ++ [" case " ++ id2c n ++ ": return " ++ linFunName n ++ "(cs);" + | (n,_) <- constructors g] + ++ [" default: "] + ++ map (" " ++) (doDie (langLinName_ l ++ " %d") ["t->type"]) + ++ [" return NULL;", + " }", + "}", + "", + "extern Term *" ++ langLinName l ++ "(Tree *t) {", + " Term *r;", + " term_alloc_pool(1000000);", -- FIXME: size? + " r = " ++ langLinName_ l ++ "(t);", + " /* term_free_pool(); */", -- FIXME: copy term? + " return r;", + "}"] + +langLinName :: CId -> String +langLinName n = id2c n ++ "_lin" + +langLinName_ :: CId -> String +langLinName_ n = id2c n ++ "_lin_" + +linFunName :: CId -> String +linFunName n = "lin_" ++ id2c n + + +mkLinFuns :: [CncDef] -> String +mkLinFuns cs = unlines $ map mkLinFunSig cs ++ [""] ++ map mkLinFun cs + +mkLinFunSig :: CncDef -> String +mkLinFunSig (Lin n t) = + "static Term *" ++ linFunName n ++ "(Term **cs);" + +mkLinFun :: CncDef -> String +mkLinFun (Lin (CId n) t) | "__" `isPrefixOf` n = "" +mkLinFun (Lin n t) = unlines [ + "static Term *" ++ linFunName n ++ "(Term **cs) {", + " return " ++ term2c t ++ ";", + "}" + ] + +term2c :: Tree a -> String +term2c t = case t of + -- terms + R terms -> fun "term_array" terms + -- an optimization of t!n where n is a constant int + P term0 (C n) -> "term_sel_int("++ term2c term0 ++ "," ++ show n ++ ")" + P term0 term1 -> "term_sel(" ++ term2c term0 ++ "," ++ term2c term1 ++ ")" + S terms -> fun "term_seq" terms + K tokn -> term2c tokn + V n -> "cs[" ++ show n ++ "]" + C n -> "term_int(" ++ show n ++ ")" + F cid -> linFunName cid ++ "(cs)" + FV terms -> fun "term_variants" terms + W str term -> "term_suffix(" ++ string2c str ++ "," ++ term2c term ++ ")" + RP term0 term1 -> "term_rp(" ++ term2c term0 ++ "," ++ term2c term1 ++ ")" + TM -> "term_meta()" + -- tokens + KS s -> "term_str(" ++ string2c s ++ ")" + KP strs vars -> error $ show t -- FIXME: pre token + _ -> error $ show t + where fun f ts = f ++ "(" ++ commaSep (show (length ts):map term2c ts) ++ ")" + +commaSep = concat . intersperse "," + + +id2c :: CId -> String +id2c (CId s) = s -- FIXME: convert ticks + +string2c :: String -> String +string2c s = "\"" ++ concatEsc (map esc s) ++ "\"" + where + esc c | isAscii c && isPrint c = [c] + esc '\n' = "\\n" + esc c = "\\x" ++ map toUpper (showHex (ord c) "") + concatEsc [] = "" + concatEsc (x:xs) | length x <= 2 = x ++ concatEsc xs + | otherwise = x ++ "\" \"" ++ concatEsc xs + +lang2file :: CId -> String -> String +lang2file n ext = id2c n ++ "." ++ ext + +constructors :: Grammar -> [(CId, ([CId],CId))] +constructors (Grm _ (Abs ads) _) = [(n,(ats,rt)) | Fun n (Typ ats rt) _ <- ads] + +absHFile :: Grammar -> FilePath +absHFile (Grm (Hdr a _) _ _) = lang2file a "h" + +cncHFile :: Concrete -> FilePath +cncHFile (Cnc l _) = lang2file l "h" + +mkAbsH :: Grammar -> String +mkAbsH g = unlines ["#include \"gfcc-tree.h\"", + "#include \"gfcc-term.h\"", + constrType g, + "", + mkFunSigs g] + +mkAbsC :: Grammar -> String +mkAbsC g = unlines [include (absHFile g), + "", + mkFuns g] + +mkCncH :: Grammar -> Concrete -> String +mkCncH g (Cnc l _) = unlines + [include (absHFile g), + "", + "extern Term *" ++ langLinName l ++ "(Tree *);"] + +mkCncC :: Grammar -> Concrete -> String +mkCncC g c@(Cnc l cds) = unlines $ + ["#include <stdio.h>", + "#include <stdlib.h>", + include (cncHFile c), + ""] + ++ [mkLinFuns cds, mkLin g l] + +mkH :: FilePath -> String -> (FilePath, String) +mkH f c = (f, c') + where c' = unlines ["#ifndef " ++ s, "#define " ++ s, "", c, "#endif"] + s = [if x=='.' then '_' else toUpper x | x <- f] + +include :: FilePath -> String +include f = "#include " ++ show f + +-- returns list of file name, file contents +gfcc2c :: Grammar -> [(FilePath, String)] +gfcc2c g@(Grm (Hdr a _) _ cs) = + [mkH (absHFile g) (mkAbsH g), (lang2file a "c", mkAbsC g)] + ++ concat [[mkH (cncHFile cnc) (mkCncH g cnc),(lang2file c "c", mkCncC g cnc)] | cnc@(Cnc c _) <- cs] + +parse :: String -> Err Grammar +parse = pGrammar . myLexer + +die :: String -> IO () +die s = do hPutStrLn stderr "Usage: gfcc2c <gfcc file>" + exitFailure + +createFile :: FilePath -> String -> IO () +createFile f c = do hPutStrLn stderr $ "Writing " ++ f ++ "..." + writeFile f c + +main :: IO () +main = do args <- getArgs + case args of + [file] -> do c <- readFile file + case parse c of + Bad err -> die err + Ok g -> do let fs = gfcc2c g + mapM_ (uncurry createFile) fs + _ -> die "Usage: gfcc2c <gfcc file>" diff --git a/src/tools/mkHelpFile.perl b/src/tools/mkHelpFile.perl new file mode 100644 index 000000000..91f434705 --- /dev/null +++ b/src/tools/mkHelpFile.perl @@ -0,0 +1,49 @@ + +$infile = $#ARGV >= 0 ? '@'.join('@, @', @ARGV).'@' : '/the input file/'; + +print <<EOF; +---------------------------------------------------------------------- +-- | +-- Module : HelpFile +-- Maintainer : Aarne Ranta +-- Stability : Stable (Autogenerated) +-- Portability : Haskell 98 +-- +-- > CVS \$Date \$ +-- > CVS \$Author \$ +-- > CVS \$Revision \$ +-- +-- Help on shell commands. Generated from $infile by invoking the +-- perl script \@mkHelpFile.perl\@. +-- Automatically generated -- PLEASE DON'T EDIT THIS FILE, +-- edit $infile instead. +----------------------------------------------------------------------------- + +module HelpFile (txtHelpFileSummary, txtHelpCommand, txtHelpFile) where + +import Operations + +txtHelpFileSummary :: String +txtHelpFileSummary = + unlines \$ map (concat . take 1 . lines) \$ paragraphs txtHelpFile + +txtHelpCommand :: String -> String +txtHelpCommand c = + case lookup c [(takeWhile (/=',') p,p) | p <- paragraphs txtHelpFile] of + Just s -> s + _ -> "Command not found." + +txtHelpFile :: String +txtHelpFile = +EOF + +while (<>) { + chop; + s/([\"\\])/\\$1/g; + $pref = /^ / ? "\\n" : "\\n"; + print " \"$pref$_\" ++\n"; +} + +print " []\n"; + + |
