diff --git a/src-2.9/FILES b/src-2.9/FILES
new file mode 100644
index 000000000..1311108b6
--- /dev/null
+++ b/src-2.9/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-2.9/GF-embed.cabal b/src-2.9/GF-embed.cabal
new file mode 100644
index 000000000..54dce00b6
--- /dev/null
+++ b/src-2.9/GF-embed.cabal
@@ -0,0 +1,52 @@
+Name: gf-embed
+Version: 2.8
+Cabal-version: >= 1.2
+Build-type: Simple
+License: GPL
+License-file: ../LICENSE
+Synopsis: Grammatical Framework embedded API.
+
+Flag split-base
+
+Library
+  Build-depends: mtl, haskell98
+  if flag(split-base)
+    Build-depends: base >= 3.0, array, containers, directory, random
+  else
+    Build-depends: base < 3.0
+  Ghc-options: -O2
+  Extensions: 
+  Exposed-Modules: 
+    GF.GFCC.API
+    -- needed by code generated by -haskell
+    GF.GFCC.DataGFCC
+    GF.GFCC.CId
+  Other-modules:
+    GF.Conversion.SimpleToFCFG
+    GF.Data.Assoc
+    GF.Data.Utilities
+    GF.Data.SortedList
+    GF.Data.BacktrackM
+    GF.Data.ErrM
+    GF.Data.GeneralDeduction
+    GF.Data.RedBlackSet
+    GF.Text.UTF8
+    GF.Infra.CompactPrint
+    GF.Infra.PrintClass
+    GF.Formalism.FCFG
+    GF.Formalism.Utilities
+    GF.Parsing.FCFG
+    GF.Parsing.FCFG.PInfo
+    GF.Parsing.FCFG.Range
+    GF.Parsing.FCFG.Active
+    GF.Command.PPrTree
+    GF.Command.AbsGFShell
+    GF.Command.PrintGFShell
+    GF.Command.ParGFShell
+    GF.Command.LexGFShell
+    GF.GFCC.Macros
+    GF.GFCC.Generate
+    GF.GFCC.Linearize
+    GF.GFCC.Raw.AbsGFCCRaw
+    GF.GFCC.Raw.ParGFCCRaw
+    GF.GFCC.Raw.ConvertGFCC
diff --git a/src-2.9/GF.hs b/src-2.9/GF.hs
new file mode 100644
index 000000000..50afeb8e9
--- /dev/null
+++ b/src-2.9/GF.hs
@@ -0,0 +1,153 @@
+{-# OPTIONS -cpp #-}
+----------------------------------------------------------------------
+-- |
+-- Module      : Main
+-- Maintainer  : Aarne Ranta
+-- Stability   : (stability)
+-- Portability : (portability)
+--
+-- > CVS $Date: 2005/06/30 11:36:49 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.29 $
+--
+-- The Main module of GF program.
+-----------------------------------------------------------------------------
+
+module Main (main) where
+
+import GF.GFModes (gfInteract, gfBatch, batchCompile)
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.Infra.Option
+import GF.API.IOGrammar
+import GF.Compile.ShellState
+import GF.Compile.Compile
+import GF.Compile.MkConcrete
+import GF.Compile.Wordlist
+import GF.Shell
+import GF.Shell.SubShell
+import GF.Shell.ShellCommands
+import GF.Shell.PShell
+import GF.Shell.JGF
+import GF.System.Signal
+import GF.Text.UTF8
+
+import GF.Today (today,version,libdir)
+import GF.System.Arch
+import System (getArgs,system,getEnv)
+import System.FilePath
+import Control.Monad (foldM,liftM)
+import Data.List (nub)
+
+#ifdef mingw32_HOST_OS
+import System.Win32.Console
+import System.Win32.NLS
+#endif
+
+-- AR 19/4/2000 -- 21/3/2006
+
+main :: IO ()
+main = do
+#ifdef mingw32_HOST_OS
+  codepage <- getACP
+  setConsoleCP codepage
+  setConsoleOutputCP codepage
+#endif
+  
+  xs <- getArgs
+  let 
+   (os,fs) = getOptions "-" xs
+   opt j   = oElem j os
+   st0     = optInitShellState os
+   ifNotSil c = if oElem beSilent os then return () else c 
+
+   doGF os fs = case 0 of
+
+    _ | opt getHelp || any opt (map iOpt ["h", "-help", "-h"])-> do
+      putStrLnFlush $ encodeUTF8 helpMsg
+
+    _ | opt forJava -> do
+      welcome <- welcomeMsgLib
+      putStrLnFlush $ encodeUTF8 welcome 
+      st <- useIOE st0 $ 
+              foldM (shellStateFromFiles os) st0 fs
+      sessionLineJ True st
+      return ()
+
+    _ | opt doMake -> do
+      mapM_ (batchCompile os) fs
+      return ()
+
+    _ | opt makeConcrete -> do
+        mkConcretes os fs
+
+    _ | opt openEditor -> do
+        system $ "jgf" +++ unwords xs
+        return ()
+
+    _ | opt doBatch -> do
+      if opt beSilent then return () else putStrLnFlush "<gfbatch>"
+      st <- useIOE st0 $ 
+              foldM (shellStateFromFiles os) st0 fs
+      gfBatch (initHState st) 
+      if opt beSilent then return () else putStrLnFlush "</gfbatch>"
+      return ()
+    _ -> do
+      welcome <- welcomeMsgLib
+      ifNotSil $ putStrLnFlush $ welcome
+      st <- useIOE st0 $ 
+              foldM (shellStateFromFiles os) st0 fs
+      if null fs then return () else (ifNotSil putCPU) 
+      blockInterrupt (gfInteract (initHState st)) 
+      return ()
+  -- preprocessing gfe
+  if opt fromExamples 
+    then do
+        es <- liftM (nub . concat) $ mapM (getGFEFiles os) fs
+        mkConcretes os es
+        doGF (removeOption fromExamples os) fs
+  -- preprocessing gfwl
+    else if (length fs == 1 && takeExtensions (head fs) == ".gfwl")
+    then do
+      fs' <- mkWordlist (head fs)
+      doGF os fs'
+    else doGF os fs
+
+helpMsg = unlines [
+  "Usage: gf <option>* <file>*",
+  "Options:",
+  "  -batch        structure session by XML tags (use > to send into a file)",
+  "  -edit         start the editor GUI (same as command 'jgf')",
+  "  -ex           first compile .gfe files as needed, then .gf files",
+  "  -examples     batch-compile .gfe files by parsing examples",
+  "     -treebank  use a treebank, instead of a grammar, as parser",
+  "  -make         batch-compile files",
+  "     -noemit      do not emit code when compiling",
+  "     -v           be verbose when compiling",
+  "  -help         show this message",
+  "Also all flags for import (i) are interpreted; see 'help import'.",
+  "An example combination of flags is",
+  "  gf -batch -nocpu -s",
+  "which suppresses all messages except the output and fatal errors."
+  ]
+
+welcomeMsgLib = do
+  lib <- getLibraryPath
+  return $ welcomeMsg lib
+
+welcomeMsg lib = 
+  "Welcome to " ++ authorMsg ++++ 
+  "If \228 and \246 (umlaut letters) look strange, see 'h -coding'." ++
+  "\nGF_LIB_PATH is set to " ++ lib ++
+  "\n\nType 'h' for help, and 'h [Command] for more detailed help.\n"
+
+authorMsg = unlines [
+ "Grammatical Framework, Version " ++ version,
+ "Compiled " ++ today,
+ "Copyright (c)", 
+ "Krasimir Angelov, Bj\246rn Bringert, H\229kan Burden, Hans-Joachim Daniels,",
+ "Markus Forsberg, Thomas Hallgren, Harald Hammarstr\246m, Kristofer Johannisson,",
+ "Janna Khegai, Peter Ljungl\246f, Petri M\228enp\228\228, and", 
+ "Aarne Ranta, 1998-2006, under GNU General Public License (GPL)",
+ "Bug reports to aarne@cs.chalmers.se"
+ ]
diff --git a/src-2.9/GF/API.hs b/src-2.9/GF/API.hs
new file mode 100644
index 000000000..b1deeddfc
--- /dev/null
+++ b/src-2.9/GF/API.hs
@@ -0,0 +1,472 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : API
+-- Maintainer  : Aarne Ranta
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:40 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.39 $
+--
+-- Application Programmer's Interface to GF; also used by Shell. AR 10/11/2001
+-----------------------------------------------------------------------------
+
+module GF.API where
+
+import qualified GF.Source.AbsGF as GF
+import qualified GF.Canon.AbsGFC as A
+import qualified GF.Compile.Rename as R
+import GF.UseGrammar.GetTree
+import GF.Canon.GFC
+--- import qualified Values as V
+import GF.Grammar.Values
+
+-----import GetGrammar
+import GF.Compile.Compile
+import GF.API.IOGrammar
+import GF.UseGrammar.Linear
+import GF.UseGrammar.Parsing
+import GF.UseGrammar.Morphology
+import GF.CF.PPrCF
+import GF.CF.CFIdent
+import GF.Compile.PGrammar
+import GF.UseGrammar.Randomized (mkRandomTree)
+
+import GF.Grammar.MMacros
+import qualified GF.Grammar.Macros as M
+import GF.Grammar.TypeCheck
+import GF.Canon.CMacros
+import GF.UseGrammar.Transfer
+import qualified GF.UseGrammar.Generate as Gen
+
+import GF.Text.Text (untokWithXML)
+import GF.Infra.Option
+import GF.UseGrammar.Custom
+import GF.Compile.ShellState
+import GF.UseGrammar.Linear
+import GF.Canon.GFC
+import qualified GF.Grammar.Grammar as G
+import GF.Infra.Modules
+import GF.Grammar.PrGrammar
+import qualified GF.Grammar.Compute as Co
+import qualified GF.Grammar.AbsCompute as AC
+import qualified GF.Infra.Ident as I
+import qualified GF.Compile.GrammarToCanon as GC
+import qualified GF.Canon.CanonToGrammar as CG
+import qualified GF.Canon.MkGFC as MC
+import qualified GF.Embed.EmbedAPI as EA
+
+import GF.UseGrammar.Editing
+
+import GF.System.SpeechInput (recognizeSpeech)
+
+----import GrammarToXML 
+
+----import GrammarToMGrammar as M
+
+import qualified Transfer.InterpreterAPI as T
+
+import GF.System.Arch (myStdGen)
+
+import GF.Text.UTF8
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.Data.Zipper
+
+import Data.List (nub)
+import Data.Char (toLower)
+import Data.Maybe (fromMaybe)
+import Control.Monad (liftM)
+import System (system)
+import System.FilePath
+
+type GFGrammar = StateGrammar
+type GFCat     = CFCat
+type Ident     = I.Ident
+--- type Tree      = V.Tree
+
+-- these are enough for many simple applications
+
+file2grammar :: FilePath -> IO GFGrammar
+file2grammar file = do
+  egr <- appIOE $ optFile2grammar (iOpts [beSilent]) file
+  err (\s -> putStrLn s >> return emptyStateGrammar) return egr
+
+linearize :: GFGrammar -> Tree -> String
+linearize sgr = err id id . optLinearizeTree opts sgr where
+  opts = addOption firstLin $ stateOptions sgr
+
+term2tree :: GFGrammar -> G.Term -> Tree
+term2tree gr = errVal uTree . annotate (grammar gr) . qualifTerm (absId gr)
+
+tree2term :: Tree -> G.Term
+tree2term = tree2exp
+
+linearizeToAll :: [GFGrammar] -> Tree -> [String]
+linearizeToAll grs t = [linearize gr t | gr <- grs]
+
+parse :: GFGrammar -> GFCat -> String -> [Tree]
+parse sgr cat = errVal [] . parseString noOptions sgr cat
+
+parseAny :: [GFGrammar] -> GFCat -> String -> [Tree]
+parseAny grs cat s = 
+  concat [errVal [] (parseString (options [iOpt "trynextlang"]) gr cat s) | gr <- grs]
+
+translate :: GFGrammar -> GFGrammar -> GFCat -> String -> [String]
+translate ig og cat = map (linearize og) . parse ig cat
+
+translateToAll :: GFGrammar -> [GFGrammar] -> GFCat -> String -> [String]
+translateToAll ig ogs cat = concat . map (linearizeToAll ogs) . parse ig cat
+
+translateFromAny :: [GFGrammar] -> GFGrammar -> GFCat -> String -> [String]
+translateFromAny igs og cat s = concat [translate ig og cat s | ig <- igs]
+
+translateBetweenAll :: [GFGrammar] -> GFCat -> String -> [String]
+translateBetweenAll grs cat = 
+  concat . map (linearizeToAll grs) . parseAny grs cat
+
+homonyms :: GFGrammar -> GFCat -> Tree -> [Tree]
+homonyms gr cat = nub . parse gr cat . linearize gr
+
+hasAmbiguousLin :: GFGrammar -> GFCat -> Tree -> Bool
+hasAmbiguousLin gr cat t = case (homonyms gr cat t) of
+  _:_:_ -> True
+  _ -> False
+
+{- ----
+-- returns printname if one exists; othewrise linearizes with metas
+printOrLin :: GFGrammar -> Fun -> String
+printOrLin gr = printOrLinearize (stateGrammarST gr)
+
+-- reads a syntax file and writes it in a format wanted
+transformGrammarFile :: Options -> FilePath -> IO String
+transformGrammarFile opts file = do
+  sy <- useIOE GF.emptySyntax $ getSyntax opts file
+  return $ optPrintSyntax opts sy
+-}
+
+prIdent :: Ident -> String
+prIdent = prt
+
+string2GFCat :: String -> String -> GFCat
+string2GFCat = string2CFCat
+
+-- then stg for customizable and internal use
+
+optFile2grammar :: Options -> FilePath -> IOE GFGrammar
+optFile2grammar os f  
+  | takeExtensions f == ".gfcm" = ioeIO $ liftM firstStateGrammar $ EA.file2grammar f
+  | otherwise = do
+      ((_,_,gr,_),_) <- compileModule os emptyShellState f
+      ioeErr $ grammar2stateGrammar os gr
+
+optFile2grammarE :: Options -> FilePath -> IOE GFGrammar
+optFile2grammarE = optFile2grammar
+
+
+string2treeInState :: GFGrammar -> String -> State -> Err Tree
+string2treeInState gr s st = do
+  let metas = allMetas st
+      xs    = map fst $ actBinds st
+  t0 <- pTerm s
+  let t = qualifTerm (absId gr) $ M.mkAbs xs $ refreshMetas metas $ t0
+  annotateExpInState (grammar gr) t st 
+
+string2srcTerm :: G.SourceGrammar -> I.Ident -> String -> Err G.Term
+string2srcTerm gr m s = do
+  t <- pTerm s
+  R.renameSourceTerm gr m t
+
+randomTreesIO :: Options -> GFGrammar -> Int -> IO [Tree]
+randomTreesIO opts gr n = do
+  gen <- myStdGen mx
+  t   <- err (\s -> putS s >> return []) 
+             (return . singleton) $ 
+                mkRandomTree gen mx g catfun
+  ts  <- if n==1 then return [] else randomTreesIO opts gr (n-1)
+  return $ t ++ ts
+ where
+   catfun = case getOptVal opts withFun of
+     Just fun -> Right $ (absId gr, I.identC fun)
+     _ -> Left $ firstAbsCat opts gr
+   g   = grammar gr
+   mx  = optIntOrN opts flagDepth 41
+   putS s = if oElem beSilent opts then return () else putStrLnFlush s
+
+
+generateTrees :: Options -> GFGrammar -> Maybe Tree -> [Tree]
+generateTrees opts gr mt =
+  optIntOrAll opts flagNumber  
+    [tr | t <- Gen.generateTrees opts gr' cat dpt mn mt, Ok tr <- [mkTr t]]
+  where
+    mkTr = annotate gr' . qualifTerm (absId gr) 
+    gr' = grammar gr
+    cat = firstAbsCat opts gr
+    dpt = maybe 3 id $ getOptInt opts flagDepth
+    mn  = getOptInt opts flagAlts
+
+speechGenerate :: Options -> String -> IO ()
+speechGenerate opts str = do
+  let lan = maybe "" (" --language" +++) $ getOptVal opts speechLanguage
+  system ("flite" +++ "\" " ++ str ++ "\"")
+---  system ("echo" +++ "\"" ++ str ++ "\" | festival --tts" ++ lan)
+  return ()
+
+speechInput :: Options -> StateGrammar -> IO [String]
+speechInput opt s = recognizeSpeech name language cfg cat number
+  where
+  opts = addOptions opt (stateOptions s)
+  name = cncId s
+  cfg = stateCFG s -- FIXME: use lang flag to select grammar
+  language = fromMaybe "en_UK" (getOptVal opts speechLanguage)
+  cat = prCFCat (firstCatOpts opts s) ++ "{}.s"
+  number = optIntOrN opts flagNumber 1
+
+optLinearizeTreeVal :: Options -> GFGrammar -> Tree -> String
+optLinearizeTreeVal opts gr = err id id . optLinearizeTree opts gr
+
+optLinearizeTree :: Options -> GFGrammar -> Tree -> Err String
+optLinearizeTree opts0 gr t = case getOptVal opts transferFun of
+  Just m -> useByTransfer flin g (I.identC m) t
+  _ -> flin t
+ where
+  opts = addOptions opts0 (stateOptions gr)
+  flin = case getOptVal opts markLin of
+    Just mk
+     | mk == markOptXML    -> lin markXML
+     | mk == markOptJava   -> lin markXMLjgf
+     | mk == markOptStruct -> lin markBracket
+     | mk == markOptFocus  -> lin markFocus
+     | mk == "metacat"     -> lin metaCatMark
+     | otherwise           -> lin noMark
+    _ -> lin noMark
+
+  lin mk
+    | oElem showRecord opts = liftM prt . linearizeNoMark g c
+    | oElem tableLin opts   = liftM (unlines . map untok . prLinTable True) . 
+                                allLinTables True g c
+    | oElem showFields opts = liftM (unlines . map untok) .
+                                allLinBranchFields g c
+    | oElem showAll opts    = liftM (unlines . map untok . prLinTable False) . 
+                                allLinTables False g c
+    | otherwise = return . unlines . map untok . optIntOrOne . linTree2strings mk g c
+  g = grammar gr
+  c = cncId gr
+  untok = if False ---- oElem (markLin markOptXML) opts 
+            then untokWithXML unt
+            else unt  
+  unt = customOrDefault opts useUntokenizer customUntokenizer gr
+  optIntOrOne = take $ optIntOrN opts flagNumber 1
+
+{- ----
+        untoksl . lin where
+  gr = concreteOf (stateGrammarST sgr)
+  lin -- options mutually exclusive, with priority: struct, rec, table, one
+   | oElem showStruct opts = markedLinString True gr . tree2loc
+   | oElem showRecord opts = err id prt                  . linTerm gr
+   | oElem tableLin opts   = err id (concatMap prLinTable)  . allLinsAsStrs gr
+   | oElem firstLin opts   = unlines . map sstr . take 1 . allLinStrings gr
+   | otherwise = unlines . map sstr . optIntOrAll opts flagNumber . allLinStrings gr
+  untoks = customOrDefault opts' useUntokenizer customUntokenizer sgr
+  opts' = addOptions opts $ stateOptions sgr
+  untoksl = unlines . map untoks . lines
+-}
+
+{-
+optLinearizeArgForm :: Options -> StateGrammar -> [Term] -> Term -> String
+optLinearizeArgForm opts sgr fs ts0 = untoksl $ lin ts where
+  gr = concreteOf (stateGrammarST sgr) 
+  ts = annotateTrm sgr ts0
+  ms = map (renameTrm (lookupConcrete gr)) fs
+  lin -- options mutually exclusive, with priority: struct, rec, table
+   | oElem tableLin opts = err id (concatMap prLinTable) . allLinsForForms gr ms
+   | otherwise = err id (unlines . map sstr . tkStrs . concat) . allLinsForForms gr ms
+  tkStrs = concat . map snd . concat . map snd
+  untoks = customOrDefault opts' useUntokenizer customUntokenizer sgr
+  opts' = addOptions opts $ stateOptions sgr
+  untoksl = unlines . map untoks . lines
+-}
+
+optParseArg :: Options -> GFGrammar -> String -> [Tree]
+optParseArg opts gr =  err (const []) id . optParseArgErr opts gr
+
+optParseArgAny :: Options -> [GFGrammar] -> String -> [Tree]
+optParseArgAny opts grs s = concat [pars gr s | gr <- grs] where
+  pars gr = optParseArg opts gr --- grammar options!
+
+optParseArgErr :: Options -> GFGrammar -> String -> Err [Tree]
+optParseArgErr opts gr = liftM fst . optParseArgErrMsg opts gr
+
+optParseArgErrMsg :: Options -> GFGrammar -> String -> Err ([Tree],String)
+optParseArgErrMsg opts gr s = do
+  let cat = firstCatOpts opts gr
+      g   = grammar gr
+  (ts,m) <- parseStringMsg opts gr cat s
+  ts' <- case getOptVal opts transferFun of
+    Just m -> mkByTransfer (const $ return ts) g (I.identC m) s
+    _ -> return ts
+  return (ts',m)
+
+-- | analyses word by word
+morphoAnalyse :: Options -> GFGrammar -> String -> String
+morphoAnalyse opts gr
+  | oElem (iOpt "status") opts = morphoTextStatus mo 
+  | oElem beShort opts = morphoTextShort mo 
+  | otherwise = morphoText mo 
+ where
+  mo = morpho gr
+
+isKnownWord :: GFGrammar -> String -> Bool
+isKnownWord gr s = GF.UseGrammar.Morphology.isKnownWord (morpho gr) s
+
+unknownTokens :: GFGrammar -> [CFTok] -> [String]
+unknownTokens gr ts = 
+  [w | TC w <- ts, unk w && unk (uncap w)] ++ [w | TS w <- ts, unk w]
+ where
+   unk w = not $ GF.API.isKnownWord gr w
+   uncap (c:cs) = toLower c : cs
+   uncap s = s
+
+
+{-
+prExpXML :: StateGrammar -> Term -> [String]
+prExpXML gr = prElementX . term2elemx (stateAbstract gr) 
+
+prMultiGrammar :: Options -> ShellState -> String
+prMultiGrammar opts = M.showMGrammar (oElem optimizeCanon opts)
+-}
+-- access to customizable commands
+
+optPrintGrammar :: Options -> StateGrammar -> String
+optPrintGrammar opts = pg opts
+    where
+    pg = customOrDefault opts grammarPrinter customGrammarPrinter
+
+optPrintMultiGrammar :: Options -> CanonGrammar -> String
+optPrintMultiGrammar opts = encodeId . pmg opts . encode
+    where 
+    pmg = customOrDefault opts grammarPrinter customMultiGrammarPrinter
+    -- if -utf8 was given, convert from language specific codings
+    encode = if oElem useUTF8 opts then mapModules moduleToUTF8 else id
+    -- if -utf8id was given, convert non-literals to UTF8
+    encodeId = if oElem useUTF8id opts then nonLiteralsToUTF8 else id
+    moduleToUTF8 m = 
+	m{ jments = mapTree (onSnd (mapInfoTerms code)) (jments m),
+	   flags = setFlag "coding" "utf8" (flags m) }
+	where code = onTokens (anyCodingToUTF8 (moduleOpts m))
+	      moduleOpts = Opts . okError . mapM CG.redFlag . flags
+
+optPrintSyntax :: Options -> GF.Grammar -> String
+optPrintSyntax opts = customOrDefault opts grammarPrinter customSyntaxPrinter
+
+optPrintTree :: Options -> GFGrammar -> Tree -> String
+optPrintTree opts = customOrDefault opts grammarPrinter customTermPrinter
+
+-- | look for string command (-filter=x)
+optStringCommand :: Options -> GFGrammar -> String -> String
+optStringCommand opts g = 
+  optIntOrAll opts flagLength .  
+  customOrDefault opts filterString customStringCommand g
+
+optTermCommand :: Options -> GFGrammar -> Tree -> [Tree]
+optTermCommand opts st = 
+  optIntOrAll opts flagNumber .  
+  customOrDefault opts termCommand customTermCommand st
+
+
+-- wraps term in a function and optionally computes the result
+
+wrapByFun :: Options -> GFGrammar -> Ident -> Tree -> Tree
+wrapByFun opts gr f t = 
+  if oElem doCompute opts 
+  then err (const t) id $ AC.computeAbsTerm (grammar gr) t' >>= annotate g
+  else err (const t) id $ annotate g t'
+ where
+   t' = qualifTerm (absId gr) $ M.appCons f [tree2exp t]
+   g = grammar gr
+
+applyTransfer :: Options -> GFGrammar -> [(Ident,T.Env)] ->
+                 (Maybe Ident,Ident) -> Tree -> Err [Tree]
+applyTransfer opts gr trs (mm,f) t = mapM (annotate g) ts'
+ where
+   ts' = map (qualifTerm (absId gr)) $ trans tr f $ tree2exp t
+   g = grammar gr
+   tr = case mm of
+     Just m -> maybe empty id $ lookup m trs
+     _ -> ifNull empty (snd . head) trs
+   -- FIXME: if the returned value is a list,
+   -- return a list of trees
+   trans :: T.Env -> Ident -> Exp -> [Exp]
+   trans tr f = (:[]) . core2exp . T.evaluateExp tr . exp2core f
+   empty = T.builtin
+
+{-
+optTransfer :: Options -> StateGrammar -> G.Term -> G.Term
+optTransfer opts g = case getOptVal opts transferFun of
+  Just f -> wrapByFun (addOption doCompute opts) g (M.zIdent f)
+  _ -> id
+-}
+
+optTokenizerResult :: Options -> GFGrammar -> String -> [[CFTok]]
+optTokenizerResult opts gr = customOrDefault opts useTokenizer customTokenizer gr
+
+optTokenizer :: Options -> GFGrammar -> String -> String
+optTokenizer opts gr = show . optTokenizerResult opts gr
+
+-- performs UTF8 if the language does not have flag coding=utf8; replaces name*U
+
+-- | convert a Unicode string into a UTF8 encoded string
+optEncodeUTF8 :: GFGrammar -> String -> String
+optEncodeUTF8 gr = case getOptVal (stateOptions gr) uniCoding of
+  Just "utf8" -> id
+  _ -> encodeUTF8
+
+-- | convert a UTF8 encoded string into a Unicode string
+optDecodeUTF8 :: GFGrammar -> String -> String
+optDecodeUTF8 gr = case getOptVal (stateOptions gr) uniCoding of
+  Just "utf8" -> decodeUTF8 
+  _ -> id
+
+-- | convert a string encoded with some coding given by the coding flag to UTF8
+anyCodingToUTF8 :: Options -> String -> String
+anyCodingToUTF8 opts = 
+    encodeUTF8 . customOrDefault opts uniCoding customUniCoding
+
+
+-- | Convert all text not inside double quotes to UTF8
+nonLiteralsToUTF8 :: String -> String
+nonLiteralsToUTF8 "" = ""
+nonLiteralsToUTF8 ('"':cs) = '"' : l ++ nonLiteralsToUTF8 rs
+    where 
+    (l,rs) = takeStringLit cs
+    -- | Split off an initial string ended by double quotes
+    takeStringLit :: String -> (String,String)
+    takeStringLit "" = ("","")
+    takeStringLit ('"':cs) = (['"'],cs)
+    takeStringLit ('\\':'"':cs) = ('\\':'"':xs,ys)
+      where (xs,ys) = takeStringLit cs 
+    takeStringLit (c:cs) = (c:xs,ys)
+      where (xs,ys) = takeStringLit cs
+nonLiteralsToUTF8 (c:cs) = encodeUTF8 [c] ++ nonLiteralsToUTF8 cs 
+
+
+printParadigm :: G.Term -> String
+printParadigm term = 
+  if hasTable term then
+    (unlines . map prBranch . branches . head . tables) term
+  else
+    prt term
+ where
+   tables t = case t of
+     G.R rs   -> concatMap (tables . snd . snd) rs
+     G.T _ cs -> [cs]
+     _        -> []
+   hasTable t = not $ null $ tables t
+   branches cs = [(p:ps,s) | 
+                    (p,t) <- cs, 
+                    let ts = tables t,
+                    (ps,s) <- if null ts then [([],t)] 
+                                else concatMap branches ts
+                 ]
+   prBranch (ps,s) = unwords (map prt ps ++ [prt s])
diff --git a/src-2.9/GF/API/BatchTranslate.hs b/src-2.9/GF/API/BatchTranslate.hs
new file mode 100644
index 000000000..c1b124526
--- /dev/null
+++ b/src-2.9/GF/API/BatchTranslate.hs
@@ -0,0 +1,43 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : BatchTranslate
+-- Maintainer  : Aarne Ranta
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:05 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- translate OCL, etc, files in batch mode
+-----------------------------------------------------------------------------
+
+module GF.API.BatchTranslate (translate) where
+
+import GF.API
+import GetMyTree (file2tree)
+
+translate :: FilePath -> FilePath -> IO ()
+translate fgr txt = do
+  gr <- file2grammar fgr
+  s  <- file2tree txt
+  putStrLn $ linearize gr s
+
+
+{- headers for model-specific grammars:
+
+abstract userDefined = oclLibrary ** {
+
+--# -path=.:abstract:prelude:English:ExtraEng
+concrete userDefinedEng of userDefined = oclLibraryEng ** open externalOperEng in {
+
+--# -path=.:abstract:prelude:German:ExtraGer
+concrete userDefinedGer of userDefined = oclLibraryGer ** open
+externalOperGer in {
+
+
+It seems we should add open 
+
+   ParadigmsX, ResourceExtX, PredicationX
+
+-}
diff --git a/src-2.9/GF/API/GrammarToHaskell.hs b/src-2.9/GF/API/GrammarToHaskell.hs
new file mode 100644
index 000000000..c57cfed42
--- /dev/null
+++ b/src-2.9/GF/API/GrammarToHaskell.hs
@@ -0,0 +1,271 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GrammarToHaskell
+-- 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.API.GrammarToHaskell (grammar2haskell, grammar2haskellGADT) where
+
+import qualified GF.Canon.GFC as GFC
+import GF.Grammar.Macros
+
+import GF.Infra.Modules
+import GF.Data.Operations
+
+import Data.List (isPrefixOf, find, intersperse)
+import Data.Maybe (fromMaybe)
+
+-- | the main function
+grammar2haskell :: GFC.CanonGrammar -> String
+grammar2haskell gr = foldr (++++) [] $  
+  haskPreamble ++ [datatypes gr', gfinstances gr', fginstances gr']
+    where gr' = hSkeleton gr
+
+grammar2haskellGADT :: GFC.CanonGrammar -> String
+grammar2haskellGADT gr = foldr (++++) [] $  
+  ["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++ 
+  haskPreamble ++ [datatypesGADT gr', composInstance gr', showInstanceGADT gr', 
+                   gfinstances gr', fginstances 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 =
+ [
+  "module GSyntax where",
+  "",
+  "import GF.Infra.Ident",
+  "import GF.Grammar.Grammar",
+  "import GF.Grammar.PrGrammar",
+  "import GF.Grammar.Macros",
+  "import GF.Data.Compos",
+  "import GF.Data.Operations",
+  "",
+  "import Control.Applicative (pure,(<*>))",
+  "import Data.Traversable (traverse)",
+  "----------------------------------------------------",
+  "-- automatic translation from GF to Haskell",
+  "----------------------------------------------------",
+  "", 
+  "class Gf a where gf :: a -> Trm",
+  "class Fg a where fg :: Trm -> a",
+  "",
+  predefInst "GString" "String" "K s",
+  "",
+  predefInst "GInt" "Integer" "EInt s",
+  "",
+  predefInst "GFloat" "Double" "EFloat s",
+  "",
+  "----------------------------------------------------",
+  "-- below this line machine-generated",
+  "----------------------------------------------------",
+  ""
+ ]
+
+predefInst gtyp typ patt = 
+  "newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ " deriving Show" +++++
+  "instance Gf" +++ gtyp +++ "where" ++++
+  "  gf (" ++ gtyp +++ "s) =" +++ patt +++++
+  "instance Fg" +++ gtyp +++ "where" ++++
+  "  fg t =" ++++
+  "    case termForm t of" ++++
+  "      Ok ([]," +++ patt +++ ",[]) ->" +++ gtyp +++ "s" ++++
+  "      _ -> error (\"no" +++ gtyp +++ "\" ++ prt t)"
+
+type OIdent = String
+
+type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
+
+datatypes, gfinstances, fginstances :: (String,HSkeleton) -> String
+datatypes   = (foldr (+++++) "") . (filter (/="")) . (map hDatatype) . snd
+gfinstances (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (hInstance m)) g
+fginstances (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (fInstance m)) g
+
+hDatatype :: (OIdent, [(OIdent, [OIdent])]) -> String
+hInstance, fInstance :: 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 ++ "_"
+
+
+----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" ++
+  (if length rules == 1 then "" else "\n") +++
+  foldr1 (\x y -> x ++ "\n" +++ y) [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 = "appqc \"" ++ m ++ "\" \"" ++ f ++ "\"" +++ 
+		   "[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]"
+
+
+----fInstance m ("Cn",_) = "" ---
+fInstance m (cat,[]) = ""
+fInstance m (cat,rules) =
+  "instance Fg" +++ gId cat +++ "where" ++++
+  " fg t =" ++++
+  "  case termForm t of" ++++
+  foldr1 (\x y -> x ++ "\n" ++ y) [mkInst f xx | (f,xx) <- rules] ++++
+  "    _ -> error (\"no" +++ cat ++ " \" ++ prt t)"
+   where
+    mkInst f xx =
+     "    Ok ([], Q (IC \"" ++ m ++ "\") (IC \"" ++ f ++ "\")," ++
+     "[" ++ prTList "," xx' ++ "])" +++
+     "->" +++ 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]
+
+composInstance :: (String,HSkeleton) -> String
+composInstance (_,skel) = unlines $
+    ["instance Compos Tree where",
+     "  compos f t = case t of"]
+    ++ map ("      "++) (concatMap prComposCat skel
+                         ++ if not allRecursive then ["_ -> pure t"] else [])
+    where
+    prComposCat c@(cat, fs) 
+        | isListCat c = [gId cat +++ "xs" +++ "->" 
+                         +++ "pure" +++ gId cat +++ "<*> traverse f" +++ "xs"]
+        | otherwise = concatMap (prComposFun cat) fs
+    prComposFun :: OIdent -> (OIdent,[OIdent]) -> [String]
+    prComposFun cat c@(fun,args) 
+	| any isTreeType args = [gId fun +++ unwords vars +++ "->" +++ rhs]
+        | otherwise = []
+      where vars = ["x" ++ show n | n <- [1..length args]]
+            rhs = "pure" +++ gId fun +++ unwords (zipWith prRec vars args)
+	        where prRec var typ
+                          | not (isTreeType typ) = "<*>" +++ "pure" +++ var
+			  | otherwise = "<*>" +++ "f" +++ var
+    allRecursive = and [any isTreeType args | (_,fs) <- skel, (_,args) <- fs] 
+    isTreeType cat = cat `elem` (map fst skel ++ builtin)
+    isList cat = case filter ((==cat) . fst) skel of
+                   [] -> error $ "Unknown cat " ++ show cat
+                   x:_ -> isListCat x
+    builtin = ["GString", "GInt", "GFloat"]
+
+showInstanceGADT :: (String,HSkeleton) -> String
+showInstanceGADT (_,skel) = unlines $
+            ["instance Show (Tree c) where",
+	     "  showsPrec n t = case t of"]
+	     ++ map ("    "++) (concatMap prShowCat skel)
+	     ++ ["   where opar n = if n > 0 then showChar '(' else id",
+	         "         cpar n = if n > 0 then showChar ')' else id"]
+  where 
+  prShowCat c@(cat, fs)
+      | isListCat c = [gId cat +++ "xs" +++ "->" +++ "showList" +++ "xs"]
+      | otherwise = map (prShowFun cat) fs
+  prShowFun :: OIdent -> (OIdent,[OIdent]) -> String
+  prShowFun cat (fun,args) 
+      | null vars = gId fun +++ "->" +++ "showString" +++ show fun
+      | otherwise = gId fun +++ unwords vars +++ "->" 
+			     +++ "opar n . showString" +++ show fun
+			     +++ unwords [". showChar ' ' . showsPrec 1 " ++ x | x <- vars]
+			     +++ ". cpar n"
+      where vars = ["x" ++ show n | n <- [1..length args]]
+
+hSkeleton :: GFC.CanonGrammar -> (String,HSkeleton)
+hSkeleton gr = (name,collectR rules [(c,[]) | c <- cats]) where
+  collectR rr hh =
+   case rr of
+     (fun,typ):rs -> case catSkeleton typ of
+        Ok (cats,cat) -> 
+             collectR rs (updateSkeleton (symid (snd cat)) hh (fun,
+	                                                    map (symid . snd) cats))
+        _ -> collectR rs hh
+     _ -> hh
+  cats =  [symid cat | (cat,GFC.AbsCat _ _) <- defs]
+  rules = [(symid fun, typ) | (fun,GFC.AbsFun typ _) <- defs]
+
+  defs = concat [tree2list (jments m) | im@(_,ModMod m) <- modules gr, isModAbs m]
+  name = ifNull "UnknownModule" (symid . last) [n | (n,ModMod m) <- modules gr, isModAbs m]
+
+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
+   _ -> error $ cat ++ ": updating empty skeleton with" +++ show 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-2.9/GF/API/GrammarToTransfer.hs b/src-2.9/GF/API/GrammarToTransfer.hs
new file mode 100644
index 000000000..658c15184
--- /dev/null
+++ b/src-2.9/GF/API/GrammarToTransfer.hs
@@ -0,0 +1,94 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GrammarToTransfer
+-- Maintainer  : Björn Bringert
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 12:39:07 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- Creates a data type definition in the transfer language
+-- for an abstract module.
+-----------------------------------------------------------------------------
+
+module GF.API.GrammarToTransfer (grammar2transfer) where
+
+import qualified GF.Canon.GFC as GFC
+import qualified GF.Grammar.Abstract as A
+import GF.Grammar.Macros
+
+import GF.Infra.Modules
+import GF.Data.Operations
+
+import Transfer.Syntax.Abs as S
+import Transfer.Syntax.Print
+
+
+-- | the main function
+grammar2transfer :: GFC.CanonGrammar -> String
+grammar2transfer gr = printTree $ S.Module imports decls
+  where
+  cat = S.Ident "Cat" -- FIXME
+  tree = S.Ident "Tree" -- FIXME
+  defs = concat [tree2list (jments m) | im@(_,ModMod m) <- modules gr, isModAbs m]
+  -- get category name and context
+  cats = [(cat, c) | (cat,GFC.AbsCat c _) <- defs]
+  -- get function name and type
+  funs = [(fun, typ) | (fun,GFC.AbsFun typ _) <- defs]
+  name = ifNull "UnknownModule" (symid . last) [n | (n,ModMod m) <- modules gr, isModAbs m]
+  imports = [Import (S.Ident "prelude")]
+  decls = [cats2cat cat tree cats, funs2tree cat tree funs] ++ instances tree
+
+
+-- | Create a declaration of the type of categories given a list
+--   of category names and their contexts.
+cats2cat :: S.Ident -- ^ the name of the Cat type
+         -> S.Ident -- ^ the name of the Tree type
+         -> [(A.Ident,A.Context)] -> Decl
+cats2cat cat tree = S.DataDecl cat S.EType . map (uncurry catCons)
+  where
+  catCons i c = S.ConsDecl (id2id i) (catConsType c)
+  catConsType = foldr pi (S.EVar cat)
+  pi (i,x) t = mkPi (id2pv i) (addTree tree $ term2exp x) t
+
+funs2tree :: S.Ident -- ^ the name of the Cat type
+          -> S.Ident -- ^ the name of the Tree type
+          -> [(A.Ident,A.Type)] -> Decl
+funs2tree cat tree = 
+    S.DataDecl tree (S.EPiNoVar (S.EVar cat) S.EType) . map (uncurry funCons)
+  where 
+  funCons i t = S.ConsDecl (id2id i) (addTree tree $ term2exp t)
+
+term2exp :: A.Term -> S.Exp
+term2exp t = case t of
+  A.Vr i         -> S.EVar (id2id i)
+  A.App t1 t2    -> S.EApp (term2exp t1) (term2exp t2)
+  A.Abs i t1     -> S.EAbs (id2pv i) (term2exp t1)
+  A.Prod i t1 t2 -> mkPi (id2pv i) (term2exp t1) (term2exp t2)
+  A.Q m i        -> S.EVar (id2id i)
+  _ -> error $ "term2exp: can't handle " ++ show t
+
+mkPi :: S.VarOrWild -> S.Exp -> S.Exp -> S.Exp 
+mkPi VWild t e = S.EPiNoVar t e
+mkPi v     t e = S.EPi v t e
+
+id2id :: A.Ident -> S.Ident
+id2id = S.Ident . symid
+
+id2pv :: A.Ident -> S.VarOrWild
+id2pv i = case symid i of
+                       "h_" -> S.VWild -- FIXME: hacky?
+                       x    -> S.VVar (S.Ident x)
+
+-- FIXME: I think this is not general enoguh.
+addTree :: S.Ident -> S.Exp -> S.Exp
+addTree tree x = case x of
+  S.EPi i t e -> S.EPi i (addTree tree t) (addTree tree e)
+  S.EPiNoVar t e -> S.EPiNoVar (addTree tree t) (addTree tree e)
+  e -> S.EApp (S.EVar tree) e
+
+instances :: S.Ident -> [S.Decl]
+instances tree = [DeriveDecl (S.Ident "Eq") tree, 
+                  DeriveDecl (S.Ident "Compos") tree]
diff --git a/src-2.9/GF/API/IOGrammar.hs b/src-2.9/GF/API/IOGrammar.hs
new file mode 100644
index 000000000..bd7fc5648
--- /dev/null
+++ b/src-2.9/GF/API/IOGrammar.hs
@@ -0,0 +1,96 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : IOGrammar
+-- Maintainer  : Aarne Ranta
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:40 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.20 $
+--
+-- for reading grammars and terms from strings and files
+-----------------------------------------------------------------------------
+
+module GF.API.IOGrammar (shellStateFromFiles,
+		  getShellStateFromFiles) where
+
+import GF.Grammar.Abstract
+import qualified GF.Canon.GFC as GFC
+import GF.Compile.PGrammar
+import GF.Grammar.TypeCheck
+import GF.Compile.Compile
+import GF.Compile.ShellState
+import GF.Compile.NoParse
+import GF.Probabilistic.Probabilistic
+import GF.UseGrammar.Treebank
+
+import GF.Infra.Modules
+import GF.Infra.ReadFiles (isOldFile)
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.System.Arch
+
+import qualified Transfer.InterpreterAPI as T
+
+import Control.Monad (liftM)
+import System.FilePath
+
+-- | a heuristic way of renaming constants is used
+string2absTerm :: String -> String -> Term 
+string2absTerm m = renameTermIn m . pTrm
+
+renameTermIn :: String -> Term -> Term
+renameTermIn m = refreshMetas [] . rename [] where
+  rename vs t = case t of
+    Abs x b -> Abs x (rename (x:vs) b)
+    Vr c    -> if elem c vs then t else Q (zIdent m) c
+    App f a -> App (rename vs f) (rename vs a)
+    _ -> t
+
+string2annotTree :: GFC.CanonGrammar -> Ident -> String -> Err Tree
+string2annotTree gr m = annotate gr . string2absTerm (prt m) ---- prt
+
+----string2paramList :: ConcreteST -> String -> [Term]
+---string2paramList st = map (renameTrm (lookupConcrete st) . patt2term) . pPattList
+
+shellStateFromFiles :: Options -> ShellState -> FilePath -> IOE ShellState
+shellStateFromFiles opts st file = do
+ ign <- ioeIO $ getNoparseFromFile opts file
+ let top = identC $ justModuleName file
+ sh <- case takeExtensions file of
+  ".trc" -> do
+     env <- ioeIO $ T.loadFile file
+     return $ addTransfer (top,env) st
+  ".gfcm" -> do
+     cenv <- compileOne opts (compileEnvShSt st []) file
+     ioeErr $ updateShellState opts ign Nothing st cenv
+  s | elem s [".cf",".ebnf"] -> do
+     let osb = addOptions (options []) opts
+     grts <- compileModule osb st file
+     ioeErr $ updateShellState opts ign Nothing st grts
+  s | oElem (iOpt "treebank") opts -> do
+     tbs <- ioeIO $ readUniTreebanks file
+     return $ addTreebanks tbs st
+  _ -> do
+     b <- ioeIO $ isOldFile file
+     let opts' = if b then (addOption showOld opts) else opts
+
+     let osb = if oElem showOld opts' 
+                 then addOptions (options []) opts' -- for old no emit
+                 else addOptions (options [emitCode]) opts'
+     grts <- compileModule osb st file
+     let mtop = if oElem showOld opts' then Nothing else Just top
+     ioeErr $ updateShellState opts' ign mtop st grts
+ if (isSetFlag opts probFile || oElem (iOpt "prob") opts)
+       then do 
+         probs <- ioeIO $ getProbsFromFile opts file
+         let lang = maybe top id $ concrete sh --- to work with cf, too
+         ioeErr $ addProbs (lang,probs) sh
+       else return sh
+
+getShellStateFromFiles :: Options -> FilePath -> IO ShellState
+getShellStateFromFiles os = 
+  useIOE emptyShellState . 
+  shellStateFromFiles os emptyShellState
diff --git a/src-2.9/GF/API/MyParser.hs b/src-2.9/GF/API/MyParser.hs
new file mode 100644
index 000000000..c926fe865
--- /dev/null
+++ b/src-2.9/GF/API/MyParser.hs
@@ -0,0 +1,25 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : MyParser
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:07 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- template to define your own parser (obsolete?)
+-----------------------------------------------------------------------------
+
+module GF.API.MyParser (myParser) where
+
+import GF.Compile.ShellState
+import GF.CF.CFIdent
+import GF.CF.CF
+import GF.Data.Operations
+
+-- type CFParser = [CFTok] -> ([(CFTree,[CFTok])],String)
+
+myParser :: StateGrammar -> CFCat -> CFParser
+myParser gr cat toks = ([],"Would you like to add your own parser?")
diff --git a/src-2.9/GF/CF/CF.hs b/src-2.9/GF/CF/CF.hs
new file mode 100644
index 000000000..9233e905a
--- /dev/null
+++ b/src-2.9/GF/CF/CF.hs
@@ -0,0 +1,213 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:07 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- context-free grammars. AR 15\/12\/1999 -- 30\/3\/2000 -- 2\/6\/2001 -- 3\/12\/2001
+-----------------------------------------------------------------------------
+
+module GF.CF.CF (-- * Types
+	   CF(..), CFRule, CFRuleGroup, 
+	   CFItem(..), CFTree(..), CFPredef, CFParser,
+	   RegExp(..), CFWord,
+	   -- * Functions
+	   cfParseResults,
+	   -- ** to construct CF grammars
+	   emptyCF, emptyCFPredef, rules2CF, groupCFRules,
+	   -- ** to construct rules
+	   atomCFRule, atomCFTerm, atomRegExp, altsCFTerm,
+	   -- ** to construct trees
+	   atomCFTree, buildCFTree,
+	   -- ** to decide whether a token matches a terminal item
+	   matchCFTerm, satRegExp,
+	   -- ** to analyse a CF grammar
+	   catsOfCF, rulesOfCF, ruleGroupsOfCF, rulesForCFCat, 
+	   valCatCF, valItemsCF, valFunCF, 
+	   startCat, predefOfCF, appCFPredef, valCFItem,
+	   cfTokens, wordsOfRegExp, forCFItem, 
+	   isCircularCF, predefRules
+	  ) where
+
+import GF.Data.Operations
+import GF.Data.Str
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.CF.CFIdent
+import Data.List (nub,nubBy)
+import Data.Char (isUpper, isLower, toUpper, toLower)
+
+-- CF grammar data types
+
+-- | abstract type CF. 
+-- Invariant: each category has all its rules grouped with it 
+--      also: the list is never empty (the category is just missing then)
+newtype CF  = CF ([CFRuleGroup], CFPredef) 
+type CFRule = (CFFun, (CFCat, [CFItem]))
+type CFRuleGroup = (CFCat,[CFRule])
+
+-- | CFPredef is a hack for variable symbols and literals; normally = @const []@
+data CFItem = CFTerm RegExp | CFNonterm CFCat deriving (Eq, Ord,Show)
+
+newtype CFTree = CFTree (CFFun,(CFCat, [CFTree])) deriving (Eq, Show)
+
+-- | recognize literals, variables, etc
+type CFPredef  = CFTok -> [(CFCat, CFFun)]
+
+-- | Wadler style + return information
+type CFParser = [CFTok] -> ([(CFTree,[CFTok])],String)
+
+cfParseResults :: ([(CFTree,[CFTok])],String) -> [CFTree]
+cfParseResults rs = [b | (b,[]) <- fst rs]
+
+-- | terminals are regular expressions on words; to be completed to full regexp
+data RegExp = 
+    RegAlts [CFWord]         -- ^ list of alternative words
+  | RegSpec CFTok            -- ^ special token
+  deriving (Eq, Ord, Show)
+
+type CFWord = String
+
+-- the above types should be kept abstract, and the following functions used
+
+-- to construct CF grammars
+
+emptyCF :: CF
+emptyCF = CF ([], emptyCFPredef)
+
+emptyCFPredef :: CFPredef
+emptyCFPredef = const []
+
+rules2CF :: [CFRule] -> CF
+rules2CF rs = CF (groupCFRules rs, emptyCFPredef)
+
+groupCFRules :: [CFRule] -> [(CFCat,[CFRule])]
+groupCFRules = foldr ins [] where
+  ins rule crs = case crs of
+    (c,r) : rs | compatCF c cat -> (c,rule:r) : rs
+    cr    : rs            -> cr         : ins rule rs
+    _                     -> [(cat,[rule])]
+   where
+     cat = valCatCF rule
+
+-- to construct rules
+
+-- | make a rule from a single token without constituents
+atomCFRule :: CFCat -> CFFun -> CFTok -> CFRule
+atomCFRule c f s = (f, (c, [atomCFTerm s]))
+
+-- | usual terminal
+atomCFTerm :: CFTok -> CFItem 
+atomCFTerm = CFTerm . atomRegExp
+
+atomRegExp :: CFTok -> RegExp
+atomRegExp t = case t of
+  TS s -> RegAlts [s] 
+  _    -> RegSpec t
+
+-- | terminal consisting of alternatives
+altsCFTerm :: [String] -> CFItem 
+altsCFTerm = CFTerm . RegAlts
+
+
+-- to construct trees
+
+-- | make a tree without constituents
+atomCFTree :: CFCat -> CFFun -> CFTree
+atomCFTree c f = buildCFTree c f []
+
+-- | make a tree with constituents. 
+buildCFTree :: CFCat -> CFFun -> [CFTree] -> CFTree
+buildCFTree c f trees = CFTree (f,(c,trees))
+
+{- ----
+cfMeta0 :: CFTree
+cfMeta0 = atomCFTree uCFCat metaCFFun
+
+-- used in happy
+litCFTree :: String -> CFTree --- Maybe CFTree
+litCFTree s = maybe cfMeta0 id $ do
+  (c,f) <- getCFLiteral s
+  return $ buildCFTree c f []
+-}
+
+-- to decide whether a token matches a terminal item
+
+matchCFTerm :: CFItem -> CFTok -> Bool
+matchCFTerm (CFTerm t) s = satRegExp t s
+matchCFTerm _ _ = False
+
+satRegExp :: RegExp -> CFTok -> Bool
+satRegExp r t = case (r,t) of 
+  (RegAlts tt, TS s) -> elem s tt
+  (RegAlts tt, TC s) -> or [elem s' tt | s' <- caseUpperOrLower s]
+  (RegSpec x,  _)    -> t == x ---
+  _ -> False
+ where
+   caseUpperOrLower s = case s of
+     c:cs | isUpper c -> [s, toLower c : cs]
+     c:cs | isLower c -> [s, toUpper c : cs]
+     _ -> [s]
+
+-- to analyse a CF grammar
+
+catsOfCF :: CF -> [CFCat]
+catsOfCF (CF (rr,_)) = map fst rr 
+
+rulesOfCF :: CF -> [CFRule]
+rulesOfCF (CF (rr,_)) = concatMap snd rr
+
+ruleGroupsOfCF :: CF -> [(CFCat,[CFRule])]
+ruleGroupsOfCF (CF (rr,_)) = rr
+
+rulesForCFCat :: CF -> CFCat -> [CFRule]
+rulesForCFCat (CF (rr,_)) cat = maybe [] id $ lookup cat rr
+
+valCatCF :: CFRule -> CFCat
+valCatCF (_,(c,_)) = c
+
+valItemsCF :: CFRule -> [CFItem]
+valItemsCF (_,(_,i)) = i
+
+valFunCF :: CFRule -> CFFun
+valFunCF  (f,(_,_)) = f
+
+startCat :: CF -> CFCat
+startCat (CF (rr,_)) = fst (head rr) --- hardly useful
+
+predefOfCF :: CF -> CFPredef
+predefOfCF (CF (_,f)) = f
+
+appCFPredef :: CF -> CFTok -> [(CFCat, CFFun)]
+appCFPredef = ($) . predefOfCF
+
+valCFItem :: CFItem -> Either RegExp CFCat
+valCFItem (CFTerm r)     = Left r
+valCFItem (CFNonterm nt) = Right nt
+
+cfTokens :: CF -> [CFWord]
+cfTokens cf = nub $ concat $ [ wordsOfRegExp i | r <- rulesOfCF cf, 
+                                                 CFTerm i <- valItemsCF r]
+
+wordsOfRegExp :: RegExp -> [CFWord]
+wordsOfRegExp (RegAlts tt) = tt
+wordsOfRegExp _ = []
+
+forCFItem :: CFTok -> CFRule -> Bool
+forCFItem a (_,(_, CFTerm r : _)) = satRegExp r a
+forCFItem _ _ = False
+
+-- | we should make a test of circular chains, too
+isCircularCF :: CFRule -> Bool
+isCircularCF (_,(c', CFNonterm c:[])) = compatCF c' c
+isCircularCF _ = False
+
+-- | coercion to the older predef cf type
+predefRules :: CFPredef -> CFTok -> [CFRule]
+predefRules pre s = [atomCFRule c f s | (c,f) <- pre s]
+
diff --git a/src-2.9/GF/CF/CFIdent.hs b/src-2.9/GF/CF/CFIdent.hs
new file mode 100644
index 000000000..02ee482c0
--- /dev/null
+++ b/src-2.9/GF/CF/CFIdent.hs
@@ -0,0 +1,253 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CFIdent
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:40 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.13 $
+--
+-- symbols (categories, functions) for context-free grammars.
+-----------------------------------------------------------------------------
+
+module GF.CF.CFIdent (-- * Tokens and categories
+		CFTok(..), CFCat(..),
+		tS, tC, tL, tI, tF, tV, tM, tInt,
+		prCFTok,
+		-- * Function names and profiles
+		CFFun(..), Profile,
+		wordsCFTok,
+		-- * CF Functions
+		mkCFFun, varCFFun, consCFFun, string2CFFun, stringCFFun, 
+                intCFFun, floatCFFun, dummyCFFun,
+		cfFun2String, cfFun2Ident, cfFun2Profile, metaCFFun,
+		-- * CF Categories
+		mkCIdent, ident2CFCat, labels2CFCat, string2CFCat, 
+                catVarCF, cat2CFCat, cfCatString, cfCatInt,cfCatFloat,
+		moduleOfCFCat, cfCat2Cat, cfCat2Ident, lexCFCat,
+		-- * CF Tokens
+		string2CFTok, str2cftoks,
+		-- * Comparisons
+		compatToks, compatTok, compatCFFun, compatCF,
+                wordsLits
+	       ) where
+
+import GF.Data.Operations
+import GF.Canon.GFC
+import GF.Infra.Ident
+import GF.Grammar.Values (cPredefAbs)
+import GF.Canon.AbsGFC
+import GF.Grammar.Macros (ident2label)
+import GF.Grammar.PrGrammar
+import GF.Data.Str
+import Data.Char (toLower, toUpper, isSpace)
+import Data.List (intersperse)
+
+-- | this type should be abstract
+data CFTok = 
+   TS String     -- ^ normal strings
+ | TC String     -- ^ strings that are ambiguous between upper or lower case
+ | TL String     -- ^ string literals
+ | TI Integer    -- ^ integer literals
+ | TF Double     -- ^ float literals
+ | TV Ident      -- ^ variables
+ | TM Int String -- ^ metavariables; the integer identifies it
+  deriving (Eq, Ord, Show)
+
+-- | this type should be abstract
+newtype CFCat = CFCat (CIdent,Label) deriving (Eq, Ord, Show)
+
+tS :: String -> CFTok
+tC :: String -> CFTok
+tL :: String -> CFTok
+tI :: String -> CFTok
+tF :: String -> CFTok
+tV :: String -> CFTok
+tM :: String -> CFTok
+
+tS  = TS
+tC  = TC
+tL  = TL
+tI  = TI . read 
+tF  = TF . read 
+tV  = TV . identC
+tM  = TM 0
+
+tInt :: Integer -> CFTok
+tInt = TI
+
+prCFTok :: CFTok -> String
+prCFTok t = case t of
+  TS s -> s
+  TC s -> s
+  TL s -> s
+  TI i -> show i
+  TF i -> show i
+  TV x -> prt x
+  TM i m -> m --- "?" --- m
+
+-- | to build trees: the Atom contains a GF function, @Cn | Meta | Vr | Literal@
+newtype CFFun = CFFun (Atom, Profile) deriving (Eq,Ord,Show) 
+-- - - - - - - - - - - - - - - - - - - - -         ^^^ added by peb, 21/5-04 
+
+type Profile  = [([[Int]],[Int])]
+
+wordsCFTok :: CFTok -> [String]
+wordsCFTok t = case t of
+  TC (c:cs) -> [c':cs | c' <- [toUpper c, toLower c]]
+  _ -> [prCFTok t]
+
+-- the following functions should be used instead of constructors
+
+-- to construct CF functions
+
+mkCFFun :: Atom -> CFFun
+mkCFFun t = CFFun (t,[])
+
+varCFFun :: Ident -> CFFun
+varCFFun = mkCFFun . AV
+
+consCFFun :: CIdent -> CFFun
+consCFFun = mkCFFun . AC
+
+-- | standard way of making cf fun
+string2CFFun :: String -> String -> CFFun
+string2CFFun m c = consCFFun $ mkCIdent m c
+
+stringCFFun :: String -> CFFun 
+stringCFFun = mkCFFun . AS
+
+intCFFun :: Integer -> CFFun 
+intCFFun = mkCFFun . AI
+
+floatCFFun :: Double -> CFFun 
+floatCFFun = mkCFFun . AF
+
+-- | used in lexer-by-need rules
+dummyCFFun :: CFFun
+dummyCFFun = varCFFun $ identC "_"
+
+cfFun2String :: CFFun -> String
+cfFun2String (CFFun (f,_)) = prt f
+
+cfFun2Ident :: CFFun -> Ident
+cfFun2Ident (CFFun (f,_)) = identC $ prt_ f ---
+
+cfFun2Profile :: CFFun -> Profile
+cfFun2Profile (CFFun (_,p)) = p
+
+{- ----
+strPro2cfFun :: String -> Profile -> CFFun
+strPro2cfFun str p = (CFFun (AC (Ident str), p))
+-}
+
+metaCFFun :: CFFun
+metaCFFun = mkCFFun $ AM 0
+
+-- to construct CF categories
+
+-- | belongs elsewhere
+mkCIdent :: String -> String -> CIdent
+mkCIdent m c = CIQ (identC m) (identC c)
+
+ident2CFCat :: CIdent -> Ident -> CFCat
+ident2CFCat mc d = CFCat (mc, L d)
+
+labels2CFCat :: CIdent -> [Label] -> CFCat
+labels2CFCat mc d = CFCat (mc, L (identC (concat (intersperse "." (map prt d))))) ----
+
+-- | standard way of making cf cat: label s
+string2CFCat :: String -> String -> CFCat
+string2CFCat m c = ident2CFCat (mkCIdent m c) (identC "s")
+
+idents2CFCat :: Ident -> Ident -> CFCat
+idents2CFCat m c = ident2CFCat (CIQ m c) (identC "s")
+
+catVarCF :: CFCat
+catVarCF = ident2CFCat (mkCIdent "_" "#Var") (identC "_") ----
+
+cat2CFCat :: (Ident,Ident) -> CFCat
+cat2CFCat = uncurry idents2CFCat
+
+-- | literals
+cfCatString :: CFCat
+cfCatString = string2CFCat (prt cPredefAbs) "String"
+
+cfCatInt, cfCatFloat :: CFCat
+cfCatInt = string2CFCat (prt cPredefAbs) "Int"
+cfCatFloat = string2CFCat (prt cPredefAbs) "Float"
+
+
+
+{- ----
+uCFCat :: CFCat
+uCFCat = cat2CFCat uCat
+-}
+
+moduleOfCFCat :: CFCat -> Ident
+moduleOfCFCat (CFCat (CIQ m _, _)) = m
+
+-- | the opposite direction
+cfCat2Cat :: CFCat -> (Ident,Ident)
+cfCat2Cat (CFCat (CIQ m c,_)) = (m,c)
+
+cfCat2Ident :: CFCat -> Ident
+cfCat2Ident = snd . cfCat2Cat
+
+lexCFCat :: CFCat -> CFCat
+lexCFCat cat = ident2CFCat (uncurry CIQ (cfCat2Cat cat)) (identC "*")
+
+-- to construct CF tokens
+
+string2CFTok :: String -> CFTok
+string2CFTok = tS
+
+str2cftoks :: Str -> [CFTok]
+str2cftoks = map tS . wordsLits . sstr
+
+-- decide if two token lists look the same (in parser postprocessing)
+
+compatToks :: [CFTok] -> [CFTok] -> Bool
+compatToks ts us = and [compatTok t u | (t,u) <- zip ts us]
+
+compatTok :: CFTok -> CFTok -> Bool
+compatTok (TM _ _) _ = True --- hack because metas are renamed
+compatTok _ (TM _ _) = True
+compatTok t u = any (`elem` (alts t)) (alts u) where
+  alts u = case u of
+    TC (c:s) -> [toLower c : s, toUpper c : s]
+    TL s -> [s, prQuotedString s]
+    _ -> [prCFTok u]
+
+-- | decide if two CFFuns have the same function head (profiles may differ)
+compatCFFun :: CFFun -> CFFun -> Bool
+compatCFFun (CFFun (f,_)) (CFFun (g,_)) = f == g
+
+-- | decide whether two categories match
+-- the modifiers can be from different modules, but on the same extension
+-- path, so there is no clash, and they can be safely ignored ---
+compatCF :: CFCat -> CFCat -> Bool
+----compatCF = (==)
+compatCF (CFCat (CIQ _ c, l)) (CFCat (CIQ _ c', l')) = c==c' && l==l'
+
+-- | Like 'words', but does not split on whitespace inside
+--   double quotes.wordsLits :: String -> [String]
+-- Also treats escaped quotes in quotes (AR 21/12/2005) by breaks
+-- instead of break
+wordsLits [] = []
+wordsLits (c:cs) | isSpace c = wordsLits (dropWhile isSpace cs)
+		 | isQuote c
+		     = let (l,rs) = breaks (==c) cs
+			   rs' = drop 1 rs
+			   in ([c]++l++[c]):wordsLits rs'
+		 | otherwise = let (w,rs) = break isSpaceQ cs
+				   in (c:w):wordsLits rs
+  where
+    breaks c cs = case break c cs of
+      (l@(_:_),d:rs) | last l == '\\' -> 
+        let (r,ts) = breaks c rs in (l++[d]++r, ts)
+      v -> v
+    isQuote c = elem c "\"'" 
+    isSpaceQ c = isSpace c ---- || isQuote c
diff --git a/src-2.9/GF/CF/CFtoGrammar.hs b/src-2.9/GF/CF/CFtoGrammar.hs
new file mode 100644
index 000000000..5e73aec31
--- /dev/null
+++ b/src-2.9/GF/CF/CFtoGrammar.hs
@@ -0,0 +1,62 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CFtoGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:09 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.7 $
+--
+-- 26\/1\/2000 -- 18\/4 -- 24\/3\/2004
+-----------------------------------------------------------------------------
+
+module GF.CF.CFtoGrammar (cf2grammar) where
+
+import GF.Infra.Ident
+import GF.Grammar.Grammar
+import qualified GF.Source.AbsGF as A
+import qualified GF.Source.GrammarToSource as S
+import GF.Grammar.Macros
+
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.CF.PPrCF
+
+import GF.Data.Operations
+
+import Data.List (nub)
+import Data.Char (isSpace)
+
+cf2grammar :: CF -> [A.TopDef]
+cf2grammar cf = concatMap S.trAnyDef (abs ++ conc) where
+  rules = rulesOfCF cf
+  abs   = cats ++ funs
+  conc  = lintypes ++ lins
+  cats  = [(cat, AbsCat (yes []) (yes [])) | 
+             cat <- nub (concat (map cf2cat rules))] ----notPredef cat
+  lintypes = [(cat, CncCat (yes defLinType) nope nope) | (cat,AbsCat _ _) <- cats]
+  (funs,lins) = unzip (map cf2rule rules)
+
+cf2cat :: CFRule -> [Ident]
+cf2cat (_,(cat, items)) = map cfCat2Ident $ cat : [c | CFNonterm c <- items]
+
+cf2rule :: CFRule -> ((Ident,Info),(Ident,Info))
+cf2rule (fun, (cat, items)) = (def,ldef) where
+ f     = cfFun2Ident fun
+ def   = (f, AbsFun (yes (mkProd (args', Cn (cfCat2Ident cat), []))) nope)
+ args0 = zip (map (mkIdent "x") [0..]) items
+ args  = [(v, Cn (cfCat2Ident c)) | (v, CFNonterm c) <- args0]
+ args' = [(zIdent "_", Cn (cfCat2Ident c)) | (_, CFNonterm c) <- args0]
+ ldef  = (f, CncFun 
+               Nothing 
+               (yes (mkAbs (map fst args) 
+                      (mkRecord (const theLinLabel) [foldconcat (map mkIt args0)])))
+               nope)
+ mkIt (v, CFNonterm _) = P (Vr v) theLinLabel
+ mkIt (_, CFTerm (RegAlts [a])) = K a
+ mkIt _ = K "" --- regexp not recognized in input CF ; use EBNF for this
+ foldconcat [] = K ""
+ foldconcat tt = foldr1 C tt
+
diff --git a/src-2.9/GF/CF/CanonToCF.hs b/src-2.9/GF/CF/CanonToCF.hs
new file mode 100644
index 000000000..80ce2e79d
--- /dev/null
+++ b/src-2.9/GF/CF/CanonToCF.hs
@@ -0,0 +1,214 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CanonToCF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.15 $
+--
+-- AR 27\/1\/2000 -- 3\/12\/2001 -- 8\/6\/2003 
+-----------------------------------------------------------------------------
+
+module GF.CF.CanonToCF (canon2cf) where
+
+import GF.System.Tracing -- peb 8/6-04
+
+import GF.Data.Operations
+import GF.Infra.Option
+import GF.Infra.Ident
+import GF.Canon.AbsGFC
+import GF.Grammar.LookAbs (allBindCatsOf)
+import GF.Canon.GFC
+import GF.Grammar.Values (isPredefCat,cPredefAbs)
+import GF.Grammar.PrGrammar
+import GF.Canon.CMacros
+import qualified GF.Infra.Modules as M
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.UseGrammar.Morphology
+import GF.Data.Trie2
+import Data.List (nub,partition)
+import Control.Monad
+
+-- | The main function: for a given cnc module 'm', build the CF grammar with all the
+-- rules coming from modules that 'm' extends. The categories are qualified by
+-- the abstract module name 'a' that 'm' is of.
+-- The ign argument tells what rules not to generate a parser for.
+canon2cf :: Options -> (Ident -> Bool) -> CanonGrammar -> Ident -> Err CF
+canon2cf opts ign gr c = tracePrt "#size of CF" (err id (show.length.rulesOfCF)) $ do -- peb 8/6-04
+  let ms = M.allExtends gr c
+  a <- M.abstractOfConcrete gr c
+  let cncs = [m | (n, M.ModMod m) <- M.modules gr, elem n ms]
+  let mms  = [(a, tree2list (M.jments m)) | m <- cncs]
+  cnc <- liftM M.jments $ M.lookupModMod gr c
+  rules0 <- liftM concat $ mapM (uncurry (cnc2cfCond opts ign cnc)) mms
+  let bindcats = map snd $ allBindCatsOf gr 
+  let rules = filter (not . isCircularCF) rules0 ---- temporarily here
+  let grules = groupCFRules rules
+  let predef = mkCFPredef opts bindcats grules
+  return $ CF predef
+
+cnc2cfCond :: Options -> (Ident -> Bool) -> BinTree Ident Info -> 
+              Ident -> [(Ident,Info)] -> Err [CFRule]
+cnc2cfCond opts ign cnc m gr = 
+  liftM concat $ 
+  mapM lin2cf [(m,fun,cat,args,lin) | 
+                 (fun, CncFun cat args lin _) <- gr, notign fun, is fun] 
+ where
+   is f = isInBinTree f cnc
+   notign = not . ign
+
+type IFun = Ident
+type ICat = CIdent
+
+-- | all CF rules corresponding to a linearization rule
+lin2cf :: (Ident, IFun, ICat, [ArgVar], Term) -> Err [CFRule]
+lin2cf (m,fun,cat,args,lin) = errIn ("building CF rule for" +++ prt fun) $ do
+  let rhss0 = allLinBranches lin          -- :: [([Label], Term)]
+  rhss1  <- mapM (mkCFItems m) rhss0    -- :: [([Label], [[PreCFItem]])]
+  mapM (mkCfRules m fun cat args) rhss1 >>= return . nub . concat
+
+-- | making sequences of CF items from every branch in a linearization
+mkCFItems :: Ident -> ([Label], Term) -> Err ([Label], [[PreCFItem]])
+mkCFItems m (labs,t) = do
+  items <- term2CFItems m t
+  return (labs, items)
+
+-- | making CF rules from sequences of CF items
+mkCfRules :: Ident -> IFun -> ICat -> [ArgVar] -> ([Label], [[PreCFItem]]) -> Err [CFRule]
+mkCfRules m fun cat args (lab, itss) = mapM mkOneRule itss
+ where
+  mkOneRule its = do
+    let nonterms = zip [0..] [(pos,d,v) | PNonterm _ pos d v <- its]
+        profile  = mkProfile nonterms
+	cfcat    = labels2CFCat (redirectIdent m cat) lab
+        cffun    = CFFun (AC (CIQ m fun), profile)
+        cfits    = map precf2cf its
+    return (cffun,(cfcat,cfits))
+  mkProfile nonterms = map mkOne args 
+    where
+      mkOne (A  c i) = mkOne (AB c 0 i)
+      mkOne (AB _ b i) = (map mkB [0..b-1], [k | (k,(j,_,True)) <- nonterms, j==i])
+        where
+          mkB x = [k | (k,(j, [LV y], False)) <- nonterms, j == i, y == x]
+
+-- | intermediate data structure of CFItems with information for profiles
+data PreCFItem = 
+    PTerm RegExp                         -- ^ like ordinary Terminal 
+  | PNonterm CIdent Integer [Label] Bool -- ^ cat, position, part\/bind, whether arg
+   deriving Eq                    
+
+precf2cf :: PreCFItem -> CFItem
+precf2cf (PTerm r) = CFTerm r
+precf2cf (PNonterm cm _ ls True) = CFNonterm (labels2CFCat cm ls)
+precf2cf (PNonterm _ _ _ False) = CFNonterm catVarCF
+
+
+-- | the main job in translating linearization rules into sequences of cf items 
+term2CFItems :: Ident -> Term -> Err [[PreCFItem]]
+term2CFItems m t = errIn "forming cf items" $ case t of
+   S c _ -> t2c c
+
+   T _ cc -> do
+     its  <- mapM t2c [t | Cas _ t <- cc]
+     tryMkCFTerm (concat its)
+   V _ cc -> do
+     its  <- mapM t2c [t | t <- cc]
+     tryMkCFTerm (concat its)
+
+   C t1 t2 -> do
+     its1 <- t2c t1
+     its2 <- t2c t2
+     return [x ++ y | x <- its1, y <- its2]
+
+   FV ts -> do
+     its <- mapM t2c ts
+     tryMkCFTerm (concat its)
+
+   P (S c _) _ -> t2c c --- w-around for bug in Compute? AR 31/1/2006
+
+   P arg s -> extrR arg s
+
+   K (KS s) -> return [[PTerm (RegAlts [s]) | not (null s)]]
+
+   E -> return [[]]
+
+   K (KP d vs) -> do
+     let its  =  [PTerm (RegAlts [s]) | s <- d]
+     let itss = [[PTerm (RegAlts [s]) | s <- t] | Var t _ <- vs]
+     tryMkCFTerm (its : itss)
+
+   _ -> return [] ---- prtBad "no cf for" t ----
+
+  where 
+
+    t2c = term2CFItems m
+
+    -- optimize the number of rules by a factorization
+    tryMkCFTerm :: [[PreCFItem]] -> Err [[PreCFItem]]  
+    tryMkCFTerm ii@(its:itss) | all (\x -> length x == length its) itss =
+      case mapM mkOne (counterparts ii) of
+        Ok tt -> return [tt]
+        _ -> return ii
+       where
+         mkOne cfits = case mapM mkOneTerm cfits of
+           Ok tt -> return $ PTerm (RegAlts (concat (nub tt)))
+           _ -> mkOneNonTerm cfits
+         mkOneTerm (PTerm (RegAlts t)) = return t
+         mkOneTerm _ = Bad ""
+         mkOneNonTerm (n@(PNonterm _ _ _ _) : cc) = 
+           if all (== n) cc 
+	      then return n
+	      else Bad ""
+         mkOneNonTerm _ = Bad ""
+         counterparts ll = [map (!! i) ll | i <- [0..length (head ll) - 1]]
+    tryMkCFTerm itss = return itss
+
+    extrR arg lab = case (arg0,labs) of
+      (Arg (A  cat pos),   [(LV _)]) -> return [[PNonterm (cIQ cat) pos labs False]]
+      (Arg (AB cat b pos), [(LV _)]) -> return [[PNonterm (cIQ cat) pos labs False]]
+      (Arg (A  cat pos),   _)  -> return [[PNonterm (cIQ cat) pos labs True]]
+      (Arg (AB cat b pos), _)  -> return [[PNonterm (cIQ cat) pos labs True]]
+                                     ---- ??
+      _   -> prtBad "cannot extract record field from" arg
+     where 
+       (arg0,labs) = headProj arg [lab]
+
+    headProj r ls = case r of
+      P r0 l0 -> headProj r0 (l0:ls)
+      S r0 _  -> headProj r0 ls
+      _ -> (r,ls)
+    cIQ c = if isPredefCat c then CIQ cPredefAbs c else CIQ m c
+
+mkCFPredef :: Options -> [Ident] -> [CFRuleGroup] -> ([CFRuleGroup],CFPredef)
+mkCFPredef opts binds rules = (ruls, \s -> preds0 s ++ look s) where
+  (ruls,preds) = if oElem lexerByNeed opts  -- option -cflexer
+                   then predefLexer rules 
+                   else (rules,emptyTrie)
+  preds0 s = 
+    [(cat,         metaCFFun)     | TM _ _ <- [s], cat <- cats] ++
+    [(cat,         varCFFun x)    | TV x   <- [s], cat <- catVarCF : bindcats] ++
+    [(cfCatString, stringCFFun t) | TL t   <- [s]]              ++
+    [(cfCatInt,    intCFFun t)    | TI t   <- [s]] ++
+    [(cfCatFloat,  floatCFFun t)  | TF t   <- [s]]
+  cats = nub [c | (_,rs) <- rules, (_,(_,its)) <- rs, CFNonterm c <- its]
+  bindcats = [c | c <- cats, elem (cfCat2Ident c) binds]
+  look = concatMap snd . map (trieLookup preds) . wordsCFTok --- for TC tokens
+
+--- TODO: integrate with morphology
+--- predefLexer :: [CFRuleGroup] -> ([CFRuleGroup],BinTree (CFTok,[(CFCat, CFFun)]))
+predefLexer groups = (reverse ruls, tcompile preds) where
+  (ruls,preds) = foldr mkOne ([],[]) groups
+  mkOne group@(cat,rules) (rs,ps) = (rule:rs,pre ++ ps) where
+    (rule,pre) = case partition isLexical rules of
+      ([],_) -> (group,[])
+      (ls,rest) -> ((cat,rest), concatMap mkLexRule ls)
+  isLexical (f,(c,its)) = case its of
+    [CFTerm (RegAlts ws)] -> True
+    _ -> False
+  mkLexRule r = case r of
+    (fun,(cat,[CFTerm (RegAlts ws)])) -> [(w, [(cat,fun)]) | w <- ws]
+    _ -> []
diff --git a/src-2.9/GF/CF/ChartParser.hs b/src-2.9/GF/CF/ChartParser.hs
new file mode 100644
index 000000000..740c4d787
--- /dev/null
+++ b/src-2.9/GF/CF/ChartParser.hs
@@ -0,0 +1,206 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ChartParser
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:12 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.10 $
+--
+-- Bottom-up Kilbury chart parser from "Pure Functional Parsing", chapter 5.
+-- OBSOLETE -- should use new MCFG parsers instead 
+-----------------------------------------------------------------------------
+
+module GF.CF.ChartParser (chartParser) where
+
+-- import Tracing
+-- import PrintParser
+-- import PrintSimplifiedTerm
+
+import GF.Data.Operations
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.CF.PPrCF (prCFItem)
+
+import GF.Data.OrdSet
+import GF.Data.OrdMap2
+
+import Data.List (groupBy)
+
+type Token      = CFTok
+type Name       = CFFun
+type Category   = CFItem
+type Grammar    = ([Production], Terminal)
+type Production = (Name, Category, [Category])
+type Terminal   = Token -> [(Category, Maybe Name)]
+type GParser    = Grammar -> Category -> [Token] -> ([ParseTree],String)
+data ParseTree  = Node Name Category [ParseTree] | Leaf Token
+
+maxTake :: Int
+-- maxTake = 1000
+maxTake = maxBound
+
+--------------------------------------------------
+-- converting between GF parsing and CFG parsing
+
+buildParser :: GParser -> CF -> CFCat -> CFParser
+buildParser gparser cf = parse
+  where 
+    parse = \start input -> 
+            let parse2 = parse' (CFNonterm start) input in 
+	    (take maxTake [(parse2tree t, []) | t <- fst parse2], snd parse2) 
+    parse' = gparser (cf2grammar cf)
+
+cf2grammar :: CF -> Grammar
+cf2grammar cf = (productions, terminal)
+  where 
+    productions  = [ (name, CFNonterm cat, rhs) | 
+		     (name, (cat, rhs)) <- cfRules ]
+    terminal tok = [ (CFNonterm cat, Just name) |
+		     (cat, name) <- cfPredef tok ] 
+		   ++
+		   [ (item, Nothing) |
+		     item <- elems rhsItems,
+		     matchCFTerm item tok ]
+    cfRules  = rulesOfCF cf
+    cfPredef = predefOfCF cf
+    rhsItems :: Set Category
+    rhsItems = union [ makeSet rhs | (_, (_, rhs)) <- cfRules ]
+
+parse2tree :: ParseTree -> CFTree
+parse2tree (Node name (CFNonterm cat) trees) = CFTree (name, (cat, trees')) 
+  where
+    trees' = [ parse2tree t | t@(Node _ _ _) <- trees ]   -- ignore leafs
+
+maybeNode :: Maybe Name -> Category -> Token -> ParseTree
+maybeNode (Just name) cat tok = Node name cat [Leaf tok]
+maybeNode Nothing     _   tok = Leaf tok
+
+
+--------------------------------------------------
+-- chart parsing (bottom up kilbury-like)
+
+type Chart   = [CState]
+type CState  = Set Edge 
+type Edge    = (Int, Category, [Category])
+type Passive = (Int, Int, Category)
+
+chartParser :: CF -> CFCat -> CFParser
+chartParser = buildParser chartParser0
+
+chartParser0 :: GParser
+chartParser0 (productions, terminal) = cparse
+  where
+    emptyCats :: Set Category
+    emptyCats = empties emptySet
+      where 
+        empties cats | cats==cats' = cats
+		     | otherwise   = empties cats'
+	  where cats' = makeSet [ cat | (_, cat, rhs) <- productions,
+				        all (`elemSet` cats) rhs ]
+
+    grammarMap :: Map Category [(Name, [Category])]
+    grammarMap = makeMapWith (++) 
+		 [ (cat, [(name,rhs)]) | (name, cat, rhs) <- productions ]
+
+    leftCornerMap :: Map Category (Set (Category,[Category]))
+    leftCornerMap = makeMapWith (<++>) [ (a, unitSet (b, bs)) | 
+					 (_, b, abs) <- productions, 
+					 (a : bs) <- removeNullable abs ]
+
+    removeNullable :: [Category] -> [[Category]]
+    removeNullable [] = []
+    removeNullable cats@(cat:cats')
+	| cat `elemSet` emptyCats = cats : removeNullable cats'
+	| otherwise               = [cats]
+
+    cparse :: Category -> [Token] -> ([ParseTree], String)
+    cparse start input = -- trace "ChartParser" $
+			 case lookup (0, length input, start) $
+			      -- tracePrt "#edgeTrees" (prt . map (length.snd)) $
+			      edgeTrees of
+			   Just trees -> -- tracePrt "#trees" (prt . length . fst) $
+					 (trees, "Chart:" ++++ prChart passiveEdges)
+			   Nothing    -> ([],    "Chart:" ++++ prChart passiveEdges)
+      where 
+        finalChart :: Chart
+        finalChart = map buildState initialChart
+
+        finalChartMap :: [Map Category (Set Edge)]
+	finalChartMap = map stateMap finalChart
+
+        stateMap :: CState -> Map Category (Set Edge)
+	stateMap state = makeMapWith (<++>) [ (a, unitSet (i,b,bs)) |
+					      (i, b, a:bs) <- elems state ]
+
+        initialChart :: Chart
+        initialChart = -- tracePrt "#initialChart" (prt . map (length.elems)) $
+		       emptySet : map initialState (zip [0..] input)
+          where initialState (j, sym) = makeSet [ (j, cat, []) | 
+						  (cat, _) <- terminal sym ]
+
+        buildState :: CState -> CState
+	buildState = limit more
+	  where more (j, a, [])   = ordSet [ (j, b, bs) |
+				             (b, bs) <- elems (lookupWith emptySet leftCornerMap a) ]
+				    <++>
+				    lookupWith emptySet (finalChartMap !! j) a
+		more (j, b, a:bs) = ordSet [ (j, b, bs) |
+					     a `elemSet` emptyCats ]
+
+        passiveEdges :: [Passive]
+	passiveEdges = -- tracePrt "#passiveEdges" (prt . length) $
+		       [ (i, j, cat) |
+			 (j, state) <- zip [0..] $
+			   -- tracePrt "#passiveChart" 
+			   -- (prt . map (length.filter (\(_,_,x)->null x).elems)) $
+			   -- tracePrt "#activeChart" (prt . map (length.elems)) $
+			   finalChart,
+			 (i, cat, []) <- elems state ]
+		       ++
+		       [ (i, i, cat) |
+			 i <- [0 .. length input],
+			 cat <- elems emptyCats ]
+
+        edgeTrees :: [ (Passive, [ParseTree]) ]
+	edgeTrees = [ (edge, treesFor edge) | edge <- passiveEdges ]
+
+        edgeTreesMap :: Map (Int, Category) [(Int, [ParseTree])]
+	edgeTreesMap = makeMapWith (++) [ ((i,c), [(j,trees)]) |
+					  ((i,j,c), trees) <- edgeTrees ]
+
+        treesFor :: Passive -> [ParseTree]
+	treesFor (i, j, cat) = [ Node name cat trees |
+				 (name, rhs) <- lookupWith [] grammarMap cat,
+				 trees <- children rhs i j ]
+			       ++
+			       [ maybeNode name cat tok |
+				 i == j-1,
+				 let tok = input !! i,
+				 Just name <- [lookup cat (terminal tok)] ]
+
+        children :: [Category] -> Int -> Int -> [[ParseTree]]
+	children []     i k = [ [] | i == k ]
+	children (c:cs) i k = [ tree : rest |
+				i <= k,
+				(j, trees) <- lookupWith [] edgeTreesMap (i,c),
+				rest <- children cs j k,
+				tree <- trees ]
+
+
+{-
+instance Print ParseTree where
+    prt (Node name cat trees) = prt name++"."++prt cat++"^{"++prtSep "," trees++"}"
+    prt (Leaf token) = prt token
+-}
+
+-- AR 10/12/2002
+
+prChart :: [Passive] -> String
+prChart = unlines . map (unwords . map prOne) . positions where
+  prOne (i,j,it) = show i ++ "-" ++ show j ++ "-" ++ prCFItem it
+  positions = groupBy (\ (i,_,_) (j,_,_) -> i == j) 
+
+
diff --git a/src-2.9/GF/CF/EBNF.hs b/src-2.9/GF/CF/EBNF.hs
new file mode 100644
index 000000000..f091d19cb
--- /dev/null
+++ b/src-2.9/GF/CF/EBNF.hs
@@ -0,0 +1,191 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : EBNF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:13 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.CF.EBNF (pEBNFasGrammar) where
+
+import GF.Data.Operations
+import GF.Data.Parsers
+import GF.Infra.Comments
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.Grammar.Grammar
+import GF.Grammar.PrGrammar
+import GF.CF.CFtoGrammar
+import qualified GF.Source.AbsGF as A
+
+import Data.List (nub, partition)
+
+-- AR 18/4/2000 - 31/3/2004
+
+-- Extended BNF grammar with token type a
+-- put a = String for simple applications
+
+type EBNF = [ERule]
+type ERule = (ECat, ERHS)
+type ECat = (String,[Int])
+type ETok = String
+
+ebnfID = "EBNF" ---- make this parametric!
+
+data ERHS =
+   ETerm ETok
+ | ENonTerm ECat
+ | ESeq  ERHS ERHS
+ | EAlt  ERHS ERHS
+ | EStar ERHS
+ | EPlus ERHS
+ | EOpt  ERHS
+ | EEmpty
+
+type CFRHS = [CFItem]
+type CFJustRule = (CFCat, CFRHS)
+
+ebnf2gf :: EBNF -> [A.TopDef]
+ebnf2gf = cf2grammar . rules2CF . ebnf2cf
+
+ebnf2cf :: EBNF -> [CFRule]
+ebnf2cf ebnf = [(mkCFF i rule,rule) | (i,rule) <- zip [0..] (normEBNF ebnf)] where
+  mkCFF i (CFCat (_,c), _) = string2CFFun ebnfID ("Mk" ++ prt c ++ "_" ++ show i)
+
+normEBNF :: EBNF -> [CFJustRule]
+normEBNF erules = let
+  erules1 = [normERule ([i],r) | (i,r) <- zip [0..] erules]
+  erules2 = erules1 ---refreshECats erules1 --- this seems to be just bad !
+  erules3 = concat (map pickERules erules2)
+  erules4 = nubERules erules3
+ in [(mkCFCatE cat, map eitem2cfitem its) | (cat,itss) <- erules3, its <- itss]
+
+refreshECats :: [NormERule] -> [NormERule]
+refreshECats rules = [recas [i] rule | (i,rule) <- zip [0..] rules] where
+ recas ii (cat,its) = (updECat ii cat, [recss ii 0 s | s <- its])
+ recss ii n [] = []
+ recss ii n (s:ss) = recit (ii ++ [n]) s : recss ii (n+1) ss
+ recit ii it = case it of
+   EINonTerm cat  -> EINonTerm (updECat ii cat)
+   EIStar (cat,t) -> EIStar (updECat ii cat, [recss ii 0 s | s <- t])
+   EIPlus (cat,t) -> EIPlus (updECat ii cat, [recss ii 0 s | s <- t])
+   EIOpt  (cat,t) -> EIOpt  (updECat ii cat, [recss ii 0 s | s <- t])
+   _ -> it
+  
+pickERules :: NormERule -> [NormERule]
+pickERules rule@(cat,alts) = rule : concat (map pics (concat alts)) where
+ pics it = case it of
+   EIStar ru@(cat,t) -> mkEStarRules cat ++ pickERules ru
+   EIPlus ru@(cat,t) -> mkEPlusRules cat ++ pickERules ru
+   EIOpt  ru@(cat,t) -> mkEOptRules cat ++ pickERules ru
+   _ -> []
+ mkEStarRules cat = [(cat', [[],[EINonTerm cat, EINonTerm cat']])] 
+                                        where cat' = mkNewECat cat "Star"
+ mkEPlusRules cat = [(cat', [[EINonTerm cat],[EINonTerm cat, EINonTerm cat']])] 
+                                        where cat' = mkNewECat cat "Plus"
+ mkEOptRules cat  = [(cat', [[],[EINonTerm cat]])] 
+                                        where cat' = mkNewECat cat "Opt"
+
+nubERules :: [NormERule] -> [NormERule]
+nubERules rules = nub optim where 
+  optim = map (substERules (map mkSubst replaces)) irreducibles
+  (replaces,irreducibles) = partition reducible rules
+  reducible (cat,[items]) = isNewCat cat && all isOldIt items
+  reducible _ = False
+  isNewCat (_,ints) = ints == []
+  isOldIt (EITerm _) = True
+  isOldIt (EINonTerm cat) = not (isNewCat cat)
+  isOldIt _ = False
+  mkSubst (cat,its) = (cat, head its) -- def of reducible: its must be singleton
+--- the optimization assumes each cat has at most one EBNF rule.
+
+substERules :: [(ECat,[EItem])] -> NormERule -> NormERule
+substERules g (cat,itss) = (cat, map sub itss) where
+  sub [] = []
+  sub (i@(EINonTerm cat') : ii) = case lookup cat g of
+                                    Just its -> its ++ sub ii 
+                                    _ -> i : sub ii
+  sub (EIStar r : ii) = EIStar (substERules g r) : ii
+  sub (EIPlus r : ii) = EIPlus (substERules g r) : ii
+  sub (EIOpt r : ii)  = EIOpt  (substERules g r) : ii
+
+eitem2cfitem :: EItem -> CFItem 
+eitem2cfitem it = case it of
+  EITerm a       -> atomCFTerm $ tS a
+  EINonTerm cat  -> CFNonterm (mkCFCatE cat)
+  EIStar (cat,_) -> CFNonterm (mkCFCatE (mkNewECat cat "Star"))
+  EIPlus (cat,_) -> CFNonterm (mkCFCatE (mkNewECat cat "Plus"))
+  EIOpt  (cat,_) -> CFNonterm (mkCFCatE (mkNewECat cat "Opt"))
+
+type NormERule = (ECat,[[EItem]]) -- disjunction of sequences of items
+
+data EItem =
+   EITerm String
+ | EINonTerm ECat
+ | EIStar NormERule
+ | EIPlus NormERule
+ | EIOpt  NormERule
+  deriving Eq
+
+normERule :: ([Int],ERule) -> NormERule
+normERule (ii,(cat,rhs)) = 
+ (cat,[map (mkEItem (ii ++ [i])) r' | (i,r') <- zip [0..] (disjNorm rhs)]) where
+  disjNorm r = case r of
+    ESeq r1 r2 -> [x ++ y | x <- disjNorm r1, y <- disjNorm r2]
+    EAlt r1 r2 -> disjNorm r1 ++ disjNorm r2
+    EEmpty -> [[]]
+    _ -> [[r]]
+
+mkEItem :: [Int] -> ERHS -> EItem
+mkEItem ii rhs = case rhs of
+  ETerm a -> EITerm a
+  ENonTerm cat -> EINonTerm cat
+  EStar r -> EIStar (normERule (ii,(mkECat ii, r)))
+  EPlus r -> EIPlus (normERule (ii,(mkECat ii, r)))
+  EOpt  r -> EIOpt  (normERule (ii,(mkECat ii, r)))
+  _ -> EINonTerm ("?????",[])
+--  _ -> error "should not happen in ebnf" ---
+
+mkECat ints = ("C", ints)
+
+prECat (c,[]) = c
+prECat (c,ints) = c ++ "_" ++ prTList "_" (map show ints)
+
+mkCFCatE :: ECat -> CFCat
+mkCFCatE = string2CFCat ebnfID . prECat
+
+updECat _ (c,[]) = (c,[])
+updECat ii (c,_) = (c,ii)
+
+mkNewECat (c,ii) str = (c ++ str,ii)
+
+------ parser for EBNF grammars
+
+pEBNFasGrammar :: String -> Err [A.TopDef]
+pEBNFasGrammar = parseResultErr (pEBNF *** ebnf2gf) . remComments
+
+pEBNF :: Parser Char EBNF
+pEBNF = longestOfMany (pJ pERule)
+
+pERule :: Parser Char ERule
+pERule = pECat ... pJ (literals ":=" ||| literals "::=") +.. pERHS 0 ..+ jL ";"
+
+pERHS :: Int -> Parser Char ERHS
+pERHS 0 = pTList "|" (pERHS 1) *** foldr1 EAlt
+pERHS 1 = longestOfMany (pJ (pERHS 2)) *** foldr ESeq EEmpty
+pERHS 2 = pERHS 3 ... pJ pUnaryEOp *** (\ (a,f) -> f a)
+pERHS 3 = pQuotedString *** ETerm
+          ||| pECat *** ENonTerm ||| pParenth (pERHS 0)
+
+pUnaryEOp :: Parser Char (ERHS -> ERHS)
+pUnaryEOp = 
+ lits "*" <<< EStar ||| lits "+" <<< EPlus ||| lits "?" <<< EOpt ||| succeed id
+
+pECat = pIdent *** (\c -> (c,[]))
+
diff --git a/src-2.9/GF/CF/PPrCF.hs b/src-2.9/GF/CF/PPrCF.hs
new file mode 100644
index 000000000..1c2203e94
--- /dev/null
+++ b/src-2.9/GF/CF/PPrCF.hs
@@ -0,0 +1,102 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PPrCF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/15 17:56:13 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.13 $
+--
+-- printing and parsing CF grammars, rules, and trees AR 26/1/2000 -- 9/6/2003
+--
+-- use the Print class instead!
+-----------------------------------------------------------------------------
+
+module GF.CF.PPrCF (prCF, prCFTree, prCFRule, prCFFun, prCFCat, prCFItem, prRegExp, pCF) where
+
+import GF.Data.Operations
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.Canon.AbsGFC
+import GF.Grammar.PrGrammar
+
+import Data.Char
+import Data.List
+
+prCF :: CF -> String
+prCF = unlines . (map prCFRule) . rulesOfCF -- hiding the literal recogn function
+
+prCFTree :: CFTree -> String
+prCFTree (CFTree (fun, (_,trees))) = prCFFun fun ++ prs trees where 
+ prs [] = ""
+ prs ts = " " ++ unwords (map ps ts)
+ ps t@(CFTree (_,(_,[]))) = prCFTree t
+ ps t = prParenth (prCFTree t)
+{-# NOINLINE prCFTree #-}
+-- Workaround ghc 6.8.2 bug
+
+
+prCFRule :: CFRule -> String
+prCFRule (fun,(cat,its)) = 
+  prCFFun fun ++ "." +++ prCFCat cat +++ "::=" +++ 
+  unwords (map prCFItem its) +++ ";"
+
+prCFFun :: CFFun -> String
+prCFFun = prCFFun' True ---- False -- print profiles for debug
+
+prCFFun' :: Bool -> CFFun -> String
+prCFFun' profs (CFFun (t, p)) = prt_ t ++ pp p where
+    pp p = if (not profs || normal p) then "" else "_" ++ concat (map show p)
+    normal p = and [x==y && null b | ((b,x),y) <- zip p (map (:[]) [0..])]
+
+prCFCat :: CFCat -> String
+prCFCat (CFCat (c,l)) = prt_ c ++ case prt_ l of
+  "s" -> []
+  _   -> "-" ++ prt_ l ----
+
+prCFItem :: CFItem -> String
+prCFItem (CFNonterm c) = prCFCat c
+prCFItem (CFTerm a) = prRegExp a
+
+prRegExp :: RegExp -> String
+prRegExp (RegAlts tt) = case tt of
+  [t] -> prQuotedString t
+  _ -> prParenth (prTList " | " (map prQuotedString tt))
+
+-- rules have an amazingly easy parser, if we use the format
+-- fun. C -> item1 item2 ... where unquoted items are treated as cats
+-- Actually would be nice to add profiles to this.
+
+getCFRule :: String -> String -> Err [CFRule]
+getCFRule mo s = getcf (wrds s) where
+  getcf ws = case ws of
+    fun : cat : a : its | isArrow a -> 
+      Ok [(string2CFFun mo (init fun), 
+            (string2CFCat mo cat, map mkIt its))]
+    cat : a : its | isArrow a -> 
+      Ok [(string2CFFun mo (mkFun cat it), 
+            (string2CFCat mo cat, map mkIt it)) | it <- chunk its]
+    _ -> Bad (" invalid rule:" +++ s)
+  isArrow a = elem a ["->", "::="] 
+  mkIt w = case w of
+    ('"':w@(_:_)) -> atomCFTerm (string2CFTok (init w))
+    _             -> CFNonterm (string2CFCat mo w)
+  chunk its = case its of
+    [] -> [[]]
+    _ -> chunks "|" its
+  mkFun cat its = case its of
+    [] -> cat ++ "_"
+    _ -> concat $ intersperse "_" (cat : map clean its) -- CLE style
+  clean = filter isAlphaNum -- to form valid identifiers
+  wrds = takeWhile (/= ";") . words -- to permit semicolon in the end
+
+pCF :: String -> String -> Err [CFRule]
+pCF mo s = do
+  rules <- mapM (getCFRule mo) $ filter isRule $ lines s
+  return $ concat rules
+ where
+   isRule line = case dropWhile isSpace line of
+     '-':'-':_ -> False
+     _ -> not $ all isSpace line
diff --git a/src-2.9/GF/CF/PrLBNF.hs b/src-2.9/GF/CF/PrLBNF.hs
new file mode 100644
index 000000000..4ba2019bc
--- /dev/null
+++ b/src-2.9/GF/CF/PrLBNF.hs
@@ -0,0 +1,150 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrLBNF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 14:15:16 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.11 $
+--
+-- Printing CF grammars generated from GF as LBNF grammar for BNFC.
+-- AR 26/1/2000 -- 9/6/2003 (PPrCF) -- 8/11/2003 -- 27/9/2004.
+-- With primitive error messaging, by rules and rule tails commented out
+-----------------------------------------------------------------------------
+
+module GF.CF.PrLBNF (prLBNF,prBNF) where
+
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.Canon.AbsGFC
+import GF.Infra.Ident
+import GF.Grammar.PrGrammar
+import GF.Compile.ShellState
+import GF.Canon.GFC
+import GF.Canon.Look
+
+import GF.Data.Operations
+import GF.Infra.Modules
+
+import Data.Char
+import Data.List (nub)
+
+prLBNF :: Bool -> StateGrammar -> String
+prLBNF new gr = unlines $ pragmas ++ (map (prCFRule cs) rules')
+  where    
+    cs = map IC ["Int","String"] ++ [catIdPlus c | (_,(c,_)) <- rules]
+    cf = stateCF gr
+    (pragmas,rules) = if new  -- tries to treat precedence levels
+                         then mkLBNF (stateGrammarST gr) $ rulesOfCF cf
+                         else ([],rulesOfCF cf) -- "normal" behaviour
+    rules' = concatMap expand rules
+    expand (f,(c,its)) = [(f,(c,it)) | it <- combinations (map expIt its)]
+    expIt i = case i of
+      CFTerm (RegAlts ss) -> [CFTerm (RegAlts [s]) | s <- ss]
+      _ -> [i]
+
+-- | a hack to hide the LBNF details
+prBNF :: Bool -> StateGrammar -> String
+prBNF b = unlines . (map (unwords . unLBNF . drop 1 . words)) . lines . prLBNF b
+  where
+    unLBNF r = case r of
+      "---":ts -> ts
+      ";":"---":ts -> ts
+      c:ts -> c : unLBNF ts
+      _ -> r
+
+--- | awful low level code without abstraction over label names etc
+mkLBNF :: CanonGrammar -> [CFRule] -> ([String],[CFRule])
+mkLBNF gr rules = (coercions, nub $ concatMap mkRule rules) where
+  coercions = ["coercions" +++ prt_ c +++ show n +++ ";"  | 
+    (_,ModMod m) <- modules gr,
+    (c,CncCat (RecType ls) _ _) <- tree2list $ jments m,
+    Lbg (L (IC "p")) (TInts n) <- ls
+    ]
+  precedences = [(f,(prec,assoc))  | 
+    (_,ModMod m) <- modules gr,
+    (f,CncFun _ _ (R lin) _) <- tree2list $ jments m,
+    (Just prec, Just assoc) <- [(
+       lookup "p" [(lab,p) | Ass (L (IC lab)) (EInt p) <- lin],
+       lookup "a" [(lab,a) | Ass (L (IC lab)) (Par (CIQ _ (IC a)) []) <- lin]
+       )]
+    ]
+  precfuns = map fst precedences
+  mkRule r@(fun@(CFFun (t, p)),(cat,its)) = case t of
+    AC (CIQ _ c) -> case lookup c precedences of
+      Just (prec,assoc) -> [(fun,(mkCat prec cat,mkIts cat prec assoc 0 its))]
+      _ -> return r
+    AD (CIQ _ c) -> case lookup c precedences of
+      Just (prec,assoc) -> [(fun,(mkCat prec cat,mkIts cat prec assoc 0 its))]
+      _ -> return r
+    _ -> return r
+  mkIts cat prec assoc i its = case its of
+    CFTerm (RegAlts ["("]):n@(CFNonterm k):CFTerm (RegAlts [")"]):rest | k==cat -> 
+      mkIts cat prec assoc i $ n:rest  -- remove variants with parentheses 
+    CFNonterm k:rest | k==cat -> 
+      CFNonterm (mkNonterm prec assoc i k) : mkIts cat prec assoc (i+1) rest
+    it:rest -> it:mkIts cat prec assoc i rest
+    [] -> []
+
+  mkCat prec (CFCat ((CIQ m (IC c)),l)) = CFCat ((CIQ m (IC (c ++ show prec ++ "+"))),l)
+  mkNonterm prec assoc i cat = mkCat prec' cat 
+    where 
+      prec' = case (assoc,i) of
+        ("PL",0) -> prec
+        ("PR",0) -> prec + 1
+        ("PR",_) -> prec
+        _        -> prec + 1
+
+catId ((CFCat ((CIQ _ c),l))) = c
+
+catIdPlus ((CFCat ((CIQ _ c@(IC s)),l))) = case reverse s of
+  '+':cs -> IC $ reverse $ dropWhile isDigit cs
+  _ -> c
+
+prCFRule :: [Ident] -> CFRule -> String
+prCFRule cs (fun,(cat,its)) = 
+  prCFFun cat fun ++ "." +++ prCFCat True cat +++ "::=" +++  --- err in cat -> in syntax
+  unwords (map (prCFItem cs) its) +++ ";"
+
+prCFFun :: CFCat -> CFFun -> String
+prCFFun (CFCat (_,l)) (CFFun (t, p)) = case t of
+  AC (CIQ _ x) -> let f = prId True x in (f ++ lab +++ f2 f +++ prP p)
+  AD (CIQ _ x) -> let f = prId True x in (f ++ lab +++ f2 f +++ prP p)
+  _ -> prErr True $ prt t
+ where
+   lab = prLab l
+   f2 f = if null lab then "" else f
+   prP = concatMap show
+   
+prId b i = case i of
+     IC "Int"  -> "Integer"
+     IC "#Var" -> "Ident"
+     IC "Var"  -> "Ident"
+     IC "id_"  -> "_"
+     IC s@(c:_) | last s == '+' -> init s  -- hack to save precedence information
+     IC s@(c:_) | isUpper c -> s ++ if isDigit (last s) then "_" else ""
+     _ -> prErr b $ prt i
+
+prLab i = case i of
+     L (IC "s") -> "" ---
+     L (IC "_") -> "" ---
+     _ -> let x = prt i in "_" ++ x ++ if isDigit (last x) then "_" else ""
+
+-- | just comment out the rest if you cannot interpret the function name in LBNF
+-- two versions, depending on whether in the beginning of a rule or elsewhere;
+-- in the latter case, error just terminates the rule 
+prErr :: Bool -> String -> String
+prErr b s = (if b then "" else " ;") +++ "---" +++ s
+
+prCFCat :: Bool -> CFCat -> String
+prCFCat b (CFCat ((CIQ _ c),l)) = prId b c ++ prLab l ----
+
+-- | if a category does not have a production of its own, we replace it by Ident
+prCFItem cs (CFNonterm c) = if elem (catIdPlus c) cs then prCFCat False c else "Ident"
+prCFItem _ (CFTerm a) = prRegExp a
+
+prRegExp (RegAlts tt) = case tt of
+  [t] -> prQuotedString t
+  _ -> prErr False $ prParenth (prTList " | " (map prQuotedString tt))
diff --git a/src-2.9/GF/CF/Profile.hs b/src-2.9/GF/CF/Profile.hs
new file mode 100644
index 000000000..e573bec78
--- /dev/null
+++ b/src-2.9/GF/CF/Profile.hs
@@ -0,0 +1,106 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Profile
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:14 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- restoring parse trees for discontinuous constituents, bindings, etc. AR 25/1/2001
+-- revised 8/4/2002 for the new profile structure
+-----------------------------------------------------------------------------
+
+module GF.CF.Profile (postParse) where
+
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import qualified GF.Infra.Ident as I
+import GF.Canon.CMacros
+---import MMacros
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.CF.PPrCF -- for error msg
+import GF.Grammar.PrGrammar
+
+import GF.Data.Operations
+
+import Control.Monad
+import Data.List (nub)
+
+-- | the job is done in two passes: 
+-- 
+--   1. tree2term: restore constituent order from Profile 
+-- 
+--   2. term2trm:  restore Bindings from Binds
+postParse :: CFTree -> Err Exp
+postParse tree = do
+  iterm <- errIn ("postprocessing parse tree" +++ prCFTree tree) $ tree2term tree
+  return $ term2trm  iterm
+
+-- | an intermediate data structure
+data ITerm = ITerm (Atom, BindVs) [ITerm] | IMeta   deriving (Eq,Show)
+type BindVs = [[I.Ident]]
+
+-- | (1) restore constituent order from Profile 
+tree2term :: CFTree -> Err ITerm
+-- tree2term (CFTree (f,(_,[t]))) | f == dummyCFFun = tree2term t -- not used
+tree2term (CFTree (cff@(CFFun (fun,pro)), (_,trees))) = case fun of
+  AM _ -> return IMeta
+  _ -> do
+    args  <- mapM mkArg pro
+    binds <- mapM mkBinds pro
+    return $ ITerm (fun, binds) args
+ where
+   mkArg (_,arg) = case arg of
+     [x] -> do               -- one occurrence
+       trx <- trees !? x
+       tree2term trx
+     []  -> return IMeta     -- suppression
+     _   -> do               -- reduplication
+       trees' <- mapM (trees !?) arg
+       xs1    <- mapM tree2term trees' 
+       xs2    <- checkArity xs1
+       unif xs2
+
+   checkArity xs = if length (nub [length xx | ITerm _ xx <- xs']) > 1 
+                   then Bad "arity error" 
+                   else return xs'
+           where xs' = [t | t@(ITerm _ _) <- xs]
+   unif xs = case [t | t@(ITerm _ _) <- xs] of 
+    [] -> return $ IMeta
+    (ITerm fp@(f,_) xx : ts) -> do
+      let hs = [h | ITerm (h,_) _ <- ts, h /= f]
+      testErr (null hs)                 -- if fails, hs must be nonempty
+              ("unification expects" +++ prt f +++ "but found" +++ prt (head hs))
+      xx' <- mapM unifArg [0 .. length xx - 1]
+      return $ ITerm fp xx'
+    where
+      unifArg i = unif [zz !! i | ITerm _ zz <- xs]
+
+   mkBinds (xss,_) = mapM mkBind xss
+   mkBind xs = do
+     ts <- mapM (trees !?) xs
+     let vs = [x | CFTree (CFFun (AV x,_),(_,[])) <- ts]
+     testErr (length ts == length vs) "non-variable in bound position"
+     case vs of
+       [x]  -> return x
+       []   -> return $ I.identC "h_" ---- uBoundVar
+       y:ys -> do
+         testErr (all (==y) ys) ("fail to unify bindings of" +++ prt y)
+         return y
+
+-- | (2) restore Bindings from Binds
+term2trm :: ITerm -> Exp 
+term2trm IMeta = EAtom (AM 0) ---- mExp0
+term2trm (ITerm (fun, binds) terms) =
+  let bterms = zip binds terms
+  in mkAppAtom fun [mkAbsR xs (term2trm t) |  (xs,t) <- bterms]
+
+ --- these are deprecated
+ where
+   mkAbsR c e = foldr EAbs e c
+   mkAppAtom a = mkApp (EAtom a)
+   mkApp = foldl EApp
diff --git a/src-2.9/GF/CFGM/AbsCFG.hs b/src-2.9/GF/CFGM/AbsCFG.hs
new file mode 100644
index 000000000..063b96802
--- /dev/null
+++ b/src-2.9/GF/CFGM/AbsCFG.hs
@@ -0,0 +1,45 @@
+module GF.CFGM.AbsCFG where
+
+-- Haskell module generated by the BNF converter
+
+newtype Ident = Ident String deriving (Eq,Ord,Show)
+newtype SingleQuoteString = SingleQuoteString String deriving (Eq,Ord,Show)
+data Grammars =
+   Grammars [Grammar]
+  deriving (Eq,Ord,Show)
+
+data Grammar =
+   Grammar Ident [Flag] [Rule]
+  deriving (Eq,Ord,Show)
+
+data Flag =
+   StartCat Category
+  deriving (Eq,Ord,Show)
+
+data Rule =
+   Rule Fun Profiles Category [Symbol]
+  deriving (Eq,Ord,Show)
+
+data Fun =
+   Cons Ident
+ | Coerce
+  deriving (Eq,Ord,Show)
+
+data Profiles =
+   Profiles [Profile]
+  deriving (Eq,Ord,Show)
+
+data Profile =
+   UnifyProfile [Integer]
+ | ConstProfile Ident
+  deriving (Eq,Ord,Show)
+
+data Symbol =
+   CatS Category
+ | TermS String
+  deriving (Eq,Ord,Show)
+
+data Category =
+   Category SingleQuoteString
+  deriving (Eq,Ord,Show)
+
diff --git a/src-2.9/GF/CFGM/CFG.cf b/src-2.9/GF/CFGM/CFG.cf
new file mode 100644
index 000000000..fa722f4a4
--- /dev/null
+++ b/src-2.9/GF/CFGM/CFG.cf
@@ -0,0 +1,36 @@
+entrypoints Grammars;
+
+Grammars. Grammars ::= [Grammar];
+
+Grammar. Grammar ::= "grammar" Ident [Flag] [Rule] "end" "grammar";
+separator Grammar "";
+
+StartCat. Flag ::= "startcat" Category;
+terminator Flag ";";
+
+Rule. Rule ::= Fun ":" Profiles "." Category "->" [Symbol];
+terminator Rule ";";
+
+Cons. Fun ::= Ident ;
+Coerce. Fun ::= "_" ;
+
+Profiles. Profiles ::= "[" [Profile] "]";
+
+separator Profile ",";
+
+UnifyProfile. Profile ::= "[" [Integer] "]";
+ConstProfile. Profile ::= Ident ;
+
+separator Integer ",";
+
+CatS. Symbol ::= Category;
+TermS. Symbol ::= String;
+
+-- separator Symbol "";
+[]. [Symbol] ::= "." ;
+(:[]). [Symbol] ::= Symbol ;
+(:). [Symbol] ::= Symbol [Symbol] ;
+
+Category. Category ::= SingleQuoteString ;
+
+token SingleQuoteString '\'' ((char - ["'\\"]) | ('\\' ["'\\"]))* '\'' ;
diff --git a/src-2.9/GF/CFGM/LexCFG.hs b/src-2.9/GF/CFGM/LexCFG.hs
new file mode 100644
index 000000000..e58fdff5a
--- /dev/null
+++ b/src-2.9/GF/CFGM/LexCFG.hs
@@ -0,0 +1,312 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LINE 3 "LexCFG.x" #-}
+module GF.CFGM.LexCFG where
+
+import GF.Data.ErrM
+
+
+#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# "\xf8\xff\xfd\xff\x02\x00\x00\x00\xd2\xff\x00\x00\xfa\xff\xfc\xff\x2d\x00\xc8\x00\x98\x01\x00\x00\x73\x00\x43\x01\x01\x01\x43\x00"#
+
+alex_table :: AlexAddr
+alex_table = AlexA# "\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x02\x00\x00\x00\x06\x00\x00\x00\x05\x00\x02\x00\x05\x00\x03\x00\x04\x00\x03\x00\x00\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x03\x00\x07\x00\x03\x00\x08\x00\x03\x00\x08\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x0e\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x0a\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0d\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\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\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0e\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00"#
+
+alex_check :: AlexAddr
+alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\xff\xff\x20\x00\xff\xff\x27\x00\xff\xff\x27\x00\x20\x00\x27\x00\x2c\x00\x2d\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\x3a\x00\x3b\x00\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\x5b\x00\x27\x00\x5d\x00\x5c\x00\x5f\x00\x5c\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x22\x00\xff\xff\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\xff\xff\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\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\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00"#
+
+alex_deflt :: AlexAddr
+alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x07\x00\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0d\x00\xff\xff\xff\xff"#
+
+alex_accept = listArray (0::Int,15) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[],[(AlexAcc (alex_action_2))],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[],[],[],[(AlexAcc (alex_action_5))]]
+{-# LINE 33 "LexCFG.x" #-}
+
+tok f p s = f p s
+
+share :: String -> String
+share = id
+
+data Tok =
+   TS !String     -- reserved words
+ | TL !String     -- string literals
+ | TI !String     -- integer literals
+ | TV !String     -- identifiers
+ | TD !String     -- double precision float literals
+ | TC !String     -- character literals
+ | T_SingleQuoteString !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_SingleQuoteString 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 "end" N N) (b "startcat" 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_1 = tok (\p s -> PT p (TS $ share s)) 
+alex_action_2 = tok (\p s -> PT p (eitherResIdent (T_SingleQuoteString . 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))    
+{-# 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" #-}
+
+
+
+
+
+
+
+
+
+
+
+data AlexAddr = AlexA# Addr#
+
+{-# INLINE alexIndexShortOffAddr #-}
+alexIndexShortOffAddr (AlexA# 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#
+
+
+
+
+-- -----------------------------------------------------------------------------
+-- 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 `unsafeAt` (I# (s)))
+  in
+  new_acc `seq`
+  case alexGetChar input of
+     Nothing -> (new_acc, input)
+     Just (c, new_input) -> 
+
+
+
+	let
+		base   = alexIndexShortOffAddr alex_base s
+		(I# (ord_c)) = ord c
+		offset = (base +# ord_c)
+		check  = alexIndexShortOffAddr alex_check offset
+		
+		new_s = if (offset >=# 0#) && (check ==# ord_c)
+			  then alexIndexShortOffAddr alex_table offset
+			  else alexIndexShortOffAddr 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-2.9/GF/CFGM/LexCFG.x b/src-2.9/GF/CFGM/LexCFG.x
new file mode 100644
index 000000000..f3ecb14eb
--- /dev/null
+++ b/src-2.9/GF/CFGM/LexCFG.x
@@ -0,0 +1,135 @@
+-- -*- haskell -*-
+-- This Alex file was machine-generated by the BNF converter
+{
+module LexCFG where
+
+import ErrM
+
+}
+
+
+$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 =    -- reserved words consisting of special symbols
+   \; | \: | \. | \- \> | \_ | \[ | \] | \,
+
+:-
+
+$white+ ;
+@rsyms { tok (\p s -> PT p (TS $ share s)) }
+\' ($u # [\' \\]| \\ [\' \\]) * \' { tok (\p s -> PT p (eitherResIdent (T_SingleQuoteString . 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))    }
+
+
+{
+
+tok f p s = f p s
+
+share :: String -> String
+share = id
+
+data Tok =
+   TS !String     -- reserved words
+ | TL !String     -- string literals
+ | TI !String     -- integer literals
+ | TV !String     -- identifiers
+ | TD !String     -- double precision float literals
+ | TC !String     -- character literals
+ | T_SingleQuoteString !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_SingleQuoteString 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 "end" N N) (b "startcat" 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-2.9/GF/CFGM/ParCFG.hs b/src-2.9/GF/CFGM/ParCFG.hs
new file mode 100644
index 000000000..cb70ef30d
--- /dev/null
+++ b/src-2.9/GF/CFGM/ParCFG.hs
@@ -0,0 +1,779 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+module GF.CFGM.ParCFG where
+import GF.CFGM.AbsCFG
+import GF.CFGM.LexCFG
+import GF.Data.ErrM
+import Array
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts
+#else
+import GlaExts
+#endif
+
+-- parser produced by Happy Version 1.15
+
+newtype HappyAbsSyn  = HappyAbsSyn (() -> ())
+happyIn4 :: (Ident) -> (HappyAbsSyn )
+happyIn4 x = unsafeCoerce# x
+{-# INLINE happyIn4 #-}
+happyOut4 :: (HappyAbsSyn ) -> (Ident)
+happyOut4 x = unsafeCoerce# x
+{-# INLINE happyOut4 #-}
+happyIn5 :: (Integer) -> (HappyAbsSyn )
+happyIn5 x = unsafeCoerce# x
+{-# INLINE happyIn5 #-}
+happyOut5 :: (HappyAbsSyn ) -> (Integer)
+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 :: (SingleQuoteString) -> (HappyAbsSyn )
+happyIn7 x = unsafeCoerce# x
+{-# INLINE happyIn7 #-}
+happyOut7 :: (HappyAbsSyn ) -> (SingleQuoteString)
+happyOut7 x = unsafeCoerce# x
+{-# INLINE happyOut7 #-}
+happyIn8 :: (Grammars) -> (HappyAbsSyn )
+happyIn8 x = unsafeCoerce# x
+{-# INLINE happyIn8 #-}
+happyOut8 :: (HappyAbsSyn ) -> (Grammars)
+happyOut8 x = unsafeCoerce# x
+{-# INLINE happyOut8 #-}
+happyIn9 :: (Grammar) -> (HappyAbsSyn )
+happyIn9 x = unsafeCoerce# x
+{-# INLINE happyIn9 #-}
+happyOut9 :: (HappyAbsSyn ) -> (Grammar)
+happyOut9 x = unsafeCoerce# x
+{-# INLINE happyOut9 #-}
+happyIn10 :: ([Grammar]) -> (HappyAbsSyn )
+happyIn10 x = unsafeCoerce# x
+{-# INLINE happyIn10 #-}
+happyOut10 :: (HappyAbsSyn ) -> ([Grammar])
+happyOut10 x = unsafeCoerce# x
+{-# INLINE happyOut10 #-}
+happyIn11 :: (Flag) -> (HappyAbsSyn )
+happyIn11 x = unsafeCoerce# x
+{-# INLINE happyIn11 #-}
+happyOut11 :: (HappyAbsSyn ) -> (Flag)
+happyOut11 x = unsafeCoerce# x
+{-# INLINE happyOut11 #-}
+happyIn12 :: ([Flag]) -> (HappyAbsSyn )
+happyIn12 x = unsafeCoerce# x
+{-# INLINE happyIn12 #-}
+happyOut12 :: (HappyAbsSyn ) -> ([Flag])
+happyOut12 x = unsafeCoerce# x
+{-# INLINE happyOut12 #-}
+happyIn13 :: (Rule) -> (HappyAbsSyn )
+happyIn13 x = unsafeCoerce# x
+{-# INLINE happyIn13 #-}
+happyOut13 :: (HappyAbsSyn ) -> (Rule)
+happyOut13 x = unsafeCoerce# x
+{-# INLINE happyOut13 #-}
+happyIn14 :: ([Rule]) -> (HappyAbsSyn )
+happyIn14 x = unsafeCoerce# x
+{-# INLINE happyIn14 #-}
+happyOut14 :: (HappyAbsSyn ) -> ([Rule])
+happyOut14 x = unsafeCoerce# x
+{-# INLINE happyOut14 #-}
+happyIn15 :: (Fun) -> (HappyAbsSyn )
+happyIn15 x = unsafeCoerce# x
+{-# INLINE happyIn15 #-}
+happyOut15 :: (HappyAbsSyn ) -> (Fun)
+happyOut15 x = unsafeCoerce# x
+{-# INLINE happyOut15 #-}
+happyIn16 :: (Profiles) -> (HappyAbsSyn )
+happyIn16 x = unsafeCoerce# x
+{-# INLINE happyIn16 #-}
+happyOut16 :: (HappyAbsSyn ) -> (Profiles)
+happyOut16 x = unsafeCoerce# x
+{-# INLINE happyOut16 #-}
+happyIn17 :: ([Profile]) -> (HappyAbsSyn )
+happyIn17 x = unsafeCoerce# x
+{-# INLINE happyIn17 #-}
+happyOut17 :: (HappyAbsSyn ) -> ([Profile])
+happyOut17 x = unsafeCoerce# x
+{-# INLINE happyOut17 #-}
+happyIn18 :: (Profile) -> (HappyAbsSyn )
+happyIn18 x = unsafeCoerce# x
+{-# INLINE happyIn18 #-}
+happyOut18 :: (HappyAbsSyn ) -> (Profile)
+happyOut18 x = unsafeCoerce# x
+{-# INLINE happyOut18 #-}
+happyIn19 :: ([Integer]) -> (HappyAbsSyn )
+happyIn19 x = unsafeCoerce# x
+{-# INLINE happyIn19 #-}
+happyOut19 :: (HappyAbsSyn ) -> ([Integer])
+happyOut19 x = unsafeCoerce# x
+{-# INLINE happyOut19 #-}
+happyIn20 :: (Symbol) -> (HappyAbsSyn )
+happyIn20 x = unsafeCoerce# x
+{-# INLINE happyIn20 #-}
+happyOut20 :: (HappyAbsSyn ) -> (Symbol)
+happyOut20 x = unsafeCoerce# x
+{-# INLINE happyOut20 #-}
+happyIn21 :: ([Symbol]) -> (HappyAbsSyn )
+happyIn21 x = unsafeCoerce# x
+{-# INLINE happyIn21 #-}
+happyOut21 :: (HappyAbsSyn ) -> ([Symbol])
+happyOut21 x = unsafeCoerce# x
+{-# INLINE happyOut21 #-}
+happyIn22 :: (Category) -> (HappyAbsSyn )
+happyIn22 x = unsafeCoerce# x
+{-# INLINE happyIn22 #-}
+happyOut22 :: (HappyAbsSyn ) -> (Category)
+happyOut22 x = unsafeCoerce# x
+{-# INLINE happyOut22 #-}
+happyInTok :: Token -> (HappyAbsSyn )
+happyInTok x = unsafeCoerce# x
+{-# INLINE happyInTok #-}
+happyOutTok :: (HappyAbsSyn ) -> Token
+happyOutTok x = unsafeCoerce# x
+{-# INLINE happyOutTok #-}
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\x00\x00\x36\x00\x00\x00\x29\x00\x35\x00\x00\x00\x32\x00\x00\x00\x30\x00\x38\x00\x19\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x34\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x2f\x00\x00\x00\x31\x00\xfd\xff\x00\x00\x2c\x00\x2a\x00\x23\x00\x22\x00\x2b\x00\x25\x00\x20\x00\x00\x00\xfd\xff\x00\x00\x00\x00\x00\x00\x17\x00\x1c\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\x28\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x21\x00\x05\x00\x01\x00\x00\x00\x1d\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x02\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\xf8\xff\x00\x00\xfe\xff\x00\x00\xfa\xff\xf7\xff\x00\x00\xf5\xff\xf2\xff\x00\x00\x00\x00\x00\x00\xe0\xff\xf6\xff\xfb\xff\xf0\xff\x00\x00\x00\x00\xef\xff\x00\x00\xf4\xff\xf9\xff\x00\x00\xf1\xff\x00\x00\xed\xff\xe9\xff\x00\x00\xec\xff\xe8\xff\x00\x00\x00\x00\xe7\xff\x00\x00\xfd\xff\xed\xff\xee\xff\xeb\xff\xea\xff\xe8\xff\x00\x00\xe4\xff\xe2\xff\xf3\xff\xe5\xff\xe3\xff\xfc\xff\xe6\xff\xe1\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x06\x00\x02\x00\x03\x00\x03\x00\x03\x00\x07\x00\x0c\x00\x00\x00\x0a\x00\x00\x00\x08\x00\x01\x00\x10\x00\x11\x00\x12\x00\x10\x00\x11\x00\x12\x00\x12\x00\x12\x00\x0d\x00\x0e\x00\x0d\x00\x0e\x00\x01\x00\x0f\x00\x00\x00\x05\x00\x03\x00\x0c\x00\x00\x00\x09\x00\x05\x00\x0d\x00\x0c\x00\x09\x00\x07\x00\x0b\x00\x0f\x00\x0e\x00\x0f\x00\x04\x00\x08\x00\x06\x00\x04\x00\x0d\x00\x0f\x00\x08\x00\x07\x00\x03\x00\x06\x00\x02\x00\x0a\x00\x01\x00\x01\x00\x11\x00\x0b\x00\xff\xff\x0f\x00\x0c\x00\x0a\x00\xff\xff\xff\xff\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+happyTable :: HappyAddr
+happyTable = HappyA# "\x00\x00\x29\x00\x0c\x00\x1e\x00\x29\x00\x0c\x00\x0c\x00\x0c\x00\x09\x00\x03\x00\x1a\x00\x0a\x00\x1a\x00\x08\x00\x20\x00\x2a\x00\x30\x00\x2c\x00\x2a\x00\x2b\x00\x2c\x00\x1f\x00\x0d\x00\x25\x00\x1c\x00\x1b\x00\x1c\x00\x20\x00\x2f\x00\x0f\x00\x13\x00\x2e\x00\x18\x00\x07\x00\x14\x00\x05\x00\x23\x00\x03\x00\x10\x00\x27\x00\x11\x00\x21\x00\x2f\x00\x0f\x00\x03\x00\x28\x00\x04\x00\x29\x00\x23\x00\x0f\x00\x24\x00\x25\x00\x1f\x00\x1a\x00\x17\x00\x16\x00\x18\x00\x15\x00\xff\xff\x0c\x00\x00\x00\x0f\x00\x03\x00\x07\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyReduceArr = array (1, 31) [
+	(1 , happyReduce_1),
+	(2 , happyReduce_2),
+	(3 , happyReduce_3),
+	(4 , happyReduce_4),
+	(5 , happyReduce_5),
+	(6 , happyReduce_6),
+	(7 , happyReduce_7),
+	(8 , happyReduce_8),
+	(9 , happyReduce_9),
+	(10 , happyReduce_10),
+	(11 , happyReduce_11),
+	(12 , happyReduce_12),
+	(13 , happyReduce_13),
+	(14 , happyReduce_14),
+	(15 , happyReduce_15),
+	(16 , happyReduce_16),
+	(17 , happyReduce_17),
+	(18 , happyReduce_18),
+	(19 , happyReduce_19),
+	(20 , happyReduce_20),
+	(21 , happyReduce_21),
+	(22 , happyReduce_22),
+	(23 , happyReduce_23),
+	(24 , happyReduce_24),
+	(25 , happyReduce_25),
+	(26 , happyReduce_26),
+	(27 , happyReduce_27),
+	(28 , happyReduce_28),
+	(29 , happyReduce_29),
+	(30 , happyReduce_30),
+	(31 , happyReduce_31)
+	]
+
+happy_n_terms = 18 :: Int
+happy_n_nonterms = 19 :: Int
+
+happyReduce_1 = happySpecReduce_1 0# happyReduction_1
+happyReduction_1 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TV happy_var_1)) -> 
+	happyIn4
+		 (Ident happy_var_1
+	)}
+
+happyReduce_2 = happySpecReduce_1 1# happyReduction_2
+happyReduction_2 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> 
+	happyIn5
+		 ((read happy_var_1) :: Integer
+	)}
+
+happyReduce_3 = happySpecReduce_1 2# 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 3# happyReduction_4
+happyReduction_4 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (T_SingleQuoteString happy_var_1)) -> 
+	happyIn7
+		 (SingleQuoteString (happy_var_1)
+	)}
+
+happyReduce_5 = happySpecReduce_1 4# happyReduction_5
+happyReduction_5 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn8
+		 (Grammars (reverse happy_var_1)
+	)}
+
+happyReduce_6 = happyReduce 6# 5# happyReduction_6
+happyReduction_6 (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 happyOut4 happy_x_2 of { happy_var_2 -> 
+	case happyOut12 happy_x_3 of { happy_var_3 -> 
+	case happyOut14 happy_x_4 of { happy_var_4 -> 
+	happyIn9
+		 (Grammar happy_var_2 (reverse happy_var_3) (reverse happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_7 = happySpecReduce_0 6# happyReduction_7
+happyReduction_7  =  happyIn10
+		 ([]
+	)
+
+happyReduce_8 = happySpecReduce_2 6# happyReduction_8
+happyReduction_8 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut9 happy_x_2 of { happy_var_2 -> 
+	happyIn10
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_9 = happySpecReduce_2 7# happyReduction_9
+happyReduction_9 happy_x_2
+	happy_x_1
+	 =  case happyOut22 happy_x_2 of { happy_var_2 -> 
+	happyIn11
+		 (StartCat happy_var_2
+	)}
+
+happyReduce_10 = happySpecReduce_0 8# happyReduction_10
+happyReduction_10  =  happyIn12
+		 ([]
+	)
+
+happyReduce_11 = happySpecReduce_3 8# happyReduction_11
+happyReduction_11 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> 
+	case happyOut11 happy_x_2 of { happy_var_2 -> 
+	happyIn12
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_12 = happyReduce 7# 9# happyReduction_12
+happyReduction_12 (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 happyOut15 happy_x_1 of { happy_var_1 -> 
+	case happyOut16 happy_x_3 of { happy_var_3 -> 
+	case happyOut22 happy_x_5 of { happy_var_5 -> 
+	case happyOut21 happy_x_7 of { happy_var_7 -> 
+	happyIn13
+		 (Rule happy_var_1 happy_var_3 happy_var_5 happy_var_7
+	) `HappyStk` happyRest}}}}
+
+happyReduce_13 = happySpecReduce_0 10# happyReduction_13
+happyReduction_13  =  happyIn14
+		 ([]
+	)
+
+happyReduce_14 = happySpecReduce_3 10# happyReduction_14
+happyReduction_14 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> 
+	case happyOut13 happy_x_2 of { happy_var_2 -> 
+	happyIn14
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_15 = happySpecReduce_1 11# happyReduction_15
+happyReduction_15 happy_x_1
+	 =  case happyOut4 happy_x_1 of { happy_var_1 -> 
+	happyIn15
+		 (Cons happy_var_1
+	)}
+
+happyReduce_16 = happySpecReduce_1 11# happyReduction_16
+happyReduction_16 happy_x_1
+	 =  happyIn15
+		 (Coerce
+	)
+
+happyReduce_17 = happySpecReduce_3 12# happyReduction_17
+happyReduction_17 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_2 of { happy_var_2 -> 
+	happyIn16
+		 (Profiles happy_var_2
+	)}
+
+happyReduce_18 = happySpecReduce_0 13# happyReduction_18
+happyReduction_18  =  happyIn17
+		 ([]
+	)
+
+happyReduce_19 = happySpecReduce_1 13# happyReduction_19
+happyReduction_19 happy_x_1
+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
+	happyIn17
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_20 = happySpecReduce_3 13# happyReduction_20
+happyReduction_20 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
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_21 = happySpecReduce_3 14# happyReduction_21
+happyReduction_21 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut19 happy_x_2 of { happy_var_2 -> 
+	happyIn18
+		 (UnifyProfile happy_var_2
+	)}
+
+happyReduce_22 = happySpecReduce_1 14# happyReduction_22
+happyReduction_22 happy_x_1
+	 =  case happyOut4 happy_x_1 of { happy_var_1 -> 
+	happyIn18
+		 (ConstProfile happy_var_1
+	)}
+
+happyReduce_23 = happySpecReduce_0 15# happyReduction_23
+happyReduction_23  =  happyIn19
+		 ([]
+	)
+
+happyReduce_24 = happySpecReduce_1 15# happyReduction_24
+happyReduction_24 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn19
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_25 = happySpecReduce_3 15# happyReduction_25
+happyReduction_25 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_3 of { happy_var_3 -> 
+	happyIn19
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_26 = happySpecReduce_1 16# happyReduction_26
+happyReduction_26 happy_x_1
+	 =  case happyOut22 happy_x_1 of { happy_var_1 -> 
+	happyIn20
+		 (CatS happy_var_1
+	)}
+
+happyReduce_27 = happySpecReduce_1 16# happyReduction_27
+happyReduction_27 happy_x_1
+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> 
+	happyIn20
+		 (TermS happy_var_1
+	)}
+
+happyReduce_28 = happySpecReduce_1 17# happyReduction_28
+happyReduction_28 happy_x_1
+	 =  happyIn21
+		 ([]
+	)
+
+happyReduce_29 = happySpecReduce_1 17# happyReduction_29
+happyReduction_29 happy_x_1
+	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_30 = happySpecReduce_2 17# happyReduction_30
+happyReduction_30 happy_x_2
+	happy_x_1
+	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
+	case happyOut21 happy_x_2 of { happy_var_2 -> 
+	happyIn21
+		 ((:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_31 = happySpecReduce_1 18# happyReduction_31
+happyReduction_31 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn22
+		 (Category happy_var_1
+	)}
+
+happyNewToken action sts stk [] =
+	happyDoAction 17# (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 "end") -> cont 9#;
+	PT _ (TS "grammar") -> cont 10#;
+	PT _ (TS "startcat") -> cont 11#;
+	PT _ (TV happy_dollar_dollar) -> cont 12#;
+	PT _ (TI happy_dollar_dollar) -> cont 13#;
+	PT _ (TL happy_dollar_dollar) -> cont 14#;
+	PT _ (T_SingleQuoteString happy_dollar_dollar) -> cont 15#;
+	_ -> cont 16#;
+	_ -> 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
+
+pGrammars tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut8 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" #-}
+-- $Id: ParCFG.hs,v 1.8 2005/05/17 14:04:37 bringert Exp $
+
+
+
+
+
+
+
+
+
+
+
+
+
+{-# LINE 27 "GenericTemplate.hs" #-}
+
+
+
+data Happy_IntList = HappyCons Int# Happy_IntList
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+infixr 9 `HappyStk`
+data HappyStk a = HappyStk a (HappyStk a)
+
+-----------------------------------------------------------------------------
+-- starting the parse
+
+happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
+
+-----------------------------------------------------------------------------
+-- Accepting the parse
+
+-- If the current token is 0#, it means we've just accepted a partial
+-- parse (a %partial parser).  We must ignore the saved token on the top of
+-- the stack in this case.
+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
+	happyReturn1 ans
+happyAccept j tk st sts (HappyStk ans _) = 
+	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+
+-----------------------------------------------------------------------------
+-- Arrays only: do the next action
+
+
+
+happyDoAction i tk st
+	= {- nothing -}
+
+
+	  case action of
+		0#		  -> {- nothing -}
+				     happyFail i tk st
+		-1# 	  -> {- nothing -}
+				     happyAccept i tk st
+		n | (n <# (0# :: Int#)) -> {- nothing -}
+
+				     (happyReduceArr ! rule) i tk st
+				     where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))
+		n		  -> {- nothing -}
+
+
+				     happyShift new_state i tk st
+				     where new_state = (n -# (1# :: Int#))
+   where off    = indexShortOffAddr happyActOffsets st
+	 off_i  = (off +# i)
+	 check  = if (off_i >=# (0# :: Int#))
+			then (indexShortOffAddr happyCheck off_i ==#  i)
+			else False
+ 	 action | check     = indexShortOffAddr happyTable off_i
+		| otherwise = indexShortOffAddr happyDefActions st
+
+
+
+
+
+
+
+
+
+
+
+indexShortOffAddr (HappyA# arr) off =
+#if __GLASGOW_HASKELL__ > 500
+	narrow16Int# i
+#elif __GLASGOW_HASKELL__ == 500
+	intToInt16# i
+#else
+	(i `iShiftL#` 16#) `iShiftRA#` 16#
+#endif
+  where
+#if __GLASGOW_HASKELL__ >= 503
+	i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
+#else
+	i = word2Int# ((high `shiftL#` 8#) `or#` low)
+#endif
+	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+	low  = int2Word# (ord# (indexCharOffAddr# arr off'))
+	off' = off *# 2#
+
+
+
+
+
+data HappyAddr = HappyA# Addr#
+
+
+
+
+-----------------------------------------------------------------------------
+-- HappyState data type (not arrays)
+
+{-# LINE 169 "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-2.9/GF/CFGM/ParCFG.y b/src-2.9/GF/CFGM/ParCFG.y
new file mode 100644
index 000000000..7b3041b3b
--- /dev/null
+++ b/src-2.9/GF/CFGM/ParCFG.y
@@ -0,0 +1,129 @@
+-- This Happy file was machine-generated by the BNF converter
+{
+module ParCFG where
+import AbsCFG
+import LexCFG
+import ErrM
+}
+
+%name pGrammars Grammars
+
+-- 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 ",") }
+ 'end' { PT _ (TS "end") }
+ 'grammar' { PT _ (TS "grammar") }
+ 'startcat' { PT _ (TS "startcat") }
+
+L_ident  { PT _ (TV $$) }
+L_integ  { PT _ (TI $$) }
+L_quoted { PT _ (TL $$) }
+L_SingleQuoteString { PT _ (T_SingleQuoteString $$) }
+L_err    { _ }
+
+
+%%
+
+Ident   :: { Ident }   : L_ident  { Ident $1 }
+Integer :: { Integer } : L_integ  { (read $1) :: Integer }
+String  :: { String }  : L_quoted { $1 }
+SingleQuoteString    :: { SingleQuoteString} : L_SingleQuoteString { SingleQuoteString ($1)}
+
+Grammars :: { Grammars }
+Grammars : ListGrammar { Grammars (reverse $1) } 
+
+
+Grammar :: { Grammar }
+Grammar : 'grammar' Ident ListFlag ListRule 'end' 'grammar' { Grammar $2 (reverse $3) (reverse $4) } 
+
+
+ListGrammar :: { [Grammar] }
+ListGrammar : {- empty -} { [] } 
+  | ListGrammar Grammar { flip (:) $1 $2 }
+
+
+Flag :: { Flag }
+Flag : 'startcat' Category { StartCat $2 } 
+
+
+ListFlag :: { [Flag] }
+ListFlag : {- empty -} { [] } 
+  | ListFlag Flag ';' { flip (:) $1 $2 }
+
+
+Rule :: { Rule }
+Rule : Fun ':' Profiles '.' Category '->' ListSymbol { Rule $1 $3 $5 $7 } 
+
+
+ListRule :: { [Rule] }
+ListRule : {- empty -} { [] } 
+  | ListRule Rule ';' { flip (:) $1 $2 }
+
+
+Fun :: { Fun }
+Fun : Ident { Cons $1 } 
+  | '_' { Coerce }
+
+
+Profiles :: { Profiles }
+Profiles : '[' ListProfile ']' { Profiles $2 } 
+
+
+ListProfile :: { [Profile] }
+ListProfile : {- empty -} { [] } 
+  | Profile { (:[]) $1 }
+  | Profile ',' ListProfile { (:) $1 $3 }
+
+
+Profile :: { Profile }
+Profile : '[' ListInteger ']' { UnifyProfile $2 } 
+  | Ident { ConstProfile $1 }
+
+
+ListInteger :: { [Integer] }
+ListInteger : {- empty -} { [] } 
+  | Integer { (:[]) $1 }
+  | Integer ',' ListInteger { (:) $1 $3 }
+
+
+Symbol :: { Symbol }
+Symbol : Category { CatS $1 } 
+  | String { TermS $1 }
+
+
+ListSymbol :: { [Symbol] }
+ListSymbol : '.' { [] } 
+  | Symbol { (:[]) $1 }
+  | Symbol ListSymbol { (:) $1 $2 }
+
+
+Category :: { Category }
+Category : SingleQuoteString { Category $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-2.9/GF/CFGM/PrintCFG.hs b/src-2.9/GF/CFGM/PrintCFG.hs
new file mode 100644
index 000000000..0fd46239c
--- /dev/null
+++ b/src-2.9/GF/CFGM/PrintCFG.hs
@@ -0,0 +1,157 @@
+module GF.CFGM.PrintCFG where
+
+-- pretty-printer generated by the BNF converter
+
+import GF.CFGM.AbsCFG
+import Char
+
+-- the top-level printing method
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+type Doc = [ShowS] -> [ShowS]
+
+doc :: ShowS -> Doc
+doc = (:)
+
+render :: Doc -> String
+render d = rend 0 (map ($ "") $ d []) "" where
+  rend i ss = case ss of
+    "["      :ts -> showChar '[' . rend i ts
+    "("      :ts -> showChar '(' . rend i ts
+    "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
+    "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
+    "}"      :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
+    ";"      :ts -> showChar ';' . new i . rend i ts
+    t  : "," :ts -> showString t . space "," . rend i ts
+    t  : ")" :ts -> showString t . showChar ')' . rend i ts
+    t  : "]" :ts -> showString t . showChar ']' . rend i ts
+    t        :ts -> space t . rend i ts
+    _            -> id
+  new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
+  space t = showString t . (\s -> if null s then "" else (' ':s))
+
+parenth :: Doc -> Doc
+parenth ss = doc (showChar '(') . ss . doc (showChar ')')
+
+concatS :: [ShowS] -> ShowS
+concatS = foldr (.) id
+
+concatD :: [Doc] -> Doc
+concatD = foldr (.) id
+
+replicateS :: Int -> ShowS -> ShowS
+replicateS n f = concatS (replicate n f)
+
+-- the printer class does the job
+class Print a where
+  prt :: Int -> a -> Doc
+  prtList :: [a] -> Doc
+  prtList = concatD . map (prt 0)
+
+instance Print a => Print [a] where
+  prt _ = prtList
+
+instance Print Char where
+  prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
+  prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
+
+mkEsc :: Char -> Char -> ShowS
+mkEsc q s = case s of
+  _ | s == q -> showChar '\\' . showChar s
+  '\\'-> showString "\\\\"
+  '\n' -> showString "\\n"
+  '\t' -> showString "\\t"
+  _ -> showChar s
+
+prPrec :: Int -> Int -> Doc -> Doc
+prPrec i j = if j<i then parenth else id
+
+
+instance Print Integer where
+  prt _ x = doc (shows x)
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+
+instance Print Double where
+  prt _ x = doc (shows x)
+
+
+instance Print Ident where
+  prt _ (Ident i) = doc (showString i)
+
+
+instance Print SingleQuoteString where
+  prt _ (SingleQuoteString i) = doc (showString i)
+
+
+
+instance Print Grammars where
+  prt i e = case e of
+   Grammars grammars -> prPrec i 0 (concatD [prt 0 grammars])
+
+
+instance Print Grammar where
+  prt i e = case e of
+   Grammar id flags rules -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 id , prt 0 flags , prt 0 rules , doc (showString "end") , doc (showString "grammar")])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print Flag where
+  prt i e = case e of
+   StartCat category -> prPrec i 0 (concatD [doc (showString "startcat") , prt 0 category])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Rule where
+  prt i e = case e of
+   Rule fun profiles category symbols -> prPrec i 0 (concatD [prt 0 fun , doc (showString ":") , prt 0 profiles , doc (showString ".") , prt 0 category , doc (showString "->") , prt 0 symbols])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Fun where
+  prt i e = case e of
+   Cons id -> prPrec i 0 (concatD [prt 0 id])
+   Coerce  -> prPrec i 0 (concatD [doc (showString "_")])
+
+
+instance Print Profiles where
+  prt i e = case e of
+   Profiles profiles -> prPrec i 0 (concatD [doc (showString "[") , prt 0 profiles , doc (showString "]")])
+
+
+instance Print Profile where
+  prt i e = case e of
+   UnifyProfile ns -> prPrec i 0 (concatD [doc (showString "[") , prt 0 ns , doc (showString "]")])
+   ConstProfile id -> prPrec i 0 (concatD [prt 0 id])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Symbol where
+  prt i e = case e of
+   CatS category -> prPrec i 0 (concatD [prt 0 category])
+   TermS str -> prPrec i 0 (concatD [prt 0 str])
+
+  prtList es = case es of
+   [] -> (concatD [doc (showString ".")])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print Category where
+  prt i e = case e of
+   Category singlequotestring -> prPrec i 0 (concatD [prt 0 singlequotestring])
+
+
+
diff --git a/src-2.9/GF/CFGM/PrintCFGrammar.hs b/src-2.9/GF/CFGM/PrintCFGrammar.hs
new file mode 100644
index 000000000..a68d2325c
--- /dev/null
+++ b/src-2.9/GF/CFGM/PrintCFGrammar.hs
@@ -0,0 +1,113 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrintCFGrammar
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/17 14:04:38 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.20 $
+--
+-- Handles printing a CFGrammar in CFGM format.
+-----------------------------------------------------------------------------
+
+module GF.CFGM.PrintCFGrammar (prCanonAsCFGM) where
+
+import GF.Canon.AbsGFC
+import qualified GF.CFGM.PrintCFG as PrintCFG
+import GF.Infra.Ident
+import GF.Canon.GFC
+import GF.Infra.Modules
+
+import qualified GF.Conversion.GFC as Cnv
+import GF.Infra.Print (prt)
+import GF.Formalism.CFG (CFRule(..))
+import qualified GF.Formalism.Utilities as GU
+import qualified GF.Conversion.Types as GT
+import qualified GF.CFGM.AbsCFG as AbsCFG
+import GF.Formalism.Utilities (Symbol(..))
+
+import GF.Data.ErrM
+import GF.Data.Utilities (compareBy)
+import qualified GF.Infra.Option as Option
+
+import Data.List (intersperse, sortBy)
+import Data.Maybe (listToMaybe, maybeToList, maybe)
+
+import GF.Infra.Print
+import GF.System.Tracing
+
+-- | FIXME: should add an Options argument,
+-- to be able to decide which CFG conversion one wants to use
+prCanonAsCFGM :: Option.Options -> CanonGrammar -> String
+prCanonAsCFGM opts gr = unlines $ map (prLangAsCFGM gr) xs 
+    where 
+    cncs = maybe [] (allConcretes gr) (greatestAbstract gr)
+    cncms = map (\i -> (i,fromOk (lookupModule gr i))) cncs
+    fromOk (Ok x) = x
+    fromOk (Bad y) = error y
+    xs = tracePrt "CFGM languages" (prtBefore "\n") 
+	 [ (i, getFlag fs "startcat", getFlag fs "conversion") | 
+	   (i, ModMod (Module{flags=fs})) <- cncms ]
+
+-- | FIXME: need to look in abstract module too
+getFlag :: [Flag] -> String -> Maybe String
+getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
+
+-- FIXME: (1) Should use 'ShellState.stateCFG'
+-- instead of 'Cnv.gfc2cfg' (which recalculates the grammar every time)
+--
+-- FIXME: (2) Should use the state options, when calculating the CFG
+-- (this is solved automatically if one solves (1) above)
+prLangAsCFGM :: CanonGrammar -> (Ident, Maybe String, Maybe String) -> String
+prLangAsCFGM gr (i, start, cnv) = prCFGrammarAsCFGM (Cnv.gfc2cfg opts (gr, i)) i start
+-- prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo opts gr i)) i start
+     where opts = Option.Opts $ maybeToList $ fmap Option.gfcConversion cnv
+
+prCFGrammarAsCFGM :: GT.CGrammar -> Ident -> Maybe String -> String
+prCFGrammarAsCFGM gr i start = PrintCFG.printTree $ cfGrammarToCFGM gr i start
+
+cfGrammarToCFGM :: GT.CGrammar -> Ident -> Maybe String -> AbsCFG.Grammar
+cfGrammarToCFGM gr i start = 
+    AbsCFG.Grammar (identToCFGMIdent i) flags $ sortCFGMRules $ map ruleToCFGMRule gr
+    where flags = maybe [] (\c -> [AbsCFG.StartCat $ strToCFGMCat (c++"{}.s")]) start
+          sortCFGMRules = sortBy (compareBy ruleKey)
+          ruleKey (AbsCFG.Rule f ps cat rhs) = (cat,f)
+
+ruleToCFGMRule :: GT.CRule -> AbsCFG.Rule
+ruleToCFGMRule (CFRule c rhs (GU.Name fun profile)) 
+    = AbsCFG.Rule fun' p' c' rhs'
+    where 
+    fun' = identToFun fun
+    p' = profileToCFGMProfile profile
+    c' = catToCFGMCat c
+    rhs' = map symbolToGFCMSymbol rhs
+
+profileToCFGMProfile :: [GU.Profile (GU.SyntaxForest GT.Fun)] -> AbsCFG.Profiles
+profileToCFGMProfile = AbsCFG.Profiles . map cnvProfile
+    where cnvProfile (GU.Unify ns)   = AbsCFG.UnifyProfile $ map fromIntegral ns
+	  -- FIXME: is it always FNode?
+	  cnvProfile (GU.Constant (GU.FNode c _)) = AbsCFG.ConstProfile $ identToCFGMIdent c
+						  
+
+identToCFGMIdent :: Ident -> AbsCFG.Ident
+identToCFGMIdent = AbsCFG.Ident . prt
+
+identToFun :: Ident -> AbsCFG.Fun
+identToFun IW = AbsCFG.Coerce
+identToFun i = AbsCFG.Cons (identToCFGMIdent i)
+
+strToCFGMCat :: String -> AbsCFG.Category
+strToCFGMCat = AbsCFG.Category . AbsCFG.SingleQuoteString . quoteSingle
+
+catToCFGMCat :: GT.CCat -> AbsCFG.Category
+catToCFGMCat = strToCFGMCat . prt
+
+symbolToGFCMSymbol :: Symbol GT.CCat GT.Token -> AbsCFG.Symbol
+symbolToGFCMSymbol (Cat c) = AbsCFG.CatS (catToCFGMCat c)
+symbolToGFCMSymbol (Tok t) = AbsCFG.TermS (prt t)
+
+quoteSingle :: String -> String
+quoteSingle s = "'" ++ escapeSingle s ++ "'"
+    where escapeSingle = concatMap (\c -> if c == '\'' then "\\'" else [c])
diff --git a/src-2.9/GF/Canon/AbsGFC.hs b/src-2.9/GF/Canon/AbsGFC.hs
new file mode 100644
index 000000000..8ce719104
--- /dev/null
+++ b/src-2.9/GF/Canon/AbsGFC.hs
@@ -0,0 +1,182 @@
+module GF.Canon.AbsGFC where
+
+import GF.Infra.Ident --H
+
+-- Haskell module generated by the BNF converter, except --H
+
+-- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
+
+data Canon =
+   MGr [Ident] Ident [Module]
+ | Gr [Module]
+  deriving (Eq,Ord,Show)
+
+data Line =
+   LMulti [Ident] Ident
+ | LHeader ModType Extend Open
+ | LFlag Flag
+ | LDef Def
+ | LEnd
+  deriving (Eq,Ord,Show)
+
+data Module =
+   Mod ModType Extend Open [Flag] [Def]
+  deriving (Eq,Ord,Show)
+
+data ModType =
+   MTAbs Ident
+ | MTCnc Ident Ident
+ | MTRes Ident
+ | MTTrans Ident Ident Ident
+  deriving (Eq,Ord,Show)
+
+data Extend =
+   Ext [Ident]
+ | NoExt
+  deriving (Eq,Ord,Show)
+
+data Open =
+   Opens [Ident]
+ | NoOpens
+  deriving (Eq,Ord,Show)
+
+data Flag =
+   Flg Ident Ident
+  deriving (Eq,Ord,Show)
+
+data Def =
+   AbsDCat Ident [Decl] [CIdent]
+ | AbsDFun Ident Exp Exp
+ | AbsDTrans Ident Exp
+ | ResDPar Ident [ParDef]
+ | ResDOper Ident CType Term
+ | CncDCat Ident CType Term Term
+ | CncDFun Ident CIdent [ArgVar] Term Term
+ | AnyDInd Ident Status Ident
+  deriving (Eq,Ord,Show)
+
+data ParDef =
+   ParD Ident [CType]
+  deriving (Eq,Ord,Show)
+
+data Status =
+   Canon
+ | NonCan
+  deriving (Eq,Ord,Show)
+
+data CIdent =
+   CIQ Ident Ident
+  deriving (Eq,Ord,Show)
+
+data Exp =
+   EApp Exp Exp
+ | EProd Ident Exp Exp
+ | EAbs Ident Exp
+ | EAtom Atom
+ | EData
+ | EEq [Equation]
+  deriving (Eq,Ord,Show)
+
+data Sort =
+   SType
+  deriving (Eq,Ord,Show)
+
+data Equation =
+   Equ [APatt] Exp
+  deriving (Eq,Ord,Show)
+
+data APatt =
+   APC CIdent [APatt]
+ | APV Ident
+ | APS String
+ | API Integer
+ | APF Double
+ | APW
+  deriving (Eq,Ord,Show)
+
+data Atom =
+   AC CIdent
+ | AD CIdent
+ | AV Ident
+ | AM Integer
+ | AS String
+ | AI Integer
+ | AF Double
+ | AT Sort
+  deriving (Eq,Ord,Show)
+
+data Decl =
+   Decl Ident Exp
+  deriving (Eq,Ord,Show)
+
+data CType =
+   RecType [Labelling]
+ | Table CType CType
+ | Cn CIdent
+ | TStr
+ | TInts Integer
+  deriving (Eq,Ord,Show)
+
+data Labelling =
+   Lbg Label CType
+  deriving (Eq,Ord,Show)
+
+data Term =
+   Arg ArgVar
+ | I CIdent
+ | Par CIdent [Term]
+ | LI Ident
+ | R [Assign]
+ | P Term Label
+ | T CType [Case]
+ | V CType [Term]
+ | S Term Term
+ | C Term Term
+ | FV [Term]
+ | EInt Integer
+ | EFloat Double
+ | K Tokn
+ | E
+  deriving (Eq,Ord,Show)
+
+data Tokn =
+   KS String
+ | KP [String] [Variant]
+ | KM String
+  deriving (Eq,Ord,Show)
+
+data Assign =
+   Ass Label Term
+  deriving (Eq,Ord,Show)
+
+data Case =
+   Cas [Patt] Term
+  deriving (Eq,Ord,Show)
+
+data Variant =
+   Var [String] [String]
+  deriving (Eq,Ord,Show)
+
+data Label =
+   L Ident
+ | LV Integer
+  deriving (Eq,Ord,Show)
+
+data ArgVar =
+   A Ident Integer
+ | AB Ident Integer Integer
+  deriving (Eq,Ord,Show)
+
+data Patt =
+   PC CIdent [Patt]
+ | PV Ident
+ | PW
+ | PR [PattAssign]
+ | PI Integer
+ | PF Double
+  deriving (Eq,Ord,Show)
+
+data PattAssign =
+   PAss Label Patt
+  deriving (Eq,Ord,Show)
+
diff --git a/src-2.9/GF/Canon/AbsToBNF.hs b/src-2.9/GF/Canon/AbsToBNF.hs
new file mode 100644
index 000000000..e30e836da
--- /dev/null
+++ b/src-2.9/GF/Canon/AbsToBNF.hs
@@ -0,0 +1,38 @@
+module GF.Canon.AbsToBNF where
+
+import GF.Grammar.SGrammar
+import GF.Data.Operations
+import GF.Infra.Option
+import GF.Canon.GFC (CanonGrammar)
+
+-- AR 10/5/2007
+
+abstract2bnf :: CanonGrammar -> String
+abstract2bnf = sgrammar2bnf . gr2sgr noOptions emptyProbs
+
+sgrammar2bnf :: SGrammar -> String
+sgrammar2bnf = unlines . map (prBNFRule . mkBNF) . allRules
+
+prBNFRule :: BNFRule -> String
+prBNFRule = id
+
+type BNFRule = String
+
+mkBNF :: SRule -> BNFRule
+mkBNF (pfun,(args,cat)) = 
+  fun ++ "." +++ gfId cat +++ "::=" +++ rhs +++ ";"
+ where
+   fun = gfId (snd pfun)
+   rhs = case args of
+     [] -> prQuotedString (snd pfun)
+     _ -> unwords (map gfId args)
+
+-- good for GF
+gfId i = i
+
+-- good for BNFC
+gfIdd i = case i of
+  "Int"    -> "Integer"
+  "String" -> i 
+  "Float"  -> "Double"
+  _   -> "G" ++ i ++ "_"
diff --git a/src-2.9/GF/Canon/CMacros.hs b/src-2.9/GF/Canon/CMacros.hs
new file mode 100644
index 000000000..572f09763
--- /dev/null
+++ b/src-2.9/GF/Canon/CMacros.hs
@@ -0,0 +1,334 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CMacros
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.29 $
+--
+-- Macros for building and analysing terms in GFC concrete syntax.
+--
+-- macros for concrete syntax in GFC that do not need lookup in a grammar
+-----------------------------------------------------------------------------
+
+module GF.Canon.CMacros where
+
+import GF.Infra.Ident
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import qualified GF.Infra.Ident as A ---- no need to qualif? 21/9
+import qualified GF.Grammar.Values as V
+import qualified GF.Grammar.MMacros as M
+import GF.Grammar.PrGrammar
+import GF.Data.Str
+
+import GF.Data.Operations
+
+import Data.Char
+import Control.Monad
+
+-- | how to mark subtrees, dep. on node, position, whether focus
+type JustMarker = V.TrNode -> [Int] -> Bool -> (String, String)
+
+-- | also to process the text (needed for escapes e.g. in XML)
+type Marker = (JustMarker, Maybe (String -> String))
+
+defTMarker :: JustMarker -> Marker
+defTMarker = flip (curry id) Nothing
+
+markSubtree :: Marker -> V.TrNode -> [Int] -> Bool -> Term -> Term
+markSubtree (mk,esc) n is = markSubterm esc . mk n is
+
+escapeMkString :: Marker -> Maybe (String -> String)
+escapeMkString = snd
+
+-- | if no marking is wanted, use the following
+noMark :: Marker
+noMark = defTMarker mk where
+  mk _ _ _ = ("","")
+
+-- | mark metas with their categories
+metaCatMark :: Marker
+metaCatMark = defTMarker mk where
+  mk nod _ _ = case nod of
+    V.N (_,V.AtM _,val,_,_) -> ("", '+':prt val)
+    _ -> ("","")
+
+-- | for vanilla brackets, focus, and position, use
+markBracket :: Marker
+markBracket = defTMarker mk where
+  mk n p b = if b then ("[*" ++ show p,"*]") else ("[" ++ show p,"]")
+
+-- | for focus only
+markFocus :: Marker
+markFocus = defTMarker mk where
+  mk n p b = if b then ("[*","*]") else ("","")
+
+-- | for XML, use
+markJustXML :: JustMarker
+markJustXML n i b = 
+  if b 
+    then ("<focus"   +++ p +++ c ++ s ++ ">", "</focus>") 
+    else ("<subtree" +++ p +++ c ++ s ++ ">", "</subtree>") 
+   where 
+     c = "type=" ++ prt (M.valNode n)
+     p = "position=" ++ (show $ reverse i)
+     s = if (null (M.constrsNode n)) then "" else " status=incorrect"
+
+markXML :: Marker
+markXML = (markJustXML, Just esc) where
+  esc s = case s of
+   '\\':'<':cs  -> '\\':'<':esc cs
+   '\\':'>':cs  -> '\\':'>':esc cs
+   '\\':'\\':cs -> '\\':'\\':esc cs
+   ----- the first 3 needed because marking may revisit; needs to be fixed
+
+   '<':cs  -> '\\':'<':esc cs
+   '>':cs  -> '\\':'>':esc cs
+   '\\':cs -> '\\':'\\':esc cs
+   c  :cs  -> c     :esc cs
+   _ -> s
+
+-- | for XML in JGF 1, use
+markXMLjgf :: Marker
+markXMLjgf = defTMarker mk where
+ mk n p b = 
+  if b 
+    then ("<focus" +++ c ++ ">", "</focus>") 
+    else ("","")
+   where 
+     c = "type=" ++ prt (M.valNode n)
+
+-- | the marking engine
+markSubterm :: Maybe (String -> String) -> (String,String) -> Term -> Term
+markSubterm esc (beg, end) t = case t of
+  R rs -> R $ map markField rs 
+  T ty cs -> T ty [Cas p (mark v) | Cas p v <- cs]
+  FV ts -> FV $ map mark ts
+  _    -> foldr1 C (tm beg ++ [mkEscIf t] ++ tm end)  -- t : Str guaranteed?
+ where
+   mark = markSubterm esc (beg, end)
+   markField lt@(Ass l t) = if isLinLabel l then (Ass l (mark t)) else lt
+   tm s = if null s then [] else [tM s]
+   mkEscIf t = case esc of
+     Just f -> mkEsc f t
+     _ -> t
+   mkEsc f t = case t of
+     K (KS s) -> K (KS (f s))
+     C u v    -> C (mkEsc f u) (mkEsc f v)
+     FV ts    -> FV (map (mkEsc f) ts)
+     _ -> t ---- do we need to look at other cases?
+
+tK,tM :: String -> Term
+tK = K . KS
+tM = K . KM
+
+term2patt :: Term -> Err Patt
+term2patt trm = case trm of
+  Par c aa -> do
+    aa' <- mapM term2patt aa
+    return (PC c aa')
+  R r -> do
+    let (ll,aa) = unzip [(l,a) | Ass l a <- r]
+    aa' <- mapM term2patt aa
+    return (PR (map (uncurry PAss) (zip ll aa')))
+  LI x -> return $ PV x
+  EInt i -> return $ PI i
+  EFloat i -> return $ PF i
+  FV (t:_) -> term2patt t ----
+  _ -> prtBad "no pattern corresponds to term" trm
+
+patt2term :: Patt -> Term
+patt2term p = case p of
+  PC x ps -> Par x (map patt2term ps)
+  PV x    -> LI x
+  PW      -> anyTerm ----
+  PR pas  -> R [ Ass lbl (patt2term q) | PAss lbl q <- pas ]
+  PI i    -> EInt i
+  PF i    -> EFloat i
+
+anyTerm :: Term
+anyTerm  = LI (A.identC "_") --- should not happen
+
+matchPatt :: [Case] -> Term -> Err Term
+matchPatt cs0 (FV ts) = liftM FV $ mapM (matchPatt cs0) ts
+matchPatt cs0 trm = term2patt trm >>= match cs0 where
+  match cs t = 
+    case cs of
+      Cas ps b  :_ | elem t ps -> return b
+      _:cs'                    -> match cs' t
+      []                       -> Bad $ "pattern not found for" +++ prt t 
+              +++ "among" ++++ unlines (map prt cs0)  ---- debug 
+
+defLinType :: CType
+defLinType = RecType [Lbg (L (A.identC "s")) TStr]
+
+defLindef :: Term
+defLindef = R [Ass (L (A.identC "s")) (Arg (A (A.identC "str") 0))]
+
+isDiscontinuousCType :: CType -> Bool
+isDiscontinuousCType t = case t of
+  RecType rs -> length [t | Lbg _ t <- rs, valTableType t == TStr] > 1
+  _ -> True --- does not occur; would not behave well in lin commands
+
+valTableType :: CType -> CType
+valTableType t = case t of
+  Table _ v -> valTableType v
+  _ -> t
+
+strsFromTerm :: Term -> Err [Str]
+strsFromTerm t = case t of
+  K (KS s) -> return [str s]
+  K (KM s) -> return [str s]
+  K (KP d vs) -> return $ [Str [TN d [(s,v) | Var s v <- vs]]]
+  C s t -> do
+    s' <- strsFromTerm s
+    t' <- strsFromTerm t
+    return [plusStr x y | x <- s', y <- t']
+  FV ts -> liftM concat $ mapM strsFromTerm ts
+  E -> return [str []]
+  _ -> return [str ("BUG[" ++ prt t ++ "]")] ---- debug
+----  _ -> prtBad "cannot get Str from term " t
+
+-- | recursively collect all branches in a table
+allInTable :: Term -> [Term]
+allInTable t =  case t of
+  T _ ts -> concatMap (\ (Cas _ v) -> allInTable v) ts --- expand ?
+  _    -> [t]
+
+-- | to gather s-fields; assumes term in normal form, preserves label
+allLinFields :: Term -> Err [[(Label,Term)]]
+allLinFields trm = case trm of
+----  R rs  -> return [[(l,t) | (l,(Just ty,t)) <- rs, isStrType ty]] -- good
+  R rs  -> return [[(l,t) | Ass l t <- rs, isLinLabel l]] ---- bad
+  FV ts -> do
+    lts <- mapM allLinFields ts
+    return $ concat lts
+
+  T _ ts -> liftM concat $ mapM allLinFields [t | Cas _ t <- ts]
+  V _ ts -> liftM concat $ mapM allLinFields ts
+  S t _  -> allLinFields t
+
+  _ -> prtBad "fields can only be sought in a record not in" trm
+
+-- | deprecated
+isLinLabel :: Label -> Bool
+isLinLabel l = case l of
+     L (A.IC ('s':cs)) | all isDigit cs -> True
+     -- peb (28/4-04), for MCFG grammars to work:
+     L (A.IC cs) | null cs || head cs `elem` ".!" -> True
+     _ -> False
+
+-- | to gather ultimate cases in a table; preserves pattern list
+allCaseValues :: Term -> [([Patt],Term)]
+allCaseValues trm = case trm of
+  T _ cs -> [(p:ps, t) | Cas pp t0 <- cs, p <- pp, (ps,t) <- allCaseValues t0]
+  _      -> [([],trm)]
+
+-- | to gather all linearizations; assumes normal form, preserves label and args
+allLinValues :: Term -> Err [[(Label,[([Patt],Term)])]]
+allLinValues trm = do
+  lts <- allLinFields trm
+  mapM (mapPairsM (return . allCaseValues)) lts
+
+-- | to gather all fields; does not assume s naming of fields; 
+-- used in Morpho only
+allAllLinValues :: Term -> Err [[(Label,[([Patt],Term)])]]
+allAllLinValues trm = do
+  lts <- allFields trm
+  mapM (mapPairsM (return . allCaseValues)) lts
+ where
+  allFields trm = case trm of
+    R rs  -> return [[(l,t) | Ass l t <- rs]]
+    FV ts -> do
+      lts <- mapM allFields ts
+      return $ concat lts
+    _ -> prtBad "fields can only be sought in a record not in" trm
+
+-- | to gather all linearizations, even from nested records; params ignored
+allLinBranches :: Term -> [([Label],Term)]
+allLinBranches trm = case trm of
+  R rs   -> [(l:ls,u) | Ass l t <- rs, (ls,u) <- allLinBranches t] 
+  FV ts  -> concatMap allLinBranches ts
+  T _ ts -> concatMap allLinBranches [t | Cas _ t <- ts]
+  V _ ts -> concatMap allLinBranches ts
+  _ -> [([],trm)]
+
+redirectIdent :: A.Ident -> CIdent -> CIdent
+redirectIdent n f@(CIQ _ c) = CIQ n c
+
+ciq :: A.Ident -> A.Ident -> CIdent
+ciq n f = CIQ n f
+
+wordsInTerm :: Term -> [String]
+wordsInTerm trm = filter (not . null) $ case trm of
+   K (KS s) -> [s]
+   S c _   -> wo c
+   R rs    -> concat [wo t | Ass _ t <- rs]
+   T _ cs  -> concat [wo t | Cas _ t <- cs]
+   V _ cs  -> concat [wo t | t <- cs]
+   C s t   -> wo s ++ wo t
+   FV ts   -> concatMap wo ts
+   K (KP ss vs) -> ss ++ concat [s | Var s _ <- vs]
+   P t _   -> wo t --- not needed ?
+   _       -> []
+ where wo = wordsInTerm
+
+onTokens :: (String -> String) -> Term -> Term
+onTokens f t = case t of
+   K (KS s) -> K (KS (f s))
+   K (KP ss vs) -> K (KP (map f ss) [Var (map f x) (map f y) | Var x y <- vs])
+   _ -> composSafeOp (onTokens f) t
+
+-- | 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
+  Par x as ->
+      do
+      as' <- mapM co as
+      return (Par x as')
+  R as -> 
+      do
+      let onAss (Ass l t) = liftM (Ass l) (co t)
+      as' <- mapM onAss as
+      return (R as')
+  P a x ->
+      do
+      a' <- co a
+      return (P a' x)
+  T x as ->
+      do
+      let onCas (Cas ps t) = liftM (Cas ps) (co t)
+      as' <- mapM onCas as
+      return (T x as')
+  S a b ->
+      do
+      a' <- co a
+      b' <- co b
+      return (S a' b')
+  C a b ->
+      do
+      a' <- co a
+      b' <- co b
+      return (C a' b')
+  FV as -> 
+      do
+      as' <- mapM co as
+      return (FV as')
+  V x as -> 
+      do 
+      as' <- mapM co as
+      return (V x as')
+  _ -> return trm -- covers Arg, I, LI, K, E
diff --git a/src-2.9/GF/Canon/CanonToGFCC.hs b/src-2.9/GF/Canon/CanonToGFCC.hs
new file mode 100644
index 000000000..044ea3669
--- /dev/null
+++ b/src-2.9/GF/Canon/CanonToGFCC.hs
@@ -0,0 +1,45 @@
+module GF.Canon.CanonToGFCC where
+
+import GF.Devel.GrammarToGFCC
+import GF.Devel.PrintGFCC
+import GF.GFCC.CheckGFCC (checkGFCCmaybe)
+import GF.GFCC.OptimizeGFCC
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.Canon.CanonToGrammar
+import GF.Canon.Subexpressions
+import GF.Devel.PrintGFCC
+import GF.Grammar.PrGrammar
+
+import qualified GF.Infra.Modules as M
+import GF.Infra.Option
+
+import GF.Data.Operations
+import GF.Text.UTF8
+
+canon2gfccPr opts = printGFCC . canon2gfcc opts
+canon2gfcc opts = source2gfcc opts . canon2source ----
+canon2source = err error id . canon2sourceGrammar . unSubelimCanon
+
+source2gfcc opts gf = 
+  let 
+    (abs,gfcc) = mkCanon2gfcc opts (gfcabs gf) gf
+    gfcc1 = maybe undefined id $ checkGFCCmaybe gfcc
+  in addParsers $ if oElem (iOpt "noopt") opts then gfcc1 else optGFCC gfcc1
+
+gfcabs gfc = 
+  prt $ head $ M.allConcretes gfc $ maybe (error "no abstract") id $ 
+   M.greatestAbstract gfc
+
+{-
+-- this variant makes utf8 conversion; used in back ends
+mkCanon2gfcc :: CanonGrammar -> D.GFCC
+mkCanon2gfcc = 
+-- canon2gfcc . reorder abs . utf8Conv . canon2canon abs
+  optGFCC . canon2gfcc . reorder . utf8Conv . canon2canon . normalize
+
+-- this variant makes no utf8 conversion; used in ShellState
+mkCanon2gfccNoUTF8 :: CanonGrammar -> D.GFCC
+mkCanon2gfccNoUTF8 = optGFCC . canon2gfcc . reorder . canon2canon . normalize
+-}
+
diff --git a/src-2.9/GF/Canon/CanonToGrammar.hs b/src-2.9/GF/Canon/CanonToGrammar.hs
new file mode 100644
index 000000000..078c3cc03
--- /dev/null
+++ b/src-2.9/GF/Canon/CanonToGrammar.hs
@@ -0,0 +1,203 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CanonToGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 14:15:17 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.15 $
+--
+-- a decompiler. AR 12/6/2003 -- 19/4/2004
+-----------------------------------------------------------------------------
+
+module GF.Canon.CanonToGrammar (canon2sourceGrammar, canon2sourceModule, redFlag) where
+
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.Canon.MkGFC
+---import CMacros
+import qualified GF.Infra.Modules as M
+import qualified GF.Infra.Option as O
+import qualified GF.Grammar.Grammar as G
+import qualified GF.Grammar.Macros as F
+
+import GF.Infra.Ident
+import GF.Data.Operations
+
+import Control.Monad
+
+canon2sourceGrammar :: CanonGrammar -> Err G.SourceGrammar
+canon2sourceGrammar gr = do
+  ms' <- mapM canon2sourceModule $ M.modules gr
+  return $ M.MGrammar ms'
+
+canon2sourceModule :: CanonModule -> Err G.SourceModule
+canon2sourceModule (i,mi) = do
+  i'    <- redIdent i 
+  info' <- case mi of
+    M.ModMod m -> do
+      (e,os) <- redExtOpen m
+      flags  <- mapM redFlag $ M.flags m 
+      (abstr,mt)  <- case M.mtype m of
+          M.MTConcrete a -> do
+            a' <- redIdent a
+            return (a', M.MTConcrete a') 
+          M.MTAbstract -> return (i',M.MTAbstract) --- c' not needed
+          M.MTResource -> return (i',M.MTResource) --- c' not needed
+          M.MTTransfer x y -> return (i',M.MTTransfer x y) --- c' not needed
+      defs   <- mapMTree redInfo $ M.jments m
+      return $ M.ModMod $ M.Module mt (M.mstatus m) flags e os defs
+    _ -> Bad $ "cannot decompile module type"
+  return (i',info')
+ where
+   redExtOpen m = do
+     e'  <- return $ M.extend m
+     os' <- mapM (\ (M.OSimple q i) -> liftM (\i -> M.OQualif q i i) (redIdent i)) $ 
+                 M.opens m
+     return (e',os')
+
+redInfo :: (Ident,Info) -> Err (Ident,G.Info)
+redInfo (c,info) = errIn ("decompiling abstract" +++ show c) $ do
+  c' <- redIdent c 
+  info' <- case info of
+    AbsCat cont fs -> do
+      return $ G.AbsCat (Yes cont) (Yes (map (uncurry G.Q) fs))
+    AbsFun typ df -> do
+      return $ G.AbsFun (Yes typ) (Yes df)
+    AbsTrans t -> do
+      return $ G.AbsTrans t
+
+    ResPar par -> do
+      par' <- mapM redParam par
+      return $ G.ResParam (Yes (par',Nothing)) ---- list of values
+
+    ResOper pty ptr -> do
+      ty'  <- redCType pty
+      trm' <- redCTerm ptr
+      return $ G.ResOper (Yes ty') (Yes trm')
+
+    CncCat pty ptr ppr -> do
+      ty'  <- redCType pty
+      trm' <- redCTerm ptr
+      ppr' <- redCTerm ppr 
+      return $ G.CncCat (Yes ty') (Yes trm') (Yes ppr')      
+    CncFun (CIQ abstr cat) xx body ppr -> do
+      xx'   <- mapM redArgVar xx
+      body' <- redCTerm body
+      ppr'  <- redCTerm ppr
+      cat'  <- redIdent cat
+      return $ G.CncFun (Just (cat', ([],F.typeStr))) -- Nothing 
+        (Yes (F.mkAbs xx' body')) (Yes ppr')
+
+    AnyInd b c -> liftM (G.AnyInd b) $ redIdent c
+
+  return (c',info')
+
+redQIdent :: CIdent -> Err G.QIdent
+redQIdent (CIQ m c) = liftM2 (,) (redIdent m) (redIdent c)
+
+redIdent :: Ident -> Err Ident
+redIdent = return
+
+redFlag :: Flag -> Err O.Option
+redFlag (Flg f x) = return $ O.Opt (prIdent f,[prIdent x])
+
+redDecl :: Decl -> Err G.Decl
+redDecl (Decl x a) = liftM2 (,) (redIdent x) (redTerm a)
+
+redType :: Exp -> Err G.Type
+redType = redTerm
+
+redTerm :: Exp -> Err G.Term
+redTerm t = return $ trExp t
+
+-- resource
+
+redParam (ParD c cont) = do
+  c'    <- redIdent c
+  cont' <- mapM redCType cont
+  return $ (c', [(IW,t) | t <- cont'])
+
+-- concrete syntax
+
+redCType :: CType -> Err G.Type
+redCType t = case t of
+  RecType lbs -> do
+    let (ls,ts) = unzip [(l,t) | Lbg l t <- lbs]
+        ls' = map redLabel ls
+    ts' <- mapM redCType ts
+    return $ G.RecType $ zip ls' ts'
+  Table p v  -> liftM2 G.Table (redCType p) (redCType v)
+  Cn mc  -> liftM (uncurry G.QC) $ redQIdent mc
+  TStr -> return $ F.typeStr
+  TInts i -> return $ F.typeInts (fromInteger i)
+
+redCTerm :: Term -> Err G.Term
+redCTerm x = case x of
+  Arg argvar  -> liftM G.Vr $ redArgVar argvar
+  I cident  -> liftM (uncurry G.Q) $ redQIdent cident
+  Par cident terms  -> liftM2 F.mkApp 
+                         (liftM (uncurry G.QC) $ redQIdent cident) 
+                         (mapM redCTerm terms)
+  LI id  -> liftM G.Vr $ redIdent id
+  R assigns  -> do
+    let (ls,ts) = unzip [(l,t) | Ass l t <- assigns]
+    let ls' = map redLabel ls
+    ts' <- mapM redCTerm ts
+    return $ G.R [(l,(Nothing,t)) | (l,t) <- zip ls' ts']
+  P term label  -> liftM2 G.P (redCTerm term) (return $ redLabel label)
+  T ctype cases  -> do
+    ctype' <- redCType ctype
+    let (ps,ts) = unzip [(p,t) | Cas [p] t <- cases]
+    ps' <- mapM redPatt ps
+    ts' <- mapM redCTerm ts
+    let tinfo = case ps' of
+                  [G.PV _] -> G.TTyped ctype'
+                  _ -> G.TComp ctype'
+    return $ G.T tinfo $ zip ps' ts'
+  V ctype ts  -> do
+    ctype' <- redCType ctype
+    ts' <- mapM redCTerm ts
+    return $ G.V ctype' ts'
+  S term0 term  -> liftM2 G.S (redCTerm term0) (redCTerm term)
+  C term0 term  -> liftM2 G.C (redCTerm term0) (redCTerm term)
+  FV terms  -> liftM G.FV $ mapM redCTerm terms
+  K (KS str) -> return $ G.K str
+  EInt i     -> return $ G.EInt i
+  EFloat i   -> return $ G.EFloat i
+  E  -> return $ G.Empty
+  K (KP d vs)  -> return $ 
+                    G.Alts (tList d,[(tList s, G.Strs $ map G.K v) | Var s v <- vs])
+ where
+   tList ss = case ss of --- this should be in Macros
+     [] -> G.Empty
+     _ -> foldr1 G.C $ map G.K ss
+
+failure x = Bad $ "not yet" +++ show x ----
+
+redArgVar :: ArgVar -> Err Ident
+redArgVar x = case x of
+  A x i -> return $ IA (prIdent x, fromInteger i)
+  AB x b i -> return $ IAV (prIdent x, fromInteger b, fromInteger i)
+
+redLabel :: Label -> G.Label
+redLabel (L x) = G.LIdent $ prIdent x
+redLabel (LV i) = G.LVar $ fromInteger i
+
+redPatt :: Patt -> Err G.Patt
+redPatt p = case p of
+  PV x -> liftM G.PV $ redIdent x
+  PC mc ps -> do
+    (m,c) <- redQIdent mc
+    liftM (G.PP m c) (mapM redPatt ps) 
+  PR rs -> do
+    let (ls,ts) = unzip [(l,t) | PAss l t <- rs]
+        ls' = map redLabel ls
+    ts <- mapM redPatt ts
+    return $ G.PR $ zip ls' ts
+  PI i -> return $ G.PInt i
+  PF i -> return $ G.PFloat i
+  _ -> Bad $ "cannot recompile pattern" +++ show p
+
diff --git a/src-2.9/GF/Canon/GFC.cf b/src-2.9/GF/Canon/GFC.cf
new file mode 100644
index 000000000..d9385a49f
--- /dev/null
+++ b/src-2.9/GF/Canon/GFC.cf
@@ -0,0 +1,170 @@
+-- top-level grammar
+
+-- Canonical GF. AR 27/4/2003
+
+entrypoints Canon, Line ;
+
+-- old approach: read in a whole grammar
+
+MGr. Canon ::= "grammar" [Ident] "of" Ident ";" [Module] ;
+Gr.  Canon ::= [Module] ;
+
+-- new approach: read line by line
+
+LMulti.  Line ::= "grammar" [Ident] "of" Ident ";" ;
+LHeader. Line ::= ModType "=" Extend Open "{" ;
+LFlag.   Line ::= Flag ";" ;
+LDef.    Line ::= Def ";" ;
+LEnd.    Line ::= "}" ;    
+
+Mod. Module ::= ModType "=" Extend Open "{" [Flag] [Def] "}" ;
+
+MTAbs.   ModType ::= "abstract" Ident ; 
+MTCnc.   ModType ::= "concrete" Ident "of" Ident ;
+MTRes.   ModType ::= "resource" Ident ;
+MTTrans. ModType ::= "transfer" Ident ":" Ident "->" Ident ;
+
+separator Module "" ;
+
+Ext.   Extend ::= [Ident] "**" ;
+NoExt. Extend ::= ;
+
+Opens.   Open ::= "open" [Ident] "in" ;
+NoOpens. Open ::= ;
+
+
+-- judgements
+
+Flg.  Flag ::= "flags" Ident "=" Ident ;  --- to have the same res word as in GF
+
+AbsDCat.   Def ::= "cat" Ident "[" [Decl] "]" "=" [CIdent] ;
+AbsDFun.   Def ::= "fun" Ident ":" Exp "=" Exp ;
+AbsDTrans. Def ::= "transfer" Ident "=" Exp ;
+
+ResDPar.   Def ::= "param"  Ident "=" [ParDef] ;
+ResDOper.  Def ::= "oper"   Ident ":" CType "=" Term ;
+
+CncDCat.   Def ::= "lincat" Ident "=" CType "=" Term ";" Term  ; 
+CncDFun.   Def ::= "lin"    Ident ":" CIdent "=" "\\" [ArgVar] "->" Term ";" Term ;
+
+AnyDInd.   Def ::= Ident Status "in" Ident ;
+
+ParD. ParDef ::= Ident [CType] ;
+
+-- the canonicity of an indirected constant
+
+Canon.  Status ::= "data" ;
+NonCan. Status ::= ;
+
+-- names originating from resource modules: prefixed by the module name
+
+CIQ. CIdent ::= Ident "." Ident ;
+
+-- types and terms in abstract syntax; no longer type-annotated
+
+EApp.   Exp1 ::= Exp1 Exp2 ;
+EProd.  Exp  ::= "(" Ident ":" Exp ")" "->" Exp ;
+EAbs.   Exp  ::= "\\" Ident "->" Exp ;
+EAtom.  Exp2 ::= Atom ;
+EData.  Exp2 ::= "data" ;
+
+EEq.    Exp  ::= "{" [Equation] "}" ;  -- list of pattern eqs; primitive notion: []
+
+coercions Exp 2 ;
+
+SType.  Sort ::= "Type" ;
+
+Equ. Equation ::= [APatt] "->" Exp ;
+
+APC. APatt ::= "(" CIdent [APatt] ")" ;
+APV. APatt ::= Ident ;
+APS. APatt ::= String ;
+API. APatt ::= Integer ;
+APF. APatt ::= Double ;
+APW. APatt ::= "_" ;
+
+separator Decl ";" ;
+terminator APatt "" ;
+terminator Equation ";" ;
+
+AC. Atom ::= CIdent ;
+AD. Atom ::= "<" CIdent ">" ;
+AV. Atom ::= "$" Ident ;
+AM. Atom ::= "?" Integer ;
+AS. Atom ::= String ;
+AI. Atom ::= Integer ;
+AT. Atom ::= Sort ;
+
+Decl. Decl ::= Ident ":" Exp ;
+
+
+-- types, terms, and patterns in concrete syntax
+
+RecType. CType ::= "{" [Labelling] "}" ;
+Table.   CType ::= "(" CType "=>" CType ")" ;
+Cn.      CType ::= CIdent ;
+TStr.    CType ::= "Str" ;
+TInts.   CType ::= "Ints" Integer ;
+
+Lbg.  Labelling ::= Label ":" CType ;
+
+Arg.  Term2 ::= ArgVar ;
+I.    Term2 ::= CIdent ; -- from resources
+Par.  Term2 ::= "<" CIdent [Term2] ">" ;
+LI.   Term2 ::= "$" Ident ;  -- from pattern variables
+
+R.    Term2 ::= "{" [Assign] "}" ;
+P.    Term1 ::= Term2 "." Label ;
+T.    Term1 ::= "table" CType "{" [Case] "}" ;
+V.    Term1 ::= "table" CType "[" [Term2] "]" ;
+S.    Term1 ::= Term1 "!" Term2 ;
+C.    Term  ::= Term "++" Term1 ;
+FV.   Term1 ::= "variants" "{" [Term2] "}" ;  --- no separator!
+
+EInt.   Term2 ::= Integer ;
+EFloat. Term2 ::= Double ;
+K.    Term2 ::= Tokn ;
+E.    Term2 ::= "[" "]" ;
+
+KS.   Tokn  ::= String ;
+KP.   Tokn  ::= "[" "pre" [String] "{" [Variant] "}" "]" ;
+internal KM.   Tokn  ::= String ; -- mark-up
+
+Ass.  Assign  ::= Label "=" Term ;
+Cas.  Case    ::= [Patt] "=>" Term ;
+Var.  Variant ::= [String] "/" [String] ;
+
+coercions Term 2 ;
+
+L.    Label  ::= Ident ;
+LV.   Label  ::= "$" Integer ;
+A.    ArgVar ::= Ident "@" Integer ;             -- no bindings
+AB.   ArgVar ::= Ident "+" Integer "@" Integer ; -- with a number of bindings
+
+PC.   Patt ::= "(" CIdent [Patt] ")" ;
+PV.   Patt ::= Ident ;
+PW.   Patt ::= "_" ;
+PR.   Patt ::= "{" [PattAssign] "}" ;
+PI.   Patt ::= Integer ;
+PF.   Patt ::= Double ;
+
+PAss. PattAssign ::= Label "=" Patt ;
+
+--- here we use the new pragmas to generate list rules
+
+terminator Flag ";" ;
+terminator Def ";" ;
+separator ParDef "|" ;
+separator CType "" ;
+separator CIdent "" ;
+separator Assign ";" ;
+separator ArgVar "," ;
+separator Labelling ";" ;
+separator Case ";" ;
+separator Term2 "" ;
+separator String "" ;
+separator Variant ";" ;
+separator PattAssign ";" ;
+separator Patt "" ;
+separator Ident "," ;
+
diff --git a/src-2.9/GF/Canon/GFC.hs b/src-2.9/GF/Canon/GFC.hs
new file mode 100644
index 000000000..ae9097c44
--- /dev/null
+++ b/src-2.9/GF/Canon/GFC.hs
@@ -0,0 +1,103 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GFC
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:22 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.12 $
+--
+-- canonical GF. AR 10\/9\/2002 -- 9\/5\/2003 -- 21\/9
+-----------------------------------------------------------------------------
+
+module GF.Canon.GFC (Context,
+	    CanonGrammar,
+	    CanonModInfo,
+	    CanonModule,
+	    CanonAbs,
+	    Info(..),
+	    Printname,
+            prPrintnamesGrammar,
+	    mapInfoTerms,
+	    setFlag,
+            flagIncomplete,
+            isIncompleteCanon,
+            hasFlagCanon,
+            flagCanon
+	   ) where
+
+import GF.Canon.AbsGFC
+import GF.Canon.PrintGFC
+import qualified GF.Grammar.Abstract as A
+
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Data.Zipper
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+
+import Data.Char
+import Control.Arrow (first)
+
+type Context = [(Ident,Exp)]
+
+type CanonGrammar = M.MGrammar Ident Flag Info
+
+type CanonModInfo = M.ModInfo Ident Flag Info
+
+type CanonModule = (Ident, CanonModInfo)
+
+type CanonAbs = M.Module Ident Option Info
+
+data Info =  
+   AbsCat  A.Context [A.Fun]
+ | AbsFun  A.Type A.Term
+ | AbsTrans A.Term
+
+ | ResPar  [ParDef]
+ | ResOper CType Term     -- ^ global constant
+ | CncCat  CType Term Printname
+ | CncFun  CIdent [ArgVar] Term Printname
+ | AnyInd Bool Ident
+  deriving (Show)
+
+type Printname = Term
+	      
+mapInfoTerms :: (Term -> Term) -> Info -> Info
+mapInfoTerms f i = case i of 
+         ResOper x a -> ResOper x (f a)
+	 CncCat  x a y -> CncCat x (f a) y
+	 CncFun  x y a z -> CncFun x y (f a) z
+	 _ -> i
+
+setFlag :: String -> String -> [Flag] -> [Flag]
+setFlag n v fs = flagCanon n v : [f | f@(Flg (IC n') _) <- fs, n' /= n]
+
+flagIncomplete :: Flag
+flagIncomplete = flagCanon "incomplete" "true"
+
+isIncompleteCanon :: CanonModule -> Bool
+isIncompleteCanon = hasFlagCanon flagIncomplete
+
+hasFlagCanon :: Flag -> CanonModule -> Bool
+hasFlagCanon f (_,M.ModMod mo) = elem f $ M.flags mo
+hasFlagCanon f _ = True ---- safe, useless 
+
+flagCanon :: String -> String -> Flag
+flagCanon f v = Flg (identC f) (identC v)
+
+-- for Ha-Jo 20/2/2005
+
+prPrintnamesGrammar :: CanonGrammar -> String
+prPrintnamesGrammar gr = unlines $ filter (not . null) [prPrint j | 
+  (_,M.ModMod m) <- M.modules gr,  
+  M.isModCnc m,
+  j <- tree2list $ M.jments m
+  ]
+  where
+    prPrint j = case j of
+      (c,CncCat _   _ p) -> "printname cat" +++ A.prt_ c +++ "=" +++ A.prt_ p
+      (c,CncFun _ _ _ p) -> "printname fun" +++ A.prt_ c +++ "=" +++ A.prt_ p
+      _ -> []
diff --git a/src-2.9/GF/Canon/GetGFC.hs b/src-2.9/GF/Canon/GetGFC.hs
new file mode 100644
index 000000000..049f75efe
--- /dev/null
+++ b/src-2.9/GF/Canon/GetGFC.hs
@@ -0,0 +1,78 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GetGFC
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/30 18:39:43 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.9 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Canon.GetGFC (getCanonModule, getCanonGrammar) where
+
+import GF.Data.Operations
+import GF.Canon.ParGFC
+import GF.Canon.GFC
+import GF.Canon.MkGFC
+import GF.Infra.Modules
+import GF.Infra.UseIO
+
+import System.IO
+import System.Directory
+import Control.Monad
+
+getCanonModule :: FilePath -> IOE CanonModule
+getCanonModule file = do
+  gr <- getCanonGrammar file
+  case modules gr of
+    [m] -> return m
+    _ -> ioeErr $ Bad "expected exactly one module in a file"
+
+getCanonGrammar :: FilePath -> IOE CanonGrammar
+-- getCanonGrammar = getCanonGrammarByLine
+getCanonGrammar file = do
+  s <- ioeIO $ readFileIf file
+  c <- ioeErr $ pCanon $ myLexer s
+  return $ canon2grammar c
+
+{-
+-- the following surprisingly does not save memory so it is
+-- not in use
+
+getCanonGrammarByLine :: FilePath -> IOE CanonGrammar
+getCanonGrammarByLine file = do
+  b <- ioeIO $ doesFileExist file
+  if not b 
+    then ioeErr $ Bad $ "file" +++ file +++ "does not exist"
+    else do
+   ioeIO $ putStrLn ""
+   hand <- ioeIO $ openFile file ReadMode ---- err
+   size <- ioeIO $ hFileSize hand
+   gr <- addNextLine (size,0) 1 hand emptyMGrammar
+   ioeIO $ hClose hand
+   return $ MGrammar $ reverse $ modules gr
+
+ where
+   addNextLine (size,act) d hand gr = do
+     eof <- ioeIO $ hIsEOF hand 
+     if eof 
+       then return gr 
+       else do
+         s <- ioeIO  $ hGetLine hand
+         let act' = act + toInteger (length s)
+--         if isHash act act' then (ioeIO $ putChar '#') else return () 
+         updGrammar act' d gr $ pLine $ myLexer s
+    where     
+      updGrammar a d gr (Ok t) = case buildCanonGrammar d gr t of 
+        (gr',d') -> addNextLine (size,a) d' hand gr'
+      updGrammar _ _ gr (Bad s) = do
+        ioeIO $ putStrLn s
+        return emptyMGrammar
+
+      isHash a b = a `div` step < b `div` step
+      step = size `div` 50
+-}
diff --git a/src-2.9/GF/Canon/LexGFC.hs b/src-2.9/GF/Canon/LexGFC.hs
new file mode 100644
index 000000000..31a4a9b30
--- /dev/null
+++ b/src-2.9/GF/Canon/LexGFC.hs
@@ -0,0 +1,346 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LINE 3 "LexGFC.x" #-}
+module GF.Canon.LexGFC where --H
+
+import GF.Data.ErrM --H
+import GF.Data.SharedString --H
+
+#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\x09\x00\x00\x00\x1d\x00\x00\x00\x0b\x00\x00\x00\x20\x00\x00\x00\x9a\x00\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\x6d\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\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x03\x00\x03\x00\x07\x00\x05\x00\x03\x00\x06\x00\x03\x00\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\x03\x00\x04\x00\x03\x00\x03\x00\x03\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x03\x00\x03\x00\x03\x00\x03\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\x03\x00\x03\x00\x03\x00\xff\xff\x03\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\x03\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\x08\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\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\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\x0a\x00\x00\x00\x00\x00\xff\xff\x08\x00\x0a\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\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\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\x0b\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\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x3e\x00\x2b\x00\x3e\x00\x2a\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\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\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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_1))],[],[],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))],[],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[],[],[]]
+{-# LINE 32 "LexGFC.x" #-}
+
+tok f p s = f p s
+
+share :: String -> String
+share = shareString
+
+data Tok =
+   TS !String     -- reserved words
+ | 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 "lin" (b "concrete" (b "Type" (b "Str" (b "Ints" N N) N) (b "cat" (b "abstract" N N) N)) (b "fun" (b "flags" (b "data" N N) N) (b "in" (b "grammar" N N) N))) (b "pre" (b "open" (b "of" (b "lincat" N N) N) (b "param" (b "oper" N N) N)) (b "transfer" (b "table" (b "resource" N N) N) (b "variants" 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_1 = tok (\p s -> PT p (TS $ share s)) 
+alex_action_2 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
+alex_action_3 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) 
+alex_action_4 = tok (\p s -> PT p (TI $ share s))    
+alex_action_5 = 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" #-}
+
+
+
+
+
+
+
+
+
+
+
+
+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-2.9/GF/Canon/LexGFC.x b/src-2.9/GF/Canon/LexGFC.x
new file mode 100644
index 000000000..0a50e49d1
--- /dev/null
+++ b/src-2.9/GF/Canon/LexGFC.x
@@ -0,0 +1,132 @@
+-- -*- haskell -*-
+-- This Alex file was machine-generated by the BNF converter
+{
+module GF.Canon.LexGFC where
+
+import GF.Data.ErrM -- H
+import GF.Data.SharedString -- H
+}
+
+
+$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 =    -- reserved words consisting of special symbols
+   \; | \= | \{ | \} | \: | \- \> | \* \* | \[ | \] | \\ | \. | \( | \) | \_ | \< | \> | \$ | \? | \= \> | \! | \+ \+ | \/ | \@ | \+ | \| | \,
+
+:-
+
+$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))    }
+
+
+{
+
+tok f p s = f p s
+
+share :: String -> String
+share = shareString
+
+data Tok =
+   TS !String     -- reserved words
+ | 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 "lin" (b "concrete" (b "Type" (b "Str" (b "Ints" N N) N) (b "cat" (b "abstract" N N) N)) (b "fun" (b "flags" (b "data" N N) N) (b "in" (b "grammar" N N) N))) (b "pre" (b "open" (b "of" (b "lincat" N N) N) (b "param" (b "oper" N N) N)) (b "transfer" (b "table" (b "resource" N N) N) (b "variants" 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-2.9/GF/Canon/Look.hs b/src-2.9/GF/Canon/Look.hs
new file mode 100644
index 000000000..a93d4c834
--- /dev/null
+++ b/src-2.9/GF/Canon/Look.hs
@@ -0,0 +1,225 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Look
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/20 09:32:56 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.17 $
+--
+-- lookup in GFC. AR 2003
+-----------------------------------------------------------------------------
+
+module GF.Canon.Look (lookupCncInfo,
+	     lookupLin,
+	     lookupLincat,
+	     lookupPrintname,
+	     lookupResInfo,
+	     lookupGlobal,
+	     lookupOptionsCan,
+	     lookupParamValues,
+	     allParamValues,
+	     ccompute
+	    ) where
+
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.Grammar.PrGrammar
+import GF.Canon.CMacros
+----import Values
+import GF.Grammar.MMacros
+import GF.Grammar.Macros (zIdent)
+import qualified GF.Infra.Modules as M
+import qualified GF.Canon.CanonToGrammar as CG
+
+import GF.Data.Operations
+import GF.Infra.Option
+
+import Control.Monad
+import Data.List
+
+-- linearization lookup
+
+lookupCncInfo :: CanonGrammar -> CIdent -> Err Info
+lookupCncInfo gr f@(CIQ m c) = do
+  mt <- M.lookupModule gr m
+  case mt of
+    M.ModMod a -> errIn ("module" +++ prt m) $ 
+                  lookupIdent c $ M.jments a 
+    _ -> prtBad "not concrete module" m
+
+lookupLin :: CanonGrammar -> CIdent -> Err Term
+lookupLin gr f = errIn "looking up linearization rule" $ do
+  info <- lookupCncInfo gr f
+  case info of
+    CncFun _ _ t _ -> return t
+    CncCat _ t _ -> return t
+    AnyInd _ n -> lookupLin gr $ redirectIdent n f
+
+lookupLincat :: CanonGrammar -> CIdent -> Err CType
+lookupLincat gr (CIQ _ c) | elem c [zIdent "String", zIdent "Int", zIdent "Float"] =
+  return defLinType --- ad hoc; not needed? cf. Grammar.Lookup.lookupLincat
+lookupLincat gr f = errIn "looking up linearization type" $ do
+  info <- lookupCncInfo gr f
+  case info of
+    CncCat t _ _ -> return t
+    AnyInd _ n -> lookupLincat gr $ redirectIdent n f
+    _ -> prtBad "no lincat found for" f
+
+lookupPrintname :: CanonGrammar -> CIdent -> Err Term
+lookupPrintname gr f = errIn "looking up printname" $ do
+  info <- lookupCncInfo gr f
+  case info of
+    CncFun _ _ _ t -> return t
+    CncCat _ _ t -> return t
+    AnyInd _ n -> lookupPrintname gr $ redirectIdent n f
+
+lookupResInfo :: CanonGrammar -> CIdent -> Err Info
+lookupResInfo gr f@(CIQ m c) = do
+  mt <- M.lookupModule gr m
+  case mt of
+    M.ModMod a -> lookupIdent c $ M.jments a 
+    _ -> prtBad "not resource module" m
+
+lookupGlobal :: CanonGrammar -> CIdent -> Err Term
+lookupGlobal gr f = do
+  info <- lookupResInfo gr f
+  case info of
+    ResOper _ t -> return t
+    AnyInd _ n -> lookupGlobal gr $ redirectIdent n f
+    _ -> prtBad "cannot find global" f
+
+lookupOptionsCan :: CanonGrammar -> Err Options
+lookupOptionsCan gr = do
+  let fs = M.allFlags gr
+  os <- mapM CG.redFlag fs
+  return $ options os
+
+lookupParamValues :: CanonGrammar -> CIdent -> Err [Term]
+lookupParamValues gr pt@(CIQ m _) = do
+  info <- lookupResInfo gr pt
+  case info of
+    ResPar ps -> liftM concat $ mapM mkPar ps
+    AnyInd _ n -> lookupParamValues gr $ redirectIdent n pt
+    _ -> prtBad "cannot find parameter type" pt
+ where
+   mkPar (ParD f co) = do
+     vs <- liftM combinations $ mapM (allParamValues gr) co
+     return $ map (Par (CIQ m f)) vs
+
+-- this is needed since param type can also be a record type
+
+allParamValues :: CanonGrammar -> CType -> Err [Term]
+allParamValues cnc ptyp = case ptyp of
+  Cn pc -> lookupParamValues cnc pc
+  RecType r -> do
+    let (ls,tys) = unzip [(l,t) | Lbg l t <- r]
+    tss <- mapM allPV tys
+    return [R (map (uncurry Ass) (zip ls ts)) | ts <- combinations tss]
+  TInts n -> return [EInt i | i <- [0..n]]
+  _ -> prtBad "cannot possibly find parameter values for" ptyp
+ where
+   allPV = allParamValues cnc
+
+-- runtime computation on GFC objects
+
+ccompute :: CanonGrammar -> [Term] -> Term -> Err Term
+ccompute cnc = vcomp
+ where
+
+  vcomp xs t = do
+    let xss = variations xs
+    ts <- mapM (\xx -> comp [] xx t) xss
+    return $ variants ts
+
+  variations xs = combinations [getVariants t | t <- xs]
+  variants ts = case ts of
+    [t] -> t
+    _ -> FV ts
+  getVariants t = case t of
+    FV ts -> ts
+    _ -> [t]
+
+  comp g xs t = case t of
+    Arg (A _ i)    -> err (const (return t)) return $ xs !? fromInteger i
+    Arg (AB _ _ i) -> err (const (return t)) return $ xs !? fromInteger i
+    I c     -> look c 
+    LI c    -> lookVar c g
+
+    -- short-cut computation of selections: compute the table only if needed
+    S u v   -> do
+      u' <- compt u
+      case u' of
+        T _ [Cas [PW] b] -> compt b  
+        T _ [Cas [PV x] b] -> do
+          v' <- compt v
+          comp ((x,v') : g) xs b  
+        T _ cs -> do
+          v' <- compt v
+          if noVar v' 
+             then matchPatt cs v' >>= compt
+             else return $ S u' v'
+        FV ccs -> do
+          v' <- compt v
+          mapM (\c -> compt (S c v')) ccs >>= return . FV
+
+        _      -> liftM (S u') $ compt v
+
+    P u l  -> do
+      u' <- compt u
+      case u' of
+        R rs -> maybe (Bad ("unknown label" +++ prt l +++ "in" +++ prt u'))
+                      return $ 
+                        lookup l [ (x,y) | Ass x y <- rs]
+        FV rrs -> do
+          mapM (\r -> compt (P r l)) rrs >>= return . FV
+
+        _    -> return $ P u' l
+    FV ts    -> liftM FV (mapM compt ts)
+    C E b    -> compt b
+    C a E    -> compt a
+    C a b    -> do
+      a' <- compt a
+      b' <- compt b
+      return $ case (a',b') of
+        (E,_) -> b'
+        (_,E) -> a'
+        _     -> C a' b'
+    R rs     -> liftM (R . map (uncurry Ass)) $ 
+                  mapPairsM compt [(l,r) | Ass l r <- rs]
+
+    -- only expand the table when the table is really needed: use expandLin
+    T ty rs -> liftM (T ty . map (uncurry Cas)) $ 
+                  mapPairsM compt [(l,r) | Cas l r <- rs]
+
+    V ptyp ts -> do
+      ts' <- mapM compt ts
+      vs0 <- allParamValues cnc ptyp
+      vs  <- mapM term2patt vs0
+      let cc = [Cas [p] u | (p,u) <- zip vs ts']
+      return $ T ptyp cc
+
+    Par c xs -> liftM (Par c) $ mapM compt xs
+
+    K (KS []) -> return E --- should not be needed
+
+    _        -> return t  
+   where
+     compt = comp g xs
+     look c = lookupGlobal cnc c >>= compt
+
+     lookVar c co = case lookup c co of
+       Just t -> return t
+       _ -> return $ LI c --- Bad $ "unknown local variable" +++ prt c --- 
+
+     noVar v = case v of
+       LI _ -> False
+       Arg _ -> False
+       R rs -> all noVar [t | Ass _ t <- rs]
+       Par _ ts -> all noVar ts
+       FV ts -> all noVar ts
+       S x y -> noVar x && noVar y
+       P t _ -> noVar t
+       _    -> True --- other cases that can be values to pattern match?
diff --git a/src-2.9/GF/Canon/MkGFC.hs b/src-2.9/GF/Canon/MkGFC.hs
new file mode 100644
index 000000000..8443354fc
--- /dev/null
+++ b/src-2.9/GF/Canon/MkGFC.hs
@@ -0,0 +1,237 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : MkGFC
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/04 11:45:38 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.16 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Canon.MkGFC (prCanonModInfo, prCanon, prCanonMGr,
+	      canon2grammar, grammar2canon, -- buildCanonGrammar,
+	      info2mod,info2def,
+	      trExp, rtExp, rtQIdent) where
+
+import GF.Canon.GFC
+import GF.Canon.AbsGFC
+import qualified GF.Grammar.Abstract as A
+import GF.Grammar.PrGrammar
+
+import GF.Infra.Ident
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+
+prCanonModInfo :: CanonModule -> String
+prCanonModInfo = prt . info2mod
+
+prCanon :: CanonGrammar -> String
+prCanon = unlines . map prCanonModInfo . M.modules
+
+prCanonMGr :: CanonGrammar -> String
+prCanonMGr g = header ++++ prCanon g where
+  header = case M.greatestAbstract g of
+    Just a -> prt (MGr (M.allConcretes g a) a [])
+    _ -> []
+
+canon2grammar :: Canon -> CanonGrammar
+canon2grammar (MGr _ _ modules) = canon2grammar (Gr modules) ---- ignoring the header
+canon2grammar (Gr modules) = M.MGrammar $ map mod2info modules
+
+mod2info m = case m of
+    Mod mt e os flags defs -> 
+      let defs' = buildTree $ map def2info defs
+          (a,mt') = case mt of
+            MTAbs a -> (a,M.MTAbstract)
+            MTRes a -> (a,M.MTResource)
+            MTCnc a x -> (a,M.MTConcrete x)
+            MTTrans a x y -> (a,M.MTTransfer (M.oSimple x) (M.oSimple y))
+      in (a,M.ModMod (M.Module mt' M.MSComplete flags (ee e) (oo os) defs'))
+ where
+  ee (Ext m) = map M.inheritAll m
+  ee _ = []
+  oo (Opens ms) = map M.oSimple ms
+  oo _ = []
+
+grammar2canon :: CanonGrammar -> Canon
+grammar2canon (M.MGrammar modules) = Gr $ map info2mod modules 
+
+info2mod :: (Ident, M.ModInfo Ident Flag Info) -> Module
+info2mod m = case m of
+    (a, M.ModMod (M.Module mt _ flags me os defs)) -> 
+      let defs' = map info2def $ tree2list defs 
+          mt'   = case mt of
+             M.MTAbstract -> MTAbs a
+             M.MTResource -> MTRes a
+             M.MTConcrete x -> MTCnc a x
+             M.MTTransfer (M.OSimple _ x) (M.OSimple _ y) -> MTTrans a x y
+      in
+        Mod mt' (gfcE me) (gfcO os) flags defs'
+ where
+  gfcE = ifNull NoExt Ext . map fst
+  gfcO os = if null os then NoOpens else Opens [m | M.OSimple _ m <- os]
+
+
+-- these translations are meant to be trivial
+
+defs2infos = sorted2tree . map def2info
+
+def2info d = case d of
+  AbsDCat c cont fs -> (c,AbsCat (trCont cont) (trFs fs))
+  AbsDFun c ty df   -> (c,AbsFun (trExp ty) (trExp df))
+  AbsDTrans c t     -> (c,AbsTrans (trExp t))
+  ResDPar c    df   -> (c,ResPar df)
+  ResDOper c ty df  -> (c,ResOper ty df)
+  CncDCat c ty df pr   -> (c, CncCat ty df pr)
+  CncDFun f c xs li pr -> (f, CncFun c xs li pr)
+  AnyDInd c b m        -> (c, AnyInd (b == Canon) m)
+
+-- from file to internal
+
+trCont cont = [(x,trExp t) | Decl x t <- cont]
+
+trFs = map trQIdent
+
+trExp :: Exp -> A.Term
+trExp t = case t of
+  EProd x a b -> A.Prod x (trExp a) (trExp b)
+  EAbs  x   b -> A.Abs  x (trExp b)
+  EApp  f a   -> A.App  (trExp f)  (trExp a)
+  EEq eqs     -> A.Eqs [(map trPt ps, trExp e) | Equ ps e <- eqs]
+  EData       -> A.EData
+  _    -> trAt t
+ where
+  trAt (EAtom t) = case t of
+    AC c   -> (uncurry A.Q)  $ trQIdent c
+    AD c   -> (uncurry A.QC) $ trQIdent c
+    AV v   -> A.Vr v
+    AM i   -> A.Meta $ A.MetaSymb $ fromInteger i
+    AT s   -> A.Sort $ prt s
+    AS s   -> A.K s
+    AI i   -> A.EInt $ i
+    AF i   -> A.EFloat $ i
+  trPt p = case p of
+    APC mc ps -> let (m,c) = trQIdent mc in A.PP m c (map trPt ps)
+    APV x -> A.PV x
+    APS s -> A.PString s
+    API i -> A.PInt $ i
+    APF i -> A.PFloat $ i
+    APW   -> A.PW
+
+trQIdent (CIQ m c) = (m,c)
+
+-- from internal to file
+
+infos2defs = map info2def . tree2list
+
+info2def d = case d of
+  (c,AbsCat cont fs)    -> AbsDCat c (rtCont cont) (rtFs fs)
+  (c,AbsFun ty df)      -> AbsDFun c (rtExp ty) (rtExp df)
+  (c,AbsTrans t)        -> AbsDTrans c (rtExp t)
+  (c,ResPar    df)      -> ResDPar c df
+  (c,ResOper ty df)     -> ResDOper c ty df
+  (c,CncCat ty df pr)   -> CncDCat c ty df pr
+  (f,CncFun c xs li pr) -> CncDFun f c xs li pr
+  (c,AnyInd b m)        -> AnyDInd c (if b then Canon else NonCan) m
+
+rtCont cont = [Decl (rtIdent x) (rtExp t) | (x,t) <- cont]
+
+rtFs = map rtQIdent
+
+rtExp :: A.Term -> Exp
+rtExp t = case t of
+  A.Prod x a b -> EProd (rtIdent x) (rtExp a) (rtExp b)
+  A.Abs  x   b -> EAbs  (rtIdent x) (rtExp b)
+  A.App  f a   -> EApp  (rtExp f) (rtExp a)
+  A.Eqs eqs    -> EEq   [Equ (map rtPt ps) (rtExp e) | (ps,e) <- eqs]
+  A.EData      -> EData
+  _ -> EAtom $ rtAt t
+ where
+  rtAt t = case t of
+    A.Q m c        -> AC $ rtQIdent (m,c)
+    A.QC m c       -> AD $ rtQIdent (m,c)
+    A.Vr v         -> AV v
+    A.Meta i       -> AM $ toInteger $ A.metaSymbInt i
+    A.Sort "Type"  -> AT SType
+    A.K s          -> AS s
+    A.EInt i       -> AI $ toInteger i
+    _ -> error $ "MkGFC.rt not defined for" +++ show t
+  rtPt p = case p of
+    A.PP m c ps -> APC (rtQIdent (m,c)) (map rtPt ps)
+    A.PV x      -> APV x
+    A.PString s -> APS s
+    A.PInt i    -> API $ toInteger i
+    A.PW        -> APW
+    _ -> error $ "MkGFC.rt not defined for" +++ show p
+
+
+rtQIdent :: (Ident, Ident) -> CIdent
+rtQIdent (m,c) = CIQ (rtIdent m) (rtIdent c)
+rtIdent x 
+  | isWildIdent x = identC "h_" --- needed in declarations
+  | otherwise = identC $ prt x ---
+
+{-
+-- the following is called in GetGFC to read gfc files line
+-- by line. It does not save memory, though, and is therefore
+-- not used.
+
+buildCanonGrammar :: Int -> CanonGrammar -> Line -> (CanonGrammar,Int)
+buildCanonGrammar n gr0 line = mgr $ case line of
+-- LMulti ids id
+  LHeader mt ext op -> newModule mt ext op
+  LFlag f@(Flg (IC "modulesize") (IC n)) -> initModule f $ read $ tail n
+  LFlag flag        -> newFlag flag
+  LDef def          -> newDef $ def2info def
+--  LEnd              -> cleanNames
+  _                 -> M.modules gr0
+ where
+   newModule mt ext op = mod2info (Mod mt ext op [] []) : mods
+   initModule f i = case actm of
+     (name, M.ModMod (M.Module mt com flags ee oo defs)) ->
+       (name, M.ModMod (M.Module mt com (f:flags) ee oo (newtree i))) : tmods
+   newFlag f = case actm of
+     (name, M.ModMod (M.Module mt com flags ee oo defs)) ->
+       (name, M.ModMod (M.Module mt com (f:flags) ee oo defs)) : tmods
+   newDef d = case actm of
+     (name, M.ModMod (M.Module mt com flags ee oo defs)) ->
+       (name, M.ModMod (M.Module mt com flags ee oo 
+          (upd (padd 8 n) d defs))) : tmods
+
+--   cleanNames = case actm of
+--     (name, M.ModMod (M.Module mt com flags ee oo defs)) ->
+--       (name, M.ModMod (M.Module mt com (reverse flags) ee oo 
+--          (mapTree (\ (IC f,t) -> (IC (drop 8 f),t)) defs))) : tmods
+
+   actm = head mods -- only used when a new mod has been created
+   mods = M.modules gr0
+   tmods = tail mods
+
+   mgr ms = (M.MGrammar ms, case line of
+     LDef _ -> n+1
+     LEnd   -> 1
+     _ -> n
+     )
+
+   -- create an initial tree with who-cares value
+   newtree (i :: Int) = emptyBinTree
+--   newtree (i :: Int) = sorted2tree [
+--     (padd 8 k, ResPar []) | 
+--     k <- [1..i]] --- padd (length (show i))
+
+   padd l k = 0
+--   padd l k = let sk = show k in identC (replicate (l - length sk) '0' ++ sk)
+
+   upd _ d defs = updateTree d defs
+--   upd n d@(f,t) defs = case defs of
+--     NT -> BT (merg n f,t) NT NT --- should not happen
+--     BT c@(a,_) left right 
+--       | n < a  -> let left'  = upd n d left  in BT c left' right 
+--       | n > a  -> let right' = upd n d right in BT c left right' 
+--       | otherwise -> BT (merg n f,t) left right
+--   merg (IC n) (IC f) = IC (n ++ f)
+-}
diff --git a/src-2.9/GF/Canon/ParGFC.hs b/src-2.9/GF/Canon/ParGFC.hs
new file mode 100644
index 000000000..4332c06e4
--- /dev/null
+++ b/src-2.9/GF/Canon/ParGFC.hs
@@ -0,0 +1,2142 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+module GF.Canon.ParGFC where  -- H
+import GF.Canon.AbsGFC -- H
+import GF.Canon.LexGFC -- H
+import GF.Data.ErrM -- H
+import GF.Infra.Ident -- H
+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 :: (Canon) -> (HappyAbsSyn )
+happyIn9 x = unsafeCoerce# x
+{-# INLINE happyIn9 #-}
+happyOut9 :: (HappyAbsSyn ) -> (Canon)
+happyOut9 x = unsafeCoerce# x
+{-# INLINE happyOut9 #-}
+happyIn10 :: (Line) -> (HappyAbsSyn )
+happyIn10 x = unsafeCoerce# x
+{-# INLINE happyIn10 #-}
+happyOut10 :: (HappyAbsSyn ) -> (Line)
+happyOut10 x = unsafeCoerce# x
+{-# INLINE happyOut10 #-}
+happyIn11 :: (Module) -> (HappyAbsSyn )
+happyIn11 x = unsafeCoerce# x
+{-# INLINE happyIn11 #-}
+happyOut11 :: (HappyAbsSyn ) -> (Module)
+happyOut11 x = unsafeCoerce# x
+{-# INLINE happyOut11 #-}
+happyIn12 :: (ModType) -> (HappyAbsSyn )
+happyIn12 x = unsafeCoerce# x
+{-# INLINE happyIn12 #-}
+happyOut12 :: (HappyAbsSyn ) -> (ModType)
+happyOut12 x = unsafeCoerce# x
+{-# INLINE happyOut12 #-}
+happyIn13 :: ([Module]) -> (HappyAbsSyn )
+happyIn13 x = unsafeCoerce# x
+{-# INLINE happyIn13 #-}
+happyOut13 :: (HappyAbsSyn ) -> ([Module])
+happyOut13 x = unsafeCoerce# x
+{-# INLINE happyOut13 #-}
+happyIn14 :: (Extend) -> (HappyAbsSyn )
+happyIn14 x = unsafeCoerce# x
+{-# INLINE happyIn14 #-}
+happyOut14 :: (HappyAbsSyn ) -> (Extend)
+happyOut14 x = unsafeCoerce# x
+{-# INLINE happyOut14 #-}
+happyIn15 :: (Open) -> (HappyAbsSyn )
+happyIn15 x = unsafeCoerce# x
+{-# INLINE happyIn15 #-}
+happyOut15 :: (HappyAbsSyn ) -> (Open)
+happyOut15 x = unsafeCoerce# x
+{-# INLINE happyOut15 #-}
+happyIn16 :: (Flag) -> (HappyAbsSyn )
+happyIn16 x = unsafeCoerce# x
+{-# INLINE happyIn16 #-}
+happyOut16 :: (HappyAbsSyn ) -> (Flag)
+happyOut16 x = unsafeCoerce# x
+{-# INLINE happyOut16 #-}
+happyIn17 :: (Def) -> (HappyAbsSyn )
+happyIn17 x = unsafeCoerce# x
+{-# INLINE happyIn17 #-}
+happyOut17 :: (HappyAbsSyn ) -> (Def)
+happyOut17 x = unsafeCoerce# x
+{-# INLINE happyOut17 #-}
+happyIn18 :: (ParDef) -> (HappyAbsSyn )
+happyIn18 x = unsafeCoerce# x
+{-# INLINE happyIn18 #-}
+happyOut18 :: (HappyAbsSyn ) -> (ParDef)
+happyOut18 x = unsafeCoerce# x
+{-# INLINE happyOut18 #-}
+happyIn19 :: (Status) -> (HappyAbsSyn )
+happyIn19 x = unsafeCoerce# x
+{-# INLINE happyIn19 #-}
+happyOut19 :: (HappyAbsSyn ) -> (Status)
+happyOut19 x = unsafeCoerce# x
+{-# INLINE happyOut19 #-}
+happyIn20 :: (CIdent) -> (HappyAbsSyn )
+happyIn20 x = unsafeCoerce# x
+{-# INLINE happyIn20 #-}
+happyOut20 :: (HappyAbsSyn ) -> (CIdent)
+happyOut20 x = unsafeCoerce# x
+{-# INLINE happyOut20 #-}
+happyIn21 :: (Exp) -> (HappyAbsSyn )
+happyIn21 x = unsafeCoerce# x
+{-# INLINE happyIn21 #-}
+happyOut21 :: (HappyAbsSyn ) -> (Exp)
+happyOut21 x = unsafeCoerce# x
+{-# INLINE happyOut21 #-}
+happyIn22 :: (Exp) -> (HappyAbsSyn )
+happyIn22 x = unsafeCoerce# x
+{-# INLINE happyIn22 #-}
+happyOut22 :: (HappyAbsSyn ) -> (Exp)
+happyOut22 x = unsafeCoerce# x
+{-# INLINE happyOut22 #-}
+happyIn23 :: (Exp) -> (HappyAbsSyn )
+happyIn23 x = unsafeCoerce# x
+{-# INLINE happyIn23 #-}
+happyOut23 :: (HappyAbsSyn ) -> (Exp)
+happyOut23 x = unsafeCoerce# x
+{-# INLINE happyOut23 #-}
+happyIn24 :: (Sort) -> (HappyAbsSyn )
+happyIn24 x = unsafeCoerce# x
+{-# INLINE happyIn24 #-}
+happyOut24 :: (HappyAbsSyn ) -> (Sort)
+happyOut24 x = unsafeCoerce# x
+{-# INLINE happyOut24 #-}
+happyIn25 :: (Equation) -> (HappyAbsSyn )
+happyIn25 x = unsafeCoerce# x
+{-# INLINE happyIn25 #-}
+happyOut25 :: (HappyAbsSyn ) -> (Equation)
+happyOut25 x = unsafeCoerce# x
+{-# INLINE happyOut25 #-}
+happyIn26 :: (APatt) -> (HappyAbsSyn )
+happyIn26 x = unsafeCoerce# x
+{-# INLINE happyIn26 #-}
+happyOut26 :: (HappyAbsSyn ) -> (APatt)
+happyOut26 x = unsafeCoerce# x
+{-# INLINE happyOut26 #-}
+happyIn27 :: ([Decl]) -> (HappyAbsSyn )
+happyIn27 x = unsafeCoerce# x
+{-# INLINE happyIn27 #-}
+happyOut27 :: (HappyAbsSyn ) -> ([Decl])
+happyOut27 x = unsafeCoerce# x
+{-# INLINE happyOut27 #-}
+happyIn28 :: ([APatt]) -> (HappyAbsSyn )
+happyIn28 x = unsafeCoerce# x
+{-# INLINE happyIn28 #-}
+happyOut28 :: (HappyAbsSyn ) -> ([APatt])
+happyOut28 x = unsafeCoerce# x
+{-# INLINE happyOut28 #-}
+happyIn29 :: ([Equation]) -> (HappyAbsSyn )
+happyIn29 x = unsafeCoerce# x
+{-# INLINE happyIn29 #-}
+happyOut29 :: (HappyAbsSyn ) -> ([Equation])
+happyOut29 x = unsafeCoerce# x
+{-# INLINE happyOut29 #-}
+happyIn30 :: (Atom) -> (HappyAbsSyn )
+happyIn30 x = unsafeCoerce# x
+{-# INLINE happyIn30 #-}
+happyOut30 :: (HappyAbsSyn ) -> (Atom)
+happyOut30 x = unsafeCoerce# x
+{-# INLINE happyOut30 #-}
+happyIn31 :: (Decl) -> (HappyAbsSyn )
+happyIn31 x = unsafeCoerce# x
+{-# INLINE happyIn31 #-}
+happyOut31 :: (HappyAbsSyn ) -> (Decl)
+happyOut31 x = unsafeCoerce# x
+{-# INLINE happyOut31 #-}
+happyIn32 :: (CType) -> (HappyAbsSyn )
+happyIn32 x = unsafeCoerce# x
+{-# INLINE happyIn32 #-}
+happyOut32 :: (HappyAbsSyn ) -> (CType)
+happyOut32 x = unsafeCoerce# x
+{-# INLINE happyOut32 #-}
+happyIn33 :: (Labelling) -> (HappyAbsSyn )
+happyIn33 x = unsafeCoerce# x
+{-# INLINE happyIn33 #-}
+happyOut33 :: (HappyAbsSyn ) -> (Labelling)
+happyOut33 x = unsafeCoerce# x
+{-# INLINE happyOut33 #-}
+happyIn34 :: (Term) -> (HappyAbsSyn )
+happyIn34 x = unsafeCoerce# x
+{-# INLINE happyIn34 #-}
+happyOut34 :: (HappyAbsSyn ) -> (Term)
+happyOut34 x = unsafeCoerce# x
+{-# INLINE happyOut34 #-}
+happyIn35 :: (Term) -> (HappyAbsSyn )
+happyIn35 x = unsafeCoerce# x
+{-# INLINE happyIn35 #-}
+happyOut35 :: (HappyAbsSyn ) -> (Term)
+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 :: (Assign) -> (HappyAbsSyn )
+happyIn38 x = unsafeCoerce# x
+{-# INLINE happyIn38 #-}
+happyOut38 :: (HappyAbsSyn ) -> (Assign)
+happyOut38 x = unsafeCoerce# x
+{-# INLINE happyOut38 #-}
+happyIn39 :: (Case) -> (HappyAbsSyn )
+happyIn39 x = unsafeCoerce# x
+{-# INLINE happyIn39 #-}
+happyOut39 :: (HappyAbsSyn ) -> (Case)
+happyOut39 x = unsafeCoerce# x
+{-# INLINE happyOut39 #-}
+happyIn40 :: (Variant) -> (HappyAbsSyn )
+happyIn40 x = unsafeCoerce# x
+{-# INLINE happyIn40 #-}
+happyOut40 :: (HappyAbsSyn ) -> (Variant)
+happyOut40 x = unsafeCoerce# x
+{-# INLINE happyOut40 #-}
+happyIn41 :: (Label) -> (HappyAbsSyn )
+happyIn41 x = unsafeCoerce# x
+{-# INLINE happyIn41 #-}
+happyOut41 :: (HappyAbsSyn ) -> (Label)
+happyOut41 x = unsafeCoerce# x
+{-# INLINE happyOut41 #-}
+happyIn42 :: (ArgVar) -> (HappyAbsSyn )
+happyIn42 x = unsafeCoerce# x
+{-# INLINE happyIn42 #-}
+happyOut42 :: (HappyAbsSyn ) -> (ArgVar)
+happyOut42 x = unsafeCoerce# x
+{-# INLINE happyOut42 #-}
+happyIn43 :: (Patt) -> (HappyAbsSyn )
+happyIn43 x = unsafeCoerce# x
+{-# INLINE happyIn43 #-}
+happyOut43 :: (HappyAbsSyn ) -> (Patt)
+happyOut43 x = unsafeCoerce# x
+{-# INLINE happyOut43 #-}
+happyIn44 :: (PattAssign) -> (HappyAbsSyn )
+happyIn44 x = unsafeCoerce# x
+{-# INLINE happyIn44 #-}
+happyOut44 :: (HappyAbsSyn ) -> (PattAssign)
+happyOut44 x = unsafeCoerce# x
+{-# INLINE happyOut44 #-}
+happyIn45 :: ([Flag]) -> (HappyAbsSyn )
+happyIn45 x = unsafeCoerce# x
+{-# INLINE happyIn45 #-}
+happyOut45 :: (HappyAbsSyn ) -> ([Flag])
+happyOut45 x = unsafeCoerce# x
+{-# INLINE happyOut45 #-}
+happyIn46 :: ([Def]) -> (HappyAbsSyn )
+happyIn46 x = unsafeCoerce# x
+{-# INLINE happyIn46 #-}
+happyOut46 :: (HappyAbsSyn ) -> ([Def])
+happyOut46 x = unsafeCoerce# x
+{-# INLINE happyOut46 #-}
+happyIn47 :: ([ParDef]) -> (HappyAbsSyn )
+happyIn47 x = unsafeCoerce# x
+{-# INLINE happyIn47 #-}
+happyOut47 :: (HappyAbsSyn ) -> ([ParDef])
+happyOut47 x = unsafeCoerce# x
+{-# INLINE happyOut47 #-}
+happyIn48 :: ([CType]) -> (HappyAbsSyn )
+happyIn48 x = unsafeCoerce# x
+{-# INLINE happyIn48 #-}
+happyOut48 :: (HappyAbsSyn ) -> ([CType])
+happyOut48 x = unsafeCoerce# x
+{-# INLINE happyOut48 #-}
+happyIn49 :: ([CIdent]) -> (HappyAbsSyn )
+happyIn49 x = unsafeCoerce# x
+{-# INLINE happyIn49 #-}
+happyOut49 :: (HappyAbsSyn ) -> ([CIdent])
+happyOut49 x = unsafeCoerce# x
+{-# INLINE happyOut49 #-}
+happyIn50 :: ([Assign]) -> (HappyAbsSyn )
+happyIn50 x = unsafeCoerce# x
+{-# INLINE happyIn50 #-}
+happyOut50 :: (HappyAbsSyn ) -> ([Assign])
+happyOut50 x = unsafeCoerce# x
+{-# INLINE happyOut50 #-}
+happyIn51 :: ([ArgVar]) -> (HappyAbsSyn )
+happyIn51 x = unsafeCoerce# x
+{-# INLINE happyIn51 #-}
+happyOut51 :: (HappyAbsSyn ) -> ([ArgVar])
+happyOut51 x = unsafeCoerce# x
+{-# INLINE happyOut51 #-}
+happyIn52 :: ([Labelling]) -> (HappyAbsSyn )
+happyIn52 x = unsafeCoerce# x
+{-# INLINE happyIn52 #-}
+happyOut52 :: (HappyAbsSyn ) -> ([Labelling])
+happyOut52 x = unsafeCoerce# x
+{-# INLINE happyOut52 #-}
+happyIn53 :: ([Case]) -> (HappyAbsSyn )
+happyIn53 x = unsafeCoerce# x
+{-# INLINE happyIn53 #-}
+happyOut53 :: (HappyAbsSyn ) -> ([Case])
+happyOut53 x = unsafeCoerce# x
+{-# INLINE happyOut53 #-}
+happyIn54 :: ([Term]) -> (HappyAbsSyn )
+happyIn54 x = unsafeCoerce# x
+{-# INLINE happyIn54 #-}
+happyOut54 :: (HappyAbsSyn ) -> ([Term])
+happyOut54 x = unsafeCoerce# x
+{-# INLINE happyOut54 #-}
+happyIn55 :: ([String]) -> (HappyAbsSyn )
+happyIn55 x = unsafeCoerce# x
+{-# INLINE happyIn55 #-}
+happyOut55 :: (HappyAbsSyn ) -> ([String])
+happyOut55 x = unsafeCoerce# x
+{-# INLINE happyOut55 #-}
+happyIn56 :: ([Variant]) -> (HappyAbsSyn )
+happyIn56 x = unsafeCoerce# x
+{-# INLINE happyIn56 #-}
+happyOut56 :: (HappyAbsSyn ) -> ([Variant])
+happyOut56 x = unsafeCoerce# x
+{-# INLINE happyOut56 #-}
+happyIn57 :: ([PattAssign]) -> (HappyAbsSyn )
+happyIn57 x = unsafeCoerce# x
+{-# INLINE happyIn57 #-}
+happyOut57 :: (HappyAbsSyn ) -> ([PattAssign])
+happyOut57 x = unsafeCoerce# x
+{-# INLINE happyOut57 #-}
+happyIn58 :: ([Patt]) -> (HappyAbsSyn )
+happyIn58 x = unsafeCoerce# x
+{-# INLINE happyIn58 #-}
+happyOut58 :: (HappyAbsSyn ) -> ([Patt])
+happyOut58 x = unsafeCoerce# x
+{-# INLINE happyOut58 #-}
+happyIn59 :: ([Ident]) -> (HappyAbsSyn )
+happyIn59 x = unsafeCoerce# x
+{-# INLINE happyIn59 #-}
+happyOut59 :: (HappyAbsSyn ) -> ([Ident])
+happyOut59 x = unsafeCoerce# x
+{-# INLINE happyOut59 #-}
+happyInTok :: Token -> (HappyAbsSyn )
+happyInTok x = unsafeCoerce# x
+{-# INLINE happyInTok #-}
+happyOutTok :: (HappyAbsSyn ) -> Token
+happyOutTok x = unsafeCoerce# x
+{-# INLINE happyOutTok #-}
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\x74\x02\xa7\x00\x6e\x02\x00\x00\x6c\x02\x66\x02\x89\x02\x88\x02\x84\x02\x00\x00\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x62\x02\x52\x02\x21\x02\x60\x02\x6d\x02\x5e\x02\x00\x00\x82\x02\x5b\x02\xdb\x00\x00\x00\x80\x02\x7e\x02\x7d\x02\x79\x02\x59\x02\x78\x02\x7a\x02\x58\x02\x73\x02\x00\x00\x00\x00\x00\x00\x28\x00\x53\x02\x00\x00\x46\x02\x51\x02\x72\x02\x44\x02\x44\x02\x44\x02\x8b\x00\x44\x02\x44\x02\x9b\x00\x9b\x00\x44\x02\x8b\x00\x44\x02\x71\x02\x28\x00\x42\x02\x42\x02\x00\x00\x70\x02\x4b\x02\x6a\x02\x64\x02\x00\x00\x00\x00\x00\x00\xdf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x02\x8b\x00\x38\x02\x38\x02\x3f\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x02\x00\x00\x00\x00\x6b\x02\xf7\xff\x9b\x00\x39\x02\x00\x00\x69\x02\x68\x02\x67\x02\x65\x02\x00\x00\x00\x00\x61\x02\x5c\x02\x63\x02\x00\x00\x5f\x02\x30\x02\x00\x00\x3e\x02\x00\x00\x2f\x02\x5d\x02\x8b\x00\x8b\x00\x00\x00\x54\x02\x12\x00\x00\x00\x4a\x02\x00\x00\x5a\x02\x57\x02\x56\x02\x26\x02\x12\x00\x27\x02\x9b\x00\x00\x00\x00\x00\x47\x02\xd7\x00\x48\x02\x50\x02\x4d\x02\x00\x00\x8b\x00\x23\x02\x23\x02\x4f\x02\x00\x00\x21\x02\x00\x00\x00\x00\x00\x00\x4e\x02\x7e\x00\x00\x00\x8b\x00\x00\x00\x8b\x00\x00\x00\x00\x00\x00\x00\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x02\x36\x02\x33\x02\x00\x00\x00\x00\xf7\xff\xfe\xff\x12\x00\x16\x02\x16\x02\x9b\x00\x43\x02\x00\x00\x00\x00\x00\x00\x9b\x00\xf7\xff\x9b\x00\xba\x00\x14\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x02\x66\x00\x2a\x02\x3d\x02\x12\x00\x12\x00\x35\x02\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x00\x00\x07\x00\x00\x00\x00\x00\x3c\x02\x2c\x02\x29\x02\x5f\x00\xf7\xff\x0d\x02\x0d\x02\x1e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8b\x00\xfb\x01\x00\x00\x00\x00\x08\x02\x28\x02\xb4\x00\x00\x00\x00\x00\x22\x02\x0c\x02\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\xf7\xff\x1a\x00\x00\x00\x55\x00\x10\x02\x00\x00\x4f\x00\x00\x00\xff\x01\xfc\x01\x12\x00\xe1\x01\x00\x00\x00\x00\xac\x00\x00\x00\x00\x00\x1d\x00\x0f\x02\x0a\x02\x65\x00\x00\x00\x00\x00\x6f\x00\x00\x00\xfa\x01\xd6\x01\x8b\x00\xda\x00\xf9\x01\x00\x00\xc8\x01\x00\x00\xf6\x01\x00\x00\x00\x00\x00\x00\x00\x00\xf4\x01\x59\x00\xf3\x01\x00\x00\x00\x00\x00\x00\x00\x00\xf7\xff\xc5\x01\x00\x00\x12\x00\x00\x00\xf0\x01\x00\x00\x12\x00\xc9\x01\x00\x00\xc9\x01\x00\x00\xdd\x01\xdc\x01\xd8\x01\xd1\x01\x00\x00\x37\x00\x00\x00\xa9\x01\x00\x00\x00\x00\xf7\xff\x16\x00\x48\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\x9c\x00\x5d\x01\x00\x00\x00\x00\xb7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc4\x01\xc2\x01\xc1\x01\xbc\x01\xb1\x01\x06\x00\xb0\x01\xa8\x01\xa4\x01\x8f\x01\x8e\x01\x8c\x01\x00\x00\x6e\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\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\x02\x00\x00\x00\x00\x00\x86\x01\x72\x01\x00\x00\x9f\x00\x7b\x01\x70\x01\x25\x02\x65\x01\xe0\x01\x36\x01\x19\x01\xa6\x00\x20\x02\x52\x01\x00\x00\x01\x00\x40\x01\x04\x00\x00\x00\x00\x00\x35\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x26\x01\x3c\x01\x0b\x02\xc6\x01\x3b\x01\x38\x01\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x18\x01\x33\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\x03\x00\x00\x00\x00\x00\x00\x00\x8f\x00\x00\x00\x06\x02\xf1\x01\x00\x00\x00\x00\x7e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x01\x6b\x01\x6a\x00\x17\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xec\x01\x1f\x01\x1d\x01\x00\x00\x14\x01\x6e\x00\xf3\x00\x00\x00\x00\x00\x00\x00\xab\x01\x00\x00\xd7\x01\x00\x00\xd2\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\xc8\x00\x00\x00\x58\x01\xb4\x01\xfd\x00\xf9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xef\x00\x0f\x00\x0c\x00\x00\x00\x35\x00\x00\x00\x00\x00\xc7\x00\x00\x00\x00\x00\xa6\x01\x00\x00\x00\x00\x00\x00\x54\x01\x82\x01\x00\x00\x00\x00\x00\x00\xc1\x00\x00\x00\x00\x00\xa8\x00\x00\x00\x00\x00\x90\x00\x00\x00\x00\x00\x00\x00\x96\x01\x0e\x00\xe8\x00\xd3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x01\x37\x01\x00\x00\x00\x00\x51\x00\x00\x00\x03\x01\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x01\xc0\x00\xa1\x00\x00\x00\x92\x01\x3a\x01\x5c\x00\x92\x01\x00\x00\x00\x00\x00\x00\x2e\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x92\x01\x00\x00\x00\x00\xff\x00\x00\x00\x00\x00\x77\x01\x00\x00\x00\x00\x74\x00\xb8\x01\xab\x01\x00\x00\x00\x00\x6c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x47\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x10\x00\x00\x00\x2a\x01\x00\x00\x3d\x00\x00\x00\x04\x01\x00\x00\x00\x00\x00\x00\xe2\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe0\xff\x91\x00\x00\x00\x17\x00\x00\x00\x00\x00\x09\x00\xf8\x00\xf4\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\xed\xff\x00\x00\x00\x00\xfd\xff\xdc\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf3\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\xff\x6f\xff\x6e\xff\x00\x00\xec\xff\x00\x00\x00\x00\x00\x00\xef\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xff\xf4\xff\xf5\xff\xea\xff\x00\x00\xdd\xff\x00\x00\xe8\xff\x00\x00\xc9\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\xff\x00\x00\x00\x00\x00\x00\xea\xff\x00\x00\x6f\xff\x6d\xff\x00\x00\xe8\xff\x00\x00\x00\x00\xbe\xff\xbd\xff\xc2\xff\xd5\xff\xe4\xff\xd9\xff\xbc\xff\xd4\xff\xc4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd1\xff\xd3\xff\xfc\xff\xfb\xff\x8b\xff\x8d\xff\xe3\xff\xb8\xff\x00\x00\x81\xff\x00\x00\x00\x00\xb7\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe7\xff\xf0\xff\x00\x00\x00\x00\xc8\xff\xeb\xff\x00\x00\x6f\xff\xdf\xff\x00\x00\xf6\xff\xc9\xff\x00\x00\x00\x00\x00\x00\xf7\xff\x00\x00\x00\x00\xb6\xff\x00\x00\x9d\xff\x80\xff\x00\x00\x00\x00\x00\x00\x00\x00\x8e\xff\xde\xff\xbf\xff\xc0\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xff\xda\xff\x00\x00\x00\x00\x00\x00\x00\x00\xed\xff\xf9\xff\x92\xff\xee\xff\xdb\xff\x00\x00\x00\x00\xd6\xff\x00\x00\xd2\xff\x00\x00\xc1\xff\x8a\xff\x8c\xff\x00\x00\xa2\xff\xaf\xff\xae\xff\xb3\xff\xa5\xff\xa3\xff\xe2\xff\xad\xff\xb4\xff\x87\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xff\x9c\xff\xba\xff\x00\x00\x81\xff\x00\x00\x00\x00\x84\xff\xe5\xff\xbb\xff\x89\xff\xc7\xff\xe9\xff\xe6\xff\x00\x00\x83\xff\x00\x00\x00\x00\x00\x00\x00\x00\x7f\xff\xb5\xff\x7b\xff\x00\x00\xb1\xff\x7b\xff\x00\x00\xac\xff\x79\xff\x86\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd7\xff\xce\xff\xcd\xff\xcc\xff\xcb\xff\xc5\xff\x00\x00\x00\x00\xca\xff\xc3\xff\x90\xff\x00\x00\x00\x00\xc6\xff\xd0\xff\x00\x00\x00\x00\x9b\xff\xaa\xff\xa7\xff\xb0\xff\x00\x00\x87\xff\x00\x00\xab\xff\x00\x00\x71\xff\x7b\xff\x00\x00\xb9\xff\xa4\xff\xe1\xff\x00\x00\x84\xff\x88\xff\x82\xff\x00\x00\x7a\xff\xa6\xff\x00\x00\x7d\xff\x00\x00\x00\x00\xb2\xff\x78\xff\x77\xff\x85\xff\xa0\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xff\x00\x00\x91\xff\x00\x00\x8f\xff\xcf\xff\xd8\xff\x9a\xff\x76\xff\x00\x00\x00\x00\x98\xff\x95\xff\x94\xff\x70\xff\x74\xff\x00\x00\x97\xff\x00\x00\xa9\xff\x71\xff\xa8\xff\x00\x00\xe0\xff\x7c\xff\x9f\xff\x71\xff\x00\x00\x73\xff\x00\x00\x00\x00\x79\xff\x77\xff\x75\xff\x9e\xff\xa1\xff\x96\xff\x74\xff\x00\x00\x00\x00\x99\xff\x93\xff\x72\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x11\x00\x00\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x32\x00\x14\x00\x0d\x00\x03\x00\x17\x00\x35\x00\x01\x00\x03\x00\x08\x00\x0f\x00\x15\x00\x03\x00\x0c\x00\x0f\x00\x03\x00\x0f\x00\x0c\x00\x11\x00\x0e\x00\x08\x00\x09\x00\x1b\x00\x31\x00\x0c\x00\x2c\x00\x1c\x00\x0f\x00\x24\x00\x11\x00\x07\x00\x27\x00\x24\x00\x24\x00\x24\x00\x27\x00\x00\x00\x25\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x36\x00\x34\x00\x2f\x00\x2e\x00\x2e\x00\x34\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x31\x00\x01\x00\x33\x00\x34\x00\x03\x00\x32\x00\x16\x00\x31\x00\x32\x00\x33\x00\x34\x00\x03\x00\x04\x00\x0c\x00\x0d\x00\x0e\x00\x08\x00\x03\x00\x31\x00\x25\x00\x0c\x00\x0b\x00\x08\x00\x0f\x00\x22\x00\x11\x00\x0c\x00\x03\x00\x2e\x00\x0f\x00\x10\x00\x11\x00\x08\x00\x03\x00\x32\x00\x00\x00\x0c\x00\x00\x00\x30\x00\x0f\x00\x16\x00\x11\x00\x0c\x00\x35\x00\x0e\x00\x06\x00\x07\x00\x02\x00\x0d\x00\x13\x00\x31\x00\x29\x00\x33\x00\x34\x00\x17\x00\x18\x00\x00\x00\x31\x00\x32\x00\x33\x00\x34\x00\x06\x00\x16\x00\x31\x00\x32\x00\x33\x00\x34\x00\x0c\x00\x32\x00\x0e\x00\x31\x00\x03\x00\x00\x00\x31\x00\x32\x00\x33\x00\x34\x00\x2a\x00\x0a\x00\x31\x00\x0c\x00\x33\x00\x34\x00\x0f\x00\x1c\x00\x11\x00\x12\x00\x03\x00\x00\x00\x04\x00\x32\x00\x01\x00\x24\x00\x08\x00\x16\x00\x00\x00\x0c\x00\x1d\x00\x1a\x00\x17\x00\x04\x00\x21\x00\x01\x00\x2f\x00\x31\x00\x32\x00\x33\x00\x34\x00\x0d\x00\x23\x00\x16\x00\x1b\x00\x1c\x00\x04\x00\x1a\x00\x03\x00\x01\x00\x31\x00\x32\x00\x33\x00\x08\x00\x00\x00\x15\x00\x32\x00\x32\x00\x33\x00\x1e\x00\x1f\x00\x20\x00\x00\x00\x22\x00\x23\x00\x24\x00\x31\x00\x26\x00\x27\x00\x15\x00\x2a\x00\x2a\x00\x2b\x00\x1f\x00\x2d\x00\x02\x00\x2f\x00\x23\x00\x31\x00\x31\x00\x26\x00\x27\x00\x05\x00\x02\x00\x2a\x00\x2b\x00\x05\x00\x21\x00\x0b\x00\x2f\x00\x24\x00\x31\x00\x0c\x00\x0d\x00\x0e\x00\x21\x00\x02\x00\x0c\x00\x24\x00\x2d\x00\x0f\x00\x00\x00\x11\x00\x12\x00\x31\x00\x2c\x00\x00\x00\x2d\x00\x02\x00\x03\x00\x00\x00\x00\x00\x02\x00\x03\x00\x1d\x00\x00\x00\x0f\x00\x00\x00\x21\x00\x02\x00\x03\x00\x00\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0f\x00\x0b\x00\x1b\x00\x31\x00\x32\x00\x33\x00\x34\x00\x0c\x00\x31\x00\x32\x00\x33\x00\x0f\x00\x1b\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x26\x00\x28\x00\x08\x00\x00\x00\x26\x00\x00\x00\x02\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x26\x00\x0f\x00\x0f\x00\x0f\x00\x25\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1b\x00\x1b\x00\x1b\x00\x02\x00\x00\x00\x00\x00\x2b\x00\x0f\x00\x02\x00\x00\x00\x00\x00\x0f\x00\x18\x00\x0a\x00\x00\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0f\x00\x0f\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x25\x00\x0f\x00\x1b\x00\x00\x00\x25\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x22\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x05\x00\x0f\x00\x07\x00\x00\x00\x25\x00\x0f\x00\x0b\x00\x0c\x00\x30\x00\x00\x00\x01\x00\x02\x00\x03\x00\x35\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x25\x00\x0f\x00\x00\x00\x0a\x00\x25\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x00\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x25\x00\x0f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x23\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x1d\x00\x1e\x00\x0f\x00\x20\x00\x25\x00\x00\x00\x0f\x00\x00\x00\x25\x00\x00\x00\x32\x00\x33\x00\x00\x00\x01\x00\x02\x00\x03\x00\x1d\x00\x00\x00\x00\x00\x20\x00\x1d\x00\x00\x00\x0f\x00\x20\x00\x25\x00\x00\x00\x01\x00\x02\x00\x25\x00\x00\x00\x00\x00\x01\x00\x02\x00\x15\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x0f\x00\x19\x00\x00\x00\x01\x00\x02\x00\x09\x00\x32\x00\x04\x00\x01\x00\x15\x00\x02\x00\x00\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x0f\x00\x19\x00\x00\x00\x01\x00\x02\x00\x04\x00\x01\x00\x31\x00\x04\x00\x02\x00\x31\x00\x01\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x33\x00\x19\x00\x00\x00\x01\x00\x02\x00\x04\x00\x15\x00\x01\x00\x15\x00\x31\x00\x14\x00\x04\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x17\x00\x19\x00\x00\x00\x01\x00\x02\x00\x06\x00\x01\x00\x22\x00\x0d\x00\x31\x00\x04\x00\x02\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x19\x00\x00\x00\x01\x00\x02\x00\x01\x00\x19\x00\x1e\x00\x33\x00\x20\x00\x0d\x00\x06\x00\x1a\x00\x31\x00\x03\x00\x31\x00\x15\x00\x0f\x00\x14\x00\x0b\x00\x12\x00\x13\x00\x2d\x00\x01\x00\x2f\x00\x04\x00\x03\x00\x19\x00\x31\x00\x0d\x00\x06\x00\x10\x00\x31\x00\x33\x00\x04\x00\x01\x00\x05\x00\x13\x00\x0a\x00\x02\x00\x31\x00\x31\x00\x03\x00\x25\x00\x01\x00\x09\x00\x05\x00\x02\x00\x01\x00\x31\x00\x02\x00\x02\x00\x33\x00\x02\x00\x19\x00\x0b\x00\x06\x00\x01\x00\x33\x00\x31\x00\x29\x00\x31\x00\x05\x00\x31\x00\x25\x00\x07\x00\x29\x00\x08\x00\x02\x00\x05\x00\x05\x00\x02\x00\x28\x00\x28\x00\x02\x00\x05\x00\x02\x00\x01\x00\x28\x00\x1a\x00\x36\x00\x01\x00\xff\xff\x02\x00\x31\x00\x21\x00\xff\xff\xff\xff\xff\xff\x31\x00\xff\xff\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\x36\x00\xff\xff\xff\xff\x31\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"#
+
+happyTable :: HappyAddr
+happyTable = HappyA# "\x00\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\xc8\x00\x7e\x00\x79\x00\x43\x00\x30\x00\x45\x00\x79\x00\x79\x00\x79\x00\x45\x00\xba\x00\x27\x01\x92\x00\xea\x00\xa6\x00\x93\x00\x2c\x01\xfd\x00\x15\x01\xa7\x00\x5b\x00\xbf\x00\xff\x00\xa8\x00\x1f\x01\xa6\x00\xa9\x00\x16\x01\xaa\x00\x17\x01\xa7\x00\x1b\x01\xbf\x00\x04\x00\xa8\x00\xc9\x00\x7a\x00\xa9\x00\x20\x01\xaa\x00\x6f\xff\x21\x01\x20\x01\xe3\x00\x7b\x00\x21\x01\xba\x00\xbb\x00\x31\x00\x31\x00\x6e\x00\x41\x00\x1a\x00\x24\x00\x2f\x01\xc0\x00\xf4\x00\xab\x00\x22\x01\xac\x00\x04\x00\x57\x00\x58\x00\xad\x00\x04\x00\xfd\x00\x58\x00\xad\x00\x15\x01\x57\x00\x79\xff\x04\x00\x57\x00\x58\x00\xad\x00\xa6\x00\xf8\x00\x16\x01\x2e\x01\x17\x01\xa7\x00\xa6\x00\x04\x00\xbb\x00\xa8\x00\xdc\x00\xa7\x00\xa9\x00\xf9\x00\xaa\x00\xa8\x00\xa6\x00\xbc\x00\xa9\x00\xfd\x00\xaa\x00\xa7\x00\x15\x01\x79\xff\x58\x00\xa8\x00\x08\x01\x1d\x01\xa9\x00\x25\x01\xaa\x00\x16\x01\xfb\x00\x17\x01\x1b\x00\x1c\x00\x0c\x01\x59\x00\x18\x01\x04\x00\xdd\x00\x58\x00\xad\x00\xcf\x00\xd0\x00\x79\x00\x04\x00\x57\x00\x58\x00\xad\x00\xd8\x00\x79\xff\x04\x00\x57\x00\x58\x00\xad\x00\xd9\x00\x57\x00\xda\x00\xf8\x00\x4f\x00\x67\x00\x04\x00\x57\x00\x58\x00\xad\x00\x9a\x00\x50\x00\x04\x00\x51\x00\x58\x00\xad\x00\x52\x00\x7a\x00\x53\x00\x54\x00\x5e\x00\x67\x00\x16\x00\x79\xff\xfd\x00\x7b\x00\x17\x00\xb7\x00\x58\x00\x5f\x00\x55\x00\x69\x00\x03\x01\x0a\x00\x56\x00\x1c\x01\x7c\x00\x04\x00\x57\x00\x58\x00\xad\x00\x59\x00\x0d\x01\x68\x00\x60\x00\x61\x00\x06\x01\x69\x00\xec\x00\xbe\x00\x04\x00\x57\x00\x58\x00\xed\x00\x79\x00\xbf\x00\xe8\x00\x0e\x01\x26\x01\x0b\x00\x0c\x00\x0d\x00\x79\x00\x0e\x00\x0f\x00\x10\x00\x04\x00\x11\x00\x12\x00\xbf\x00\x5a\x00\x13\x00\x14\x00\x0c\x00\x15\x00\xe1\x00\x16\x00\x0f\x00\x04\x00\xea\x00\x11\x00\x12\x00\x98\x00\x3c\x00\x13\x00\x14\x00\x3d\x00\xc9\x00\x8b\x00\x07\x01\xca\x00\x04\x00\xd9\x00\x0b\x01\xda\x00\xc9\x00\xe2\x00\x8a\x00\xca\x00\xff\x00\x52\x00\x45\x00\x53\x00\x54\x00\xed\x00\xb9\x00\x10\x01\xcb\x00\x11\x01\x12\x01\x10\x01\x45\x00\x11\x01\x12\x01\x55\x00\xc4\x00\x5b\x00\x10\x01\x56\x00\x11\x01\x12\x01\x04\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x5b\x00\x8b\x00\xc1\x00\x04\x00\x57\x00\x58\x00\xad\x00\x04\x01\x04\x00\x57\x00\x58\x00\x9f\x00\xc3\x00\xcf\x00\xd0\x00\x45\x00\x45\x00\x45\x00\x13\x01\xdb\x00\x8e\x00\x90\x00\x2e\x01\x91\x00\xad\x00\xa0\x00\xa1\x00\x1c\x01\xa3\x00\x13\x01\x5b\x00\x5b\x00\x5b\x00\xa4\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x99\x00\x78\x00\x5c\x00\x77\x00\x45\x00\x45\x00\x80\x00\x9f\x00\x81\x00\x82\x00\x86\x00\x9f\x00\x87\x00\x8c\x00\x42\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x5b\x00\xde\x00\xa0\x00\xa1\x00\x1e\x01\xa3\x00\xa0\x00\xa1\x00\xf5\x00\xa3\x00\xa4\x00\x9f\x00\x61\x00\x44\x00\xa4\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\xf9\x00\x04\x00\xa0\x00\xa1\x00\x00\x01\xa3\x00\x05\x00\x9f\x00\x06\x00\x63\x00\xa4\x00\x9f\x00\x07\x00\x08\x00\xfa\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\xfb\x00\x65\x00\xa0\x00\xa1\x00\xf0\x00\xa3\x00\xa0\x00\xa1\x00\xc6\x00\xa3\x00\xa4\x00\x9f\x00\x66\x00\x6b\x00\xa4\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x6d\x00\x3d\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\x1e\x00\x9f\x00\x1f\x00\x20\x00\xa4\x00\x9f\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x0d\x01\xa0\x00\xa1\x00\xb2\x00\xa3\x00\xa0\x00\xef\x00\x9f\x00\xa3\x00\xa4\x00\x21\x00\x9f\x00\x45\x00\xa4\x00\x22\x00\x0e\x01\x0f\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xf6\x00\x23\x00\x25\x00\xa3\x00\xe4\x00\x45\x00\xf3\x00\xa3\x00\xa4\x00\x45\x00\x46\x00\x47\x00\xa4\x00\x26\x00\x45\x00\x46\x00\x47\x00\xd6\x00\x27\x00\x28\x00\xc5\x00\x29\x00\x2d\x00\x45\x00\x48\x00\x49\x00\x0b\x01\x4b\x00\x4c\x00\x48\x00\x49\x00\xdf\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x83\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x29\x01\x57\x00\x2a\x01\x2b\x01\xbf\x00\x2c\x01\x45\x00\x48\x00\x49\x00\xd0\x00\x4b\x00\x4c\x00\x48\x00\x49\x00\xd1\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x62\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x7e\xff\x26\x01\x04\x00\x24\x01\x3c\x00\x04\x00\x0a\x01\x48\x00\x49\x00\x85\x00\x4b\x00\x4c\x00\x48\x00\x49\x00\xb4\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x58\x00\x4d\x00\x84\x00\x46\x00\x47\x00\x19\x01\xbf\x00\x1a\x01\xbf\x00\x04\x00\xcd\x00\x7e\xff\x48\x00\x49\x00\xb5\x00\x4b\x00\x4c\x00\x48\x00\x49\x00\x85\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\x02\x01\x4d\x00\x45\x00\x46\x00\x47\x00\x03\x01\x08\x01\x0e\x00\xe1\x00\x04\x00\xe6\x00\xe7\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x48\x00\x49\x00\x64\x00\x4b\x00\x4c\x00\x4d\x00\x45\x00\x46\x00\x47\x00\xe8\x00\x4d\x00\x0b\x00\x58\x00\x0d\x00\xef\x00\xf2\x00\xf3\x00\x04\x00\xc3\x00\x04\x00\xbf\x00\x48\x00\xcd\x00\xce\x00\x88\x00\x4c\x00\x15\x00\xdb\x00\x1e\x00\x95\x00\x90\x00\x4d\x00\x04\x00\x97\x00\x96\x00\x99\x00\x04\x00\x58\x00\xaf\x00\xb1\x00\xb0\x00\xb2\x00\xb4\x00\xb7\x00\x04\x00\x04\x00\x70\x00\xb9\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x04\x00\x76\x00\x77\x00\x58\x00\x7f\x00\x80\x00\x8b\x00\x8c\x00\x8e\x00\x58\x00\x04\x00\x6d\x00\x04\x00\x3d\x00\x04\x00\x30\x00\x6b\x00\x6d\x00\x33\x00\x35\x00\x36\x00\x38\x00\x39\x00\x34\x00\x37\x00\x3b\x00\x3a\x00\x3f\x00\x2b\x00\x40\x00\x41\x00\xff\xff\x2c\x00\x00\x00\x2d\x00\x04\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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, 146) [
+	(2 , happyReduce_2),
+	(3 , happyReduce_3),
+	(4 , happyReduce_4),
+	(5 , happyReduce_5),
+	(6 , happyReduce_6),
+	(7 , happyReduce_7),
+	(8 , happyReduce_8),
+	(9 , happyReduce_9),
+	(10 , happyReduce_10),
+	(11 , happyReduce_11),
+	(12 , happyReduce_12),
+	(13 , happyReduce_13),
+	(14 , happyReduce_14),
+	(15 , happyReduce_15),
+	(16 , happyReduce_16),
+	(17 , happyReduce_17),
+	(18 , happyReduce_18),
+	(19 , happyReduce_19),
+	(20 , happyReduce_20),
+	(21 , happyReduce_21),
+	(22 , happyReduce_22),
+	(23 , happyReduce_23),
+	(24 , happyReduce_24),
+	(25 , happyReduce_25),
+	(26 , happyReduce_26),
+	(27 , happyReduce_27),
+	(28 , happyReduce_28),
+	(29 , happyReduce_29),
+	(30 , happyReduce_30),
+	(31 , happyReduce_31),
+	(32 , happyReduce_32),
+	(33 , happyReduce_33),
+	(34 , happyReduce_34),
+	(35 , happyReduce_35),
+	(36 , happyReduce_36),
+	(37 , happyReduce_37),
+	(38 , happyReduce_38),
+	(39 , happyReduce_39),
+	(40 , happyReduce_40),
+	(41 , happyReduce_41),
+	(42 , happyReduce_42),
+	(43 , happyReduce_43),
+	(44 , happyReduce_44),
+	(45 , happyReduce_45),
+	(46 , happyReduce_46),
+	(47 , happyReduce_47),
+	(48 , happyReduce_48),
+	(49 , happyReduce_49),
+	(50 , happyReduce_50),
+	(51 , happyReduce_51),
+	(52 , happyReduce_52),
+	(53 , happyReduce_53),
+	(54 , happyReduce_54),
+	(55 , happyReduce_55),
+	(56 , happyReduce_56),
+	(57 , happyReduce_57),
+	(58 , happyReduce_58),
+	(59 , happyReduce_59),
+	(60 , happyReduce_60),
+	(61 , happyReduce_61),
+	(62 , happyReduce_62),
+	(63 , happyReduce_63),
+	(64 , happyReduce_64),
+	(65 , happyReduce_65),
+	(66 , happyReduce_66),
+	(67 , happyReduce_67),
+	(68 , happyReduce_68),
+	(69 , happyReduce_69),
+	(70 , happyReduce_70),
+	(71 , happyReduce_71),
+	(72 , happyReduce_72),
+	(73 , happyReduce_73),
+	(74 , happyReduce_74),
+	(75 , happyReduce_75),
+	(76 , happyReduce_76),
+	(77 , happyReduce_77),
+	(78 , happyReduce_78),
+	(79 , happyReduce_79),
+	(80 , happyReduce_80),
+	(81 , happyReduce_81),
+	(82 , happyReduce_82),
+	(83 , happyReduce_83),
+	(84 , happyReduce_84),
+	(85 , happyReduce_85),
+	(86 , happyReduce_86),
+	(87 , happyReduce_87),
+	(88 , happyReduce_88),
+	(89 , happyReduce_89),
+	(90 , happyReduce_90),
+	(91 , happyReduce_91),
+	(92 , happyReduce_92),
+	(93 , happyReduce_93),
+	(94 , happyReduce_94),
+	(95 , happyReduce_95),
+	(96 , happyReduce_96),
+	(97 , happyReduce_97),
+	(98 , happyReduce_98),
+	(99 , happyReduce_99),
+	(100 , happyReduce_100),
+	(101 , happyReduce_101),
+	(102 , happyReduce_102),
+	(103 , happyReduce_103),
+	(104 , happyReduce_104),
+	(105 , happyReduce_105),
+	(106 , happyReduce_106),
+	(107 , happyReduce_107),
+	(108 , happyReduce_108),
+	(109 , happyReduce_109),
+	(110 , happyReduce_110),
+	(111 , happyReduce_111),
+	(112 , happyReduce_112),
+	(113 , happyReduce_113),
+	(114 , happyReduce_114),
+	(115 , happyReduce_115),
+	(116 , happyReduce_116),
+	(117 , happyReduce_117),
+	(118 , happyReduce_118),
+	(119 , happyReduce_119),
+	(120 , happyReduce_120),
+	(121 , happyReduce_121),
+	(122 , happyReduce_122),
+	(123 , happyReduce_123),
+	(124 , happyReduce_124),
+	(125 , happyReduce_125),
+	(126 , happyReduce_126),
+	(127 , happyReduce_127),
+	(128 , happyReduce_128),
+	(129 , happyReduce_129),
+	(130 , happyReduce_130),
+	(131 , happyReduce_131),
+	(132 , happyReduce_132),
+	(133 , happyReduce_133),
+	(134 , happyReduce_134),
+	(135 , happyReduce_135),
+	(136 , happyReduce_136),
+	(137 , happyReduce_137),
+	(138 , happyReduce_138),
+	(139 , happyReduce_139),
+	(140 , happyReduce_140),
+	(141 , happyReduce_141),
+	(142 , happyReduce_142),
+	(143 , happyReduce_143),
+	(144 , happyReduce_144),
+	(145 , happyReduce_145),
+	(146 , happyReduce_146)
+	]
+
+happy_n_terms = 55 :: Int
+happy_n_nonterms = 55 :: 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
+		 (identC happy_var_1 --H
+	)}
+
+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 = happyReduce 6# 4# happyReduction_6
+happyReduction_6 (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 happyOut59 happy_x_2 of { happy_var_2 -> 
+	case happyOut5 happy_x_4 of { happy_var_4 -> 
+	case happyOut13 happy_x_6 of { happy_var_6 -> 
+	happyIn9
+		 (MGr happy_var_2 happy_var_4 (reverse happy_var_6)
+	) `HappyStk` happyRest}}}
+
+happyReduce_7 = happySpecReduce_1 4# happyReduction_7
+happyReduction_7 happy_x_1
+	 =  case happyOut13 happy_x_1 of { happy_var_1 -> 
+	happyIn9
+		 (Gr (reverse happy_var_1)
+	)}
+
+happyReduce_8 = happyReduce 5# 5# happyReduction_8
+happyReduction_8 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut59 happy_x_2 of { happy_var_2 -> 
+	case happyOut5 happy_x_4 of { happy_var_4 -> 
+	happyIn10
+		 (LMulti happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_9 = happyReduce 5# 5# happyReduction_9
+happyReduction_9 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut12 happy_x_1 of { happy_var_1 -> 
+	case happyOut14 happy_x_3 of { happy_var_3 -> 
+	case happyOut15 happy_x_4 of { happy_var_4 -> 
+	happyIn10
+		 (LHeader happy_var_1 happy_var_3 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_10 = happySpecReduce_2 5# happyReduction_10
+happyReduction_10 happy_x_2
+	happy_x_1
+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> 
+	happyIn10
+		 (LFlag happy_var_1
+	)}
+
+happyReduce_11 = happySpecReduce_2 5# happyReduction_11
+happyReduction_11 happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	happyIn10
+		 (LDef happy_var_1
+	)}
+
+happyReduce_12 = happySpecReduce_1 5# happyReduction_12
+happyReduction_12 happy_x_1
+	 =  happyIn10
+		 (LEnd
+	)
+
+happyReduce_13 = happyReduce 8# 6# happyReduction_13
+happyReduction_13 (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 happyOut12 happy_x_1 of { happy_var_1 -> 
+	case happyOut14 happy_x_3 of { happy_var_3 -> 
+	case happyOut15 happy_x_4 of { happy_var_4 -> 
+	case happyOut45 happy_x_6 of { happy_var_6 -> 
+	case happyOut46 happy_x_7 of { happy_var_7 -> 
+	happyIn11
+		 (Mod happy_var_1 happy_var_3 happy_var_4 (reverse happy_var_6) (reverse happy_var_7)
+	) `HappyStk` happyRest}}}}}
+
+happyReduce_14 = happySpecReduce_2 7# happyReduction_14
+happyReduction_14 happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_2 of { happy_var_2 -> 
+	happyIn12
+		 (MTAbs happy_var_2
+	)}
+
+happyReduce_15 = happyReduce 4# 7# happyReduction_15
+happyReduction_15 (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 happyOut5 happy_x_4 of { happy_var_4 -> 
+	happyIn12
+		 (MTCnc happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_16 = happySpecReduce_2 7# happyReduction_16
+happyReduction_16 happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_2 of { happy_var_2 -> 
+	happyIn12
+		 (MTRes happy_var_2
+	)}
+
+happyReduce_17 = happyReduce 6# 7# happyReduction_17
+happyReduction_17 (happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut5 happy_x_2 of { happy_var_2 -> 
+	case happyOut5 happy_x_4 of { happy_var_4 -> 
+	case happyOut5 happy_x_6 of { happy_var_6 -> 
+	happyIn12
+		 (MTTrans happy_var_2 happy_var_4 happy_var_6
+	) `HappyStk` happyRest}}}
+
+happyReduce_18 = happySpecReduce_0 8# happyReduction_18
+happyReduction_18  =  happyIn13
+		 ([]
+	)
+
+happyReduce_19 = happySpecReduce_2 8# happyReduction_19
+happyReduction_19 happy_x_2
+	happy_x_1
+	 =  case happyOut13 happy_x_1 of { happy_var_1 -> 
+	case happyOut11 happy_x_2 of { happy_var_2 -> 
+	happyIn13
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_20 = happySpecReduce_2 9# happyReduction_20
+happyReduction_20 happy_x_2
+	happy_x_1
+	 =  case happyOut59 happy_x_1 of { happy_var_1 -> 
+	happyIn14
+		 (Ext happy_var_1
+	)}
+
+happyReduce_21 = happySpecReduce_0 9# happyReduction_21
+happyReduction_21  =  happyIn14
+		 (NoExt
+	)
+
+happyReduce_22 = happySpecReduce_3 10# happyReduction_22
+happyReduction_22 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut59 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (Opens happy_var_2
+	)}
+
+happyReduce_23 = happySpecReduce_0 10# happyReduction_23
+happyReduction_23  =  happyIn15
+		 (NoOpens
+	)
+
+happyReduce_24 = happyReduce 4# 11# happyReduction_24
+happyReduction_24 (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 happyOut5 happy_x_4 of { happy_var_4 -> 
+	happyIn16
+		 (Flg happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_25 = happyReduce 7# 12# happyReduction_25
+happyReduction_25 (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 happyOut27 happy_x_4 of { happy_var_4 -> 
+	case happyOut49 happy_x_7 of { happy_var_7 -> 
+	happyIn17
+		 (AbsDCat happy_var_2 happy_var_4 (reverse happy_var_7)
+	) `HappyStk` happyRest}}}
+
+happyReduce_26 = happyReduce 6# 12# happyReduction_26
+happyReduction_26 (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 happyOut22 happy_x_4 of { happy_var_4 -> 
+	case happyOut22 happy_x_6 of { happy_var_6 -> 
+	happyIn17
+		 (AbsDFun happy_var_2 happy_var_4 happy_var_6
+	) `HappyStk` happyRest}}}
+
+happyReduce_27 = happyReduce 4# 12# happyReduction_27
+happyReduction_27 (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 happyOut22 happy_x_4 of { happy_var_4 -> 
+	happyIn17
+		 (AbsDTrans happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_28 = happyReduce 4# 12# happyReduction_28
+happyReduction_28 (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 happyOut47 happy_x_4 of { happy_var_4 -> 
+	happyIn17
+		 (ResDPar happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_29 = happyReduce 6# 12# happyReduction_29
+happyReduction_29 (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 happyOut32 happy_x_4 of { happy_var_4 -> 
+	case happyOut36 happy_x_6 of { happy_var_6 -> 
+	happyIn17
+		 (ResDOper happy_var_2 happy_var_4 happy_var_6
+	) `HappyStk` happyRest}}}
+
+happyReduce_30 = happyReduce 8# 12# happyReduction_30
+happyReduction_30 (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 happyOut32 happy_x_4 of { happy_var_4 -> 
+	case happyOut36 happy_x_6 of { happy_var_6 -> 
+	case happyOut36 happy_x_8 of { happy_var_8 -> 
+	happyIn17
+		 (CncDCat happy_var_2 happy_var_4 happy_var_6 happy_var_8
+	) `HappyStk` happyRest}}}}
+
+happyReduce_31 = happyReduce 11# 12# happyReduction_31
+happyReduction_31 (happy_x_11 `HappyStk`
+	happy_x_10 `HappyStk`
+	happy_x_9 `HappyStk`
+	happy_x_8 `HappyStk`
+	happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut5 happy_x_2 of { happy_var_2 -> 
+	case happyOut20 happy_x_4 of { happy_var_4 -> 
+	case happyOut51 happy_x_7 of { happy_var_7 -> 
+	case happyOut36 happy_x_9 of { happy_var_9 -> 
+	case happyOut36 happy_x_11 of { happy_var_11 -> 
+	happyIn17
+		 (CncDFun happy_var_2 happy_var_4 happy_var_7 happy_var_9 happy_var_11
+	) `HappyStk` happyRest}}}}}
+
+happyReduce_32 = happyReduce 4# 12# happyReduction_32
+happyReduction_32 (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 happyOut19 happy_x_2 of { happy_var_2 -> 
+	case happyOut5 happy_x_4 of { happy_var_4 -> 
+	happyIn17
+		 (AnyDInd happy_var_1 happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_33 = happySpecReduce_2 13# happyReduction_33
+happyReduction_33 happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_2 of { happy_var_2 -> 
+	happyIn18
+		 (ParD happy_var_1 (reverse happy_var_2)
+	)}}
+
+happyReduce_34 = happySpecReduce_1 14# happyReduction_34
+happyReduction_34 happy_x_1
+	 =  happyIn19
+		 (Canon
+	)
+
+happyReduce_35 = happySpecReduce_0 14# happyReduction_35
+happyReduction_35  =  happyIn19
+		 (NonCan
+	)
+
+happyReduce_36 = happySpecReduce_3 15# happyReduction_36
+happyReduction_36 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut5 happy_x_3 of { happy_var_3 -> 
+	happyIn20
+		 (CIQ happy_var_1 happy_var_3
+	)}}
+
+happyReduce_37 = happySpecReduce_2 16# happyReduction_37
+happyReduction_37 happy_x_2
+	happy_x_1
+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
+	case happyOut23 happy_x_2 of { happy_var_2 -> 
+	happyIn21
+		 (EApp happy_var_1 happy_var_2
+	)}}
+
+happyReduce_38 = happySpecReduce_1 16# happyReduction_38
+happyReduction_38 happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 (happy_var_1
+	)}
+
+happyReduce_39 = happyReduce 7# 17# happyReduction_39
+happyReduction_39 (happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut5 happy_x_2 of { happy_var_2 -> 
+	case happyOut22 happy_x_4 of { happy_var_4 -> 
+	case happyOut22 happy_x_7 of { happy_var_7 -> 
+	happyIn22
+		 (EProd happy_var_2 happy_var_4 happy_var_7
+	) `HappyStk` happyRest}}}
+
+happyReduce_40 = happyReduce 4# 17# happyReduction_40
+happyReduction_40 (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 happyOut22 happy_x_4 of { happy_var_4 -> 
+	happyIn22
+		 (EAbs happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_41 = happySpecReduce_3 17# happyReduction_41
+happyReduction_41 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut29 happy_x_2 of { happy_var_2 -> 
+	happyIn22
+		 (EEq (reverse happy_var_2)
+	)}
+
+happyReduce_42 = happySpecReduce_1 17# happyReduction_42
+happyReduction_42 happy_x_1
+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
+	happyIn22
+		 (happy_var_1
+	)}
+
+happyReduce_43 = happySpecReduce_1 18# happyReduction_43
+happyReduction_43 happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 (EAtom happy_var_1
+	)}
+
+happyReduce_44 = happySpecReduce_1 18# happyReduction_44
+happyReduction_44 happy_x_1
+	 =  happyIn23
+		 (EData
+	)
+
+happyReduce_45 = happySpecReduce_3 18# happyReduction_45
+happyReduction_45 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut22 happy_x_2 of { happy_var_2 -> 
+	happyIn23
+		 (happy_var_2
+	)}
+
+happyReduce_46 = happySpecReduce_1 19# happyReduction_46
+happyReduction_46 happy_x_1
+	 =  happyIn24
+		 (SType
+	)
+
+happyReduce_47 = happySpecReduce_3 20# happyReduction_47
+happyReduction_47 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	case happyOut22 happy_x_3 of { happy_var_3 -> 
+	happyIn25
+		 (Equ (reverse happy_var_1) happy_var_3
+	)}}
+
+happyReduce_48 = happyReduce 4# 21# happyReduction_48
+happyReduction_48 (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 happyOut28 happy_x_3 of { happy_var_3 -> 
+	happyIn26
+		 (APC happy_var_2 (reverse happy_var_3)
+	) `HappyStk` happyRest}}
+
+happyReduce_49 = happySpecReduce_1 21# happyReduction_49
+happyReduction_49 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn26
+		 (APV happy_var_1
+	)}
+
+happyReduce_50 = happySpecReduce_1 21# happyReduction_50
+happyReduction_50 happy_x_1
+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> 
+	happyIn26
+		 (APS happy_var_1
+	)}
+
+happyReduce_51 = happySpecReduce_1 21# happyReduction_51
+happyReduction_51 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn26
+		 (API happy_var_1
+	)}
+
+happyReduce_52 = happySpecReduce_1 21# happyReduction_52
+happyReduction_52 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn26
+		 (APF happy_var_1
+	)}
+
+happyReduce_53 = happySpecReduce_1 21# happyReduction_53
+happyReduction_53 happy_x_1
+	 =  happyIn26
+		 (APW
+	)
+
+happyReduce_54 = happySpecReduce_0 22# happyReduction_54
+happyReduction_54  =  happyIn27
+		 ([]
+	)
+
+happyReduce_55 = happySpecReduce_1 22# happyReduction_55
+happyReduction_55 happy_x_1
+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
+	happyIn27
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_56 = happySpecReduce_3 22# happyReduction_56
+happyReduction_56 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
+	case happyOut27 happy_x_3 of { happy_var_3 -> 
+	happyIn27
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_57 = happySpecReduce_0 23# happyReduction_57
+happyReduction_57  =  happyIn28
+		 ([]
+	)
+
+happyReduce_58 = happySpecReduce_2 23# happyReduction_58
+happyReduction_58 happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	case happyOut26 happy_x_2 of { happy_var_2 -> 
+	happyIn28
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_59 = happySpecReduce_0 24# happyReduction_59
+happyReduction_59  =  happyIn29
+		 ([]
+	)
+
+happyReduce_60 = happySpecReduce_3 24# happyReduction_60
+happyReduction_60 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	case happyOut25 happy_x_2 of { happy_var_2 -> 
+	happyIn29
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_61 = happySpecReduce_1 25# happyReduction_61
+happyReduction_61 happy_x_1
+	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 (AC happy_var_1
+	)}
+
+happyReduce_62 = happySpecReduce_3 25# happyReduction_62
+happyReduction_62 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut20 happy_x_2 of { happy_var_2 -> 
+	happyIn30
+		 (AD happy_var_2
+	)}
+
+happyReduce_63 = happySpecReduce_2 25# happyReduction_63
+happyReduction_63 happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_2 of { happy_var_2 -> 
+	happyIn30
+		 (AV happy_var_2
+	)}
+
+happyReduce_64 = happySpecReduce_2 25# happyReduction_64
+happyReduction_64 happy_x_2
+	happy_x_1
+	 =  case happyOut7 happy_x_2 of { happy_var_2 -> 
+	happyIn30
+		 (AM happy_var_2
+	)}
+
+happyReduce_65 = happySpecReduce_1 25# happyReduction_65
+happyReduction_65 happy_x_1
+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 (AS happy_var_1
+	)}
+
+happyReduce_66 = happySpecReduce_1 25# happyReduction_66
+happyReduction_66 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 (AI happy_var_1
+	)}
+
+happyReduce_67 = happySpecReduce_1 25# happyReduction_67
+happyReduction_67 happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 (AT happy_var_1
+	)}
+
+happyReduce_68 = happySpecReduce_3 26# happyReduction_68
+happyReduction_68 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut22 happy_x_3 of { happy_var_3 -> 
+	happyIn31
+		 (Decl happy_var_1 happy_var_3
+	)}}
+
+happyReduce_69 = happySpecReduce_3 27# happyReduction_69
+happyReduction_69 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut52 happy_x_2 of { happy_var_2 -> 
+	happyIn32
+		 (RecType happy_var_2
+	)}
+
+happyReduce_70 = happyReduce 5# 27# happyReduction_70
+happyReduction_70 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut32 happy_x_2 of { happy_var_2 -> 
+	case happyOut32 happy_x_4 of { happy_var_4 -> 
+	happyIn32
+		 (Table happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_71 = happySpecReduce_1 27# happyReduction_71
+happyReduction_71 happy_x_1
+	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
+	happyIn32
+		 (Cn happy_var_1
+	)}
+
+happyReduce_72 = happySpecReduce_1 27# happyReduction_72
+happyReduction_72 happy_x_1
+	 =  happyIn32
+		 (TStr
+	)
+
+happyReduce_73 = happySpecReduce_2 27# happyReduction_73
+happyReduction_73 happy_x_2
+	happy_x_1
+	 =  case happyOut7 happy_x_2 of { happy_var_2 -> 
+	happyIn32
+		 (TInts happy_var_2
+	)}
+
+happyReduce_74 = happySpecReduce_3 28# happyReduction_74
+happyReduction_74 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut32 happy_x_3 of { happy_var_3 -> 
+	happyIn33
+		 (Lbg happy_var_1 happy_var_3
+	)}}
+
+happyReduce_75 = happySpecReduce_1 29# happyReduction_75
+happyReduction_75 happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 (Arg happy_var_1
+	)}
+
+happyReduce_76 = happySpecReduce_1 29# happyReduction_76
+happyReduction_76 happy_x_1
+	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 (I happy_var_1
+	)}
+
+happyReduce_77 = happyReduce 4# 29# happyReduction_77
+happyReduction_77 (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 happyOut54 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 (Par happy_var_2 (reverse happy_var_3)
+	) `HappyStk` happyRest}}
+
+happyReduce_78 = happySpecReduce_2 29# happyReduction_78
+happyReduction_78 happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_2 of { happy_var_2 -> 
+	happyIn34
+		 (LI happy_var_2
+	)}
+
+happyReduce_79 = happySpecReduce_3 29# happyReduction_79
+happyReduction_79 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut50 happy_x_2 of { happy_var_2 -> 
+	happyIn34
+		 (R happy_var_2
+	)}
+
+happyReduce_80 = happySpecReduce_1 29# happyReduction_80
+happyReduction_80 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 (EInt happy_var_1
+	)}
+
+happyReduce_81 = happySpecReduce_1 29# happyReduction_81
+happyReduction_81 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 (EFloat happy_var_1
+	)}
+
+happyReduce_82 = happySpecReduce_1 29# happyReduction_82
+happyReduction_82 happy_x_1
+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 (K happy_var_1
+	)}
+
+happyReduce_83 = happySpecReduce_2 29# happyReduction_83
+happyReduction_83 happy_x_2
+	happy_x_1
+	 =  happyIn34
+		 (E
+	)
+
+happyReduce_84 = happySpecReduce_3 29# happyReduction_84
+happyReduction_84 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut36 happy_x_2 of { happy_var_2 -> 
+	happyIn34
+		 (happy_var_2
+	)}
+
+happyReduce_85 = happySpecReduce_3 30# happyReduction_85
+happyReduction_85 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut41 happy_x_3 of { happy_var_3 -> 
+	happyIn35
+		 (P happy_var_1 happy_var_3
+	)}}
+
+happyReduce_86 = happyReduce 5# 30# happyReduction_86
+happyReduction_86 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut32 happy_x_2 of { happy_var_2 -> 
+	case happyOut53 happy_x_4 of { happy_var_4 -> 
+	happyIn35
+		 (T happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_87 = happyReduce 5# 30# happyReduction_87
+happyReduction_87 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut32 happy_x_2 of { happy_var_2 -> 
+	case happyOut54 happy_x_4 of { happy_var_4 -> 
+	happyIn35
+		 (V happy_var_2 (reverse happy_var_4)
+	) `HappyStk` happyRest}}
+
+happyReduce_88 = happySpecReduce_3 30# happyReduction_88
+happyReduction_88 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut35 happy_x_1 of { happy_var_1 -> 
+	case happyOut34 happy_x_3 of { happy_var_3 -> 
+	happyIn35
+		 (S happy_var_1 happy_var_3
+	)}}
+
+happyReduce_89 = happyReduce 4# 30# happyReduction_89
+happyReduction_89 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut54 happy_x_3 of { happy_var_3 -> 
+	happyIn35
+		 (FV (reverse happy_var_3)
+	) `HappyStk` happyRest}
+
+happyReduce_90 = happySpecReduce_1 30# happyReduction_90
+happyReduction_90 happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	happyIn35
+		 (happy_var_1
+	)}
+
+happyReduce_91 = happySpecReduce_3 31# happyReduction_91
+happyReduction_91 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut36 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn36
+		 (C happy_var_1 happy_var_3
+	)}}
+
+happyReduce_92 = happySpecReduce_1 31# happyReduction_92
+happyReduction_92 happy_x_1
+	 =  case happyOut35 happy_x_1 of { happy_var_1 -> 
+	happyIn36
+		 (happy_var_1
+	)}
+
+happyReduce_93 = happySpecReduce_1 32# happyReduction_93
+happyReduction_93 happy_x_1
+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> 
+	happyIn37
+		 (KS happy_var_1
+	)}
+
+happyReduce_94 = happyReduce 7# 32# happyReduction_94
+happyReduction_94 (happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut55 happy_x_3 of { happy_var_3 -> 
+	case happyOut56 happy_x_5 of { happy_var_5 -> 
+	happyIn37
+		 (KP (reverse happy_var_3) happy_var_5
+	) `HappyStk` happyRest}}
+
+happyReduce_95 = happySpecReduce_3 33# happyReduction_95
+happyReduction_95 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut36 happy_x_3 of { happy_var_3 -> 
+	happyIn38
+		 (Ass happy_var_1 happy_var_3
+	)}}
+
+happyReduce_96 = happySpecReduce_3 34# happyReduction_96
+happyReduction_96 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> 
+	case happyOut36 happy_x_3 of { happy_var_3 -> 
+	happyIn39
+		 (Cas (reverse happy_var_1) happy_var_3
+	)}}
+
+happyReduce_97 = happySpecReduce_3 35# happyReduction_97
+happyReduction_97 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	case happyOut55 happy_x_3 of { happy_var_3 -> 
+	happyIn40
+		 (Var (reverse happy_var_1) (reverse happy_var_3)
+	)}}
+
+happyReduce_98 = happySpecReduce_1 36# happyReduction_98
+happyReduction_98 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn41
+		 (L happy_var_1
+	)}
+
+happyReduce_99 = happySpecReduce_2 36# happyReduction_99
+happyReduction_99 happy_x_2
+	happy_x_1
+	 =  case happyOut7 happy_x_2 of { happy_var_2 -> 
+	happyIn41
+		 (LV happy_var_2
+	)}
+
+happyReduce_100 = happySpecReduce_3 37# happyReduction_100
+happyReduction_100 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut7 happy_x_3 of { happy_var_3 -> 
+	happyIn42
+		 (A happy_var_1 happy_var_3
+	)}}
+
+happyReduce_101 = happyReduce 5# 37# happyReduction_101
+happyReduction_101 (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 happyOut7 happy_x_3 of { happy_var_3 -> 
+	case happyOut7 happy_x_5 of { happy_var_5 -> 
+	happyIn42
+		 (AB happy_var_1 happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_102 = happyReduce 4# 38# happyReduction_102
+happyReduction_102 (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 happyOut58 happy_x_3 of { happy_var_3 -> 
+	happyIn43
+		 (PC happy_var_2 (reverse happy_var_3)
+	) `HappyStk` happyRest}}
+
+happyReduce_103 = happySpecReduce_1 38# happyReduction_103
+happyReduction_103 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn43
+		 (PV happy_var_1
+	)}
+
+happyReduce_104 = happySpecReduce_1 38# happyReduction_104
+happyReduction_104 happy_x_1
+	 =  happyIn43
+		 (PW
+	)
+
+happyReduce_105 = happySpecReduce_3 38# happyReduction_105
+happyReduction_105 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut57 happy_x_2 of { happy_var_2 -> 
+	happyIn43
+		 (PR happy_var_2
+	)}
+
+happyReduce_106 = happySpecReduce_1 38# happyReduction_106
+happyReduction_106 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn43
+		 (PI happy_var_1
+	)}
+
+happyReduce_107 = happySpecReduce_1 38# happyReduction_107
+happyReduction_107 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn43
+		 (PF happy_var_1
+	)}
+
+happyReduce_108 = happySpecReduce_3 39# happyReduction_108
+happyReduction_108 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut43 happy_x_3 of { happy_var_3 -> 
+	happyIn44
+		 (PAss happy_var_1 happy_var_3
+	)}}
+
+happyReduce_109 = happySpecReduce_0 40# happyReduction_109
+happyReduction_109  =  happyIn45
+		 ([]
+	)
+
+happyReduce_110 = happySpecReduce_3 40# happyReduction_110
+happyReduction_110 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	case happyOut16 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_111 = happySpecReduce_0 41# happyReduction_111
+happyReduction_111  =  happyIn46
+		 ([]
+	)
+
+happyReduce_112 = happySpecReduce_3 41# happyReduction_112
+happyReduction_112 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> 
+	case happyOut17 happy_x_2 of { happy_var_2 -> 
+	happyIn46
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_113 = happySpecReduce_0 42# happyReduction_113
+happyReduction_113  =  happyIn47
+		 ([]
+	)
+
+happyReduce_114 = happySpecReduce_1 42# happyReduction_114
+happyReduction_114 happy_x_1
+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
+	happyIn47
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_115 = happySpecReduce_3 42# happyReduction_115
+happyReduction_115 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
+	case happyOut47 happy_x_3 of { happy_var_3 -> 
+	happyIn47
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_116 = happySpecReduce_0 43# happyReduction_116
+happyReduction_116  =  happyIn48
+		 ([]
+	)
+
+happyReduce_117 = happySpecReduce_2 43# happyReduction_117
+happyReduction_117 happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut32 happy_x_2 of { happy_var_2 -> 
+	happyIn48
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_118 = happySpecReduce_0 44# happyReduction_118
+happyReduction_118  =  happyIn49
+		 ([]
+	)
+
+happyReduce_119 = happySpecReduce_2 44# happyReduction_119
+happyReduction_119 happy_x_2
+	happy_x_1
+	 =  case happyOut49 happy_x_1 of { happy_var_1 -> 
+	case happyOut20 happy_x_2 of { happy_var_2 -> 
+	happyIn49
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_120 = happySpecReduce_0 45# happyReduction_120
+happyReduction_120  =  happyIn50
+		 ([]
+	)
+
+happyReduce_121 = happySpecReduce_1 45# happyReduction_121
+happyReduction_121 happy_x_1
+	 =  case happyOut38 happy_x_1 of { happy_var_1 -> 
+	happyIn50
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_122 = happySpecReduce_3 45# happyReduction_122
+happyReduction_122 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut38 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_123 = happySpecReduce_0 46# happyReduction_123
+happyReduction_123  =  happyIn51
+		 ([]
+	)
+
+happyReduce_124 = happySpecReduce_1 46# happyReduction_124
+happyReduction_124 happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	happyIn51
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_125 = happySpecReduce_3 46# happyReduction_125
+happyReduction_125 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut51 happy_x_3 of { happy_var_3 -> 
+	happyIn51
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_126 = happySpecReduce_0 47# happyReduction_126
+happyReduction_126  =  happyIn52
+		 ([]
+	)
+
+happyReduce_127 = happySpecReduce_1 47# happyReduction_127
+happyReduction_127 happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	happyIn52
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_128 = happySpecReduce_3 47# happyReduction_128
+happyReduction_128 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	case happyOut52 happy_x_3 of { happy_var_3 -> 
+	happyIn52
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_129 = happySpecReduce_0 48# happyReduction_129
+happyReduction_129  =  happyIn53
+		 ([]
+	)
+
+happyReduce_130 = happySpecReduce_1 48# happyReduction_130
+happyReduction_130 happy_x_1
+	 =  case happyOut39 happy_x_1 of { happy_var_1 -> 
+	happyIn53
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_131 = happySpecReduce_3 48# happyReduction_131
+happyReduction_131 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut39 happy_x_1 of { happy_var_1 -> 
+	case happyOut53 happy_x_3 of { happy_var_3 -> 
+	happyIn53
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_132 = happySpecReduce_0 49# happyReduction_132
+happyReduction_132  =  happyIn54
+		 ([]
+	)
+
+happyReduce_133 = happySpecReduce_2 49# happyReduction_133
+happyReduction_133 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_134 = happySpecReduce_0 50# happyReduction_134
+happyReduction_134  =  happyIn55
+		 ([]
+	)
+
+happyReduce_135 = happySpecReduce_2 50# happyReduction_135
+happyReduction_135 happy_x_2
+	happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	case happyOut6 happy_x_2 of { happy_var_2 -> 
+	happyIn55
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_136 = happySpecReduce_0 51# happyReduction_136
+happyReduction_136  =  happyIn56
+		 ([]
+	)
+
+happyReduce_137 = happySpecReduce_1 51# happyReduction_137
+happyReduction_137 happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	happyIn56
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_138 = happySpecReduce_3 51# happyReduction_138
+happyReduction_138 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut56 happy_x_3 of { happy_var_3 -> 
+	happyIn56
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_139 = happySpecReduce_0 52# happyReduction_139
+happyReduction_139  =  happyIn57
+		 ([]
+	)
+
+happyReduce_140 = happySpecReduce_1 52# happyReduction_140
+happyReduction_140 happy_x_1
+	 =  case happyOut44 happy_x_1 of { happy_var_1 -> 
+	happyIn57
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_141 = happySpecReduce_3 52# happyReduction_141
+happyReduction_141 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut44 happy_x_1 of { happy_var_1 -> 
+	case happyOut57 happy_x_3 of { happy_var_3 -> 
+	happyIn57
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_142 = happySpecReduce_0 53# happyReduction_142
+happyReduction_142  =  happyIn58
+		 ([]
+	)
+
+happyReduce_143 = happySpecReduce_2 53# happyReduction_143
+happyReduction_143 happy_x_2
+	happy_x_1
+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> 
+	case happyOut43 happy_x_2 of { happy_var_2 -> 
+	happyIn58
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_144 = happySpecReduce_0 54# happyReduction_144
+happyReduction_144  =  happyIn59
+		 ([]
+	)
+
+happyReduce_145 = happySpecReduce_1 54# happyReduction_145
+happyReduction_145 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn59
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_146 = happySpecReduce_3 54# happyReduction_146
+happyReduction_146 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut59 happy_x_3 of { happy_var_3 -> 
+	happyIn59
+		 ((:) 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 "Ints") -> cont 27#;
+	PT _ (TS "Str") -> cont 28#;
+	PT _ (TS "Type") -> cont 29#;
+	PT _ (TS "abstract") -> cont 30#;
+	PT _ (TS "cat") -> cont 31#;
+	PT _ (TS "concrete") -> cont 32#;
+	PT _ (TS "data") -> cont 33#;
+	PT _ (TS "flags") -> cont 34#;
+	PT _ (TS "fun") -> cont 35#;
+	PT _ (TS "grammar") -> cont 36#;
+	PT _ (TS "in") -> cont 37#;
+	PT _ (TS "lin") -> cont 38#;
+	PT _ (TS "lincat") -> cont 39#;
+	PT _ (TS "of") -> cont 40#;
+	PT _ (TS "open") -> cont 41#;
+	PT _ (TS "oper") -> cont 42#;
+	PT _ (TS "param") -> cont 43#;
+	PT _ (TS "pre") -> cont 44#;
+	PT _ (TS "resource") -> cont 45#;
+	PT _ (TS "table") -> cont 46#;
+	PT _ (TS "transfer") -> cont 47#;
+	PT _ (TS "variants") -> 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
+
+pCanon tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut9 x))
+
+pLine tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut10 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" #-}
+
+
+
+
+
+
+
+
+
+
+infixr 9 `HappyStk`
+data HappyStk a = HappyStk a (HappyStk a)
+
+-----------------------------------------------------------------------------
+-- starting the parse
+
+happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
+
+-----------------------------------------------------------------------------
+-- Accepting the parse
+
+-- If the current token is 0#, it means we've just accepted a partial
+-- parse (a %partial parser).  We must ignore the saved token on the top of
+-- the stack in this case.
+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
+	happyReturn1 ans
+happyAccept j tk st sts (HappyStk ans _) = 
+	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+
+-----------------------------------------------------------------------------
+-- Arrays only: do the next action
+
+
+
+happyDoAction i tk st
+	= {- nothing -}
+
+
+	  case action of
+		0#		  -> {- nothing -}
+				     happyFail i tk st
+		-1# 	  -> {- nothing -}
+				     happyAccept i tk st
+		n | (n <# (0# :: Int#)) -> {- nothing -}
+
+				     (happyReduceArr ! rule) i tk st
+				     where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))
+		n		  -> {- nothing -}
+
+
+				     happyShift new_state i tk st
+				     where new_state = (n -# (1# :: Int#))
+   where off    = indexShortOffAddr happyActOffsets st
+	 off_i  = (off +# i)
+	 check  = if (off_i >=# (0# :: Int#))
+			then (indexShortOffAddr happyCheck off_i ==#  i)
+			else False
+ 	 action | check     = indexShortOffAddr happyTable off_i
+		| otherwise = indexShortOffAddr happyDefActions st
+
+
+
+
+
+
+
+
+
+
+
+indexShortOffAddr (HappyA# arr) off =
+#if __GLASGOW_HASKELL__ > 500
+	narrow16Int# i
+#elif __GLASGOW_HASKELL__ == 500
+	intToInt16# i
+#else
+	(i `iShiftL#` 16#) `iShiftRA#` 16#
+#endif
+  where
+#if __GLASGOW_HASKELL__ >= 503
+	i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
+#else
+	i = word2Int# ((high `shiftL#` 8#) `or#` low)
+#endif
+	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+	low  = int2Word# (ord# (indexCharOffAddr# arr off'))
+	off' = off *# 2#
+
+
+
+
+
+data HappyAddr = HappyA# Addr#
+
+
+
+
+-----------------------------------------------------------------------------
+-- HappyState data type (not arrays)
+
+{-# LINE 170 "GenericTemplate.hs" #-}
+
+-----------------------------------------------------------------------------
+-- Shifting a token
+
+happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =
+     let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in
+--     trace "shifting the error token" $
+     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)
+
+happyShift new_state i tk st sts stk =
+     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)
+
+-- happyReduce is specialised for the common cases.
+
+happySpecReduce_0 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_0 nt fn j tk st@((action)) sts stk
+     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)
+
+happySpecReduce_1 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')
+     = let r = fn v1 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_2 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')
+     = let r = fn v1 v2 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_3 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
+     = let r = fn v1 v2 v3 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happyReduce k i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyReduce k nt fn j tk st sts stk
+     = case happyDrop (k -# (1# :: Int#)) sts of
+	 sts1@((HappyCons (st1@(action)) (_))) ->
+        	let r = fn stk in  -- it doesn't hurt to always seq here...
+       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+
+happyMonadReduce k nt fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyMonadReduce k nt fn j tk st sts stk =
+        happyThen1 (fn stk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
+       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
+             drop_stk = happyDropStk k stk
+
+happyDrop 0# l = l
+happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t
+
+happyDropStk 0# l = l
+happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs
+
+-----------------------------------------------------------------------------
+-- Moving to a new state after a reduction
+
+
+happyGoto nt j tk st = 
+   {- nothing -}
+   happyDoAction j tk new_state
+   where off    = indexShortOffAddr happyGotoOffsets st
+	 off_i  = (off +# nt)
+ 	 new_state = indexShortOffAddr happyTable off_i
+
+
+
+
+-----------------------------------------------------------------------------
+-- Error recovery (0# is the error token)
+
+-- parse error if we are in recovery and we fail again
+happyFail  0# tk old_st _ stk =
+--	trace "failing" $ 
+    	happyError_ tk
+
+{-  We don't need state discarding for our restricted implementation of
+    "error".  In fact, it can cause some bogus parses, so I've disabled it
+    for now --SDM
+
+-- discard a state
+happyFail  0# tk old_st (HappyCons ((action)) (sts)) 
+						(saved_tok `HappyStk` _ `HappyStk` stk) =
+--	trace ("discarding state, depth " ++ show (length stk))  $
+	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
+-}
+
+-- Enter error recovery: generate an error token,
+--                       save the old token and carry on.
+happyFail  i tk (action) sts stk =
+--      trace "entering error recovery" $
+	happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)
+
+-- Internal happy errors:
+
+notHappyAtAll = error "Internal Happy error\n"
+
+-----------------------------------------------------------------------------
+-- Hack to get the typechecker to accept our action functions
+
+
+happyTcHack :: Int# -> a -> a
+happyTcHack x y = y
+{-# INLINE happyTcHack #-}
+
+
+-----------------------------------------------------------------------------
+-- Seq-ing.  If the --strict flag is given, then Happy emits 
+--	happySeq = happyDoSeq
+-- otherwise it emits
+-- 	happySeq = happyDontSeq
+
+happyDoSeq, happyDontSeq :: a -> b -> b
+happyDoSeq   a b = a `seq` b
+happyDontSeq a b = b
+
+-----------------------------------------------------------------------------
+-- Don't inline any functions from the template.  GHC has a nasty habit
+-- of deciding to inline happyGoto everywhere, which increases the size of
+-- the generated parser quite a bit.
+
+
+{-# NOINLINE happyDoAction #-}
+{-# NOINLINE happyTable #-}
+{-# NOINLINE happyCheck #-}
+{-# NOINLINE happyActOffsets #-}
+{-# NOINLINE happyGotoOffsets #-}
+{-# NOINLINE happyDefActions #-}
+
+{-# NOINLINE happyShift #-}
+{-# NOINLINE happySpecReduce_0 #-}
+{-# NOINLINE happySpecReduce_1 #-}
+{-# NOINLINE happySpecReduce_2 #-}
+{-# NOINLINE happySpecReduce_3 #-}
+{-# NOINLINE happyReduce #-}
+{-# NOINLINE happyMonadReduce #-}
+{-# NOINLINE happyGoto #-}
+{-# NOINLINE happyFail #-}
+
+-- end of Happy Template.
diff --git a/src-2.9/GF/Canon/ParGFC.y b/src-2.9/GF/Canon/ParGFC.y
new file mode 100644
index 000000000..6432a8696
--- /dev/null
+++ b/src-2.9/GF/Canon/ParGFC.y
@@ -0,0 +1,385 @@
+-- This Happy file was machine-generated by the BNF converter
+{
+module GF.Canon.ParGFC where
+import GF.Canon.AbsGFC
+import GF.Canon.LexGFC
+import GF.Data.ErrM -- H
+import GF.Infra.Ident -- H
+}
+
+%name pCanon Canon
+%name pLine Line
+
+-- 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 ",") }
+ 'Ints' { PT _ (TS "Ints") }
+ 'Str' { PT _ (TS "Str") }
+ 'Type' { PT _ (TS "Type") }
+ 'abstract' { PT _ (TS "abstract") }
+ 'cat' { PT _ (TS "cat") }
+ 'concrete' { PT _ (TS "concrete") }
+ 'data' { PT _ (TS "data") }
+ 'flags' { PT _ (TS "flags") }
+ 'fun' { PT _ (TS "fun") }
+ 'grammar' { PT _ (TS "grammar") }
+ 'in' { PT _ (TS "in") }
+ 'lin' { PT _ (TS "lin") }
+ 'lincat' { PT _ (TS "lincat") }
+ 'of' { PT _ (TS "of") }
+ 'open' { PT _ (TS "open") }
+ 'oper' { PT _ (TS "oper") }
+ 'param' { PT _ (TS "param") }
+ 'pre' { PT _ (TS "pre") }
+ 'resource' { PT _ (TS "resource") }
+ 'table' { PT _ (TS "table") }
+ 'transfer' { PT _ (TS "transfer") }
+ 'variants' { PT _ (TS "variants") }
+
+L_ident  { PT _ (TV $$) }
+L_quoted { PT _ (TL $$) }
+L_integ  { PT _ (TI $$) }
+L_err    { _ }
+
+
+%%
+
+Ident   :: { Ident }   : L_ident  { identC $1 } -- H
+String  :: { String }  : L_quoted { $1 }
+Integer :: { Integer } : L_integ  { (read $1) :: Integer }
+
+Canon :: { Canon }
+Canon : 'grammar' ListIdent 'of' Ident ';' ListModule { MGr $2 $4 (reverse $6) } 
+  | ListModule { Gr (reverse $1) }
+
+
+Line :: { Line }
+Line : 'grammar' ListIdent 'of' Ident ';' { LMulti $2 $4 } 
+  | ModType '=' Extend Open '{' { LHeader $1 $3 $4 }
+  | Flag ';' { LFlag $1 }
+  | Def ';' { LDef $1 }
+  | '}' { LEnd }
+
+
+Module :: { Module }
+Module : ModType '=' Extend Open '{' ListFlag ListDef '}' { Mod $1 $3 $4 (reverse $6) (reverse $7) } 
+
+
+ModType :: { ModType }
+ModType : 'abstract' Ident { MTAbs $2 } 
+  | 'concrete' Ident 'of' Ident { MTCnc $2 $4 }
+  | 'resource' Ident { MTRes $2 }
+  | 'transfer' Ident ':' Ident '->' Ident { MTTrans $2 $4 $6 }
+
+
+ListModule :: { [Module] }
+ListModule : {- empty -} { [] } 
+  | ListModule Module { flip (:) $1 $2 }
+
+
+Extend :: { Extend }
+Extend : ListIdent '**' { Ext $1 } 
+  | {- empty -} { NoExt }
+
+
+Open :: { Open }
+Open : 'open' ListIdent 'in' { Opens $2 } 
+  | {- empty -} { NoOpens }
+
+
+Flag :: { Flag }
+Flag : 'flags' Ident '=' Ident { Flg $2 $4 } 
+
+
+Def :: { Def }
+Def : 'cat' Ident '[' ListDecl ']' '=' ListCIdent { AbsDCat $2 $4 (reverse $7) } 
+  | 'fun' Ident ':' Exp '=' Exp { AbsDFun $2 $4 $6 }
+  | 'transfer' Ident '=' Exp { AbsDTrans $2 $4 }
+  | 'param' Ident '=' ListParDef { ResDPar $2 $4 }
+  | 'oper' Ident ':' CType '=' Term { ResDOper $2 $4 $6 }
+  | 'lincat' Ident '=' CType '=' Term ';' Term { CncDCat $2 $4 $6 $8 }
+  | 'lin' Ident ':' CIdent '=' '\\' ListArgVar '->' Term ';' Term { CncDFun $2 $4 $7 $9 $11 }
+  | Ident Status 'in' Ident { AnyDInd $1 $2 $4 }
+
+
+ParDef :: { ParDef }
+ParDef : Ident ListCType { ParD $1 (reverse $2) } 
+
+
+Status :: { Status }
+Status : 'data' { Canon } 
+  | {- empty -} { NonCan }
+
+
+CIdent :: { CIdent }
+CIdent : Ident '.' Ident { CIQ $1 $3 } 
+
+
+Exp1 :: { Exp }
+Exp1 : Exp1 Exp2 { EApp $1 $2 } 
+  | Exp2 { $1 }
+
+
+Exp :: { Exp }
+Exp : '(' Ident ':' Exp ')' '->' Exp { EProd $2 $4 $7 } 
+  | '\\' Ident '->' Exp { EAbs $2 $4 }
+  | '{' ListEquation '}' { EEq (reverse $2) }
+  | Exp1 { $1 }
+
+
+Exp2 :: { Exp }
+Exp2 : Atom { EAtom $1 } 
+  | 'data' { EData }
+  | '(' Exp ')' { $2 }
+
+
+Sort :: { Sort }
+Sort : 'Type' { SType } 
+
+
+Equation :: { Equation }
+Equation : ListAPatt '->' Exp { Equ (reverse $1) $3 } 
+
+
+APatt :: { APatt }
+APatt : '(' CIdent ListAPatt ')' { APC $2 (reverse $3) } 
+  | Ident { APV $1 }
+  | String { APS $1 }
+  | Integer { API $1 }
+  | '_' { APW }
+
+
+ListDecl :: { [Decl] }
+ListDecl : {- empty -} { [] } 
+  | Decl { (:[]) $1 }
+  | Decl ';' ListDecl { (:) $1 $3 }
+
+
+ListAPatt :: { [APatt] }
+ListAPatt : {- empty -} { [] } 
+  | ListAPatt APatt { flip (:) $1 $2 }
+
+
+ListEquation :: { [Equation] }
+ListEquation : {- empty -} { [] } 
+  | ListEquation Equation ';' { flip (:) $1 $2 }
+
+
+Atom :: { Atom }
+Atom : CIdent { AC $1 } 
+  | '<' CIdent '>' { AD $2 }
+  | '$' Ident { AV $2 }
+  | '?' Integer { AM $2 }
+  | String { AS $1 }
+  | Integer { AI $1 }
+  | Sort { AT $1 }
+
+
+Decl :: { Decl }
+Decl : Ident ':' Exp { Decl $1 $3 } 
+
+
+CType :: { CType }
+CType : '{' ListLabelling '}' { RecType $2 } 
+  | '(' CType '=>' CType ')' { Table $2 $4 }
+  | CIdent { Cn $1 }
+  | 'Str' { TStr }
+  | 'Ints' Integer { TInts $2 }
+
+
+Labelling :: { Labelling }
+Labelling : Label ':' CType { Lbg $1 $3 } 
+
+
+Term2 :: { Term }
+Term2 : ArgVar { Arg $1 } 
+  | CIdent { I $1 }
+  | '<' CIdent ListTerm2 '>' { Par $2 (reverse $3) }
+  | '$' Ident { LI $2 }
+  | '{' ListAssign '}' { R $2 }
+  | Integer { EInt $1 }
+  | Tokn { K $1 }
+  | '[' ']' { E }
+  | '(' Term ')' { $2 }
+
+
+Term1 :: { Term }
+Term1 : Term2 '.' Label { P $1 $3 } 
+  | 'table' CType '{' ListCase '}' { T $2 $4 }
+  | 'table' CType '[' ListTerm2 ']' { V $2 (reverse $4) }
+  | Term1 '!' Term2 { S $1 $3 }
+  | 'variants' '{' ListTerm2 '}' { FV (reverse $3) }
+  | Term2 { $1 }
+
+
+Term :: { Term }
+Term : Term '++' Term1 { C $1 $3 } 
+  | Term1 { $1 }
+
+
+Tokn :: { Tokn }
+Tokn : String { KS $1 } 
+  | '[' 'pre' ListString '{' ListVariant '}' ']' { KP (reverse $3) $5 }
+
+
+Assign :: { Assign }
+Assign : Label '=' Term { Ass $1 $3 } 
+
+
+Case :: { Case }
+Case : ListPatt '=>' Term { Cas (reverse $1) $3 } 
+
+
+Variant :: { Variant }
+Variant : ListString '/' ListString { Var (reverse $1) (reverse $3) } 
+
+
+Label :: { Label }
+Label : Ident { L $1 } 
+  | '$' Integer { LV $2 }
+
+
+ArgVar :: { ArgVar }
+ArgVar : Ident '@' Integer { A $1 $3 } 
+  | Ident '+' Integer '@' Integer { AB $1 $3 $5 }
+
+
+Patt :: { Patt }
+Patt : '(' CIdent ListPatt ')' { PC $2 (reverse $3) } 
+  | Ident { PV $1 }
+  | '_' { PW }
+  | '{' ListPattAssign '}' { PR $2 }
+  | Integer { PI $1 }
+
+
+PattAssign :: { PattAssign }
+PattAssign : Label '=' Patt { PAss $1 $3 } 
+
+
+ListFlag :: { [Flag] }
+ListFlag : {- empty -} { [] } 
+  | ListFlag Flag ';' { flip (:) $1 $2 }
+
+
+ListDef :: { [Def] }
+ListDef : {- empty -} { [] } 
+  | ListDef Def ';' { flip (:) $1 $2 }
+
+
+ListParDef :: { [ParDef] }
+ListParDef : {- empty -} { [] } 
+  | ParDef { (:[]) $1 }
+  | ParDef '|' ListParDef { (:) $1 $3 }
+
+
+ListCType :: { [CType] }
+ListCType : {- empty -} { [] } 
+  | ListCType CType { flip (:) $1 $2 }
+
+
+ListCIdent :: { [CIdent] }
+ListCIdent : {- empty -} { [] } 
+  | ListCIdent CIdent { flip (:) $1 $2 }
+
+
+ListAssign :: { [Assign] }
+ListAssign : {- empty -} { [] } 
+  | Assign { (:[]) $1 }
+  | Assign ';' ListAssign { (:) $1 $3 }
+
+
+ListArgVar :: { [ArgVar] }
+ListArgVar : {- empty -} { [] } 
+  | ArgVar { (:[]) $1 }
+  | ArgVar ',' ListArgVar { (:) $1 $3 }
+
+
+ListLabelling :: { [Labelling] }
+ListLabelling : {- empty -} { [] } 
+  | Labelling { (:[]) $1 }
+  | Labelling ';' ListLabelling { (:) $1 $3 }
+
+
+ListCase :: { [Case] }
+ListCase : {- empty -} { [] } 
+  | Case { (:[]) $1 }
+  | Case ';' ListCase { (:) $1 $3 }
+
+
+ListTerm2 :: { [Term] }
+ListTerm2 : {- empty -} { [] } 
+  | ListTerm2 Term2 { flip (:) $1 $2 }
+
+
+ListString :: { [String] }
+ListString : {- empty -} { [] } 
+  | ListString String { flip (:) $1 $2 }
+
+
+ListVariant :: { [Variant] }
+ListVariant : {- empty -} { [] } 
+  | Variant { (:[]) $1 }
+  | Variant ';' ListVariant { (:) $1 $3 }
+
+
+ListPattAssign :: { [PattAssign] }
+ListPattAssign : {- empty -} { [] } 
+  | PattAssign { (:[]) $1 }
+  | PattAssign ';' ListPattAssign { (:) $1 $3 }
+
+
+ListPatt :: { [Patt] }
+ListPatt : {- empty -} { [] } 
+  | ListPatt Patt { flip (:) $1 $2 }
+
+
+ListIdent :: { [Ident] }
+ListIdent : {- empty -} { [] } 
+  | Ident { (:[]) $1 }
+  | Ident ',' ListIdent { (:) $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-2.9/GF/Canon/PrExp.hs b/src-2.9/GF/Canon/PrExp.hs
new file mode 100644
index 000000000..6202a760e
--- /dev/null
+++ b/src-2.9/GF/Canon/PrExp.hs
@@ -0,0 +1,46 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrExp
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:28 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- print trees without qualifications
+-----------------------------------------------------------------------------
+
+module GF.Canon.PrExp (prExp) where
+
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+
+import GF.Data.Operations
+
+prExp :: Exp -> String
+prExp e = case e of
+  EApp f a   -> pr1 f +++ pr2 a
+  EAbsR x b  -> "\\" ++ prtt x +++ "->" +++ prExp b
+  EAbs x _ b -> prExp $ EAbsR x b
+  EProd x a b -> "(\\" ++ prtt x +++ ":" +++ prExp a ++ ")" +++ "->" +++ prExp b
+  EAtomR a   -> prAtom a
+  EAtom a _  -> prAtom a
+  _ -> prtt e
+ where
+   pr1 e = case e of
+     EAbsR _ _   -> prParenth $ prExp e
+     EAbs _ _ _  -> prParenth $ prExp e
+     EProd _ _ _ -> prParenth $ prExp e
+     _ -> prExp e
+   pr2 e = case e of
+     EApp _ _ -> prParenth $ prExp e
+     _ -> pr1 e
+
+prAtom a = case a of
+  AC c -> prCIdent c
+  AD c -> prCIdent c
+  _ -> prtt a
+
+prCIdent (CIQ _ c) = prtt c
diff --git a/src-2.9/GF/Canon/PrintGFC.hs b/src-2.9/GF/Canon/PrintGFC.hs
new file mode 100644
index 000000000..437f3a1e9
--- /dev/null
+++ b/src-2.9/GF/Canon/PrintGFC.hs
@@ -0,0 +1,376 @@
+module GF.Canon.PrintGFC where
+
+
+-- pretty-printer generated by the BNF converter, except handhacked spacing --H
+
+import GF.Infra.Ident --H
+import GF.Canon.AbsGFC
+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 = (:)
+
+docs :: ShowS -> Doc
+docs x y = concatD [spc, doc x, spc ] y
+
+spc = doc (showString "&")
+
+render :: Doc -> String
+render d = rend 0 (map ($ "") $ d []) "" where
+  rend i ss = case ss of
+    "*"    :ts -> realnew . rend i ts --H
+    "&":"&":ts -> showChar ' ' . rend i ts --H
+    "&"    :ts -> rend i ts --H
+    t      :ts -> showString t . rend i ts
+    _          -> id
+  realnew = showChar '\n' --H
+
+{-
+render :: Doc -> String
+render d = rend 0 (map ($ "") $ d []) "" where
+  rend i ss = case ss of
+    "*NEW"   :ts -> realnew . rend i ts --H
+    "<"      :ts -> showString "<" . rend i ts --H
+    "$"      :ts -> showString "$" . rend i ts --H
+    "?"      :ts -> showString "?" . rend i ts --H
+    "["      :ts -> showChar '[' . rend i ts
+    "("      :ts -> showChar '(' . rend i ts
+    "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
+    "}" : ";":ts -> new (i-1) . showChar '}' . 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 . showChar '@' . rend i ts
+    t  : "," :ts -> showString t . showChar ',' . rend i ts
+    t  : ")" :ts -> showString t . showChar ')' . rend i ts
+    t  : "]" :ts -> showString t . showChar ']' . rend i ts
+    t  : ">" :ts -> showString t . showChar '>' . rend i ts --H
+    t  : "." :ts -> showString t . showChar '.' . rend i ts --H
+    t@"=>"   :ts -> showString t . rend i ts --H
+    t@"->"   :ts -> showString t . rend i ts --H
+    t        :ts -> realspace t . rend i ts --H
+    _            -> id
+  space t = showString t . showChar ' ' -- H
+  realspace t = showString t . (\s -> if null s then "" else (' ':s)) -- H
+  new i s   = s  -- H
+  realnew = showChar '\n' --H
+-}
+
+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 = docs (shows x)
+
+
+instance Print Double where
+  prt _ x = docs (shows x)
+
+instance Print Ident where
+  prt _ i = docs (showString $ prIdent i) -- H
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Canon where
+  prt i e = case e of
+   MGr ids id modules -> prPrec i 0 (concatD [spc, doc (showString "grammar") , spc, prt 0 ids , spc , doc (showString "of") , spc, prt 0 id , doc (showString ";") , prt 0 modules])
+   Gr modules -> prPrec i 0 (concatD [prt 0 modules])
+
+
+instance Print Line where
+  prt i e = case e of
+   LMulti ids id -> prPrec i 0 (concatD [spc, doc (showString "grammar") , spc, prt 0 ids , spc, doc (showString "of") , spc, prt 0 id , doc (showString ";")])
+   LHeader modtype extend open -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{")])
+   LFlag flag -> prPrec i 0 (concatD [prt 0 flag , doc (showString ";")])
+   LDef def -> prPrec i 0 (concatD [prt 0 def , doc (showString ";")])
+   LEnd  -> prPrec i 0 (concatD [doc (showString "}")])
+
+
+instance Print Module where
+  prt i e = case e of
+   Mod modtype extend open flags defs -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{") , prt 0 flags , prt 0 defs , 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
+   MTAbs id -> prPrec i 0 (concatD [spc, doc (showString "abstract") , spc , prt 0 id])
+   MTCnc id0 id -> prPrec i 0 (concatD [spc, doc (showString "concrete") , spc, prt 0 id0 , spc, doc (showString "of") , spc, prt 0 id])
+   MTRes id -> prPrec i 0 (concatD [spc, doc (showString "resource") , spc, prt 0 id])
+   MTTrans id0 id1 id -> prPrec i 0 (concatD [spc, doc (showString "transfer") , spc, prt 0 id0 , doc (showString ":") , prt 0 id1 , doc (showString "->") , prt 0 id])
+
+
+instance Print Extend where
+  prt i e = case e of
+   Ext ids -> prPrec i 0 (concatD [prt 0 ids , doc (showString "**")])
+   NoExt  -> prPrec i 0 (concatD [])
+
+
+instance Print Open where
+  prt i e = case e of
+   Opens ids -> prPrec i 0 (concatD [spc, doc (showString "open") , spc, prt 0 ids , docs (showString "in")])
+   NoOpens  -> prPrec i 0 (concatD [])
+
+
+instance Print Flag where
+  prt i e = case e of
+   Flg id0 id -> prPrec i 0 (concatD [spc, doc (showString "flags") , spc, prt 0 id0 , doc (showString "=") , prt 0 id])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Def where
+  prt i e = case e of
+   AbsDCat id decls cidents -> prPrec i 0 (concatD [docs (showString "cat") , prt 0 id , doc (showString "[") , prt 0 decls , doc (showString "]") , doc (showString "=") , prt 0 cidents])
+   AbsDFun id exp0 exp -> prPrec i 0 (concatD [docs (showString "fun") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
+   AbsDTrans id exp -> prPrec i 0 (concatD [docs (showString "transfer") , prt 0 id , doc (showString "=") , prt 0 exp])
+   ResDPar id pardefs -> prPrec i 0 (concatD [docs (showString "param") , prt 0 id , doc (showString "=") , prt 0 pardefs])
+   ResDOper id ctype term -> prPrec i 0 (concatD [docs (showString "oper") , prt 0 id , doc (showString ":") , prt 0 ctype , doc (showString "=") , prt 0 term])
+   CncDCat id ctype term0 term -> prPrec i 0 (concatD [docs (showString "lincat") , prt 0 id , doc (showString "=") , prt 0 ctype , doc (showString "=") , prt 0 term0 , doc (showString ";") , prt 0 term])
+   CncDFun id cident argvars term0 term -> prPrec i 0 (concatD [docs (showString "lin") , prt 0 id , doc (showString ":") , prt 0 cident , doc (showString "=") , doc (showString "\\") , prt 0 argvars , doc (showString "->") , prt 0 term0 , doc (showString ";") , prt 0 term])
+   AnyDInd id0 status id -> prPrec i 0 (concatD [prt 0 id0 , prt 0 status , docs (showString "in") , prt 0 id])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , doc (showString ";"), doc (showString "*") , prt 0 xs]) -- H
+
+
+instance Print ParDef where
+  prt i e = case e of
+   ParD id ctypes -> prPrec i 0 (concatD [prt 0 id , prt 0 ctypes])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
+
+instance Print Status where
+  prt i e = case e of
+   Canon  -> prPrec i 0 (concatD [docs (showString "data")])
+   NonCan  -> prPrec i 0 (concatD [])
+
+
+instance Print CIdent where
+  prt i e = case e of
+   CIQ id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print Exp where
+  prt i e = case e of
+   EApp exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , prt 2 exp])
+   EProd id exp0 exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString ")") , doc (showString "->") , prt 0 exp])
+   EAbs id exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 id , doc (showString "->") , prt 0 exp])
+   EAtom atom -> prPrec i 2 (concatD [prt 0 atom])
+   EData  -> prPrec i 2 (concatD [docs (showString "data")])
+   EEq equations -> prPrec i 0 (concatD [doc (showString "{") , prt 0 equations , doc (showString "}")])
+
+
+instance Print Sort where
+  prt i e = case e of
+   SType  -> prPrec i 0 (concatD [docs (showString "Type")])
+
+
+instance Print Equation where
+  prt i e = case e of
+   Equ apatts exp -> prPrec i 0 (concatD [prt 0 apatts , doc (showString "->") , prt 0 exp])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print APatt where
+  prt i e = case e of
+   APC cident apatts -> prPrec i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 apatts , doc (showString ")")])
+   APV id -> prPrec i 0 (concatD [prt 0 id])
+   APS str -> prPrec i 0 (concatD [prt 0 str])
+   API n -> prPrec i 0 (concatD [prt 0 n])
+   APF n -> prPrec i 0 (concatD [prt 0 n])
+   APW  -> prPrec i 0 (concatD [doc (showString "_")])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print Atom where
+  prt i e = case e of
+   AC cident -> prPrec i 0 (concatD [prt 0 cident])
+   AD cident -> prPrec i 0 (concatD [doc (showString "<") , prt 0 cident , doc (showString ">")])
+   AV id -> prPrec i 0 (concatD [doc (showString "$") , prt 0 id])
+   AM n -> prPrec i 0 (concatD [doc (showString "?") , prt 0 n])
+   AS str -> prPrec i 0 (concatD [prt 0 str])
+   AI n -> prPrec i 0 (concatD [prt 0 n])
+   AT sort -> prPrec i 0 (concatD [prt 0 sort])
+
+
+instance Print Decl where
+  prt i e = case e of
+   Decl id exp -> prPrec i 0 (concatD [prt 0 id , 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 CType where
+  prt i e = case e of
+   RecType labellings -> prPrec i 0 (concatD [doc (showString "{") , prt 0 labellings , doc (showString "}")])
+   Table ctype0 ctype -> prPrec i 0 (concatD [doc (showString "(") , prt 0 ctype0 , doc (showString "=>") , prt 0 ctype , doc (showString ")")])
+   Cn cident -> prPrec i 0 (concatD [prt 0 cident])
+   TStr  -> prPrec i 0 (concatD [docs (showString "Str")])
+   TInts n -> prPrec i 0 (concatD [docs (showString "Ints") , prt 0 n])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print Labelling where
+  prt i e = case e of
+   Lbg label ctype -> prPrec i 0 (concatD [prt 0 label , doc (showString ":") , prt 0 ctype])
+
+  prtList 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 i e = case e of
+   Arg argvar -> prPrec i 2 (concatD [prt 0 argvar])
+   I cident -> prPrec i 2 (concatD [prt 0 cident])
+   Par cident terms -> prPrec i 2 (concatD [doc (showString "<") , prt 0 cident , prt 2 terms , doc (showString ">")])
+   LI id -> prPrec i 2 (concatD [doc (showString "$") , prt 0 id])
+   R assigns -> prPrec i 2 (concatD [doc (showString "{") , prt 0 assigns , doc (showString "}")])
+   P term label -> prPrec i 1 (concatD [prt 2 term , doc (showString ".") , prt 0 label])
+   T ctype cases -> prPrec i 1 (concatD [docs (showString "table") , prt 0 ctype , doc (showString "{") , prt 0 cases , doc (showString "}")])
+   V ctype terms -> prPrec i 1 (concatD [docs (showString "table") , prt 0 ctype , doc (showString "[") , prt 2 terms , doc (showString "]")])
+   S term0 term -> prPrec i 1 (concatD [prt 1 term0 , doc (showString "!") , prt 2 term])
+   C term0 term -> prPrec i 0 (concatD [prt 0 term0 , doc (showString "++") , prt 1 term])
+   FV terms -> prPrec i 1 (concatD [docs (showString "variants") , doc (showString "{") , prt 2 terms , doc (showString "}")])
+   EInt n -> prPrec i 2 (concatD [prt 0 n])
+   EFloat n -> prPrec i 2 (concatD [prt 0 n])
+   K tokn -> prPrec i 2 (concatD [prt 0 tokn])
+   E  -> prPrec i 2 (concatD [doc (showString "[") , doc (showString "]")])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 2 x , prt 2 xs])
+
+instance Print Tokn where
+  prt i e = case e of
+   KS str -> prPrec i 0 (concatD [prt 0 str])
+   KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , docs (showString "pre") , prt 0 strs , doc (showString "{") , prt 0 variants , doc (showString "}") , doc (showString "]")])
+   KM str -> prPrec i 0 (concatD [prt 0 str])
+
+
+instance Print Assign where
+  prt i e = case e of
+   Ass label term -> prPrec i 0 (concatD [prt 0 label , doc (showString "=") , prt 0 term])
+
+  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
+   Cas patts term -> prPrec i 0 (concatD [prt 0 patts , doc (showString "=>") , prt 0 term])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Variant where
+  prt i e = case e of
+   Var strs0 strs -> prPrec i 0 (concatD [prt 0 strs0 , doc (showString "/") , prt 0 strs])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Label where
+  prt i e = case e of
+   L id -> prPrec i 0 (concatD [prt 0 id])
+   LV n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
+
+
+instance Print ArgVar where
+  prt i e = case e of
+   A id n -> prPrec i 0 (concatD [prt 0 id , doc (showString "@") , prt 0 n])
+   AB id n0 n -> prPrec i 0 (concatD [prt 0 id , doc (showString "+") , prt 0 n0 , doc (showString "@") , prt 0 n])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+instance Print Patt where
+  prt i e = case e of
+   PC cident patts -> prPrec i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 patts , doc (showString ")")])
+   PV id -> prPrec i 0 (concatD [prt 0 id])
+   PW  -> prPrec i 0 (concatD [docs (showString "_")])
+   PR pattassigns -> prPrec i 0 (concatD [doc (showString "{") , prt 0 pattassigns , doc (showString "}")])
+   PI n -> prPrec i 0 (concatD [prt 0 n])
+   PF n -> prPrec i 0 (concatD [prt 0 n])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print PattAssign where
+  prt i e = case e of
+   PAss label patt -> prPrec i 0 (concatD [prt 0 label , 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])
+
+
diff --git a/src-2.9/GF/Canon/Share.hs b/src-2.9/GF/Canon/Share.hs
new file mode 100644
index 000000000..69725001a
--- /dev/null
+++ b/src-2.9/GF/Canon/Share.hs
@@ -0,0 +1,147 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Share
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 14:15:18 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.12 $
+--
+-- Optimizations on GFC code: sharing, parametrization, value sets.
+--
+-- optimization: sharing branches in tables. AR 25\/4\/2003.
+-- following advice of Josef Svenningsson
+-----------------------------------------------------------------------------
+
+module GF.Canon.Share (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where
+
+import GF.Canon.AbsGFC
+import GF.Infra.Ident
+import GF.Canon.GFC
+import qualified GF.Canon.CMacros as C
+import GF.Grammar.PrGrammar (prt)
+import GF.Data.Operations
+import Data.List
+import qualified GF.Infra.Modules as M
+
+type OptSpec = [Integer] ---
+
+doOptFactor opt = elem 2 opt
+doOptValues opt = elem 3 opt
+
+shareOpt :: OptSpec
+shareOpt = []
+
+paramOpt :: OptSpec
+paramOpt = [2]
+
+valOpt :: OptSpec
+valOpt = [3]
+
+allOpt :: OptSpec
+allOpt = [2,3]
+
+shareModule :: OptSpec -> (Ident, CanonModInfo) -> (Ident, CanonModInfo)
+shareModule opt (i,m) = case m of
+  M.ModMod (M.Module mt st fs me ops js) -> 
+    (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
+  _ -> (i,m)
+
+shareInfo opt (c, CncCat ty t m) = (c, CncCat ty (shareOptim opt c t) m)
+shareInfo opt (c, CncFun k xs t m) = (c, CncFun k xs (shareOptim opt c t) m)
+shareInfo _ i = i
+
+-- | the function putting together optimizations
+shareOptim :: OptSpec -> Ident -> Term -> Term
+shareOptim opt c 
+  | doOptFactor opt && doOptValues opt = values . factor c 0
+  | doOptFactor opt = share . factor c 0
+  | doOptValues opt = values    
+  | otherwise = share
+
+-- | we need no counter to create new variable names, since variables are 
+-- local to tables
+share :: Term -> Term
+share t = case t of
+  T ty cs  -> shareT ty [(p, share v) | Cas ps v <- cs, p <- ps]  -- only substant.
+  R lts -> R [Ass l (share t) | Ass l t <- lts]
+  P t l -> P (share t) l
+  S t a -> S (share t) (share a)
+  C t a -> C (share t) (share a)
+  FV ts -> FV (map share ts)
+
+  _ -> t  -- including D, which is always born shared
+
+ where
+   shareT ty = finalize ty . groupC . sortC
+ 
+   sortC :: [(Patt,Term)] -> [(Patt,Term)]
+   sortC = sortBy $ \a b -> compare (snd a) (snd b)
+
+   groupC :: [(Patt,Term)] -> [[(Patt,Term)]]
+   groupC = groupBy $ \a b -> snd a == snd b
+
+   finalize :: CType -> [[(Patt,Term)]] -> Term
+   finalize ty css = T ty [Cas (map fst ps) t | ps@((_,t):_) <- css]
+
+
+-- | do even more: factor parametric branches
+factor :: Ident -> Int -> Term -> Term
+factor c i t = case t of
+  T _ [_] -> t
+  T _ []  -> t
+  T ty cs -> T ty $ factors i [Cas [p] (factor c (i+1) v) | Cas ps v <- cs, p <- ps]
+  R lts   -> R [Ass l (factor c i t) | Ass l t <- lts]
+  P t l   -> P (factor c i t) l
+  S t a   -> S (factor c i t) (factor c i a)
+  C t a   -> C (factor c i t) (factor c i a)
+  FV ts   -> FV (map (factor c i) ts)
+
+  _ -> t
+ where
+
+   factors i psvs =   -- we know psvs has at least 2 elements
+     let p   = pIdent c i
+         vs' = map (mkFun p) psvs
+     in if   allEqs vs'
+        then mkCase p vs' 
+        else psvs
+
+   mkFun p (Cas [patt] val) = replace (C.patt2term patt) (LI p) val
+
+   allEqs (v:vs) = all (==v) vs
+
+   mkCase p (v:_) = [Cas [PV p] v]
+
+pIdent c i = identC ("p_" ++ prt c ++ "__" ++ show i)
+
+
+-- | we need to replace subterms
+replace :: Term -> Term -> Term -> Term
+replace old new trm = case trm of
+  T ty cs -> T ty [Cas p (repl v) | Cas p v <- cs]
+  P t l   -> P (repl t) l
+  S t a   -> S (repl t) (repl a)
+  C t a   -> C (repl t) (repl a)
+  FV ts   -> FV (map repl ts)
+  
+  -- these are the important cases, since they can correspond to patterns  
+  Par c ts | trm == old -> new
+  Par c ts            -> Par c (map repl ts)
+  R _ | isRec && trm == old -> new
+  R lts   -> R [Ass l (repl t) | Ass l t <- lts]
+
+  _ -> trm
+ where
+   repl = replace old new
+   isRec = case trm of
+     R _ -> True
+     _ -> False
+
+values :: Term -> Term
+values t = case t of
+  T ty [c] -> T ty [Cas p (values t) | Cas p t <- [c]] -- preserve parametrization
+  T ty cs  -> V ty [values t | Cas _ t <- cs] -- assumes proper order
+  _ -> C.composSafeOp values t
diff --git a/src-2.9/GF/Canon/SkelGFC.hs b/src-2.9/GF/Canon/SkelGFC.hs
new file mode 100644
index 000000000..a1d9331d8
--- /dev/null
+++ b/src-2.9/GF/Canon/SkelGFC.hs
@@ -0,0 +1,217 @@
+module GF.Canon.SkelGFC where
+
+-- Haskell module generated by the BNF converter
+
+import GF.Canon.AbsGFC
+import GF.Data.ErrM
+import GF.Infra.Ident
+
+type Result = Err String
+
+failure :: Show a => a -> Result
+failure x = Bad $ "Undefined case: " ++ show x
+
+transIdent :: Ident -> Result
+transIdent x = case x of
+  Ident str  -> failure x
+
+
+transCanon :: Canon -> Result
+transCanon x = case x of
+  MGr ids id modules  -> failure x
+  Gr modules  -> failure x
+
+
+transLine :: Line -> Result
+transLine x = case x of
+  LMulti ids id  -> failure x
+  LHeader modtype extend open  -> failure x
+  LFlag flag  -> failure x
+  LDef def  -> failure x
+  LEnd  -> failure x
+
+
+transModule :: Module -> Result
+transModule x = case x of
+  Mod modtype extend open flags defs  -> failure x
+
+
+transModType :: ModType -> Result
+transModType x = case x of
+  MTAbs id  -> failure x
+  MTCnc id0 id  -> failure x
+  MTRes id  -> failure x
+  MTTrans id0 id1 id  -> failure x
+
+
+transExtend :: Extend -> Result
+transExtend x = case x of
+  Ext ids  -> failure x
+  NoExt  -> failure x
+
+
+transOpen :: Open -> Result
+transOpen x = case x of
+  Opens ids  -> failure x
+  NoOpens  -> failure x
+
+
+transFlag :: Flag -> Result
+transFlag x = case x of
+  Flg id0 id  -> failure x
+
+
+transDef :: Def -> Result
+transDef x = case x of
+  AbsDCat id decls cidents  -> failure x
+  AbsDFun id exp0 exp  -> failure x
+  AbsDTrans id exp  -> failure x
+  ResDPar id pardefs  -> failure x
+  ResDOper id ctype term  -> failure x
+  CncDCat id ctype term0 term  -> failure x
+  CncDFun id cident argvars term0 term  -> failure x
+  AnyDInd id0 status id  -> failure x
+
+
+transParDef :: ParDef -> Result
+transParDef x = case x of
+  ParD id ctypes  -> failure x
+
+
+transStatus :: Status -> Result
+transStatus x = case x of
+  Canon  -> failure x
+  NonCan  -> failure x
+
+
+transCIdent :: CIdent -> Result
+transCIdent x = case x of
+  CIQ id0 id  -> failure x
+
+
+transExp :: Exp -> Result
+transExp x = case x of
+  EApp exp0 exp  -> failure x
+  EProd id exp0 exp  -> failure x
+  EAbs id exp  -> failure x
+  EAtom atom  -> failure x
+  EData  -> failure x
+  EEq equations  -> failure x
+
+
+transSort :: Sort -> Result
+transSort x = case x of
+  SType  -> failure x
+
+
+transEquation :: Equation -> Result
+transEquation x = case x of
+  Equ apatts exp  -> failure x
+
+
+transAPatt :: APatt -> Result
+transAPatt x = case x of
+  APC cident apatts  -> failure x
+  APV id  -> failure x
+  APS str  -> failure x
+  API n  -> failure x
+  APW  -> failure x
+
+
+transAtom :: Atom -> Result
+transAtom x = case x of
+  AC cident  -> failure x
+  AD cident  -> failure x
+  AV id  -> failure x
+  AM n  -> failure x
+  AS str  -> failure x
+  AI n  -> failure x
+  AT sort  -> failure x
+
+
+transDecl :: Decl -> Result
+transDecl x = case x of
+  Decl id exp  -> failure x
+
+
+transCType :: CType -> Result
+transCType x = case x of
+  RecType labellings  -> failure x
+  Table ctype0 ctype  -> failure x
+  Cn cident  -> failure x
+  TStr  -> failure x
+  TInts n  -> failure x
+
+
+transLabelling :: Labelling -> Result
+transLabelling x = case x of
+  Lbg label ctype  -> failure x
+
+
+transTerm :: Term -> Result
+transTerm x = case x of
+  Arg argvar  -> failure x
+  I cident  -> failure x
+  Par cident terms  -> failure x
+  LI id  -> failure x
+  R assigns  -> failure x
+  P term label  -> failure x
+  T ctype cases  -> failure x
+  V ctype terms  -> failure x
+  S term0 term  -> failure x
+  C term0 term  -> failure x
+  FV terms  -> failure x
+  EInt n  -> failure x
+  K tokn  -> failure x
+  E  -> failure x
+
+
+transTokn :: Tokn -> Result
+transTokn x = case x of
+  KS str  -> failure x
+  KP strs variants  -> failure x
+  KM str  -> failure x
+
+
+transAssign :: Assign -> Result
+transAssign x = case x of
+  Ass label term  -> failure x
+
+
+transCase :: Case -> Result
+transCase x = case x of
+  Cas patts term  -> failure x
+
+
+transVariant :: Variant -> Result
+transVariant x = case x of
+  Var strs0 strs  -> failure x
+
+
+transLabel :: Label -> Result
+transLabel x = case x of
+  L id  -> failure x
+  LV n  -> failure x
+
+
+transArgVar :: ArgVar -> Result
+transArgVar x = case x of
+  A id n  -> failure x
+  AB id n0 n  -> failure x
+
+
+transPatt :: Patt -> Result
+transPatt x = case x of
+  PC cident patts  -> failure x
+  PV id  -> failure x
+  PW  -> failure x
+  PR pattassigns  -> failure x
+  PI n  -> failure x
+
+
+transPattAssign :: PattAssign -> Result
+transPattAssign x = case x of
+  PAss label patt  -> failure x
+
+
+
diff --git a/src-2.9/GF/Canon/Subexpressions.hs b/src-2.9/GF/Canon/Subexpressions.hs
new file mode 100644
index 000000000..683f9eecf
--- /dev/null
+++ b/src-2.9/GF/Canon/Subexpressions.hs
@@ -0,0 +1,170 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Subexpressions
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/20 09:32:56 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.4 $
+--
+-- Common subexpression elimination.
+-- all tables. AR 18\/9\/2005.
+-----------------------------------------------------------------------------
+
+module GF.Canon.Subexpressions (
+  elimSubtermsMod, prSubtermStat, unSubelimCanon, unSubelimModule
+  ) where
+
+import GF.Canon.AbsGFC
+import GF.Infra.Ident
+import GF.Canon.GFC
+import GF.Canon.Look
+import GF.Grammar.PrGrammar
+import GF.Canon.CMacros as C
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+
+import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.List
+
+{-
+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.
+
+-}
+
+-- exported functions
+
+elimSubtermsMod :: (Ident,CanonModInfo) -> Err (Ident, CanonModInfo)
+elimSubtermsMod (mo,m) = case m of
+  M.ModMod (M.Module mt st fs me ops js) -> do
+    (tree,_) <- appSTM (getSubtermsMod mo (tree2list js)) (Map.empty,0)
+    js2 <- liftM buildTree $ addSubexpConsts mo tree $ tree2list js
+    return (mo,M.ModMod (M.Module mt st fs me ops js2))
+  _ -> return (mo,m)
+
+prSubtermStat :: CanonGrammar -> String
+prSubtermStat gr = unlines [prt mo ++++ expsIn mo js | (mo,js) <- mos] where
+  mos = [(i, tree2list (M.jments m)) | (i, M.ModMod m) <- M.modules gr, M.isModCnc m]
+  expsIn mo js = err id id $ do
+    (tree,_) <- appSTM (getSubtermsMod mo js) (Map.empty,0)
+    let list0 = Map.toList tree
+    let list1 = sortBy (\ (_,(m,_)) (_,(n,_)) -> compare n m) list0
+    return $ unlines [show n ++ "\t" ++ prt trm | (trm,(n,_)) <- list1]
+
+unSubelimCanon :: CanonGrammar -> CanonGrammar
+unSubelimCanon gr@(M.MGrammar modules) = 
+    M.MGrammar $ map unSubelimModule modules 
+ 
+unSubelimModule :: CanonModule -> CanonModule
+unSubelimModule mo@(i,m) = case m of
+    M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) | hasSub ljs ->
+      (i, M.ModMod (M.Module mt st fs me ops 
+                     (rebuild (map unparInfo ljs)))) 
+                        where ljs = tree2list js
+    _ -> (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 k xs t m -> [(c, CncFun k xs (unparTerm t) m)]
+      ResOper _ _ -> []
+      _ -> [(c,info)]
+    unparTerm t = case t of
+      I c -> errVal t $ liftM unparTerm $ lookupGlobal gr c 
+      _ -> C.composSafeOp unparTerm t
+    gr = M.MGrammar [mo] 
+    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 ci xs trm pn -> do
+       trm' <- recomp f trm
+       return (f,CncFun ci xs trm' pn)
+     ResOper ty trm -> do
+       trm' <- recomp f trm
+       return (f,ResOper ty trm')
+     _ -> return (f,def)
+   recomp f t = case Map.lookup t tree of
+     Just (_,id) | ident id /= f -> return $ I $ cident mo id
+     _ -> composOp (recomp f) t
+
+   list = Map.toList tree
+
+   oper id trm = (ident id, ResOper TStr trm) --- type TStr does not matter
+
+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 ci xs trm pn -> do
+       get trm
+       return $ fi
+     ResOper ty trm -> do
+       get trm
+       return $ fi
+     _ -> return fi
+
+collectSubterms :: Ident -> Term -> TermM Term
+collectSubterms mo t = case t of
+  Par _ (_:_) -> add t
+  T ty cs -> do
+    let (ps,ts) = unzip [(p,t) | Cas p t <- cs]
+    mapM (collectSubterms mo) ts
+    add t
+  V ty ts -> do
+    mapM (collectSubterms mo) ts
+    add t
+  K (KP _ _)  -> add t
+  _ -> composOp (collectSubterms mo) t
+ 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)
+     return t --- only because of composOp
+
+ident :: Int -> Ident
+ident i = identC ("A''" ++ show i) ---
+
+cident :: Ident -> Int -> CIdent
+cident mo = CIQ mo . ident
diff --git a/src-2.9/GF/Canon/TestGFC.hs b/src-2.9/GF/Canon/TestGFC.hs
new file mode 100644
index 000000000..7c89d64e8
--- /dev/null
+++ b/src-2.9/GF/Canon/TestGFC.hs
@@ -0,0 +1,58 @@
+-- automatically generated by BNF Converter
+module Main where
+
+
+import IO ( stdin, hGetContents )
+import System ( getArgs, getProgName )
+
+import GF.Canon.LexGFC
+import GF.Canon.ParGFC
+import GF.Canon.SkelGFC
+import GF.Canon.PrintGFC
+import GF.Canon.AbsGFC
+import GF.Infra.Ident
+
+
+
+import GF.Data.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 pCanon
+            "-s":fs -> mapM_ (runFile 0 pCanon) fs
+            fs -> mapM_ (runFile 2 pCanon) fs
+
+
+
+
+
diff --git a/src-2.9/GF/Canon/Unlex.hs b/src-2.9/GF/Canon/Unlex.hs
new file mode 100644
index 000000000..dd93390e2
--- /dev/null
+++ b/src-2.9/GF/Canon/Unlex.hs
@@ -0,0 +1,49 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Unlex
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:32 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- elementary text postprocessing. AR 21/11/2001
+-----------------------------------------------------------------------------
+
+module GF.Canon.Unlex (formatAsText, unlex, performBinds) where
+
+import GF.Data.Operations
+import GF.Data.Str
+
+import Data.Char
+import Data.List (isPrefixOf)
+
+formatAsText :: String -> String
+formatAsText = unwords . format . cap . words where
+  format ws = case ws of
+    w : c : ww | major c -> (w ++ c)      : format (cap ww)
+    w : c : ww | minor c -> (w ++ c)      : format ww
+    c     : ww | para  c -> "\n\n"        : format ww
+    w     : ww           -> w             : format ww
+    [] -> []
+  cap (p:(c:cs):ww) | para p = p : (toUpper c : cs) : ww
+  cap ((c:cs):ww) = (toUpper c : cs) : ww
+  cap [] = []
+  major = flip elem (map (:[]) ".!?") 
+  minor = flip elem (map (:[]) ",:;")
+  para  = (=="&-") 
+
+unlex :: [Str] -> String
+unlex = formatAsText . performBinds . concat . map sstr . take 1 ----
+
+-- | modified from GF/src/Text by adding hyphen
+performBinds :: String -> String
+performBinds = unwords . format . words where
+  format ws = case ws of
+    w : "-"  : u : ws -> format ((w ++ "-" ++ u) : ws)
+    w : "&+" : u : ws -> format ((w ++ u) : ws)
+    w : ws            -> w : format ws
+    []                -> []
+
diff --git a/src-2.9/GF/Canon/Unparametrize.hs b/src-2.9/GF/Canon/Unparametrize.hs
new file mode 100644
index 000000000..0ca6a2d9c
--- /dev/null
+++ b/src-2.9/GF/Canon/Unparametrize.hs
@@ -0,0 +1,63 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Unparametrize
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/14 16:26:21 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.1 $
+--
+-- Taking away parameters from a canonical grammar. All param
+-- types are replaced by {}, and only one branch is left in
+-- all tables. AR 14\/9\/2005.
+-----------------------------------------------------------------------------
+
+module GF.Canon.Unparametrize (unparametrizeCanon) where
+
+import GF.Canon.AbsGFC
+import GF.Infra.Ident
+import GF.Canon.GFC
+import qualified GF.Canon.CMacros as C
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+
+unparametrizeCanon :: CanonGrammar -> CanonGrammar
+unparametrizeCanon (M.MGrammar modules) = 
+    M.MGrammar $ map unparModule modules where 
+
+  unparModule (i,m) = case m of
+    M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) ->
+      let me' = [(unparIdent j,incl) | (j,incl) <- me] in 
+      (unparIdent i, M.ModMod (M.Module mt st fs me' ops (mapTree unparInfo js)))
+    _ -> (i,m)
+
+  unparInfo (c,info) = case info of
+    CncCat ty t m   -> (c, CncCat   (unparCType ty) (unparTerm t) m)
+    CncFun k xs t m -> (c, CncFun k xs (unparTerm t) m)
+    AnyInd b i      -> (c, AnyInd b (unparIdent i))
+    _ -> (c,info)
+
+  unparCType ty = case ty of
+    RecType ls -> RecType [Lbg lab (unparCType t) | Lbg lab t <- ls]
+    Table _ v  -> unparCType v --- Table unitType (unparCType v)
+    Cn _       -> unitType
+    _ -> ty
+
+  unparTerm t = case t of
+    Par _ _ -> unitTerm
+    T _ cs  -> unparTerm (head [t | Cas _ t <- cs])
+    V _ ts  -> unparTerm (head ts)
+    S t _   -> unparTerm t
+{-
+    T _ cs  -> V unitType [unparTerm (head [t | Cas _ t <- cs])]
+    V _ ts  -> V unitType [unparTerm (head ts)]
+    S t _   -> S (unparTerm t) unitTerm
+-}
+    _ -> C.composSafeOp unparTerm t
+
+  unitType = RecType []
+  unitTerm = R []
+
+  unparIdent (IC s) = IC $ "UP_" ++ s
diff --git a/src-2.9/GF/Canon/log.txt b/src-2.9/GF/Canon/log.txt
new file mode 100644
index 000000000..44dba3954
--- /dev/null
+++ b/src-2.9/GF/Canon/log.txt
@@ -0,0 +1,20 @@
+GFCC, 6/9/2006
+
+66661   24  Par remaining to be sent to GFC
+66662    0  not covered by mkTerm
+66663   36  label not in numeric format in mkTerm
+66664    2  label not found in symbol table
+66665   36  projection from deeper than just arg var: NP.agr.n
+66667    0  parameter value not found in symbol table
+66668    1  variable in parameter argument
+
+
+
+66664    2
+66665  125  missing: (VP.s!vf).fin
+66668    1
+
+
+66661/3 24  same lines: 
+66664    2
+66668    1
diff --git a/src-2.9/GF/Command/AbsGFShell.hs b/src-2.9/GF/Command/AbsGFShell.hs
new file mode 100644
index 000000000..c13004cf9
--- /dev/null
+++ b/src-2.9/GF/Command/AbsGFShell.hs
@@ -0,0 +1,42 @@
+module GF.Command.AbsGFShell where
+
+-- Haskell module generated by the BNF converter
+
+newtype Ident = Ident String deriving (Eq,Ord,Show)
+data CommandLine =
+   CLine [Pipe]
+ | CEmpty
+  deriving (Eq,Ord,Show)
+
+data Pipe =
+   PComm [Command]
+  deriving (Eq,Ord,Show)
+
+data Command =
+   Comm Ident [Option] Argument
+ | CNoarg Ident [Option]
+  deriving (Eq,Ord,Show)
+
+data Option =
+   OOpt Ident
+ | OFlag Ident Value
+  deriving (Eq,Ord,Show)
+
+data Value =
+   VId Ident
+ | VInt Integer
+  deriving (Eq,Ord,Show)
+
+data Argument =
+   ATree Tree
+  deriving (Eq,Ord,Show)
+
+data Tree =
+   TApp Ident [Tree]
+ | TAbs [Ident] Tree
+ | TId Ident
+ | TInt Integer
+ | TStr String
+ | TFloat Double
+  deriving (Eq,Ord,Show)
+
diff --git a/src-2.9/GF/Command/Commands.hs b/src-2.9/GF/Command/Commands.hs
new file mode 100644
index 000000000..d5b5a8768
--- /dev/null
+++ b/src-2.9/GF/Command/Commands.hs
@@ -0,0 +1,159 @@
+module GF.Command.Commands (
+  allCommands,
+  lookCommand,
+  exec,
+  isOpt,
+  options,
+  flags,
+  CommandInfo,
+  CommandOutput
+  ) where
+
+import GF.Command.AbsGFShell hiding (Tree)
+import GF.Command.PPrTree
+import GF.Command.ParGFShell
+import GF.GFCC.ShowLinearize
+import GF.GFCC.API
+import GF.GFCC.Macros
+import GF.Devel.PrintGFCC
+import GF.GFCC.DataGFCC ----
+
+import GF.Data.ErrM ----
+
+import qualified Data.Map as Map
+
+type CommandOutput = ([Tree],String) ---- errors, etc
+
+data CommandInfo = CommandInfo {
+  exec     :: [Option] -> [Tree] -> IO CommandOutput,
+  synopsis :: String,
+  explanation :: String,
+  longname :: String,
+  options  :: [String],
+  flags    :: [String]
+  }
+
+emptyCommandInfo :: CommandInfo
+emptyCommandInfo = CommandInfo {
+  exec = \_ ts -> return (ts,[]), ----
+  synopsis = "synopsis",
+  explanation = "explanation",
+  longname = "longname",
+  options = [],
+  flags = []
+  }
+
+lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo
+lookCommand = Map.lookup
+
+commandHelpAll :: MultiGrammar -> [Option] -> String
+commandHelpAll mgr opts = unlines
+  [commandHelp (isOpt "full" opts) (co,info)
+    | (co,info) <- Map.assocs (allCommands mgr)]
+
+commandHelp :: Bool -> (String,CommandInfo) -> String
+commandHelp full (co,info) = unlines $ [
+  co ++ ", " ++ longname info,
+  synopsis info] ++ if full then [
+  explanation info,
+  "options: " ++ unwords (options info),
+  "flags: " ++ unwords (flags info)
+  ] else []
+
+valIdOpts :: String -> String -> [Option] -> String
+valIdOpts flag def opts = case valOpts flag (VId (Ident def)) opts of
+  VId (Ident v) -> v
+  _ -> def
+
+valIntOpts :: String -> Integer -> [Option] -> Int
+valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of
+  VInt 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 (Ident f) v <- opts]
+
+isOpt :: String -> [Option] -> Bool
+isOpt o opts = elem o [x | OOpt (Ident x) <- opts]
+
+-- this list must be kept sorted by the command name!
+allCommands :: MultiGrammar -> Map.Map String CommandInfo
+allCommands mgr = Map.fromAscList [
+  ("gr", emptyCommandInfo {
+     longname = "generate_random",
+     synopsis = "generates a list of random trees, by default one tree",
+     flags = ["cat","number"],
+     exec = \opts _ -> do
+       ts <- generateRandom mgr (optCat opts)
+       return $ fromTrees $ take (optNum opts) ts
+     }),
+  ("gt", emptyCommandInfo {
+     longname = "generate_trees",
+     synopsis = "generates a list of trees, by default exhaustive",
+     flags = ["cat","depth","number"],
+     exec = \opts _ -> do
+       let dp = return $ valIntOpts "depth" 4 opts
+       let ts = generateAllDepth mgr (optCat opts) dp
+       return $ fromTrees $ take (optNumInf opts) ts
+     }),
+  ("h", emptyCommandInfo {
+     longname = "help",
+     synopsis = "get description of a command, or a the full list of commands",
+     options = ["full"],
+     exec = \opts ts -> return ([], case ts of
+       [t] -> let co = (showTree t) in 
+              case lookCommand co (allCommands mgr) of   ---- new map ??!!
+                Just info -> commandHelp True (co,info)
+                _ -> "command not found"
+       _ -> commandHelpAll mgr opts)
+     }),
+  ("l", emptyCommandInfo {
+     exec = \opts -> return . fromStrings . map (optLin opts),
+     options = ["all","record","table","term"],
+     flags = ["lang"]
+     }),
+  ("p", emptyCommandInfo {
+     exec = \opts -> return . fromTrees . concatMap (par opts). toStrings,
+     flags = ["cat","lang"]
+     }),
+  ("pg", emptyCommandInfo {
+     exec  = \opts _ -> return $ fromString $ prGrammar opts,
+     flags = ["cat","lang","printer"]
+     })
+  ]
+ where
+   lin opts t = unlines [linearize mgr lang t    | lang <- optLangs opts]
+   par opts s = concat  [parse mgr lang (optCat opts) s | lang <- optLangs opts]
+ 
+   optLin opts t = unlines [linea lang t | lang <- optLangs opts] where
+     linea lang = case opts of
+       _ | isOpt "all"    opts -> allLinearize gr (cid lang)
+       _ | isOpt "table"  opts -> tableLinearize gr (cid lang)
+       _ | isOpt "term"   opts -> termLinearize gr (cid lang)
+       _ | isOpt "record" opts -> recordLinearize gr (cid lang)
+       _  -> linearize mgr lang
+
+
+   optLangs opts = case valIdOpts "lang" "" opts of
+     "" -> languages mgr
+     lang -> [lang] 
+   optCat opts = valIdOpts "cat" (lookStartCat gr) opts
+   optNum opts = valIntOpts "number" 1 opts
+   optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
+
+   gr       = gfcc mgr
+
+   fromTrees ts = (ts,unlines (map showTree ts))
+   fromStrings ss = (map tStr ss, unlines ss)
+   fromString  s  = ([tStr s], s)
+   toStrings ts = [s | DTr [] (AS s) [] <- ts] 
+   tStr s = DTr [] (AS s) []
+
+   prGrammar opts = case valIdOpts "printer" "" opts of
+     "cats" -> unwords $ categories mgr
+     v -> prGFCC v gr 
+
diff --git a/src-2.9/GF/Command/GFShell.cf b/src-2.9/GF/Command/GFShell.cf
new file mode 100644
index 000000000..1f5a9fa6d
--- /dev/null
+++ b/src-2.9/GF/Command/GFShell.cf
@@ -0,0 +1,27 @@
+--entrypoints CommandLine, Tree ;
+
+CLine.   CommandLine ::= [Pipe] ;
+CEmpty.  CommandLine ::= ;
+PComm.   Pipe        ::= [Command] ;
+Comm.    Command     ::= Ident [Option] Argument ;
+CNoarg.  Command     ::= Ident [Option] ;
+OOpt.    Option      ::= "-" Ident ;
+OFlag.   Option      ::= "-" Ident "=" Value ;
+VId.     Value       ::= Ident ;
+VInt.    Value       ::= Integer ;
+ATree.   Argument    ::= Tree ;
+
+TApp.    Tree1       ::= Ident [Tree2] ;
+TAbs.    Tree        ::= "\\" [Ident] "->" Tree ;
+TId.     Tree2       ::= Ident ;
+TInt.    Tree2       ::= Integer ; 
+TStr.    Tree2       ::= String ; 
+TFloat.  Tree2       ::= Double ; 
+
+coercions Tree 2 ;
+
+separator nonempty Pipe ";" ;
+separator nonempty Command "|" ;
+terminator Option "" ;
+terminator nonempty Tree2 "" ;
+terminator nonempty Ident "," ;
diff --git a/src-2.9/GF/Command/Importing.hs b/src-2.9/GF/Command/Importing.hs
new file mode 100644
index 000000000..a09ba8de6
--- /dev/null
+++ b/src-2.9/GF/Command/Importing.hs
@@ -0,0 +1,28 @@
+module GF.Command.Importing (importGrammar) where
+
+import GF.Compile.API
+import GF.GFCC.DataGFCC
+import GF.GFCC.API
+
+import GF.Devel.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 :: MultiGrammar -> Options -> [FilePath] -> IO MultiGrammar
+importGrammar mgr0 opts files =
+  case takeExtensions (last files) of
+    s | elem s [".gf",".gfo"] -> do
+      res <- appIOE $ compileToGFCC opts files
+      case res of
+        Ok gfcc2 -> do let gfcc3 = unionGFCC (gfcc mgr0) gfcc2
+                       return $ MultiGrammar gfcc3
+        Bad msg  -> do putStrLn msg
+                       return mgr0
+    ".gfcc" -> do
+      gfcc2 <- mapM file2gfcc files >>= return . foldl1 unionGFCC
+      let gfcc3 = unionGFCC (gfcc mgr0) gfcc2
+      return $ MultiGrammar gfcc3
\ No newline at end of file
diff --git a/src-2.9/GF/Command/Interpreter.hs b/src-2.9/GF/Command/Interpreter.hs
new file mode 100644
index 000000000..10730e7ef
--- /dev/null
+++ b/src-2.9/GF/Command/Interpreter.hs
@@ -0,0 +1,74 @@
+module GF.Command.Interpreter (
+  CommandEnv (..),
+  interpretCommandLine
+  ) where
+
+import GF.Command.Commands
+import GF.Command.AbsGFShell hiding (Tree)
+import GF.Command.PPrTree
+import GF.Command.ParGFShell
+import GF.GFCC.API
+import GF.GFCC.Macros
+import GF.GFCC.DataGFCC
+
+import GF.Data.ErrM ----
+
+import qualified Data.Map as Map
+
+data CommandEnv = CommandEnv {
+  multigrammar :: MultiGrammar,
+  commands     :: Map.Map String CommandInfo
+  }
+
+interpretCommandLine :: CommandEnv -> String -> IO ()
+interpretCommandLine env line = case (pCommandLine (myLexer line)) of
+  Ok CEmpty -> return ()
+  Ok (CLine pipes) -> mapM_ interPipe pipes
+  _ -> putStrLn "command not parsed"
+ where
+   interPipe (PComm cs) = do
+     (_,s) <- intercs ([],"") cs
+     putStrLn s
+   intercs treess [] = return treess
+   intercs (trees,_) (c:cs) = do
+     treess2 <- interc trees c
+     intercs treess2 cs
+   interc = interpret env
+
+-- 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 comm trees0
+   comms = commands env
+   checkOpts info = 
+     case
+       [o | OOpt  (Ident o)   <- opts, notElem o (options info)] ++
+       [o | OFlag (Ident o) _ <- opts, notElem o (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
+getCommand :: Command -> [Tree] -> (String,[Option],[Tree])
+getCommand co ts = case co of
+  Comm   (Ident c) opts (ATree t) -> (getOp c,opts,[tree2exp t]) -- ignore piped
+  CNoarg (Ident c) opts           -> (getOp c,opts,ts)           -- use piped
+ where
+   -- abbreviation convention from gf
+   getOp 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-2.9/GF/Command/LexGFShell.hs b/src-2.9/GF/Command/LexGFShell.hs
new file mode 100644
index 000000000..8e0191039
--- /dev/null
+++ b/src-2.9/GF/Command/LexGFShell.hs
@@ -0,0 +1,337 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LINE 3 "GF/Command/LexGFShell.x" #-}
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Command.LexGFShell 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# "\xf8\xff\xff\xff\xfd\xff\xff\xff\x02\x00\x00\x00\x00\x00\x00\x00\xd2\xff\xff\xff\xc8\x00\x00\x00\x98\x01\x00\x00\x00\x00\x00\x00\x73\x00\x00\x00\x43\x01\x00\x00\x31\x00\x00\x00\x4e\x00\x00\x00\x13\x01\x00\x00\x76\x00\x00\x00\x1e\x01\x00\x00\x2b\x01\x00\x00\x36\x01\x00\x00"#
+
+alex_table :: AlexAddr
+alex_table = AlexA# "\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x08\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x03\x00\x03\x00\x02\x00\x00\x00\x03\x00\x04\x00\x00\x00\x00\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x00\x00\x03\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x09\x00\x03\x00\x00\x00\x00\x00\x00\x00\x09\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\xff\xff\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\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\x07\x00\x00\x00\x00\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\x09\x00\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\x00\x00\x00\x00\x00\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x0a\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\xff\xff\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x0c\x00\x10\x00\x00\x00\x00\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x07\x00\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\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x0a\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x00\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00"#
+
+alex_check :: AlexAddr
+alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x28\x00\x29\x00\x20\x00\xff\xff\x2c\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\x3b\x00\xff\xff\x3d\x00\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\x5c\x00\xff\xff\xff\xff\xff\xff\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\x7c\x00\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\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\x0a\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\x22\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\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\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\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00"#
+
+alex_deflt :: AlexAddr
+alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_accept = listArray (0::Int,16) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))],[],[],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[],[],[]]
+{-# LINE 32 "GF/Command/LexGFShell.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 = 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 (TV . share) s)) 
+alex_action_3 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) 
+alex_action_4 = tok (\p s -> PT p (TI $ share s))    
+alex_action_5 = 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 -> 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-2.9/GF/Command/PPrTree.hs b/src-2.9/GF/Command/PPrTree.hs
new file mode 100644
index 000000000..7372c722d
--- /dev/null
+++ b/src-2.9/GF/Command/PPrTree.hs
@@ -0,0 +1,39 @@
+module GF.Command.PPrTree (pTree, prExp, tree2exp) where
+
+import GF.GFCC.DataGFCC
+import GF.GFCC.CId
+import GF.GFCC.Macros
+import qualified GF.Command.ParGFShell as P
+import GF.Command.PrintGFShell
+import GF.Command.AbsGFShell
+import GF.Data.ErrM
+
+pTree :: String -> Exp
+pTree s = case P.pTree (P.myLexer s) of
+  Ok t -> tree2exp t
+  Bad s -> error s
+
+tree2exp t = case t of
+  TApp f ts -> tree (AC (i2i f)) (map tree2exp ts)  
+  TAbs xs t -> DTr (map i2i xs ++ ys) f ts where DTr ys f ts = tree2exp t 
+  TId c     -> tree (AC (i2i c)) [] 
+  TInt i    -> tree (AI i) []
+  TStr s    -> tree (AS s) []
+  TFloat d  -> tree (AF d) [] 
+ where
+   i2i (Ident s) = CId s
+
+prExp :: Exp -> String
+prExp = printTree . exp2tree
+
+exp2tree (DTr xs at ts) = tabs (map i4i xs) (tapp at (map exp2tree ts)) 
+  where
+    tabs [] t = t
+    tabs ys t = TAbs ys t
+    tapp (AC f) [] = TId (i4i f)
+    tapp (AC f) vs = TApp (i4i f) vs
+    tapp (AI i) [] = TInt i
+    tapp (AS i) [] = TStr i
+    tapp (AF i) [] = TFloat i
+    tapp (AM i) [] = TId (Ident "?") ----
+    i4i (CId s) = Ident s
diff --git a/src-2.9/GF/Command/ParGFShell.hs b/src-2.9/GF/Command/ParGFShell.hs
new file mode 100644
index 000000000..1fc85b4b7
--- /dev/null
+++ b/src-2.9/GF/Command/ParGFShell.hs
@@ -0,0 +1,809 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
+module GF.Command.ParGFShell where
+import GF.Command.AbsGFShell
+import GF.Command.LexGFShell
+import GF.Data.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 (() -> ())
+happyIn17 :: (Ident) -> (HappyAbsSyn )
+happyIn17 x = unsafeCoerce# x
+{-# INLINE happyIn17 #-}
+happyOut17 :: (HappyAbsSyn ) -> (Ident)
+happyOut17 x = unsafeCoerce# x
+{-# INLINE happyOut17 #-}
+happyIn18 :: (Integer) -> (HappyAbsSyn )
+happyIn18 x = unsafeCoerce# x
+{-# INLINE happyIn18 #-}
+happyOut18 :: (HappyAbsSyn ) -> (Integer)
+happyOut18 x = unsafeCoerce# x
+{-# INLINE happyOut18 #-}
+happyIn19 :: (String) -> (HappyAbsSyn )
+happyIn19 x = unsafeCoerce# x
+{-# INLINE happyIn19 #-}
+happyOut19 :: (HappyAbsSyn ) -> (String)
+happyOut19 x = unsafeCoerce# x
+{-# INLINE happyOut19 #-}
+happyIn20 :: (Double) -> (HappyAbsSyn )
+happyIn20 x = unsafeCoerce# x
+{-# INLINE happyIn20 #-}
+happyOut20 :: (HappyAbsSyn ) -> (Double)
+happyOut20 x = unsafeCoerce# x
+{-# INLINE happyOut20 #-}
+happyIn21 :: (CommandLine) -> (HappyAbsSyn )
+happyIn21 x = unsafeCoerce# x
+{-# INLINE happyIn21 #-}
+happyOut21 :: (HappyAbsSyn ) -> (CommandLine)
+happyOut21 x = unsafeCoerce# x
+{-# INLINE happyOut21 #-}
+happyIn22 :: (Pipe) -> (HappyAbsSyn )
+happyIn22 x = unsafeCoerce# x
+{-# INLINE happyIn22 #-}
+happyOut22 :: (HappyAbsSyn ) -> (Pipe)
+happyOut22 x = unsafeCoerce# x
+{-# INLINE happyOut22 #-}
+happyIn23 :: (Command) -> (HappyAbsSyn )
+happyIn23 x = unsafeCoerce# x
+{-# INLINE happyIn23 #-}
+happyOut23 :: (HappyAbsSyn ) -> (Command)
+happyOut23 x = unsafeCoerce# x
+{-# INLINE happyOut23 #-}
+happyIn24 :: (Option) -> (HappyAbsSyn )
+happyIn24 x = unsafeCoerce# x
+{-# INLINE happyIn24 #-}
+happyOut24 :: (HappyAbsSyn ) -> (Option)
+happyOut24 x = unsafeCoerce# x
+{-# INLINE happyOut24 #-}
+happyIn25 :: (Value) -> (HappyAbsSyn )
+happyIn25 x = unsafeCoerce# x
+{-# INLINE happyIn25 #-}
+happyOut25 :: (HappyAbsSyn ) -> (Value)
+happyOut25 x = unsafeCoerce# x
+{-# INLINE happyOut25 #-}
+happyIn26 :: (Argument) -> (HappyAbsSyn )
+happyIn26 x = unsafeCoerce# x
+{-# INLINE happyIn26 #-}
+happyOut26 :: (HappyAbsSyn ) -> (Argument)
+happyOut26 x = unsafeCoerce# x
+{-# INLINE happyOut26 #-}
+happyIn27 :: (Tree) -> (HappyAbsSyn )
+happyIn27 x = unsafeCoerce# x
+{-# INLINE happyIn27 #-}
+happyOut27 :: (HappyAbsSyn ) -> (Tree)
+happyOut27 x = unsafeCoerce# x
+{-# INLINE happyOut27 #-}
+happyIn28 :: (Tree) -> (HappyAbsSyn )
+happyIn28 x = unsafeCoerce# x
+{-# INLINE happyIn28 #-}
+happyOut28 :: (HappyAbsSyn ) -> (Tree)
+happyOut28 x = unsafeCoerce# x
+{-# INLINE happyOut28 #-}
+happyIn29 :: (Tree) -> (HappyAbsSyn )
+happyIn29 x = unsafeCoerce# x
+{-# INLINE happyIn29 #-}
+happyOut29 :: (HappyAbsSyn ) -> (Tree)
+happyOut29 x = unsafeCoerce# x
+{-# INLINE happyOut29 #-}
+happyIn30 :: ([Pipe]) -> (HappyAbsSyn )
+happyIn30 x = unsafeCoerce# x
+{-# INLINE happyIn30 #-}
+happyOut30 :: (HappyAbsSyn ) -> ([Pipe])
+happyOut30 x = unsafeCoerce# x
+{-# INLINE happyOut30 #-}
+happyIn31 :: ([Command]) -> (HappyAbsSyn )
+happyIn31 x = unsafeCoerce# x
+{-# INLINE happyIn31 #-}
+happyOut31 :: (HappyAbsSyn ) -> ([Command])
+happyOut31 x = unsafeCoerce# x
+{-# INLINE happyOut31 #-}
+happyIn32 :: ([Option]) -> (HappyAbsSyn )
+happyIn32 x = unsafeCoerce# x
+{-# INLINE happyIn32 #-}
+happyOut32 :: (HappyAbsSyn ) -> ([Option])
+happyOut32 x = unsafeCoerce# x
+{-# INLINE happyOut32 #-}
+happyIn33 :: ([Tree]) -> (HappyAbsSyn )
+happyIn33 x = unsafeCoerce# x
+{-# INLINE happyIn33 #-}
+happyOut33 :: (HappyAbsSyn ) -> ([Tree])
+happyOut33 x = unsafeCoerce# x
+{-# INLINE happyOut33 #-}
+happyIn34 :: ([Ident]) -> (HappyAbsSyn )
+happyIn34 x = unsafeCoerce# x
+{-# INLINE happyIn34 #-}
+happyOut34 :: (HappyAbsSyn ) -> ([Ident])
+happyOut34 x = unsafeCoerce# x
+{-# INLINE happyOut34 #-}
+happyInTok :: Token -> (HappyAbsSyn )
+happyInTok x = unsafeCoerce# x
+{-# INLINE happyInTok #-}
+happyOutTok :: (HappyAbsSyn ) -> Token
+happyOutTok x = unsafeCoerce# x
+{-# INLINE happyOutTok #-}
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\x8d\x00\x8d\x00\x8d\x00\x91\x00\x16\x00\x80\x00\x89\x00\x80\x00\x89\x00\x7c\x00\x7c\x00\x00\x00\x89\x00\x7c\x00\x7c\x00\x00\x00\x7b\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x73\x00\x80\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x79\x00\x6c\x00\x72\x00\x69\x00\x00\x00\x69\x00\x89\x00\x00\x00\x69\x00\x00\x00\x62\x00\x5f\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x5f\x00\x5d\x00\x54\x00\x54\x00\x54\x00\x00\x00\x60\x00\x52\x00\x00\x00\x3a\x00\x3a\x00\x6a\x00\x00\x00\x24\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x16\x00\x00\x00\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\x1f\x00\x09\x00\x35\x00\x2a\x00\x90\x00\x49\x00\x70\x00\x5e\x00\x7d\x00\x33\x00\x34\x00\x42\x00\x1b\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x12\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x29\x00\x22\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x87\x00\x00\x00\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\xec\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd6\xff\x00\x00\x00\x00\x00\x00\xf1\xff\x00\x00\x00\x00\xdf\xff\xde\xff\xdd\xff\xdc\xff\xd4\xff\x00\x00\x00\x00\xf0\xff\xef\xff\xee\xff\x00\x00\xd6\xff\xd8\xff\x00\x00\xda\xff\x00\x00\xeb\xff\x00\x00\xdf\xff\xe0\xff\x00\x00\xe2\xff\x00\x00\x00\x00\x00\x00\xe4\xff\xe6\xff\xe5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\xff\xe8\xff\x00\x00\xe3\xff\x00\x00\x00\x00\xe9\xff\xd5\xff\x00\x00\xd3\xff\xd2\xff\xd1\xff\xdb\xff\xea\xff\xd7\xff\xd9\xff\x00\x00\x00\x00\xe7\xff\xe1\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x00\x00\x01\x00\x02\x00\x03\x00\x05\x00\x06\x00\x0a\x00\x0c\x00\x11\x00\x11\x00\x11\x00\x10\x00\x0c\x00\x0e\x00\x01\x00\x07\x00\x10\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x0a\x00\x0b\x00\x00\x00\x04\x00\x05\x00\x06\x00\x0f\x00\x0c\x00\x06\x00\x00\x00\x06\x00\x10\x00\x0d\x00\x0e\x00\x05\x00\x06\x00\x0e\x00\x07\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x0e\x00\x05\x00\x06\x00\x06\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0d\x00\x0e\x00\x0e\x00\x07\x00\x0a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0f\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x04\x00\x0a\x00\x0b\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x02\x00\x0f\x00\x0a\x00\x0b\x00\x0c\x00\x0a\x00\x0a\x00\x0b\x00\x0c\x00\x01\x00\x0a\x00\x03\x00\x0f\x00\x05\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0f\x00\x07\x00\x0a\x00\x0f\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x08\x00\x0f\x00\x03\x00\x09\x00\x05\x00\x0a\x00\x00\x00\x01\x00\x0c\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x05\x00\x08\x00\x00\x00\x01\x00\x01\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x08\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"#
+
+happyTable :: HappyAddr
+happyTable = HappyA# "\x00\x00\x10\x00\x10\x00\x10\x00\x35\x00\x12\x00\x13\x00\x14\x00\x15\x00\x1d\x00\x12\x00\x13\x00\x14\x00\x15\x00\x32\x00\x1e\x00\x10\x00\x16\x00\x3f\x00\x36\x00\x11\x00\x37\x00\x16\x00\x22\x00\x31\x00\x3b\x00\x3d\x00\x12\x00\x13\x00\x14\x00\x15\x00\x1d\x00\x10\x00\x1a\x00\x1d\x00\x33\x00\x20\x00\x1e\x00\xff\xff\x16\x00\x1e\x00\x1d\x00\x41\x00\x17\x00\x34\x00\x22\x00\x20\x00\x1e\x00\x42\x00\x2f\x00\x3a\x00\x1d\x00\x1d\x00\x1d\x00\x43\x00\x22\x00\x20\x00\x1e\x00\x1e\x00\x31\x00\x24\x00\x13\x00\x14\x00\x15\x00\x21\x00\x22\x00\x1f\x00\x3b\x00\x10\x00\x41\x00\x25\x00\x2b\x00\x27\x00\x24\x00\x13\x00\x14\x00\x15\x00\x24\x00\x13\x00\x14\x00\x15\x00\x1c\x00\x2a\x00\x25\x00\x2b\x00\x27\x00\x45\x00\x25\x00\x47\x00\x27\x00\x24\x00\x13\x00\x14\x00\x15\x00\x24\x00\x13\x00\x14\x00\x15\x00\x46\x00\xff\xff\x25\x00\x3c\x00\x27\x00\x10\x00\x25\x00\x26\x00\x27\x00\x31\x00\x10\x00\x29\x00\xff\xff\x19\x00\x24\x00\x13\x00\x14\x00\x15\x00\x10\x00\x1a\x00\x1b\x00\x1c\x00\xff\xff\x39\x00\x29\x00\xff\xff\x27\x00\x12\x00\x13\x00\x14\x00\x15\x00\x3a\x00\xff\xff\x29\x00\x3f\x00\x19\x00\x10\x00\x2c\x00\x2d\x00\x23\x00\x10\x00\x1a\x00\x1b\x00\x1c\x00\x19\x00\x46\x00\x2c\x00\x2d\x00\x31\x00\x10\x00\x1a\x00\x1b\x00\x1c\x00\x10\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (14, 46) [
+	(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)
+	]
+
+happy_n_terms = 16 :: Int
+happy_n_nonterms = 18 :: Int
+
+happyReduce_14 = happySpecReduce_1  0# happyReduction_14
+happyReduction_14 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TV happy_var_1)) -> 
+	happyIn17
+		 (Ident happy_var_1
+	)}
+
+happyReduce_15 = happySpecReduce_1  1# happyReduction_15
+happyReduction_15 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> 
+	happyIn18
+		 ((read happy_var_1) :: Integer
+	)}
+
+happyReduce_16 = happySpecReduce_1  2# happyReduction_16
+happyReduction_16 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> 
+	happyIn19
+		 (happy_var_1
+	)}
+
+happyReduce_17 = happySpecReduce_1  3# happyReduction_17
+happyReduction_17 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> 
+	happyIn20
+		 ((read happy_var_1) :: Double
+	)}
+
+happyReduce_18 = happySpecReduce_1  4# happyReduction_18
+happyReduction_18 happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 (CLine happy_var_1
+	)}
+
+happyReduce_19 = happySpecReduce_0  4# happyReduction_19
+happyReduction_19  =  happyIn21
+		 (CEmpty
+	)
+
+happyReduce_20 = happySpecReduce_1  5# happyReduction_20
+happyReduction_20 happy_x_1
+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
+	happyIn22
+		 (PComm happy_var_1
+	)}
+
+happyReduce_21 = happySpecReduce_3  6# happyReduction_21
+happyReduction_21 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	case happyOut32 happy_x_2 of { happy_var_2 -> 
+	case happyOut26 happy_x_3 of { happy_var_3 -> 
+	happyIn23
+		 (Comm happy_var_1 (reverse happy_var_2) happy_var_3
+	)}}}
+
+happyReduce_22 = happySpecReduce_2  6# happyReduction_22
+happyReduction_22 happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	case happyOut32 happy_x_2 of { happy_var_2 -> 
+	happyIn23
+		 (CNoarg happy_var_1 (reverse happy_var_2)
+	)}}
+
+happyReduce_23 = happySpecReduce_2  7# happyReduction_23
+happyReduction_23 happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_2 of { happy_var_2 -> 
+	happyIn24
+		 (OOpt happy_var_2
+	)}
+
+happyReduce_24 = happyReduce 4# 7# happyReduction_24
+happyReduction_24 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut17 happy_x_2 of { happy_var_2 -> 
+	case happyOut25 happy_x_4 of { happy_var_4 -> 
+	happyIn24
+		 (OFlag happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_25 = happySpecReduce_1  8# happyReduction_25
+happyReduction_25 happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	happyIn25
+		 (VId happy_var_1
+	)}
+
+happyReduce_26 = happySpecReduce_1  8# happyReduction_26
+happyReduction_26 happy_x_1
+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
+	happyIn25
+		 (VInt happy_var_1
+	)}
+
+happyReduce_27 = happySpecReduce_1  9# happyReduction_27
+happyReduction_27 happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	happyIn26
+		 (ATree happy_var_1
+	)}
+
+happyReduce_28 = happySpecReduce_2  10# happyReduction_28
+happyReduction_28 happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	case happyOut33 happy_x_2 of { happy_var_2 -> 
+	happyIn27
+		 (TApp happy_var_1 happy_var_2
+	)}}
+
+happyReduce_29 = happySpecReduce_1  10# happyReduction_29
+happyReduction_29 happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	happyIn27
+		 (happy_var_1
+	)}
+
+happyReduce_30 = happyReduce 4# 11# happyReduction_30
+happyReduction_30 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut34 happy_x_2 of { happy_var_2 -> 
+	case happyOut28 happy_x_4 of { happy_var_4 -> 
+	happyIn28
+		 (TAbs happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_31 = happySpecReduce_1  11# happyReduction_31
+happyReduction_31 happy_x_1
+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	happyIn28
+		 (happy_var_1
+	)}
+
+happyReduce_32 = happySpecReduce_1  12# happyReduction_32
+happyReduction_32 happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	happyIn29
+		 (TId happy_var_1
+	)}
+
+happyReduce_33 = happySpecReduce_1  12# happyReduction_33
+happyReduction_33 happy_x_1
+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
+	happyIn29
+		 (TInt happy_var_1
+	)}
+
+happyReduce_34 = happySpecReduce_1  12# happyReduction_34
+happyReduction_34 happy_x_1
+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> 
+	happyIn29
+		 (TStr happy_var_1
+	)}
+
+happyReduce_35 = happySpecReduce_1  12# happyReduction_35
+happyReduction_35 happy_x_1
+	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
+	happyIn29
+		 (TFloat happy_var_1
+	)}
+
+happyReduce_36 = happySpecReduce_3  12# happyReduction_36
+happyReduction_36 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_2 of { happy_var_2 -> 
+	happyIn29
+		 (happy_var_2
+	)}
+
+happyReduce_37 = happySpecReduce_1  13# happyReduction_37
+happyReduction_37 happy_x_1
+	 =  case happyOut22 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_38 = happySpecReduce_3  13# happyReduction_38
+happyReduction_38 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut22 happy_x_1 of { happy_var_1 -> 
+	case happyOut30 happy_x_3 of { happy_var_3 -> 
+	happyIn30
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_39 = happySpecReduce_1  14# happyReduction_39
+happyReduction_39 happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	happyIn31
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_40 = happySpecReduce_3  14# happyReduction_40
+happyReduction_40 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	case happyOut31 happy_x_3 of { happy_var_3 -> 
+	happyIn31
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_41 = happySpecReduce_0  15# happyReduction_41
+happyReduction_41  =  happyIn32
+		 ([]
+	)
+
+happyReduce_42 = happySpecReduce_2  15# happyReduction_42
+happyReduction_42 happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	case happyOut24 happy_x_2 of { happy_var_2 -> 
+	happyIn32
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_43 = happySpecReduce_1  16# happyReduction_43
+happyReduction_43 happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	happyIn33
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_44 = happySpecReduce_2  16# happyReduction_44
+happyReduction_44 happy_x_2
+	happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	case happyOut33 happy_x_2 of { happy_var_2 -> 
+	happyIn33
+		 ((:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_45 = happySpecReduce_2  17# happyReduction_45
+happyReduction_45 happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_46 = happySpecReduce_3  17# happyReduction_46
+happyReduction_46 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	case happyOut34 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyNewToken action sts stk [] =
+	happyDoAction 15# 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 _ (TV happy_dollar_dollar) -> cont 10#;
+	PT _ (TI happy_dollar_dollar) -> cont 11#;
+	PT _ (TL happy_dollar_dollar) -> cont 12#;
+	PT _ (TD happy_dollar_dollar) -> cont 13#;
+	_ -> cont 14#;
+	_ -> 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
+
+pCommandLine tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut21 x))
+
+pPipe tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut22 x))
+
+pCommand tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 2# tks) (\x -> happyReturn (happyOut23 x))
+
+pOption tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 3# tks) (\x -> happyReturn (happyOut24 x))
+
+pValue tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 4# tks) (\x -> happyReturn (happyOut25 x))
+
+pArgument tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 5# tks) (\x -> happyReturn (happyOut26 x))
+
+pTree1 tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 6# tks) (\x -> happyReturn (happyOut27 x))
+
+pTree tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 7# tks) (\x -> happyReturn (happyOut28 x))
+
+pTree2 tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 8# tks) (\x -> happyReturn (happyOut29 x))
+
+pListPipe tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 9# tks) (\x -> happyReturn (happyOut30 x))
+
+pListCommand tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 10# tks) (\x -> happyReturn (happyOut31 x))
+
+pListOption tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 11# tks) (\x -> happyReturn (happyOut32 x))
+
+pListTree2 tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 12# tks) (\x -> happyReturn (happyOut33 x))
+
+pListIdent tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 13# tks) (\x -> happyReturn (happyOut34 x))
+
+happySeq = happyDontSeq
+
+
+returnM :: a -> Err a
+returnM = return
+
+thenM :: Err a -> (a -> Err b) -> Err b
+thenM = (>>=)
+
+happyError :: [Token] -> Err a
+happyError ts =
+  Bad $ "syntax error at " ++ tokenPos ts ++ 
+  case ts of
+    [] -> []
+    [Err _] -> " due to lexer error"
+    _ -> " before " ++ unwords (map prToken (take 4 ts))
+
+myLexer = tokens
+{-# LINE 1 "GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
+{-# LINE 1 "<command line>" #-}
+{-# LINE 1 "GenericTemplate.hs" #-}
+-- Id: 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-2.9/GF/Command/PrintGFShell.hs b/src-2.9/GF/Command/PrintGFShell.hs
new file mode 100644
index 000000000..31a4584b6
--- /dev/null
+++ b/src-2.9/GF/Command/PrintGFShell.hs
@@ -0,0 +1,144 @@
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Command.PrintGFShell where
+
+-- pretty-printer generated by the BNF converter
+
+import GF.Command.AbsGFShell
+import Char
+
+-- the top-level printing method
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+type Doc = [ShowS] -> [ShowS]
+
+doc :: ShowS -> Doc
+doc = (:)
+
+render :: Doc -> String
+render d = rend 0 (map ($ "") $ d []) "" where
+  rend i ss = case ss of
+    "["      :ts -> showChar '[' . rend i ts
+    "("      :ts -> showChar '(' . rend i ts
+    "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
+    "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
+    "}"      :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
+    ";"      :ts -> showChar ';' . new i . rend i ts
+    t  : "," :ts -> showString t . space "," . rend i ts
+    t  : ")" :ts -> showString t . showChar ')' . rend i ts
+    t  : "]" :ts -> showString t . showChar ']' . rend i ts
+    t        :ts -> space t . rend i ts
+    _            -> id
+  new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
+  space t = showString t . (\s -> if null s then "" else (' ':s))
+
+parenth :: Doc -> Doc
+parenth ss = doc (showChar '(') . ss . doc (showChar ')')
+
+concatS :: [ShowS] -> ShowS
+concatS = foldr (.) id
+
+concatD :: [Doc] -> Doc
+concatD = foldr (.) id
+
+replicateS :: Int -> ShowS -> ShowS
+replicateS n f = concatS (replicate n f)
+
+-- the printer class does the job
+class Print a where
+  prt :: Int -> a -> Doc
+  prtList :: [a] -> Doc
+  prtList = concatD . map (prt 0)
+
+instance Print a => Print [a] where
+  prt _ = prtList
+
+instance Print Char where
+  prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
+  prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
+
+mkEsc :: Char -> Char -> ShowS
+mkEsc q s = case s of
+  _ | s == q -> showChar '\\' . showChar s
+  '\\'-> showString "\\\\"
+  '\n' -> showString "\\n"
+  '\t' -> showString "\\t"
+  _ -> showChar s
+
+prPrec :: Int -> Int -> Doc -> Doc
+prPrec i j = if j<i then parenth else id
+
+
+instance Print Integer where
+  prt _ x = doc (shows x)
+
+
+instance Print Double where
+  prt _ x = doc (shows x)
+
+
+instance Print Ident where
+  prt _ (Ident i) = doc (showString i)
+  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 CommandLine where
+  prt i e = case e of
+   CLine pipes -> prPrec i 0 (concatD [prt 0 pipes])
+   CEmpty  -> prPrec i 0 (concatD [])
+
+
+instance Print Pipe where
+  prt i e = case e of
+   PComm commands -> prPrec i 0 (concatD [prt 0 commands])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Command where
+  prt i e = case e of
+   Comm id options argument -> prPrec i 0 (concatD [prt 0 id , prt 0 options , prt 0 argument])
+   CNoarg id options -> prPrec i 0 (concatD [prt 0 id , prt 0 options])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
+
+instance Print Option where
+  prt i e = case e of
+   OOpt id -> prPrec i 0 (concatD [doc (showString "-") , prt 0 id])
+   OFlag id value -> prPrec i 0 (concatD [doc (showString "-") , prt 0 id , doc (showString "=") , prt 0 value])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print Value where
+  prt i e = case e of
+   VId id -> prPrec i 0 (concatD [prt 0 id])
+   VInt n -> prPrec i 0 (concatD [prt 0 n])
+
+
+instance Print Argument where
+  prt i e = case e of
+   ATree tree -> prPrec i 0 (concatD [prt 0 tree])
+
+
+instance Print Tree where
+  prt i e = case e of
+   TApp id trees -> prPrec i 1 (concatD [prt 0 id , prt 2 trees])
+   TAbs ids tree -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 ids , doc (showString "->") , prt 0 tree])
+   TId id -> prPrec i 2 (concatD [prt 0 id])
+   TInt n -> prPrec i 2 (concatD [prt 0 n])
+   TStr str -> prPrec i 2 (concatD [prt 0 str])
+   TFloat d -> prPrec i 2 (concatD [prt 0 d])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 2 x])
+   x:xs -> (concatD [prt 2 x , prt 2 xs])
+
+
diff --git a/src-2.9/GF/Compile/API.hs b/src-2.9/GF/Compile/API.hs
new file mode 100644
index 000000000..242a9e87a
--- /dev/null
+++ b/src-2.9/GF/Compile/API.hs
@@ -0,0 +1,21 @@
+module GF.Compile.API (batchCompile, compileToGFCC) where
+
+import GF.Devel.Compile
+import GF.Devel.GrammarToGFCC
+import GF.GFCC.OptimizeGFCC
+import GF.GFCC.CheckGFCC
+import GF.GFCC.DataGFCC
+import GF.Infra.Option
+import GF.Devel.UseIO
+
+-- | Compiles a number of source files and builds a 'GFCC' structure for them.
+compileToGFCC :: Options -> [FilePath] -> IOE GFCC
+compileToGFCC opts fs = 
+    do gr <- batchCompile opts fs
+       let name = justModuleName (last fs)
+       gc1 <- putPointE opts "linking ... " $
+                let (abs,gc0) = mkCanon2gfcc opts name gr
+                in ioeIO $ checkGFCCio gc0
+       let opt = if oElem (iOpt "noopt") opts then id else optGFCC
+           par = if oElem (iOpt "noparse") opts then id else addParsers
+       return (par (opt gc1))
diff --git a/src-2.9/GF/Compile/BackOpt.hs b/src-2.9/GF/Compile/BackOpt.hs
new file mode 100644
index 000000000..8356f2ba2
--- /dev/null
+++ b/src-2.9/GF/Compile/BackOpt.hs
@@ -0,0 +1,141 @@
+----------------------------------------------------------------------
+-- |
+-- 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, shareOpt, paramOpt, valOpt, allOpt) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+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
+
+type OptSpec = [Integer] ---
+
+doOptFactor :: OptSpec -> Bool
+doOptFactor opt = elem 2 opt
+
+doOptValues :: OptSpec -> Bool
+doOptValues opt = elem 3 opt
+
+shareOpt :: OptSpec
+shareOpt = []
+
+paramOpt :: OptSpec
+paramOpt = [2]
+
+valOpt :: OptSpec
+valOpt = [3]
+
+allOpt :: OptSpec
+allOpt = [2,3]
+
+shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+shareModule opt (i,m) = case m of
+  M.ModMod (M.Module mt st fs me ops js) -> 
+    (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
+  _ -> (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 
+  | doOptFactor opt && doOptValues opt = values . factor c 0
+  | doOptFactor opt = share . factor c 0
+  | doOptValues opt = values    
+  | otherwise = share
+
+-- we need no counter to create new variable names, since variables are 
+-- local to tables (only true in GFC) ---
+
+share :: Term -> Term
+share t = case t of
+  T ty@(TComp _) cs -> shareT ty [(p, share v) | (p, v) <- cs]
+  _ -> C.composSafeOp share t
+
+ where
+   shareT ty = finalize ty . groupC . sortC
+ 
+   sortC :: [(Patt,Term)] -> [(Patt,Term)]
+   sortC = sortBy $ \a b -> compare (snd a) (snd b)
+
+   groupC :: [(Patt,Term)] -> [[(Patt,Term)]]
+   groupC = groupBy $ \a b -> snd a == snd b
+
+   finalize :: TInfo -> [[(Patt,Term)]] -> Term
+   finalize ty css = TSh ty [(map fst ps, t) | ps@((_,t):_) <- css]
+
+-- 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 ("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-2.9/GF/Compile/CheckGrammar.hs b/src-2.9/GF/Compile/CheckGrammar.hs
new file mode 100644
index 000000000..b33d11017
--- /dev/null
+++ b/src-2.9/GF/Compile/CheckGrammar.hs
@@ -0,0 +1,1078 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Modules
+import GF.Grammar.Refresh ----
+
+import GF.Grammar.TypeCheck
+import GF.Grammar.Values (cPredefAbs) ---
+
+import GF.Grammar.PrGrammar
+import GF.Grammar.Lookup
+import GF.Grammar.LookAbs
+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)
+
+-- | 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@(Module mt st fs me ops js) -> do
+    checkRestrictedInheritance ms (name, mo)
+    js' <- case mt of
+      MTAbstract -> mapMTree (checkAbsInfo gr name) js
+
+      MTTransfer a b -> mapMTree (checkAbsInfo gr name) js
+
+      MTResource -> mapMTree (checkResInfo gr name) js
+
+      MTConcrete a -> do
+        checkErr $ topoSortOpers $ allOperDependencies name js
+        ModMod abs <- checkErr $ lookupModule gr a
+        js1 <- checkCompleteGrammar abs mo
+        mapMTree (checkCncInfo gr name (a,abs)) js1
+
+      MTInterface -> mapMTree (checkResInfo gr name) js
+
+      MTInstance a -> do
+        ModMod abs <- checkErr $ lookupModule gr a
+        -- checkCompleteInstance abs mo -- this is done in Rebuild
+        mapMTree (checkResInfo gr name) js
+
+    return $ (name, ModMod (Module mt st fs me ops 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 -> (Ident,Info) -> Check (Ident,Info)
+checkAbsInfo st m (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 $ prtBad (unlines ss ++++ "in" +++ cat) c
+   ---- temporary solution when tc of defs is incomplete
+   mkCheckWarn cat ss = case ss of
+     [] -> return (c,info)
+     ["[]"] -> return (c,info) ----
+     _  -> checkWarn (unlines ss ++++ "in" +++ cat +++ prt c) >> return (c,info)
+   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 -> (Ident,Info) -> Check (Ident,Info)
+checkResInfo gr mo (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 tysts -> chIn "overloading" $ do
+      tysts' <- mapM (uncurry $ flip check) tysts
+      let tysts2 = [(y,x) | (x,y) <- tysts']
+      --- 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 tysts2)
+
+    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 +++ ":")
+   comp = computeLType gr
+
+   checkUniq xss = case xss of
+     x:y:xs 
+      | x == y -> raise $ "ambiguous for argument list" +++ 
+                         unwords (map (prtType gr) x)  
+      | otherwise -> checkUniq $ y:xs
+     _ -> return ()
+
+
+checkCncInfo :: SourceGrammar -> Ident -> (Ident,SourceAbs) -> 
+                (Ident,Info) -> Check (Ident,Info)
+checkCncInfo gr m (a,abs) (c,info) = do
+  checkReservedId c
+  case info of
+
+    CncFun _ (Yes trm) mpr -> chIn "linearization of" $ do
+      typ        <- checkErr $ lookupFunTypeSrc 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 $ lookupCatContextSrc 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 (c,info)
+
+ where
+   env = gr
+   infer = inferLType gr
+   comp = computeLType gr 
+   check = checkLType gr
+   chIn cat = checkIn ("Happened in" +++ cat +++ prt 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
+  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 must be a record type instead of" 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
+
+    App (Q (IC "Predef") (IC "Ints")) _ -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Int")          -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Float")        -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Error")        -> return ty ---- shouldn't be needed
+
+    Q m c | elem c [cPredef,cPredefAbs] -> return ty
+    Q m c | elem c [zIdent "Int"] -> 
+      return $ linTypeInt
+    Q m c | elem c [zIdent "Float",zIdent "String"] -> return defLinType ----
+
+    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' = sortBy (\x y -> compare (fst x) (fst y)) 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 (sortBy (\ x y -> compare (fst x) (fst y)) 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
+     ,
+{-
+     do
+       over <- getOverload gr Nothing trm
+       case over of
+         Just trty -> return trty
+         _ -> prtFail "not overloaded" trm
+     ,
+-}
+     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 checkWarn ("WARNING: space in token \"" ++ s ++ 
+                        "\". Lexical analysis may fail.")
+        else return ()
+     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 (IC "#conflict") : ts) -> 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
+
+   _ -> 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
+     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
+     PChar    -> return $ typeStr
+     PRep _   -> 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 t = case appForm t 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
+
+     case [vf | vf@(v,f) <- vfs, matchVal mt v] of
+       [(val,fun)] -> return (mkApp fun tts, val)
+       [] -> 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
+
+      ----  ++++ "DEBUG" +++ unwords (map show tys) +++ ";" 
+      ----  ++++ unlines (map (show . fst) typs) ----
+
+       vfs' -> case [(v,f) | (v,f) <- vfs', noProd v] of
+         [(val,fun)] -> do
+           checkWarn $ "WARNING: overloading of" +++ prt f +++ 
+             "resolved by excluding partial applications:" ++++
+             unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
+           return (mkApp fun tts, val)
+
+         _ -> raise $ "ambiguous overloading of" +++ prt f +++
+           "for" +++ unwords (map (prtType env) tys) ++++ "with alternatives" ++++ 
+           unlines [prtType env ty | (ty,_) <- vfs']
+
+   matchVal mt v = elem mt ([Nothing,Just v] ++ unlocked) where
+     unlocked = case v of
+       RecType fs -> [Just $ RecType $ filter (not . isLockLabel . fst) fs]
+       _ -> []
+   ---- TODO: accept subtypes
+   ---- TODO: use a trie
+   lookupOverloadInstance tys typs = 
+     [(mkFunType rest val, t) | 
+       let lt = length tys,
+       (ty,(val,t)) <- typs, length ty >= lt,
+       let (pre,rest) = splitAt lt ty, 
+       pre == tys
+     ]
+
+   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
+     (_,Q (IC "Predef") (IC "Error")) -> 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
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        Q (IC "Predef") (IC "Int"))                 -> True ---- check size!
+     
+     (Q (IC "Predef") (IC "Int"),  ---- why this ???? AR 11/12/2005
+        App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
+
+     ---- 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 <- 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-2.9/GF/Compile/Compile.hs b/src-2.9/GF/Compile/Compile.hs
new file mode 100644
index 000000000..422df0fd5
--- /dev/null
+++ b/src-2.9/GF/Compile/Compile.hs
@@ -0,0 +1,401 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Compile
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/05 20:02:19 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.45 $
+--
+-- The top-level compilation chain from source file to gfc\/gfr.
+-----------------------------------------------------------------------------
+
+module GF.Compile.Compile (compileModule, compileEnvShSt, compileOne,
+		CompileEnv, TimedCompileEnv,gfGrammarPathVar,pathListOpts,
+	       getGFEFiles) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Infra.CompactPrint
+import GF.Grammar.PrGrammar
+import GF.Compile.Update
+import GF.Grammar.Lookup
+import GF.Infra.Modules
+import GF.Infra.ReadFiles
+import GF.Compile.ShellState
+import GF.Compile.MkResource
+---- import MkUnion
+
+-- the main compiler passes
+import GF.Compile.GetGrammar
+import GF.Compile.Extend
+import GF.Compile.Rebuild
+import GF.Compile.Rename
+import GF.Grammar.Refresh
+import GF.Compile.CheckGrammar
+import GF.Compile.Optimize
+import GF.Compile.Evaluate
+import GF.Compile.GrammarToCanon
+--import GF.Devel.GrammarToGFCC -----
+import GF.Devel.OptimizeGF (subexpModule,unsubexpModule)
+import GF.Canon.Share
+import GF.Canon.Subexpressions (elimSubtermsMod,unSubelimModule)
+import GF.UseGrammar.Linear (unoptimizeCanonMod) ----
+
+import qualified GF.Canon.CanonToGrammar as CG
+
+import qualified GF.Canon.GFC as GFC
+import qualified GF.Canon.MkGFC as MkGFC
+import GF.Canon.GetGFC
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.Text.UTF8 ----
+import GF.System.Arch
+
+import Control.Monad
+import System.Directory
+import System.FilePath
+
+-- | in batch mode: write code in a file
+batchCompile f = liftM fst $ compileModule defOpts emptyShellState f
+  where
+    defOpts = options [emitCode] 
+batchCompileOpt f = liftM fst $ compileModule defOpts emptyShellState f
+  where
+    defOpts = options [emitCode, optimizeCanon] 
+
+batchCompileOld f = compileOld defOpts f
+  where
+    defOpts = options [emitCode] 
+
+-- | 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 -> ShellState -> FilePath -> IOE TimedCompileEnv
+----             IOE (GFC.CanonGrammar, (SourceGrammar,[(String,(FilePath,ModTime))]))
+
+compileModule opts st0 file | 
+     oElem showOld opts || 
+     elem suff [".cf",".ebnf",".gfm"] = do
+  let putp  = putPointE opts
+  let putpp = putPointEsil opts
+  let path = [] ----
+  grammar1 <- case suff of
+    ".cf"   -> putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file
+    ".ebnf" -> putp ("- parsing" +++ suff +++ file) $ getEBNFGrammar opts file
+    ".gfm"  -> putp ("- parsing" +++ suff +++ file) $ getSourceGrammar opts file
+    _       -> putp ("- parsing old gf" +++ file)   $ getOldGrammar opts file
+  let mods = modules grammar1
+  let env = compileEnvShSt st0 []
+  foldM (comp putpp path) env mods
+ where
+   suff = takeExtensions file
+   comp putpp path env sm0 = do
+     (k',sm,eenv')  <- makeSourceModule opts (fst env) sm0
+     cm  <- putpp "  generating code... " $ generateModuleCode opts path sm
+     ft <- getReadTimes file ---
+     extendCompileEnvInt env (k',sm,cm) eenv' ft
+
+compileModule opts1 st0 file = do
+  opts0 <- ioeIO $ getOptionsFromFile file
+  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
+  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
+  let opts = addOptions opts1 opts0 
+  let fpath = dropFileName file
+  ps0 <- ioeIO $ pathListOpts opts fpath
+
+  let ps1 = if (useFileOpt && not useLineOpt) 
+              then (ps0 ++ map (combine fpath) ps0)
+              else ps0
+  ps <- ioeIO $ extendPathEnv ps1
+  let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
+  ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
+  let st = st0 --- if useFileOpt then emptyShellState else st0
+  let rfs = [(m,t) | (m,(_,t)) <- readFiles st]
+  let file' = if useFileOpt then takeFileName file else file -- to find file itself
+  files <- getAllFiles opts ps rfs file'
+  ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
+  let names = map justModuleName files
+  ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
+  let env0 = compileEnvShSt st names
+  (e,mm) <- foldIOE (compileOne opts) env0 files
+  maybe (return ()) putStrLnE mm
+  return e
+
+getReadTimes file = do
+  t <- ioeIO getNowTime
+  let m = justModuleName file
+  return $ (m,(file,t)) : [(resModName m,(file,t)) | not (isGFC file)]
+
+compileEnvShSt :: ShellState -> [ModName] -> TimedCompileEnv
+compileEnvShSt st fs = ((0,sgr,cgr,eenv),fts) where
+  cgr = MGrammar [m | m@(i,_) <- modules (canModules st), notInc i]
+  sgr = MGrammar [m | m@(i,_) <- modules (srcModules st), notIns i]
+  notInc i = notElem (prt i) $ map dropExtension fs
+  notIns i = notElem (prt i) $ map dropExtension fs
+  fts = readFiles st
+  eenv = evalEnv st
+
+pathListOpts :: Options -> FileName -> IO [InitPath]
+pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
+
+reverseModules (MGrammar ms) = MGrammar $ reverse ms
+
+keepResModules :: Options -> SourceGrammar -> SourceGrammar
+keepResModules opts gr = 
+  if oElem retainOpers opts 
+    then MGrammar $ reverse [(i,mi) | (i,mi@(ModMod m)) <- modules gr, isModRes m]
+    else emptyMGrammar
+
+
+-- | the environment
+type CompileEnv = (Int,SourceGrammar, GFC.CanonGrammar,EEnv)
+
+emptyCompileEnv :: TimedCompileEnv
+emptyCompileEnv = ((0,emptyMGrammar,emptyMGrammar,emptyEEnv),[])
+
+extendCompileEnvInt ((_,MGrammar ss, MGrammar cs,_),fts) (k,sm,cm) eenv ft = 
+  return ((k,MGrammar (sm:ss), MGrammar (cm:cs),eenv),ft++fts) --- reverse later
+
+extendCompileEnv e@((k,_,_,_),_) (sm,cm) = extendCompileEnvInt e (k,sm,cm)
+
+extendCompileEnvCanon ((k,s,c,e),fts) cgr eenv ft = 
+  return ((k,s, MGrammar (modules cgr ++ modules c),eenv),ft++fts)
+
+type TimedCompileEnv = (CompileEnv,[(String,(FilePath,ModTime))])
+
+compileOne :: Options -> TimedCompileEnv -> FullPath -> IOE TimedCompileEnv
+compileOne opts env@((_,srcgr,cancgr0,eenv),_) file = do
+
+  let putp = putPointE opts
+  let putpp = putPointEsil opts
+  let putpOpt v m act
+       | oElem beVerbose opts =  putp v act
+       | oElem beSilent opts  =  putpp v act
+       | otherwise = ioeIO (putStrFlush m) >> act
+
+  let gf   = takeExtensions file
+  let path = dropFileName file
+  let name = dropExtension file
+  let mos  = modules srcgr
+
+  case gf of
+    -- for multilingual canonical gf, just read the file and update environment
+    ".gfcm" -> do
+       cgr <- putp ("+ reading" +++ file) $ getCanonGrammar file
+       ft <- getReadTimes file
+       extendCompileEnvCanon env cgr eenv ft
+
+    -- for canonical gf, read the file and update environment, also source env
+    ".gfc" -> do
+       cm <- putp ("+ reading" +++ file) $ getCanonModule file
+       let cancgr = updateMGrammar (MGrammar [cm]) cancgr0 
+       sm <- ioeErr $ CG.canon2sourceModule $ unoptimizeCanonMod cancgr $ unSubelimModule cm
+       ft <- getReadTimes file
+       extendCompileEnv env (sm, cm) eenv ft
+
+    -- for compiled resource, parse and organize, then update environment
+    ".gfr" -> do
+       sm0 <- putp ("| reading" +++ file) $ getSourceModule opts file
+       let sm1 = unsubexpModule sm0
+       sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
+---- experiment with not optimizing gfr 
+----      sm:_  <- putp "  optimizing " $ ioeErr $ evalModule mos sm1
+       let gfc = gfcFile name 
+       cm  <- putp ("+ reading" +++ gfc) $ getCanonModule gfc
+       ft  <- getReadTimes file
+       extendCompileEnv env (sm,cm) eenv ft
+
+    -- for gf source, do full compilation
+
+    _ -> do
+
+      --- hack fix to a bug in ReadFiles with reused concrete
+
+      let modu = dropExtension file
+      b1 <- ioeIO $ doesFileExist file
+      b2 <- ioeIO $ doesFileExist $ gfrFile modu
+      if not b1
+        then if b2 
+          then compileOne opts env $ gfrFile $ modu 
+          else compileOne opts env $ gfcFile $ modu 
+        else do
+
+       sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ 
+                                           getSourceModule opts file
+       (k',sm,eenv')  <- makeSourceModule opts (fst env) sm0
+       cm  <- putpp "  generating code... " $ generateModuleCode opts path sm
+       ft <- getReadTimes file
+
+       sm':_ <- case snd sm of
+----         ModMod n | isModRes n -> putp "  optimizing " $ ioeErr $ evalModule mos sm
+         _ -> return [sm]
+
+       extendCompileEnvInt env (k',sm',cm) eenv' ft
+
+-- | dispatch reused resource at early stage
+makeSourceModule :: Options -> CompileEnv -> 
+                    SourceModule -> IOE (Int,SourceModule,EEnv)
+makeSourceModule opts env@(k,gr,can,eenv) mo@(i,mi) = case mi of
+
+  ModMod m -> case mtype m of
+    MTReuse c -> do
+      sm <- ioeErr $ makeReuse gr i (extend m) c
+      let mo2 = (i, ModMod sm)
+          mos = modules gr
+      --- putp "  type checking reused" $ ioeErr $ showCheckModule mos mo2
+      return $ (k,mo2,eenv)
+{- ---- obsolete
+    MTUnion ty imps -> do
+      mo' <- ioeErr $ makeUnion gr i ty imps
+      compileSourceModule opts env mo'
+-}
+
+    _ -> compileSourceModule opts env mo
+  _ -> compileSourceModule opts env mo
+ where
+   putp = putPointE opts
+
+compileSourceModule :: Options -> CompileEnv -> 
+                       SourceModule -> IOE (Int,SourceModule,EEnv)
+compileSourceModule opts env@(k,gr,can,eenv) mo@(i,mi) = do
+
+  let putp  = putPointE opts
+      putpp = putPointEsil opts
+      mos   = modules gr
+
+  if (oElem showOld opts && oElem emitCode opts) 
+    then do
+      let (file,out) = (gfFile (prt i), prGrammar (MGrammar [mo]))
+      putp ("  wrote file" +++ file) $ ioeIO $ writeFile file out
+    else return ()
+
+  mo1   <- ioeErr $ rebuildModule mos mo
+
+  mo1b  <- ioeErr $ extendModule mos mo1
+
+  case mo1b of
+    (_,ModMod n) | not (isCompleteModule n) -> do
+      return (k,mo1b,eenv)   -- refresh would fail, since not renamed
+    _ -> do
+      mo2:_ <- putpp "  renaming " $ ioeErr $ renameModule mos mo1b
+
+      (mo3:_,warnings) <- putpp "  type checking" $ ioeErr $ showCheckModule mos mo2
+      if null warnings then return () else putp warnings $ return ()
+
+      (k',mo3r:_) <- putpp "  refreshing " $ ioeErr $ refreshModule (k,mos) mo3
+
+      (mo4,eenv') <- 
+        ---- if oElem "check_only" opts 
+          putpp "  optimizing " $ ioeErr $ optimizeModule opts (mos,eenv) mo3r
+      return (k',mo4,eenv')
+ where
+   ----   prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
+   prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo]
+
+generateModuleCode :: Options -> InitPath -> SourceModule -> IOE GFC.CanonModule
+generateModuleCode opts path minfo@(name,info) = do
+
+--- DEPREC
+---  if oElem (iOpt "gfcc") opts
+---    then ioeIO $ putStrLn $ prGrammar2gfcc minfo
+---    else return ()
+
+  let pname = path </> prt name
+  minfo0     <- ioeErr $ redModInfo minfo
+  let oopts  = addOptions opts (iOpts (flagsModule minfo))
+      optims = maybe "all_subs" id $ getOptVal oopts useOptimizer
+      optim  = takeWhile (/='_') optims
+      subs   = drop 1 (dropWhile (/='_') optims) == "subs"
+  minfo1     <- return $ 
+    case optim of
+      "parametrize" -> shareModule paramOpt minfo0  -- parametrization and sharing
+      "values"      -> shareModule valOpt minfo0    -- tables as courses-of-values
+      "share"       -> shareModule shareOpt minfo0  -- sharing of branches
+      "all"         -> shareModule allOpt minfo0    -- first parametrize then values
+      "none"        -> minfo0                       -- no optimization
+      _             -> shareModule shareOpt minfo0  -- sharing; default
+
+  -- do common subexpression elimination if required by flag "subs"
+  minfo' <- 
+    if subs
+      then ioeErr $ elimSubtermsMod minfo1
+      else return minfo1
+
+  -- for resource, also emit gfr. 
+  --- Also for incomplete, to create timestamped gfc/gfr files
+  case info of
+    ModMod m | emitsGFR m && emit && nomulti -> do
+      let rminfo = if isCompilable info 
+                   then subexpModule minfo 
+                   else (name, ModMod emptyModule) 
+      let (file,out) = (gfrFile pname, prGrammar (MGrammar [rminfo]))
+      putp ("  wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out
+    _ -> return ()
+  let encode = case getOptVal opts uniCoding of
+        Just "utf8" -> encodeUTF8
+        _ -> id
+  (file,out) <- do
+      code <- return $ MkGFC.prCanonModInfo minfo'
+      return (gfcFile pname, encode code)
+  if emit && nomulti ---- && isCompilable info 
+     then putp  ("  wrote file" +++ file) $ ioeIO $ writeFile file out
+     else putpp ("no need to save module" +++ prt name) $ return ()
+  return minfo'
+ where 
+   putp  = putPointE opts
+   putpp = putPointEsil opts
+
+   emitsGFR m = isModRes m ---- && isCompilable info
+     ---- isModRes m || (isModCnc m && mstatus m == MSIncomplete)
+   isCompilable mi = case mi of
+     ModMod m -> not $ isModCnc m && mstatus m == MSIncomplete 
+     _ -> True
+   nomulti = not $ oElem makeMulti opts
+   emit  = oElem emitCode opts && not (oElem notEmitCode opts)
+
+-- for old GF: sort into modules, write files, compile as usual
+
+compileOld :: Options -> FilePath -> IOE GFC.CanonGrammar
+compileOld opts file = do
+  let putp = putPointE opts
+  grammar1 <- putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
+  files <- mapM writeNewGF $ modules grammar1
+  ((_,_,grammar,_),_) <- foldM (compileOne opts) emptyCompileEnv files
+  return grammar
+
+writeNewGF :: SourceModule -> IOE FilePath
+writeNewGF m@(i,_) = do
+  let file = gfFile $ prt i
+  ioeIO $ writeFile file $ prGrammar (MGrammar [m])
+  ioeIO $ putStrLn $ "wrote file" +++ file
+  return file
+
+--- this function duplicates a lot of code from compileModule.
+--- It does not really belong here either.
+-- It selects those .gfe files that a grammar depends on and that
+-- are younger than corresponding gf
+
+getGFEFiles :: Options -> FilePath -> IO [FilePath]
+getGFEFiles opts1 file = useIOE [] $ do
+  opts0 <- ioeIO $ getOptionsFromFile file
+  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
+  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
+  let opts = addOptions opts1 opts0 
+  let fpath = dropFileName file
+  ps0 <- ioeIO $ pathListOpts opts fpath
+
+  let ps1 = if (useFileOpt && not useLineOpt) 
+              then (map (combine fpath) ps0)
+              else ps0
+  ps <- ioeIO $ extendPathEnv ps1
+  let file' = if useFileOpt then takeFileName file else file -- to find file itself
+  files <- getAllFiles opts ps [] file'
+  efiles <- ioeIO $ filterM doesFileExist [replaceExtension f "gfe" | f <- files]
+  es <- ioeIO $ mapM (uncurry selectLater) [(f, init f) | f <- efiles] -- init gfe == gf
+  return $ filter ((=='e') . last) es
diff --git a/src-2.9/GF/Compile/Evaluate.hs b/src-2.9/GF/Compile/Evaluate.hs
new file mode 100644
index 000000000..a574fef40
--- /dev/null
+++ b/src-2.9/GF/Compile/Evaluate.hs
@@ -0,0 +1,477 @@
+----------------------------------------------------------------------
+-- |
+-- 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, EEnv, emptyEEnv) 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 
+  (FTC c, _:_) -> FTC $ foldl App c ts
+  _ -> ft
+
+apps :: Term -> (Term,[Term])
+apps t = case t of
+  App f a -> (f',xs ++ [a]) where (f',xs) = apps f
+  _ -> (t,[])
+
+appEvalConcrete gr bt env = appSTM (evalConcrete gr bt) env
+
+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 >>= recomp subst
+    return $ mkAbs vars trm3
+
+  ---- temporary hack to ascertain full evaluation, because of bug in comp
+  recomp g t = if notReady t then comp g t else return t
+  notReady = not . null . redexes
+  redexes t = case t of
+    Q _ _ -> return [()]
+    _ -> collectOp redexes t
+
+  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") _ -> return t ----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@(QC p c),xs) -> do
+        xs' <- mapM (comp g) xs
+        case lookupValueIndex gr ty t of 
+        Ok v -> return v
+        _ -> return t
+-}
+      (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)
+         ExtR (R a) b -> case lookup l a of  ----comp g (P (R b) l) of
+           Just (_,v) -> comp g v
+           _ -> comp g (P b 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'
+
+         (_, FV ss) -> liftM FV $ mapM (comp g) [ExtR t u | u <- ss]
+
+         _ -> 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-2.9/GF/Compile/Extend.hs b/src-2.9/GF/Compile/Extend.hs
new file mode 100644
index 000000000..ae87b3e71
--- /dev/null
+++ b/src-2.9/GF/Compile/Extend.hs
@@ -0,0 +1,136 @@
+----------------------------------------------------------------------
+-- |
+-- 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 mod@(Module mt st fs es ops js) (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) mt) 
+                    ("illegal extension type to module" +++ prt name)
+          return (m, isCompleteModule m)
+----       return (m, if (isCompleteModule m) then True else not (isCompleteModule mod))
+
+        -- build extension in a way depending on whether the old module is complete
+        js1 <- extendMod isCompl (n, isInherited cond) name (jments m0) js
+
+        -- if incomplete, throw away extension information
+        let me' = if isCompl then es else (filter ((/=n) . fst) es) 
+        return $ Module mt st fs me' ops 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
+  (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-2.9/GF/Compile/Flatten.hs b/src-2.9/GF/Compile/Flatten.hs
new file mode 100644
index 000000000..6b25edebb
--- /dev/null
+++ b/src-2.9/GF/Compile/Flatten.hs
@@ -0,0 +1,92 @@
+module Flatten where
+
+import Data.List
+-- import GF.Data.Operations
+
+-- (AR 15/3/2006)
+--
+-- A method for flattening grammars: create many flat rules instead of
+-- a few deep ones. This is generally better for parsins.
+-- The rules are obtained as follows:
+-- 1. write a config file tellinq which constants are variables: format 'c : C'
+-- 2. generate a list of trees with their types: format 't : T'
+-- 3. for each such tree, form a fun rule 'fun fui : X -> Y -> T' and a lin
+--    rule 'lin fui x y = t' where x:X,y:Y is the list of variables in t, as
+--    found in the config file.
+-- 4. You can go on and produce def or transfer rules similar to the lin rules
+--    except for the keyword.
+--
+-- So far this module is used outside gf. You can e.g. generate a list of
+-- trees by 'gt', write it in a file, and then in ghci call
+-- flattenGrammar <Config> <Trees> <OutFile>
+
+type Ident = String ---
+type Term  = String ---
+type Rule  = String ---
+
+type Config = [(Ident,Ident)]
+
+flattenGrammar :: FilePath -> FilePath -> FilePath -> IO ()
+flattenGrammar conff tf out = do
+  conf <- readFile conff >>= return . lines
+  ts   <- readFile tf    >>= return . lines
+  writeFile out $ mkFlatten conf ts
+
+mkFlatten :: [String] -> [String] -> String
+mkFlatten conff = unlines . concatMap getOne . zip [1..] where
+  getOne (k,t) = let (x,y) = mkRules conf ("fu" ++ show k) t in [x,y] 
+  conf = getConfig conff
+
+mkRules :: Config -> Ident -> Term -> (Rule,Rule)
+mkRules conf f t = (fun f ty, lin f (takeWhile (/=':') t)) where
+  args = mkArgs conf ts
+  ty   = concat [a ++ " -> " | a <- map snd args] ++ val
+  (ts,val) = let tt = lexTerm t in (init tt,last tt)
+---  f  = mkIdent t
+  fun c a = unwords   ["  fun", c, ":",a,";"] 
+  lin c a = unwords $ ["  lin", c] ++ map fst args ++ ["=",a,";"] 
+
+mkArgs :: Config -> [Ident] -> [(Ident,Ident)]
+mkArgs conf ids = [(x,ty) | x <- ids, Just ty <- [lookup x conf]]
+
+mkIdent :: Term -> Ident
+mkIdent = map mkChar where
+  mkChar c = case c of
+   '(' -> '6'
+   ')' -> '9'
+   ' ' -> '_'
+   _   -> c
+
+-- to get just the identifiers
+lexTerm :: String -> [String]
+lexTerm ss = case lex ss of
+  [([c],ws)] | isSpec c ->     lexTerm ws
+  [(w@(_:_),ws)]        -> w : lexTerm ws
+  _ -> []
+ where
+   isSpec = flip elem "();:"
+
+
+getConfig :: [String] -> Config
+getConfig = map getOne . filter (not . null) where
+  getOne line = case lexTerm line of
+    v:c:_ -> (v,c)
+
+ex = putStrLn fs where
+  fs = 
+    mkFlatten
+      ["man_N : N", 
+       "sleep_V : V"
+      ] 
+      ["PredVP (DefSg man_N) (UseV sleep_V) : Cl",
+       "PredVP (DefPl man_N) (UseV sleep_V) : Cl"
+      ]
+
+{-
+-- result of ex
+  
+  fun fu1 : N -> V -> Cl ;
+  lin fu1 man_N sleep_V = PredVP (DefSg man_N) (UseV sleep_V)  ;
+  fun fu2 : N -> V -> Cl ;
+  lin fu2 man_N sleep_V = PredVP (DefPl man_N) (UseV sleep_V)  ;
+-}
diff --git a/src-2.9/GF/Compile/GetGrammar.hs b/src-2.9/GF/Compile/GetGrammar.hs
new file mode 100644
index 000000000..294edbf9a
--- /dev/null
+++ b/src-2.9/GF/Compile/GetGrammar.hs
@@ -0,0 +1,146 @@
+----------------------------------------------------------------------
+-- |
+-- 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 (
+  getSourceModule, getSourceGrammar,
+  getOldGrammar, getCFGrammar, getEBNFGrammar
+		  ) where
+
+import GF.Data.Operations
+import qualified GF.Source.ErrM as E
+
+import GF.Infra.UseIO
+import GF.Grammar.Grammar
+import GF.Infra.Modules
+import GF.Grammar.PrGrammar
+import qualified GF.Source.AbsGF as A
+import GF.Source.SourceToGrammar
+---- import Macros
+---- import Rename
+import GF.Text.UTF8 ----
+import GF.Infra.Option
+--- import Custom
+import GF.Source.ParGF
+import qualified GF.Source.LexGF as L
+
+import GF.CF.CF (rules2CF)
+import GF.CF.PPrCF
+import GF.CF.CFtoGrammar
+import GF.CF.EBNF
+
+import GF.Infra.ReadFiles ----
+
+import Data.Char (toUpper)
+import Data.List (nub)
+import qualified Data.ByteString.Char8 as BS
+import Control.Monad (foldM)
+import System (system)
+import System.FilePath
+
+getSourceModule :: Options -> FilePath -> IOE SourceModule
+getSourceModule opts file0 = do
+  file <- case getOptVal opts usePreprocessor of
+    Just p -> do
+      let tmp = "_gf_preproc.tmp"
+          cmd = p +++ file0 ++ ">" ++ tmp
+      ioeIO $ system cmd
+      -- ioeIO $ putStrLn $ "preproc" +++ cmd
+      return tmp
+    _ -> return file0
+  string0    <- readFileIOE file
+  let string = case getOptVal opts uniCoding of
+        Just "utf8" -> decodeUTF8 string0
+        _ -> string0
+  let tokens = myLexer (BS.pack string)
+  mo1  <- ioeErr $ pModDef tokens
+  ioeErr $ transModDef mo1
+
+getSourceGrammar :: Options -> FilePath -> IOE SourceGrammar
+getSourceGrammar opts file = do
+  string    <- readFileIOE file
+  let tokens = myLexer (BS.pack string)
+  gr1  <- ioeErr $ pGrammar tokens
+  ioeErr $ transGrammar gr1
+
+
+-- for old GF format with includes
+
+getOldGrammar :: Options -> FilePath -> IOE SourceGrammar
+getOldGrammar opts file = do
+  defs <- parseOldGrammarFiles file
+  let g = A.OldGr A.NoIncl defs
+  let name = takeFileName file
+  ioeErr $ transOldGrammar opts name g
+
+parseOldGrammarFiles :: FilePath -> IOE [A.TopDef]
+parseOldGrammarFiles file = do
+   putStrLnE $ "reading grammar of old format" +++ file
+   (_, g) <- getImports "" ([],[]) file
+   return g  -- now we can throw away includes
+  where 
+   getImports oldInitPath (oldImps, oldG) f = do
+     (path,s) <- readFileLibraryIOE oldInitPath f
+     if not (elem path oldImps) 
+       then do
+         (imps,g) <- parseOldGrammar path
+         foldM (getImports (initFilePath path)) (path : oldImps, g ++ oldG) imps
+       else 
+         return (oldImps, oldG)
+
+parseOldGrammar :: FilePath -> IOE ([FilePath],[A.TopDef])
+parseOldGrammar file = do
+  putStrLnE $ "reading old file" +++ file
+  s <- ioeIO $ readFileIf file
+  A.OldGr incl topdefs <- ioeErr $ pOldGrammar $ oldLexer $ fixNewlines s
+  includes <- ioeErr $ transInclude incl
+  return (includes, topdefs)
+
+----
+
+-- | To resolve the new reserved words: 
+-- change them by turning the final letter to upper case.
+--- There is a risk of clash. 
+oldLexer :: String -> [L.Token]
+oldLexer = map change . L.tokens . BS.pack where
+  change t = case t of
+    (L.PT p (L.TS s)) | elem s newReservedWords -> 
+        (L.PT p (L.TV (init s ++ [toUpper (last s)])))
+    _ -> t
+
+getCFGrammar :: Options -> FilePath -> IOE SourceGrammar
+getCFGrammar opts file = do
+  let mo = takeWhile (/='.') file
+  s    <- ioeIO  $ readFileIf file
+  let files = case words (concat (take 1 (lines s))) of
+        "--":"include":fs -> fs
+        _ -> []
+  ss   <- ioeIO  $ mapM readFileIf files
+  cfs  <- ioeErr $ mapM (pCF mo) $ s:ss
+  defs <- return $ cf2grammar $ rules2CF $ concat cfs
+  let g = A.OldGr A.NoIncl defs
+---  let ma = justModuleName file
+---  let mc = 'C':ma ---
+---  let opts' = addOptions (options [useAbsName ma, useCncName mc]) opts
+  ioeErr $ transOldGrammar opts file g
+
+getEBNFGrammar :: Options -> FilePath -> IOE SourceGrammar
+getEBNFGrammar opts file = do
+  let mo = takeWhile (/='.') file
+  s    <- ioeIO $ readFileIf file
+  defs <- ioeErr $ pEBNFasGrammar s
+  let g = A.OldGr A.NoIncl defs
+---  let ma = justModuleName file
+---  let mc = 'C':ma ---
+---  let opts' = addOptions (options [useAbsName ma, useCncName mc]) opts
+  ioeErr $ transOldGrammar opts file g
diff --git a/src-2.9/GF/Compile/GrammarToCanon.hs b/src-2.9/GF/Compile/GrammarToCanon.hs
new file mode 100644
index 000000000..09c0d3d95
--- /dev/null
+++ b/src-2.9/GF/Compile/GrammarToCanon.hs
@@ -0,0 +1,293 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GrammarToCanon
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/11 23:24:33 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.23 $
+--
+-- Code generator from optimized GF source code to GFC.
+-----------------------------------------------------------------------------
+
+module GF.Compile.GrammarToCanon (showGFC,
+		       redModInfo, redQIdent
+		      ) where
+
+import GF.Data.Operations
+import GF.Data.Zipper
+import GF.Infra.Option
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Grammar.PrGrammar
+import GF.Infra.Modules
+import GF.Grammar.Macros
+import qualified GF.Canon.AbsGFC as G
+import qualified GF.Canon.GFC as C
+import GF.Canon.MkGFC
+---- import Alias
+import qualified GF.Canon.PrintGFC as P
+
+import Control.Monad
+import Data.List (nub,sortBy)
+
+-- compilation of optimized grammars to canonical GF. AR 5/10/2001 -- 12/5/2003
+
+-- | This is the top-level function printing a gfc file
+showGFC :: SourceGrammar -> String
+showGFC = err id id . liftM (P.printTree . grammar2canon) . redGrammar
+
+-- | any grammar, first trying without dependent types
+-- abstract syntax without dependent types
+redGrammar :: SourceGrammar -> Err C.CanonGrammar
+redGrammar (MGrammar gr) = liftM MGrammar $ mapM redModInfo $ filter active gr where
+  active (_,m) = case typeOfModule m of
+    MTInterface -> False
+    _ -> True
+
+redModInfo :: (Ident, SourceModInfo) -> Err (Ident, C.CanonModInfo)
+redModInfo (c,info) = do
+  c'    <- redIdent c
+  info' <- case info of
+    ModMod m -> do
+      let isIncompl = not $ isCompleteModule m
+      (e,os) <- if isIncompl then return ([],[]) else redExtOpen m ----
+      flags <- mapM redFlag $ flags m 
+      (a,mt0) <- case mtype m of
+         MTConcrete a -> do
+           a' <- redIdent a
+           return (a', MTConcrete a') 
+         MTAbstract -> return (c',MTAbstract) --- c' not needed
+         MTResource -> return (c',MTResource) --- c' not needed
+         MTInterface -> return (c',MTResource) ---- not needed
+         MTInstance _ -> return (c',MTResource) --- c' not needed
+         MTTransfer x y -> return (c',MTTransfer (om x) (om y)) --- c' not needed
+
+      --- this generates empty GFC reosurce for interface and incomplete
+      let js = if isIncompl then emptyBinTree else jments m
+          mt = mt0 ---- if isIncompl then MTResource else mt0
+
+      defss <- mapM (redInfo a) $ tree2list $ js
+      let defs0 = concat defss
+      let lgh = length defs0
+      defs  <- return $ sorted2tree $ defs0  -- sorted, but reduced
+      let flags1 = if isIncompl then C.flagIncomplete : flags else flags
+      let flags' = G.Flg (identC "modulesize") (identC ("n"++show lgh)) : flags1
+      return $ ModMod $ Module mt MSComplete flags' e os defs
+  return (c',info')
+ where
+   redExtOpen m = do
+     e' <- case extends m of
+       es -> mapM (liftM inheritAll . redIdent) es
+     os' <- mapM (\o -> case o of 
+              OQualif q _ i -> liftM (OSimple q) (redIdent i)
+              _ -> prtBad "cannot translate unqualified open in" c) $ opens m
+     return (e',nub os')
+   om = oSimple . openedModule --- normalizing away qualif
+
+redInfo :: Ident -> (Ident,Info) -> Err [(Ident,C.Info)]
+redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do
+  c' <- redIdent c 
+  case info of
+    AbsCat (Yes cont) pfs -> do
+      let fs = case pfs of
+                 Yes ts -> [(m,c) | Q m c <- ts]
+                 _ -> []
+      returns c' $ C.AbsCat cont fs
+    AbsFun (Yes typ) pdf -> do
+      let df = case pdf of
+                 Yes t -> t  -- definition or "data"
+                 _ -> Eqs [] -- primitive notion
+      returns c' $ C.AbsFun typ df
+    AbsTrans t -> 
+      returns c' $ C.AbsTrans t
+
+    ResParam (Yes (ps,_)) -> do
+      ps' <- mapM redParam ps
+      returns c' $ C.ResPar ps'
+
+    CncCat pty ptr ppr -> case (pty,ptr,ppr) of
+      (Yes ty, Yes (Abs _ t), Yes pr) -> do
+        ty'  <- redCType ty
+        trm' <- redCTerm t
+        pr'  <- redCTerm pr 
+        return [(c', C.CncCat ty' trm' pr')]
+      _ -> prtBad ("cannot reduce rule for") c
+      
+    CncFun mt ptr ppr -> case (mt,ptr,ppr) of
+      (Just (cat,_), Yes trm, Yes pr) -> do
+        cat' <- redIdent cat
+        (xx,body,_) <- termForm trm
+        xx'   <- mapM redArgvar xx
+        body' <- errIn (prt body) $ redCTerm body ---- debug
+        pr'   <- redCTerm pr 
+        return [(c',C.CncFun (G.CIQ am cat') xx' body' pr')]
+      _ -> prtBad ("cannot reduce rule" +++ show info +++ "for") c ---- debug
+
+    AnyInd s b -> do
+      b' <- redIdent b
+      returns c' $ C.AnyInd s b'
+
+    _ -> return [] --- retain some operations
+ where
+   returns f i = return [(f,i)]
+
+redQIdent :: QIdent -> Err G.CIdent
+redQIdent (m,c) = return $ G.CIQ m c
+
+redIdent :: Ident -> Err Ident
+redIdent x 
+  | isWildIdent x = return $ identC "h_" --- needed in declarations
+  | otherwise = return $ identC $ prt x ---
+
+redFlag :: Option -> Err G.Flag
+redFlag (Opt (f,[x])) = return $ G.Flg (identC f) (identC x)
+redFlag o = Bad $ "cannot reduce option" +++ prOpt o
+
+redDecl :: Decl -> Err G.Decl
+redDecl (x,a) = liftM2 G.Decl (redIdent x) (redType a)
+
+redType :: Type -> Err G.Exp
+redType = redTerm
+
+redTerm :: Type -> Err G.Exp
+redTerm t = return $ rtExp t
+
+-- to normalize records and record types
+sortByFst :: Ord a => [(a,b)] -> [(a,b)]
+sortByFst = sortBy (\ x y -> compare (fst x) (fst y))
+
+-- resource
+
+redParam :: Param -> Err G.ParDef
+redParam (c,cont) = do
+  c'    <- redIdent c
+  cont' <- mapM (redCType . snd) cont
+  return $ G.ParD c' cont'
+
+redArgvar :: Ident -> Err G.ArgVar
+redArgvar x = case x of
+  IA (x,i)     -> return $ G.A  (identC x) (toInteger i)
+  IAV (x,b,i) -> return $ G.AB (identC x) (toInteger b) (toInteger i)
+  _ -> Bad $ "cannot reduce" +++ show x +++ "as argument variable"
+
+redLindef :: Term -> Err G.Term
+redLindef t = case t of
+  Abs x b -> redCTerm b ---
+  _ -> redCTerm t
+
+redCType :: Type -> Err G.CType
+redCType t = case t of
+  RecType lbs -> do
+    let (ls,ts) = unzip lbs
+        ls' = map redLabel ls
+    ts' <- mapM redCType ts
+    return $ G.RecType $ map (uncurry G.Lbg) $ sortByFst $ zip ls' ts'
+  Table p v  -> liftM2 G.Table (redCType p) (redCType v)
+  Q m c    -> liftM G.Cn $ redQIdent (m,c)
+  QC m c   -> liftM G.Cn $ redQIdent (m,c)
+
+  App (Q (IC "Predef") (IC "Ints")) (EInt n) -> return $ G.TInts (toInteger n)
+
+  Sort "Str" -> return $ G.TStr
+  Sort "Tok" -> return $ G.TStr
+  _ -> prtBad "cannot reduce to canonical the type" t
+
+redCTerm :: Term -> Err G.Term
+redCTerm t = case t of
+  Vr x -> checkAgain 
+            (liftM G.Arg $ redArgvar x) 
+            (liftM G.LI  $ redIdent x) --- for parametrize optimization
+  App _ s -> do  -- only constructor applications can remain
+    (_,c,xx) <- termForm t
+    xx' <- mapM redCTerm xx
+    case c of
+      QC p c -> liftM2 G.Par (redQIdent (p,c)) (return xx')
+      Q (IC "Predef") (IC "error") -> fail $ "error: " ++ stringFromTerm s
+      _ -> prtBad "expected constructor head instead of" c
+  Q p c  -> liftM G.I (redQIdent (p,c))
+  QC p c -> liftM2 G.Par (redQIdent (p,c)) (return [])
+  R rs     -> do
+    let (ls,tts) = unzip rs
+        ls' = map redLabel ls
+    ts <- mapM (redCTerm . snd) tts
+    return $ G.R $ map (uncurry G.Ass) $ sortByFst $ zip ls' ts
+  RecType [] -> return $ G.R [] --- comes out in parsing
+  P tr l -> do
+    tr' <- redCTerm tr
+    return $ G.P tr' (redLabel l)
+  PI tr l _ -> redCTerm $ P tr l -----
+  T i cs     -> do
+    ty  <- getTableType i
+    ty' <- redCType ty
+    let (ps,ts) = unzip cs
+    ps' <- mapM redPatt ps
+    ts' <- mapM redCTerm ts
+    return $ G.T ty' $ map (uncurry G.Cas) $ zip (map singleton ps') ts'
+  TSh i cs -> do
+    ty  <- getTableType i
+    ty' <- redCType ty
+    let (pss,ts) = unzip cs
+    pss' <- mapM (mapM redPatt) pss
+    ts' <- mapM redCTerm ts
+    return $ G.T ty' $ map (uncurry G.Cas) $ zip pss' ts'
+  V ty ts     -> do
+    ty' <- redCType ty
+    ts' <- mapM redCTerm ts
+    return $ G.V ty' ts'
+  S u v -> liftM2 G.S (redCTerm u) (redCTerm v)
+  K s   -> return $ G.K (G.KS s)
+  EInt i -> return $ G.EInt i
+  EFloat i -> return $ G.EFloat i
+  C u v -> liftM2 G.C (redCTerm u) (redCTerm v)
+  FV ts -> liftM G.FV $ mapM redCTerm ts
+---  Ready ss -> return $ G.Ready [redStr ss] --- obsolete
+
+  Alts (d,vs) -> do ---
+    d'  <- redCTermTok d
+    vs' <- mapM redVariant vs
+    return $ G.K $ G.KP d' vs'
+
+  Empty -> return $ G.E
+
+---  Strs ss -> return $ G.Strs [s | K s <- ss] ---
+
+---- Glue obsolete in canon, should not occur here
+  Glue x y -> redCTerm (C x y)
+
+  _ -> Bad ("cannot reduce term" +++ prt t)
+
+redPatt :: Patt -> Err G.Patt
+redPatt p = case p of
+  PP m c ps -> liftM2 G.PC (redQIdent (m,c)) (mapM redPatt ps) 
+  PR rs -> do
+    let (ls,tts) = unzip rs
+        ls' = map redLabel ls
+    ts <- mapM redPatt tts
+    return $ G.PR $  map (uncurry G.PAss) $ sortByFst $ zip ls' ts
+  PT _ q -> redPatt q
+  PInt i -> return $ G.PI i
+  PFloat i -> return $ G.PF i
+  PV x -> liftM G.PV $ redIdent x --- for parametrize optimization
+  _ -> prtBad "cannot reduce pattern" p
+
+redLabel :: Label -> G.Label
+redLabel (LIdent s) = G.L $ identC s
+redLabel (LVar i)   = G.LV $ toInteger i
+
+redVariant :: (Term, Term) -> Err G.Variant
+redVariant (v,c) = do
+  v' <- redCTermTok v
+  c' <- redCTermTok c
+  return $ G.Var v' c'
+
+redCTermTok :: Term -> Err [String]
+redCTermTok t = case t of
+  K s   -> return [s]
+  Empty -> return []
+  C a b -> liftM2 (++) (redCTermTok a) (redCTermTok b)
+  Strs ss -> return [s | K s <- ss] ---
+  _ -> prtBad "cannot get strings from term" t
+
diff --git a/src-2.9/GF/Compile/MkConcrete.hs b/src-2.9/GF/Compile/MkConcrete.hs
new file mode 100644
index 000000000..d016a7e47
--- /dev/null
+++ b/src-2.9/GF/Compile/MkConcrete.hs
@@ -0,0 +1,154 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : MkConcrete
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 
+-- > CVS $Author: 
+-- > CVS $Revision: 
+--
+-- Compile a gfe file into a concrete syntax by using the parser on a resource grammar.
+-----------------------------------------------------------------------------
+
+module GF.Compile.MkConcrete (mkConcretes) where
+
+import GF.Grammar.Values (Tree,tree2exp)
+import GF.Grammar.PrGrammar (prt_,prModule)
+import GF.Grammar.Grammar --- (Term(..),SourceModule)
+import GF.Grammar.Macros (composSafeOp, composOp, record2subst, zIdent)
+import GF.Compile.ShellState --(firstStateGrammar,stateGrammarWords)
+import GF.Compile.PGrammar (pTerm,pTrm)
+import GF.Compile.Compile
+import GF.Compile.PrOld (stripTerm)
+import GF.Compile.GetGrammar
+import GF.API
+import GF.API.IOGrammar
+import qualified GF.Embed.EmbedAPI as EA
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.Infra.Option
+import GF.Infra.Modules
+import GF.Infra.ReadFiles
+import GF.System.Arch
+import GF.UseGrammar.Treebank
+
+import System.Directory
+import System.FilePath
+import Data.Char
+import Control.Monad
+import Data.List
+
+-- translate strings into lin rules by parsing in a resource
+-- grammar. AR 2/6/2005
+
+-- Format of rule (on one line):
+--    lin F x y = in C "ssss" ;
+-- Format of resource path (on first line):
+--    --# -resource=PATH
+-- Other lines are copied verbatim.
+-- A sequence of files can be processed with the same resource without
+-- rebuilding the grammar and parser.
+
+-- notice: we use a hand-crafted lexer and parser in order to preserve
+-- the layout and comments in the rest of the file.
+
+mkConcretes :: Options -> [FilePath] -> IO ()
+mkConcretes opts files = do
+  ress <- mapM getResPath files
+  let grps = groupBy (\a b -> fst a == fst b) $ 
+               sortBy (\a b -> compare (fst a) (fst b)) $ zip ress files
+  mapM_ (mkCncGroups opts) [(rp,map snd gs) | gs@((rp,_):_) <- grps]
+
+mkCncGroups opts0 ((res,path),files) = do
+  putStrLnFlush $ "Going to preprocess examples in " ++ unwords files
+  putStrLn $ "Compiling resource " ++ res
+  let opts = addOptions (options [beSilent,pathList path]) opts0
+  let treebank = oElem (iOpt "treebank") opts
+  resf <- useIOE res $ do
+    (fp,_) <- readFileLibraryIOE "" res
+    return fp
+  egr <- appIOE $ shellStateFromFiles opts emptyShellState resf
+  (parser,morpho) <- if treebank then do
+      tb <- err (\_ -> error $ "no treebank of name" +++ path)
+                return
+                (egr >>= flip findTreebank (zIdent path))
+      return (\_ -> flip (,) "Not in treebank" . map pTrm . lookupTreebank tb,
+              isWordInTreebank tb)
+    else do
+      gr  <- err (\s -> putStrLn s >> error "resource grammar rejected") 
+                 (return . firstStateGrammar) egr
+      return 
+            (\cat s -> 
+                errVal ([],"No parse") $ 
+                optParseArgErrMsg (options [newFParser, firstCat cat, beVerbose]) gr s >>=
+                (\ (ts,e) -> return (map tree2exp ts, e)) , 
+            isKnownWord gr)
+  putStrLn "Building parser"
+  mapM_ (mkConcrete parser morpho) files
+
+type Parser = String -> String -> ([Term],String)
+type Morpho = String -> Bool 
+
+getResPath :: FilePath -> IO (String,String)
+getResPath file = do
+  s <- liftM lines $ readFileIf file
+  case filter (not . all isSpace) s of
+    res:path:_ | is "resource" res && is "path"     path -> return (val res, val path)
+    res:path:_ | is "resource" res && is "treebank" path -> return (val res, val path)
+    res:_ | is "resource" res -> return (val res, "")
+    _ -> error 
+           "expected --# -resource=FILE and optional --# -path=PATH or --# -treebank=IDENT"
+ where
+   val = dropWhile (isSpace) . tail . dropWhile (not . (=='='))
+   is tag s = case words s of
+     "--#":w:_ -> isPrefixOf ('-':tag) w
+     _ -> False 
+
+
+mkConcrete :: Parser -> Morpho -> FilePath -> IO ()
+mkConcrete parser morpho file = do
+  src <- appIOE (getSourceModule noOptions file) >>= err error return
+  let (src',msgs) = mkModule parser morpho src
+  let out = addExtension (justModuleName file) "gf"
+  writeFile out $ "-- File generated by GF from " ++ file
+  appendFile out "\n"
+  appendFile out (prModule src')
+  appendFile out "{-\n"
+  appendFile out $ unlines $ filter (not . null) msgs
+  appendFile out "-}\n"
+
+mkModule :: Parser -> Morpho -> SourceModule -> (SourceModule,[String])
+mkModule parser morpho (name,src) = case src of 
+  ModMod m@(Module mt st fs me ops js) ->
+
+    let js1 = jments m
+        (js2,msgs) = err error id $ appSTM (mapMTree mkInfo js1) []
+        mod2 = ModMod $ Module mt st fs me ops $ js2
+    in ((name,mod2), msgs)
+ where
+  mkInfo ni@(name,info) = case info of
+    CncFun mt (Yes trm) ppr -> do
+      trm' <- mkTrm trm
+      return (name, CncFun mt (Yes trm') ppr) 
+    _ -> return ni
+   where
+     mkTrm t = case t of
+       Example (P _ cat) s -> parse cat s t
+       Example (Vr  cat) s -> parse cat s t
+       _ -> composOp mkTrm t
+     parse cat s t = case parser (prt_ cat) s of
+       (tr:[], _) -> do
+         updateSTM ((("PARSED in" +++ prt_ name) : s : [prt_ tr]) ++)
+         return $ stripTerm tr
+       (tr:trs,_) -> do
+         updateSTM ((("AMBIGUOUS in" +++ prt_ name) : s : map prt_ trs) ++)
+         return $ stripTerm tr
+       ([],ms) -> do
+         updateSTM ((("NO PARSE in" +++ prt_ name) : s : ms : [morph s]) ++)
+         return t
+  morph s = case [w | w <- words s, not (morpho w)] of
+    [] -> ""
+    ws -> "unknown words: " ++ unwords ws
diff --git a/src-2.9/GF/Compile/MkResource.hs b/src-2.9/GF/Compile/MkResource.hs
new file mode 100644
index 000000000..10831b5c6
--- /dev/null
+++ b/src-2.9/GF/Compile/MkResource.hs
@@ -0,0 +1,128 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : MkResource
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/30 21:08:14 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.14 $
+--
+-- Compile a gfc module into a "reuse" gfr resource, interface, or instance.
+-----------------------------------------------------------------------------
+
+module GF.Compile.MkResource (makeReuse) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Modules
+import GF.Grammar.Macros
+import GF.Grammar.Lockfield
+import GF.Grammar.PrGrammar
+
+import GF.Data.Operations
+
+import Control.Monad
+
+-- | extracting resource r from abstract + concrete syntax.
+-- AR 21\/8\/2002 -- 22\/6\/2003 for GF with modules
+makeReuse :: SourceGrammar -> Ident -> [(Ident,MInclude Ident)] -> 
+             MReuseType Ident -> Err SourceRes
+makeReuse gr r me mrc = do
+  flags <- return [] --- no flags are passed: they would not make sense
+  case mrc of
+    MRResource c -> do
+      (ops,jms) <- mkFull True c
+      return $ Module MTResource MSComplete flags me ops jms
+
+    MRInstance c a -> do
+      (ops,jms) <- mkFull False c
+      return $ Module (MTInstance a) MSComplete flags me ops jms
+
+    MRInterface c -> do
+      mc <- lookupModule gr c
+
+      (ops,jms) <- case mc of 
+        ModMod m -> case mtype m of
+          MTAbstract -> liftM ((,) (opens m)) $ 
+                          mkResDefs True False gr r c me 
+                            (extend m) (jments m) emptyBinTree
+          _ -> prtBad "expected abstract to be the type of" c
+        _ -> prtBad "expected abstract to be the type of" c
+
+      return $ Module MTInterface MSIncomplete flags me ops jms
+
+ where
+    mkFull hasT c = do
+      mc <- lookupModule gr c
+
+      case mc of 
+        ModMod m -> case mtype m of
+          MTConcrete a -> do
+            ma <- lookupModule gr a
+            jmsA <- case ma of 
+               ModMod m' -> return $ jments m'
+               _ -> prtBad "expected abstract to be the type of" a
+            liftM ((,) (opens m)) $ 
+               mkResDefs hasT True gr r a me (extend m) jmsA (jments m)
+          _ -> prtBad "expected concrete to be the type of" c
+        _ -> prtBad "expected concrete to be the type of" c
+
+
+-- | the first  Boolean indicates if the type needs be given
+-- the second Boolean indicates if the definition needs be given
+mkResDefs :: Bool -> Bool -> 
+             SourceGrammar -> Ident -> Ident -> 
+             [(Ident,MInclude Ident)] -> [(Ident,MInclude Ident)] -> 
+             BinTree Ident Info -> BinTree Ident Info -> 
+             Err (BinTree Ident Info)
+mkResDefs hasT isC gr r a mext maext abs cnc = mapMTree (mkOne a maext) abs where
+
+  ifTyped  = yes --- if hasT then yes else const nope --- needed for TC
+  ifCompl  = if isC  then yes else const nope
+  doIf b t = if b then t else return typeType -- latter value not used
+
+  mkOne a mae (f,info) = case info of
+      AbsCat _ _ -> do
+        typ  <- doIf isC $ err (const (return defLinType)) return $ look cnc f
+        typ' <- doIf isC $ lockRecType f typ 
+        return (f, ResOper (ifTyped typeType) (ifCompl typ'))
+      AbsFun (Yes typ0) _ -> do
+        trm <- doIf isC $ look cnc f
+        testErr (not (isHardType typ0)) 
+                ("cannot build reuse for function" +++ prt f +++ ":" +++ prt typ0)
+        typ <- redirTyp True a mae typ0
+        cat <- valCat typ
+        trm' <- doIf isC $ unlockRecord (snd cat) trm 
+        return (f, ResOper (ifTyped typ) (ifCompl trm'))
+      AnyInd b n -> do
+        mo    <- lookupModMod gr n
+        info' <- lookupInfo mo f
+        mkOne n (extend mo) (f,info')
+
+  look cnc f = do
+     info <- lookupTree prt f cnc
+     case info of
+       CncCat (Yes ty) _ _ -> return ty
+       CncCat _ _ _        -> return defLinType
+       CncFun _ (Yes tr) _ -> return tr
+       AnyInd _ n -> do 
+         mo    <- lookupModMod gr n
+         t <- look (jments mo) f
+         redirTyp False n (extend mo) t
+       _ -> prtBad "not enough information to reuse" f
+
+  -- type constant qualifications changed from abstract to resource
+  redirTyp always a mae ty = case ty of
+    Q _ c | always -> return $ Q r c
+    Q n c | n == a || [n] == map fst mae -> return $ Q r c ---- FIX for non-singleton exts
+    _ -> composOp (redirTyp always a mae) ty
+
+-- | no reuse for functions of HO\/dep types
+isHardType t = case t of
+  Prod x a b -> not (isWild x) || isHardType a || isHardType b
+  App _ _    -> True
+  _          -> False  
+ where 
+   isWild x = isWildIdent x || prt x == "h_" --- produced by transl from canon
diff --git a/src-2.9/GF/Compile/MkUnion.hs b/src-2.9/GF/Compile/MkUnion.hs
new file mode 100644
index 000000000..b4b1f40c8
--- /dev/null
+++ b/src-2.9/GF/Compile/MkUnion.hs
@@ -0,0 +1,83 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : MkUnion
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:39 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.7 $
+--
+-- building union of modules.
+-- AR 1\/3\/2004 --- OBSOLETE 15\/9\/2004 with multiple inheritance
+-----------------------------------------------------------------------------
+
+module GF.Compile.MkUnion (makeUnion) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Modules
+import GF.Grammar.Macros
+import GF.Grammar.PrGrammar
+
+import GF.Data.Operations
+import GF.Infra.Option
+
+import Data.List
+import Control.Monad
+
+makeUnion :: SourceGrammar -> Ident -> ModuleType Ident -> [(Ident,[Ident])] ->
+             Err SourceModule
+makeUnion gr m ty imps = do
+  ms    <- mapM (lookupModMod gr . fst) imps
+  typ   <- return ty ---- getTyp ms
+  ext   <- getExt [i | Just i <- map extends ms]
+  ops   <- return $ nub $ concatMap opens ms
+  flags <- return $ concatMap flags ms
+  js    <- liftM (buildTree . concat) $ mapM getJments imps
+  return $ (m, ModMod (Module typ MSComplete flags ext ops js))
+
+ where
+   getExt es = case es of
+     [] -> return Nothing
+     i:is -> if all (==i) is then return (Just i) 
+               else Bad "different extended modules in union forbidden"
+   getJments (i,fs) = do
+     m  <- lookupModMod gr i
+     let js = jments m
+     if null fs 
+       then 
+         return (map (unqual i) $ tree2list js) 
+       else do
+         ds <- mapM (flip justLookupTree js) fs
+         return $ map (unqual i) $ zip fs ds
+
+   unqual i (f,d) = curry id f $ case d of
+     AbsCat  pty pts -> AbsCat (qualCo pty) (qualPs pts)
+     AbsFun  pty pt -> AbsFun (qualP pty) (qualP pt)
+     AbsTrans t     -> AbsTrans $ qual t
+     ResOper pty pt -> ResOper (qualP pty) (qualP pt)
+     CncCat  pty pt pp -> CncCat (qualP pty) (qualP pt) (qualP pp)
+     CncFun  mp pt pp -> CncFun (qualLin mp) (qualP pt) (qualP pp) ---- mp
+     ResParam (Yes ps) -> ResParam (yes (map qualParam ps)) 
+     ResValue pty ->  ResValue (qualP pty)
+     _ -> d
+    where
+     qualP pt = case pt of
+       Yes t -> yes $ qual t
+       _ -> pt
+     qualPs pt = case pt of
+       Yes ts -> yes $ map qual ts
+       _ -> pt
+     qualCo pco = case pco of
+       Yes co -> yes $ [(x,qual t) | (x,t) <- co]
+       _ -> pco
+     qual t = case t of
+       Q m c  | m==i -> Cn c
+       QC m c | m==i -> Cn c
+       _ -> composSafeOp qual t
+     qualParam (p,co) = (p,[(x,qual t) | (x,t) <- co])
+     qualLin (Just (c,(co,t))) = (Just (c,([(x,qual t) | (x,t) <- co], qual t)))
+     qualLin Nothing = Nothing
+     
diff --git a/src-2.9/GF/Compile/ModDeps.hs b/src-2.9/GF/Compile/ModDeps.hs
new file mode 100644
index 000000000..8331057d1
--- /dev/null
+++ b/src-2.9/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 f 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-2.9/GF/Compile/NewRename.hs b/src-2.9/GF/Compile/NewRename.hs
new file mode 100644
index 000000000..cec8ed24f
--- /dev/null
+++ b/src-2.9/GF/Compile/NewRename.hs
@@ -0,0 +1,294 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:41 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- 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.NewRename (renameSourceTerm, renameModule) where
+
+import GF.Grammar.Grammar
+import GF.Grammar.Values
+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
+
+-- | 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)
+  let status = (modules g,(m,mo)) --- <- buildStatus g m mo
+  renameTerm status [] t
+
+-- | this is used in the compiler, separately for each module
+renameModule :: [SourceModule] -> SourceModule -> Err [SourceModule]
+renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of
+  ModMod m@(Module mt st fs me ops js) -> do
+    let js1 = jments m
+    let status = (ms, (name, mod))
+    js2    <- mapMTree (renameInfo status) js1
+    let mod2 = ModMod $ Module mt st fs me (map forceQualif ops) js2
+    return $ (name,mod2) : ms
+
+type Status = ([SourceModule],SourceModule)   --- (StatusTree, [(OpenSpec Ident, StatusTree)])
+
+--- type StatusTree = BinTree (Ident,StatusInfo)
+
+--- type StatusInfo = Ident -> Term
+
+lookupStatusInfo :: Ident -> SourceModule -> Err Term
+lookupStatusInfo c (q,ModMod m) = do
+  i <- lookupTree prt c $ jments m
+  return $ case i of
+    AbsFun _ (Yes EData) -> QC q c
+    ResValue _           -> QC q c
+    ResParam _           -> QC q c
+    AnyInd True n        -> QC n c --- should go further?
+    AnyInd False n       -> Q  n c
+    _                    -> Q  q c
+lookupStatusInfo c (q,_) = prtBad "ModMod expected for" q
+
+lookupStatusInfoMany :: [SourceModule] -> Ident -> Err Term
+lookupStatusInfoMany (m:ms) c = case lookupStatusInfo c m of
+  Ok v -> return v
+  _ -> lookupStatusInfoMany ms c
+lookupStatusInfoMany [] x = 
+  prtBad "renaming failed to find unqualified constant" x
+---- should also give error if stg is found in more than one module
+
+renameIdentTerm :: Status -> Term -> Err Term
+renameIdentTerm env@(imps,act@(_,ModMod this)) t = 
+ errIn ("atomic term" +++ prt t +++ "given" +++ unwords (map (prt . fst) qualifs)) $
+   case t of
+  Vr c -> do
+    f <- err (predefAbs c) return $ lookupStatusInfoMany openeds c
+    return $ f
+  Cn c -> do
+    f <- lookupStatusInfoMany openeds c
+    return $ f
+  Q m' c | m' == cPredef {- && isInPredefined c -} -> return t
+  Q m' c -> do
+    m <- lookupErr m' qualifs
+    f <- lookupStatusInfo c m
+    return $ f
+  QC m' c | m' == cPredef {- && isInPredefined c -} -> return t
+  QC m' c -> do
+    m <- lookupErr m' qualifs
+    f <- lookupStatusInfo c m
+    return $ f
+  _ -> return t
+ where
+   openeds = act : [(m,st) | OSimple _ m <- opens this, Just st <- [lookup m imps]]
+   qualifs = 
+     [(m, (n,st)) | OQualif _ m n <- opens this, Just st <- [lookup n imps]] 
+     ++ 
+     [(m, (m,st)) | OSimple _ m   <- opens this, Just st <- [lookup m imps]] 
+                                -- qualif is always possible
+
+   -- this facility is mainly for BWC with GF1: you need not import PredefAbs
+   predefAbs c s = case c of
+     IC "Int"    -> return $ Q cPredefAbs cInt
+     IC "String" -> return $ Q cPredefAbs cString
+     _ -> Bad s
+
+-- | 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'
+
+{- deprec !
+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 <- allExtendsPlus gr1 c] ++ allOpens m
+    mods <- mapM (lookupModule gr1 . openedModule) ops
+    let sts = map modInfo2status $ zip ops mods    
+    return $ if isModCnc m
+      then (NT, 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 :: Status -> (Ident,Info) -> Err (Ident,Info)
+renameInfo status (i,info) = errIn ("renaming definition of" +++ prt 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)
+  ResParam pp -> liftM ResParam (renPerh (mapM (renameParam status)) pp)
+  ResValue t  -> liftM ResValue (ren t)
+  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
+          _ -> liftM (flip P l) $ renid t                 -- const proj last
+
+    _ -> 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
+
+  PC c ps -> do
+    c' <- renameIdentTerm env $ Cn c
+    psvss <- mapM renp ps
+    let (ps',vs) = unzip psvss
+    case c' of
+      QC p d -> return (PP p d ps', concat vs)
+      Q  p d -> return (PP p d ps', concat vs) ---- should not happen
+      _ -> prtBad "unresolved pattern" c' ---- (PC c ps', concat vs)
+
+----  PP p c ps -> (PP p c ps',concat vs') where (ps',vs') = unzip $ map renp ps
+
+  PV x -> case renid patt of
+    Ok p -> return (p,[])
+    _    -> 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') 
+
+  _ -> return (patt,[])
+
+ where 
+   renp  = renamePattern env
+   renid = renameIdentPatt 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-2.9/GF/Compile/NoParse.hs b/src-2.9/GF/Compile/NoParse.hs
new file mode 100644
index 000000000..c8f828970
--- /dev/null
+++ b/src-2.9/GF/Compile/NoParse.hs
@@ -0,0 +1,49 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : NoParse
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.1 $
+--
+-- Probabilistic abstract syntax. AR 30\/10\/2005
+--
+-- (c) Aarne Ranta 2005 under GNU GPL
+--
+-- Contents: decide what lin rules no parser is generated.
+-- Usually a list of noparse idents from 'i -boparse=file'.
+
+-----------------------------------------------------------------------------
+
+module GF.Compile.NoParse (
+  NoParse             -- =  Ident -> Bool
+ ,getNoparseFromFile  -- :: Opts -> IO NoParse
+ ,doParseAll          -- :: NoParse
+  ) where
+
+import GF.Infra.Ident
+import GF.Data.Operations
+import GF.Infra.Option
+
+
+type NoParse = (Ident -> Bool)
+
+doParseAll :: NoParse
+doParseAll = const False
+
+getNoparseFromFile :: Options -> FilePath -> IO NoParse
+getNoparseFromFile opts file = do 
+  let f = maybe file id $ getOptVal opts noparseFile
+  s <- readFile f
+  let tree = buildTree $ flip zip (repeat ()) $ concat $ map getIgnores $ lines s
+  tree `seq` return $ igns tree
+ where
+  igns tree i = isInBinTree i tree
+
+-- where
+getIgnores s = case dropWhile (/="--#") (words s) of
+     _:"noparse":fs -> map identC fs
+     _ -> []
diff --git a/src-2.9/GF/Compile/Optimize.hs b/src-2.9/GF/Compile/Optimize.hs
new file mode 100644
index 000000000..a540ee715
--- /dev/null
+++ b/src-2.9/GF/Compile/Optimize.hs
@@ -0,0 +1,300 @@
+----------------------------------------------------------------------
+-- |
+-- 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
+
+import Debug.Trace
+
+
+-- conditional trace
+
+prtIf :: (Print a) => Bool -> a -> a
+prtIf b t = if b then trace (" " ++ prt t) t else t
+
+-- experimental evaluation, option to import
+oEval = iOpt "eval"
+
+-- | 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)],EEnv) -> 
+                  (Ident,SourceModInfo) -> Err ((Ident,SourceModInfo),EEnv)
+optimizeModule opts mse@(ms,eenv) mo@(_,mi) = case mi of
+  ModMod m0@(Module mt st fs me ops js) | 
+    st == MSComplete && isModRes m0 && not (oElem oEval oopts)-> do
+      (mo1,_) <- evalModule oopts mse mo
+      let 
+       mo2 = 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
+      return (mo2,eenv)
+  _ -> evalModule oopts mse mo
+ where
+   oopts = addOptions opts (iOpts (flagsModule mo))
+   optim = maybe "all" id $ getOptVal oopts useOptimizer
+
+evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> 
+               Err ((Ident,SourceModInfo),EEnv)
+evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
+
+  ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
+    _ | isModRes m0 && not (oElem oEval oopts) -> do
+      let deps = allOperDependencies name js
+      ids <- topoSortOpers deps
+      MGrammar (mod' : _) <- foldM evalOp gr ids
+      return $ (mod',eenv)
+
+    MTConcrete a | oElem oEval oopts -> do
+      (js0,eenv') <- appEvalConcrete gr js eenv
+      js' <- mapMTree (evalCncInfo oopts gr name a) js0 ---- <- gr0 6/12/2005 
+      return $ ((name, ModMod (Module mt st fs me ops js')),eenv')
+
+    MTConcrete a -> do
+      js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
+      return $ ((name, ModMod (Module mt st fs me ops 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 = 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) = do
+
+ seq (prtIf (oElem beVerbose opts) 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 ([(strVar, typeStr)], typ) de
+      (Yes typ, Nope)   -> 
+        liftM yes $ mkLinDefault gr typ >>= partEval noOptions gr ([(strVar, 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 | notNewEval -> 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 +++ ":")
+   notNewEval = not (oElem oEval opts)
+
+-- | 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 subst trm1 >>= outCase subst
+             else etaExpand subst trm1
+  return $ mkAbs vars trm3
+
+ where 
+
+   globalTable = oElem showAll opts --- i -all
+
+   comp g t = {- refreshTerm t >>= -} computeTerm gr g t
+
+   etaExpand su t = do
+     t' <- comp su t 
+     case t' of
+       R _ | rightType t' -> comp su t' --- return t' wo noexpand...
+       _ -> recordExpand val t' >>= comp su
+   -- don't eta expand records of right length (correct by type checking)
+   rightType t = case (t,val) of
+     (R rs, RecType ts) -> length rs == length ts
+     _ -> False
+
+   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 strVar . 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 strVar
+     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-2.9/GF/Compile/PGrammar.hs b/src-2.9/GF/Compile/PGrammar.hs
new file mode 100644
index 000000000..521f616b5
--- /dev/null
+++ b/src-2.9/GF/Compile/PGrammar.hs
@@ -0,0 +1,77 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/25 10:27:12 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Compile.PGrammar (pTerm, pTrm, pTrms,
+		 pMeta, pzIdent, 
+		 string2ident
+		) where
+
+---import LexGF
+import GF.Source.ParGF
+import GF.Source.SourceToGrammar (transExp)
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import qualified GF.Canon.AbsGFC as A
+import qualified GF.Canon.GFC as G
+import GF.Compile.GetGrammar
+import GF.Grammar.Macros
+import GF.Grammar.MMacros
+
+import GF.Data.Operations
+import qualified Data.ByteString.Char8 as BS
+
+pTerm :: String -> Err Term
+pTerm s = do
+  e <- pExp $ myLexer (BS.pack s)
+  transExp e
+
+pTrm :: String -> Term
+pTrm = errVal (vr (zIdent "x")) . pTerm ---
+
+pTrms :: String -> [Term]
+pTrms = map pTrm . sep [] where
+  sep t cs = case cs of
+    ',' : cs2 -> reverse t : sep [] cs2
+    c   : cs2 -> sep (c:t) cs2
+    _         -> [reverse t]
+
+pTrm' :: String -> [Term]
+pTrm' = err (const []) singleton . pTerm
+
+pMeta :: String -> Integer
+pMeta _ = 0 ---
+
+pzIdent :: String -> Ident
+pzIdent = zIdent
+
+{-
+string2formsAndTerm :: String -> ([Term],Term)
+string2formsAndTerm s = case s of
+    '[':_:_ -> case span (/=']') s of  
+      (x,_:y) -> (pTrms (tail x), pTrm y)
+      _ -> ([],pTrm s)
+    _ -> ([], pTrm s)
+-}
+
+string2ident :: String -> Err Ident
+string2ident s = return $ string2var s
+
+{-
+-- reads the Haskell datatype
+readGrammar :: String -> Err GrammarST
+readGrammar s =  case [x | (x,t) <- reads s, ("","") <- lex t] of
+  [x] -> return x
+  []  -> Bad "no parse of Grammar"
+  _   -> Bad "ambiguous parse of Grammar"
+-}
diff --git a/src-2.9/GF/Compile/PrOld.hs b/src-2.9/GF/Compile/PrOld.hs
new file mode 100644
index 000000000..29920fab6
--- /dev/null
+++ b/src-2.9/GF/Compile/PrOld.hs
@@ -0,0 +1,84 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrOld
+-- Maintainer  : GF
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:21:44 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- a hack to print gf2 into gf1 readable files
+-- Works only for canonical grammars, printed into GFC. Otherwise we would have
+-- problems with qualified names.
+-- --- printnames are not preserved, nor are lindefs
+-----------------------------------------------------------------------------
+
+module GF.Compile.PrOld (printGrammarOld, stripTerm) where
+
+import GF.Grammar.PrGrammar
+import GF.Canon.CanonToGrammar
+import qualified GF.Canon.GFC as GFC
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Grammar.Macros
+import GF.Infra.Modules
+import qualified GF.Source.PrintGF as P
+import GF.Source.GrammarToSource
+
+import Data.List
+import GF.Data.Operations
+import GF.Infra.UseIO
+
+printGrammarOld :: GFC.CanonGrammar -> String
+printGrammarOld gr = err id id $ do
+  as0 <- mapM canon2sourceModule [im | im@(_,ModMod m) <- modules gr, isModAbs m]
+  cs0 <- mapM canon2sourceModule 
+           [im | im@(_,ModMod m) <- modules gr, isModCnc m || isModRes m]
+  as1 <- return $ concatMap stripInfo $ concatMap (tree2list . js . snd) as0
+  cs1 <- return $ concatMap stripInfo $ concatMap (tree2list . js . snd) cs0
+  return $ unlines $ map prj $ srt as1 ++ srt cs1
+ where
+   js (ModMod m) = jments m
+   srt = sortBy (\ (i,_) (j,_) -> compare i j)
+   prj ii = P.printTree $ trAnyDef ii
+
+stripInfo :: (Ident,Info) -> [(Ident,Info)]
+stripInfo (c,i) = case i of
+  AbsCat   (Yes co) (Yes fs) -> rc $ AbsCat (Yes (stripContext co)) nope
+  AbsFun   (Yes ty) (Yes tr) -> rc $ AbsFun (Yes (stripTerm ty)) (Yes(stripTerm tr))
+  AbsFun   (Yes ty) _ -> rc $ AbsFun (Yes (stripTerm ty)) nope
+  ResParam (Yes (ps,m))       -> rc $ ResParam (Yes ([(c,stripContext co) | (c,co)<- ps],Nothing))
+  CncCat   (Yes ty) _ _ -> rc $
+    CncCat (Yes (stripTerm ty)) nope nope
+  CncFun   _ (Yes tr) _ -> rc $ CncFun Nothing (Yes (stripTerm tr)) nope
+  _ -> []
+ where
+   rc j = [(c,j)]
+
+stripContext co = [(x, stripTerm t) | (x,t) <- co]
+
+stripTerm :: Term -> Term
+stripTerm t = case t of
+  Q _ c -> Vr c
+  QC _ c -> Vr c
+  T ti cs -> T ti' [(stripPattern p, stripTerm c) | (p,c) <- cs] where
+               ti' = case ti of
+                  TTyped ty -> TTyped $ stripTerm ty
+                  TComp ty -> TComp $ stripTerm ty
+                  TWild ty -> TWild $ stripTerm ty
+                  _ -> ti
+----  R [] -> EInt 8      --- GF 1.2 parser doesn't accept empty records 
+----  RecType [] -> Cn (zIdent "Int") ---
+  _ -> composSafeOp stripTerm t
+
+stripPattern p = case p of
+  PC c [] -> PV c
+  PP _ c [] -> PV c
+  PC c ps -> PC c (map stripPattern ps)
+  PP _ c ps -> PC c (map stripPattern ps)
+  PR lps -> PR [(l, stripPattern p) | (l,p) <- lps]
+  PT t p -> PT (stripTerm t) (stripPattern p)
+  _ -> p
+
diff --git a/src-2.9/GF/Compile/Rebuild.hs b/src-2.9/GF/Compile/Rebuild.hs
new file mode 100644
index 000000000..152983b96
--- /dev/null
+++ b/src-2.9/GF/Compile/Rebuild.hs
@@ -0,0 +1,99 @@
+----------------------------------------------------------------------
+-- |
+-- 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.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
+          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_) (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 <- 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 = fs_ ++ fs                            -- new flags have priority
+      let js0 = [ci | ci@(c,_) <- tree2list js, isInherited incl c]
+      let js1 = buildTree (tree2list js_ ++ js0)
+      return $ ModMod $ Module mt0 stat' fs1 me ops1 js1 
+                          ---- (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-2.9/GF/Compile/RemoveLiT.hs b/src-2.9/GF/Compile/RemoveLiT.hs
new file mode 100644
index 000000000..28aae9b84
--- /dev/null
+++ b/src-2.9/GF/Compile/RemoveLiT.hs
@@ -0,0 +1,63 @@
+----------------------------------------------------------------------
+-- |
+-- 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.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 (Module mt st fs me ops js) -> do
+    js1 <- mapMTree (remlResInfo gr) js
+    let mod2 = ModMod $ Module mt st fs me ops 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
+     _ -> zIdent "CNC" 
diff --git a/src-2.9/GF/Compile/Rename.hs b/src-2.9/GF/Compile/Rename.hs
new file mode 100644
index 000000000..c3fef557b
--- /dev/null
+++ b/src-2.9/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.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 m@(Module mt st fs me ops js) -> do
+    let js1 = jments m
+    status <- buildStatus (MGrammar ms) name mod
+    js2    <- mapMTree (renameInfo status) js1
+    let mod2 = ModMod $ Module mt st fs me (map forceQualif ops) 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 = case c of
+     IC "Int" -> return $ Q cPredefAbs cInt
+     IC "Float" -> return $ Q cPredefAbs cFloat
+     IC "String" -> return $ Q cPredefAbs cString
+     _ -> 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)
+----          ts -> return $ Strs $ (cnIC "#conflict") : reverse ts
+            -- 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 :: Status -> (Ident,Info) -> Err (Ident,Info)
+renameInfo status (i,info) = errIn ("renaming definition of" +++ prt 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 tysts -> liftM ResOverload $ 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-2.9/GF/Compile/ShellState.hs b/src-2.9/GF/Compile/ShellState.hs
new file mode 100644
index 000000000..0e24da601
--- /dev/null
+++ b/src-2.9/GF/Compile/ShellState.hs
@@ -0,0 +1,568 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ShellState
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.53 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Compile.ShellState where
+
+import GF.Data.Operations
+import GF.Canon.GFC
+import GF.Canon.AbsGFC
+import GF.GFCC.CId
+--import GF.GFCC.DataGFCC(mkGFCC)
+import GF.GFCC.Macros (lookFCFG)
+import GF.Canon.CanonToGFCC
+import GF.Grammar.Macros
+import GF.Grammar.MMacros
+
+import GF.Canon.Look
+import GF.Canon.Subexpressions
+import GF.Grammar.LookAbs
+import GF.Compile.ModDeps
+import GF.Compile.Evaluate
+import qualified GF.Infra.Modules as M
+import qualified GF.Grammar.Grammar as G
+import qualified GF.Grammar.PrGrammar as P
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.CF.CanonToCF
+import GF.UseGrammar.Morphology
+import GF.Probabilistic.Probabilistic
+import GF.Compile.NoParse
+import GF.Infra.Option
+import GF.Infra.Ident
+import GF.Infra.UseIO (justModuleName)
+import GF.System.Arch (ModTime)
+
+import qualified Transfer.InterpreterAPI as T
+
+import GF.Formalism.FCFG
+import qualified GF.OldParsing.ConvertGrammar as CnvOld -- OBSOLETE
+import qualified GF.Conversion.GFC as Cnv
+import qualified GF.Conversion.SimpleToFCFG as FCnv
+import qualified GF.Parsing.GFC as Prs
+
+import Control.Monad (mplus)
+import Data.List (nub,nubBy)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+
+
+-- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished
+
+-- | multilingual state with grammars and options
+data ShellState = ShSt {
+  abstract   :: Maybe Ident ,        -- ^ pointer to actual abstract, if not empty st
+  concrete   :: Maybe Ident ,        -- ^ pointer to primary concrete
+  concretes  :: [((Ident,Ident),Bool)], -- ^ list of all concretes, and whether active
+  canModules :: CanonGrammar ,       -- ^ compiled abstracts and concretes
+  srcModules :: G.SourceGrammar ,    -- ^ saved resource modules
+  cfs        :: [(Ident,CF)] ,       -- ^ context-free grammars (small, no parameters, very over-generating)
+  abstracts  :: [(Ident,[Ident])],   -- ^ abstracts and their associated concretes
+  mcfgs      :: [(Ident, Cnv.MGrammar)], -- ^ MCFG, converted according to Ljunglöf (2004, ch 3)
+  fcfgs      :: [(Ident, FGrammar)], -- ^ FCFG, optimized MCFG by Krasimir Angelov
+  cfgs       :: [(Ident, Cnv.CGrammar)], -- ^ CFG, converted from mcfg 
+                                         -- (large, with parameters, no-so overgenerating)
+  pInfos     :: [(Ident, Prs.PInfo)], -- ^ parsing information (compiled mcfg&cfg grammars)
+  morphos    :: [(Ident,Morpho)],    -- ^ morphologies
+  treebanks  :: [(Ident,Treebank)],  -- ^ treebanks
+  probss     :: [(Ident,Probs)],     -- ^ probability distributions
+  gloptions  :: Options,             -- ^ global options
+  readFiles  :: [(String,(FilePath,ModTime))],-- ^ files read
+  absCats    :: [(G.Cat,(G.Context,
+                  [(G.Fun,G.Type)],
+                  [((G.Fun,Int),G.Type)]))],   -- ^ cats, (their contexts, 
+                                               -- functions to them,
+                                               -- functions on them)
+  statistics :: [Statistics],         -- ^ statistics on grammars
+  transfers  :: [(Ident,T.Env)],      -- ^ transfer modules
+  evalEnv    :: EEnv                  -- ^ evaluation environment
+  }                             
+
+type Treebank = Map.Map String [String] -- string, trees
+
+actualConcretes :: ShellState -> [((Ident,Ident),Bool)]
+actualConcretes sh = nub [((c,c),b) | 
+  Just a <- [abstract sh],
+  ((c,_),_) <- concretes sh, ----concretesOfAbstract sh a,
+  let b = True -----
+  ]
+
+concretesOfAbstract :: ShellState -> Ident -> [Ident]
+concretesOfAbstract sh a = [c | (b,cs) <- abstracts sh, b == a, c <- cs]
+
+data Statistics = 
+    StDepTypes Bool        -- ^ whether there are dependent types      
+  | StBoundVars [G.Cat]    -- ^ which categories have bound variables
+  ---                      -- etc
+   deriving (Eq,Ord)
+
+emptyShellState :: ShellState
+emptyShellState = ShSt {
+  abstract   = Nothing,
+  concrete   = Nothing,
+  concretes  = [],
+  canModules = M.emptyMGrammar,
+  srcModules = M.emptyMGrammar,
+  cfs        = [],
+  abstracts  = [],
+  mcfgs      = [],
+  fcfgs      = [],
+  cfgs       = [],
+  pInfos     = [],
+  morphos    = [],
+  treebanks  = [],
+  probss     = [],
+  gloptions  = noOptions,
+  readFiles  = [],
+  absCats    = [],
+  statistics = [],
+  transfers  = [],
+  evalEnv    = emptyEEnv
+  }
+
+optInitShellState :: Options -> ShellState
+optInitShellState os = addGlobalOptions os emptyShellState
+
+type Language = Ident
+
+language :: String -> Language
+language = identC
+
+prLanguage :: Language -> String
+prLanguage = prIdent
+
+-- | grammar for one language in a state, comprising its abs and cnc
+data StateGrammar = StGr {
+  absId    :: Ident,
+  cncId    :: Ident,
+  grammar  :: CanonGrammar,
+  cf       :: CF,
+  mcfg     :: Cnv.MGrammar,
+  fcfg     :: FGrammar,
+  cfg      :: Cnv.CGrammar,
+  pInfo    :: Prs.PInfo,
+  morpho   :: Morpho,
+  probs    :: Probs,
+  loptions :: Options
+  }
+
+emptyStateGrammar :: StateGrammar
+emptyStateGrammar = StGr {
+  absId    = identC "#EMPTY", ---
+  cncId    = identC "#EMPTY", ---
+  grammar  = M.emptyMGrammar,
+  cf       = emptyCF,
+  mcfg     = [],
+  fcfg     = ([], Map.empty),
+  cfg      = [],
+  pInfo    = Prs.buildPInfo [] ([], Map.empty) [],
+  morpho   = emptyMorpho,
+  probs    = emptyProbs,
+  loptions = noOptions
+  }
+
+-- analysing shell grammar into parts
+
+stateGrammarST    :: StateGrammar -> CanonGrammar
+stateCF           :: StateGrammar -> CF
+stateMCFG         :: StateGrammar -> Cnv.MGrammar
+stateFCFG         :: StateGrammar -> FGrammar
+stateCFG          :: StateGrammar -> Cnv.CGrammar
+statePInfo        :: StateGrammar -> Prs.PInfo
+stateMorpho       :: StateGrammar -> Morpho
+stateProbs        :: StateGrammar -> Probs
+stateOptions      :: StateGrammar -> Options
+stateGrammarWords :: StateGrammar -> [String]
+stateGrammarLang  :: StateGrammar -> (CanonGrammar, Ident)
+
+stateGrammarST = grammar
+stateCF        = cf
+stateMCFG      = mcfg
+stateFCFG      = fcfg
+stateCFG       = cfg
+statePInfo     = pInfo
+stateMorpho    = morpho
+stateProbs     = probs
+stateOptions   = loptions
+stateGrammarWords = allMorphoWords . stateMorpho
+stateGrammarLang st = (grammar st, cncId st)
+
+---- this should be computed at compile time and stored
+stateHasHOAS :: StateGrammar -> Bool
+stateHasHOAS = hasHOAS . stateGrammarST
+
+cncModuleIdST :: StateGrammar -> CanonGrammar
+cncModuleIdST = stateGrammarST
+
+-- | form a shell state from a canonical grammar
+grammar2shellState :: Options -> (CanonGrammar, G.SourceGrammar) -> Err ShellState 
+grammar2shellState opts (gr,sgr) = 
+  updateShellState opts doParseAll Nothing emptyShellState ((0,sgr,gr,emptyEEnv),[]) --- is 0 safe?
+
+-- | update a shell state from a canonical grammar
+updateShellState :: Options -> NoParse -> Maybe Ident -> ShellState -> 
+   ((Int,G.SourceGrammar,CanonGrammar,EEnv),[(String,(FilePath,ModTime))]) ->
+   Err ShellState 
+updateShellState opts ign mcnc sh ((_,sgr,gr,eenv),rts) = do 
+  let cgr0 = M.updateMGrammar (canModules sh) gr
+
+  -- a0 = abstract of old state
+  -- a1 = abstract of compiled grammar
+
+  let a0 = abstract sh
+  a1 <- return $ case mcnc of
+    Just cnc -> err (const Nothing) Just $ M.abstractOfConcrete cgr0 cnc
+    _ -> M.greatestAbstract cgr0
+
+  -- abstr0 = a1 if it exists
+
+  let (abstr0,isNew) = case (a0,a1) of
+        (Just a,  Just b) | a /= b -> (a1, True)
+        (Nothing, Just _)          -> (a1, True)
+        _                          -> (a0, False)
+
+  let concrs0 = maybe [] (M.allConcretes cgr0) abstr0
+
+  let abstrs = nubBy (\ (x,_) (y,_) -> x == y) $ 
+               maybe id (\a -> ((a,concrs0):)) abstr0 $ abstracts sh
+               
+  let needed = nub $ concatMap (requiredCanModules (length abstrs == 1) cgr0) (maybe [] singleton abstr0 ++ concrs0)
+      purge  = nubBy (\x y -> fst x == fst y) . filter (\(m,mo) -> elem m needed && not (isIncompleteCanon (m,mo)))
+      
+  let cgr = M.MGrammar $ purge $ M.modules cgr0
+
+  let oldConcrs = map (snd . fst) (concretes sh)
+      newConcrs = maybe [] (M.allConcretes gr) abstr0
+      toRetain (c,v) = notElem c newConcrs
+  let complete m = case M.lookupModule gr m of
+        Ok mo -> not $ isIncompleteCanon (m,mo)
+        _ -> False
+        
+  let concrs = filter (\i -> complete i && elem i needed) $ nub $ newConcrs ++ oldConcrs
+      concr0 = ifNull Nothing (return . head) concrs
+      notInrts f = notElem f $ map fst rts
+      subcgr = unSubelimCanon cgr
+  cf's0 <- if (not (oElem (iOpt "docf") opts) &&       -- cf only built with -docf
+               (oElem noCF opts || not (hasHOAS cgr))) -- or HOAS, if not -nocf
+            then return $ map snd $ cfs sh
+            else mapM (canon2cf opts ign subcgr) newConcrs 
+  let cf's = zip newConcrs cf's0 ++ filter toRetain (cfs sh)
+
+  let morphs = [(c,mkMorpho subcgr c) | c <- newConcrs] ++ filter toRetain (morphos sh)
+  let probss = [] -----
+
+
+  let fromGFC       = snd . snd . Cnv.convertGFC opts
+      (mcfgs, cfgs) = unzip $ map (curry fromGFC cgr) concrs
+      gfcc          = canon2gfcc opts cgr ---- UTF8
+      fcfgs         = [(c,g) | c@(IC cn) <- concrs, Just g <- [lookFCFG gfcc (CId cn)]]
+      pInfos        = zipWith3 Prs.buildPInfo mcfgs (map snd fcfgs) cfgs
+      
+  let funs = funRulesOf cgr
+  let cats = allCatsOf cgr
+  let csi  = [(c,(co,
+                  [(fun,typ) | (fun,typ) <- funs, compatType tc typ], 
+                  funsOnTypeFs compatType funs tc))
+                                      | (c,co) <- cats, let tc = cat2val co c]
+  let deps = True ---- not $ null $ allDepCats cgr
+  let binds = [] ---- allCatsWithBind cgr 
+  let src = M.updateMGrammar (srcModules sh) sgr
+
+  return $ ShSt {
+    abstract   = abstr0, 
+    concrete   = concr0, 
+    concretes  = zip (zip concrs concrs) (repeat True),
+    canModules = cgr,
+    srcModules = src,
+    cfs        = cf's,
+    abstracts  = maybe [] (\a -> [(a,concrs)]) abstr0,
+    mcfgs      = zip concrs mcfgs,
+    fcfgs      = fcfgs,
+    cfgs       = zip concrs cfgs,
+    pInfos     = zip concrs pInfos,
+    morphos    = morphs,
+    treebanks  = treebanks sh,
+    probss     = zip concrs probss,
+    gloptions  = gloptions sh, --- opts, -- this would be command-line options
+    readFiles  = [ft | ft@(f,(_,_)) <- readFiles sh, notInrts f] ++ rts,
+    absCats    = csi,
+    statistics = [StDepTypes deps,StBoundVars binds],
+    transfers  = transfers sh,
+    evalEnv    = eenv
+    }            
+
+prShellStateInfo :: ShellState -> String
+prShellStateInfo sh = unlines [
+  "main abstract :    " +++ abstractName sh,
+  "main concrete :    " +++ maybe "(none)" P.prt (concrete sh),
+  "actual concretes : " +++ unwords (map (P.prt . fst . fst) (actualConcretes sh)),
+  "all abstracts :    " +++ unwords (map (P.prt . fst) (abstracts sh)),
+  "all concretes :    " +++ unwords (map (P.prt . fst . fst) (concretes sh)),
+  "canonical modules :" +++ unwords (map (P.prt .fst) (M.modules (canModules sh))),
+  "source modules :   " +++ unwords (map (P.prt .fst) (M.modules (srcModules sh))),
+  "global options :   " +++ prOpts (gloptions sh),
+  "transfer modules : " +++ unwords (map (P.prt . fst) (transfers sh)),
+  "treebanks :        " +++ unwords (map (P.prt . fst) (treebanks sh))
+  ]
+
+abstractName :: ShellState -> String
+abstractName sh = maybe "(none)" P.prt (abstract sh)
+
+-- | throw away those abstracts that are not needed --- could be more aggressive
+filterAbstracts :: [Ident] -> CanonGrammar -> CanonGrammar
+filterAbstracts absts cgr = M.MGrammar (nubBy (\x y -> fst x == fst y) [m | m <- ms, needed m]) where
+  ms = M.modules cgr
+  needed (i,_) = elem i needs
+  needs   = [i | (i,M.ModMod m) <- ms, not (M.isModAbs m) || any (dep i) absts]
+  dep i a = elem i (ext mse a)
+  mse = [(i,me) | (i,M.ModMod m) <- ms, M.isModAbs m, me <- [M.extends m]]
+  ext es a = case lookup a es of
+    Just e -> a : concatMap (ext es) e  ---- FIX multiple exts
+    _ -> []
+
+purgeShellState :: ShellState -> ShellState
+purgeShellState sh = ShSt {
+  abstract   = abstr,
+  concrete   = concrete sh,
+  concretes  = concrs,
+  canModules = M.MGrammar $ filter complete $ purge $ M.modules $ canModules sh,
+  srcModules = M.emptyMGrammar,
+  cfs        = cfs sh,
+  abstracts  = maybe [] (\a -> [(a,map (snd . fst) concrs)]) abstr,
+  mcfgs      = mcfgs sh,
+  fcfgs      = fcfgs sh,
+  cfgs       = cfgs sh,
+  pInfos     = pInfos sh,
+  morphos    = morphos sh,
+  treebanks  = treebanks sh,
+  probss     = probss sh,
+  gloptions  = gloptions sh,
+  readFiles  = [],
+  absCats    = absCats sh,
+  statistics = statistics sh,
+  transfers  = transfers sh,
+  evalEnv    = emptyEEnv
+  }
+ where
+   abstr = abstract sh
+   concrs = [((a,i),b) | ((a,i),b) <- concretes sh, elem i needed]
+   isSingle = length (abstracts sh) == 1
+   needed = nub $ concatMap (requiredCanModules isSingle (canModules sh)) acncs
+   purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
+   acncs = maybe [] singleton abstr ++ map (snd . fst) (actualConcretes sh)
+   complete = not . isIncompleteCanon
+
+changeMain :: Maybe Ident -> ShellState -> Err ShellState
+changeMain Nothing (ShSt _ _ cs ms ss cfs old_pis mcfgs fcfgs cfgs pinfos mos tbs pbs os rs acs s trs ee) = 
+  return (ShSt Nothing Nothing [] ms ss cfs old_pis mcfgs fcfgs cfgs pinfos mos tbs pbs os rs acs s trs ee)
+changeMain 
+  (Just c) st@(ShSt _ _ cs ms ss cfs old_pis mcfgs fcfgs cfgs pinfos mos tbs pbs os rs acs s trs ee) = 
+   case lookup c (M.modules ms) of 
+    Just _ -> do
+      a   <- M.abstractOfConcrete ms c
+      let cas = M.allConcretes ms a
+      let cs' = [((c,c),True) | c <- cas]
+      return (ShSt (Just a) (Just c) cs' ms ss cfs old_pis mcfgs fcfgs cfgs
+        pinfos mos tbs pbs os rs acs s trs ee) 
+    _ -> P.prtBad "The state has no concrete syntax named" c
+
+-- | form just one state grammar, if unique, from a canonical grammar
+grammar2stateGrammar :: Options -> CanonGrammar -> Err StateGrammar 
+grammar2stateGrammar opts gr = do 
+  st    <- grammar2shellState opts (gr,M.emptyMGrammar)
+  concr <- maybeErr "no concrete syntax" $ concrete st 
+  return $ stateGrammarOfLang st concr
+
+resourceOfShellState :: ShellState -> Maybe Ident
+resourceOfShellState = M.greatestResource . srcModules
+
+qualifTop :: StateGrammar -> G.QIdent -> G.QIdent
+qualifTop gr (_,c) = (absId gr,c)
+
+stateGrammarOfLang :: ShellState -> Language -> StateGrammar
+stateGrammarOfLang = stateGrammarOfLangOpt True
+
+stateGrammarOfLangOpt :: Bool -> ShellState -> Language -> StateGrammar
+stateGrammarOfLangOpt purg st0 l = StGr {
+  absId    = err (const (identC "Abs")) id  $ M.abstractOfConcrete allCan l, ---
+  cncId    = l,
+  grammar  = allCan,
+  cf       = maybe emptyCF id (lookup l (cfs st)),
+  mcfg     = maybe [] id $ lookup l $ mcfgs st,
+  fcfg     = maybe ([],Map.empty) id $ lookup l $ fcfgs st,
+  cfg      = maybe [] id $ lookup l $ cfgs st,
+  pInfo    = maybe (Prs.buildPInfo [] ([],Map.empty) []) id $ lookup l $ pInfos st,
+  morpho   = maybe emptyMorpho id (lookup l (morphos st)),
+  probs    = maybe emptyProbs id (lookup l (probss st)),
+  loptions = errVal noOptions $ lookupOptionsCan allCan
+  }
+ where
+   st = (if purg then purgeShellState else id) $ errVal st0 $ changeMain (Just l) st0
+   allCan = canModules st
+
+grammarOfLang :: ShellState -> Language -> CanonGrammar
+cfOfLang      :: ShellState -> Language -> CF
+morphoOfLang  :: ShellState -> Language -> Morpho
+probsOfLang   :: ShellState -> Language -> Probs
+optionsOfLang :: ShellState -> Language -> Options
+
+grammarOfLang st = stateGrammarST . stateGrammarOfLang st
+cfOfLang st      = stateCF        . stateGrammarOfLang st
+morphoOfLang st  = stateMorpho    . stateGrammarOfLang st
+probsOfLang st   = stateProbs     . stateGrammarOfLang st
+optionsOfLang st = stateOptions   . stateGrammarOfLang st
+
+removeLang :: Language -> ShellState -> ShellState
+removeLang lang st = purgeShellState $ st{concretes = concs1} where
+  concs1 = filter ((/=lang) . snd . fst) $ concretes st
+
+-- | the last introduced grammar, stored in options, is the default for operations
+firstStateGrammar :: ShellState -> StateGrammar
+firstStateGrammar st = errVal (stateAbstractGrammar st) $ do
+  concr <- maybeErr "no concrete syntax" $ concrete st 
+  return $ stateGrammarOfLang st concr
+
+mkStateGrammar :: ShellState -> Language -> StateGrammar
+mkStateGrammar = stateGrammarOfLang
+
+stateAbstractGrammar :: ShellState -> StateGrammar
+stateAbstractGrammar st = StGr {
+  absId    = maybe (identC "Abs") id (abstract st), ---
+  cncId    = identC "#Cnc", ---
+  grammar  = canModules st, ---- only abstarct ones
+  cf       = emptyCF,
+  mcfg     = [],
+  fcfg     = ([],Map.empty),
+  cfg      = [],
+  pInfo    = Prs.buildPInfo [] ([],Map.empty) [],
+  morpho   = emptyMorpho,
+  probs    = emptyProbs,
+  loptions = gloptions st ----
+  }
+
+
+-- analysing shell state into parts
+
+globalOptions                   :: ShellState -> Options
+allLanguages                    :: ShellState -> [Language]
+allTransfers                    :: ShellState -> [Ident]
+allCategories                   :: ShellState -> [G.Cat]
+allStateGrammars                :: ShellState -> [StateGrammar]
+allStateGrammarsWithNames       :: ShellState -> [(Language, StateGrammar)]
+allGrammarFileNames             :: ShellState -> [String]
+allActiveStateGrammarsWithNames :: ShellState -> [(Language, StateGrammar)]
+allActiveGrammars               :: ShellState -> [StateGrammar]
+
+globalOptions = gloptions
+--allLanguages  = map (fst . fst) . concretes
+allLanguages  = map (snd . fst) . actualConcretes
+allTransfers  = map fst . transfers
+allCategories = map fst . allCatsOf . canModules
+
+allStateGrammars = map snd . allStateGrammarsWithNames
+
+allStateGrammarsWithNames st = 
+  [(c, mkStateGrammar st c) | ((c,_),_) <- actualConcretes st]
+
+allGrammarFileNames st = [prLanguage c ++ ".gf" | ((c,_),_) <- actualConcretes st]
+
+allActiveStateGrammarsWithNames st =   
+  [(c, mkStateGrammar st c) | ((c,_),True) <- concretes st] --- actual
+
+allActiveGrammars = map snd . allActiveStateGrammarsWithNames
+
+pathOfModule :: ShellState -> Ident -> FilePath
+pathOfModule sh m = maybe "module not found" fst $ lookup (P.prt m) $ readFiles sh
+
+-- command-line option -lang=foo overrides the actual grammar in state
+grammarOfOptState :: Options -> ShellState -> StateGrammar
+grammarOfOptState opts st = 
+  maybe (firstStateGrammar st) (stateGrammarOfLang st . language) $ 
+                                               getOptVal opts useLanguage
+
+languageOfOptState :: Options -> ShellState -> Maybe Language
+languageOfOptState opts st = 
+  maybe (concrete st) (return . language) $ getOptVal opts useLanguage
+
+-- | command-line option -cat=foo overrides the possible start cat of a grammar
+firstCatOpts :: Options -> StateGrammar -> CFCat
+firstCatOpts opts sgr = 
+  maybe (stateFirstCat sgr) (string2CFCat (P.prt (absId sgr))) $ 
+    getOptVal opts firstCat
+
+-- | the first cat for random generation
+firstAbsCat :: Options -> StateGrammar -> G.QIdent
+firstAbsCat opts = cfCat2Cat . firstCatOpts opts
+
+-- | Gets the start category for the grammar from the options.
+--   If the startcat is not set in the options, we look
+--   for a flag in the grammar. If there is no flag in the
+--   grammar, S is returned.
+startCatStateOpts :: Options -> StateGrammar -> CFCat
+startCatStateOpts opts sgr = 
+    string2CFCat a (fromMaybe "S" (optsStartCat `mplus` grStartCat))
+  where optsStartCat = getOptVal opts gStartCat
+        grStartCat = getOptVal (stateOptions sgr) gStartCat
+        a = P.prt (absId sgr)
+
+-- | a grammar can have start category as option startcat=foo ; default is S 
+stateFirstCat :: StateGrammar -> CFCat
+stateFirstCat = startCatStateOpts noOptions
+
+stateIsWord :: StateGrammar -> String -> Bool
+stateIsWord sg = isKnownWord (stateMorpho sg)
+
+addProbs :: (Ident,Probs) -> ShellState -> Err ShellState
+addProbs ip@(lang,probs) sh = do
+  let gr = grammarOfLang sh lang
+  probs' <- checkGrammarProbs gr probs
+  let pbs' = (lang,probs') : filter ((/= lang) . fst) (probss sh)
+  return $ sh{probss = pbs'}
+
+addTransfer :: (Ident,T.Env) -> ShellState -> ShellState
+addTransfer it@(i,_) sh = 
+  sh {transfers = it : filter ((/= i) . fst) (transfers sh)}
+
+addTreebanks :: [(Ident,Treebank)] -> ShellState -> ShellState
+addTreebanks its sh = sh {treebanks = its ++ treebanks sh}
+
+findTreebank :: ShellState -> Ident -> Err Treebank
+findTreebank sh i = maybeErr "no treebank found" $ lookup i $ treebanks sh
+
+-- modify state
+
+type ShellStateOper = ShellState -> ShellState
+type ShellStateOperErr = ShellState -> Err ShellState
+
+reinitShellState :: ShellStateOper
+reinitShellState = const emptyShellState
+
+languageOn, languageOff :: Language -> ShellStateOper
+languageOn  = languageOnOff True
+languageOff = languageOnOff False
+
+languageOnOff :: Bool -> Language -> ShellStateOper
+---                                         __________ this is OBSOLETE
+languageOnOff b lang sh = sh {concretes = cs'} where
+  cs' = [if lang==l then (lc,b) else i | i@(lc@(l,c),_) <- concretes sh]
+
+changeOptions :: (Options -> Options) -> ShellStateOper
+---                                      __________ this is OBSOLETE
+changeOptions f sh = sh {gloptions = f (gloptions sh)}
+
+addGlobalOptions :: Options -> ShellStateOper
+addGlobalOptions = changeOptions . addOptions
+
+removeGlobalOptions :: Options -> ShellStateOper
+removeGlobalOptions = changeOptions . removeOptions
+
diff --git a/src-2.9/GF/Compile/Update.hs b/src-2.9/GF/Compile/Update.hs
new file mode 100644
index 000000000..82d7a609e
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Compile/Wordlist.hs b/src-2.9/GF/Compile/Wordlist.hs
new file mode 100644
index 000000000..3fbc066bd
--- /dev/null
+++ b/src-2.9/GF/Compile/Wordlist.hs
@@ -0,0 +1,108 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Wordlist
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 
+-- > CVS $Author: 
+-- > CVS $Revision: 
+--
+-- Compile a gfwl file (multilingual word list) to an abstract + concretes
+-----------------------------------------------------------------------------
+
+module GF.Compile.Wordlist (mkWordlist) where
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+import Data.List
+import Data.Char
+import System.FilePath
+
+-- read File.gfwl, write File.gf (abstract) and a set of concretes
+-- return the names of the concretes
+
+mkWordlist :: FilePath -> IO [FilePath]
+mkWordlist file = do
+  s <- readFileIf file
+  let abs = dropExtension file
+  let (cnchs,wlist) = pWordlist abs $ filter notComment $ lines s
+  let (gr,grs) = mkGrammars abs cnchs wlist
+  let cncfs = [cnc ++ ".gf" | (cnc,_) <- cnchs]
+  mapM_ (uncurry writeFile) $ (abs ++ ".gf",gr) : zip cncfs grs
+  putStrLn $ "wrote " ++ unwords ((abs ++ ".gf") : cncfs)
+  return cncfs
+
+{-
+-- syntax of files, e.g.
+
+  # Svenska - Franska - Finska  -- names of concretes
+ 
+  berg  - montagne - vuori      -- word entry
+
+-- this creates:
+
+  cat S ; 
+  fun berg_S : S ; 
+  lin berg_S = {s = ["berg"]} ;
+  lin berg_S = {s = ["montagne"]} ;
+  lin berg_S = {s = ["vuori"]} ;
+
+-- support for different categories to be elaborated. The syntax it
+
+  Verb . klättra - grimper / escalader - kiivetä / kiipeillä
+
+-- notice that a word can have several alternative (separator /)
+-- and that an alternative can consist of several words
+-}
+
+type CncHeader = (String,String) -- module name, module header
+
+type Wordlist = [(String, [[String]])] -- cat, variants for each cnc
+
+
+pWordlist :: String -> [String] -> ([CncHeader],Wordlist)
+pWordlist abs ls = (headers,rules) where
+  (hs,rs) = span ((=="#") . take 1) ls
+  headers = map mkHeader $ chunks "-" $ filter (/="#") $ words $ concat hs
+  rules   = map (mkRule   . words) rs
+
+  mkHeader ws = case ws of
+    w:ws2 -> (w, unwords ("concrete":w:"of":abs:"=":ws2))
+  mkRule ws = case ws of
+    cat:".":vs -> (cat, mkWords vs)
+    _          -> ("S", mkWords ws)
+  mkWords = map (map unwords . chunks "/") . chunks "-"
+
+
+mkGrammars :: String -> [CncHeader] -> Wordlist -> (String,[String])
+mkGrammars ab hs wl = (abs,cncs) where
+  abs = unlines $ map unwords $
+    ["abstract",ab,"=","{"]:
+    cats ++
+    funs ++
+    [["}"]]
+
+  cncs = [unlines $ (h ++ " {") : map lin rs ++ ["}"] | ((_,h),rs) <- zip hs rss]
+
+  cats = [["cat",c,";"] | c <- nub $ map fst wl]
+  funs = [["fun", f , ":", c,";"] | (f,c,_) <- wlf]
+
+  wlf = [(ident f c, c, ws) | (c,ws@(f:_)) <- wl]
+
+  rss = [[(f, wss !! i) | (f,_,wss) <- wlf] | i <- [0..length hs - 1]]
+
+  lin (f,ss) = unwords ["lin", f, "=", "{s", "=", val ss, "}", ";"]
+
+  val ss = case ss of
+    [w] -> quote w
+    _   -> "variants {" ++ unwords (intersperse ";" (map quote ss)) ++ "}"
+
+  quote w = "[" ++ prQuotedString w ++ "]" 
+
+  ident f c = concat $ intersperse "_" $ words (head f) ++ [c]
+
+
+notComment s = not (all isSpace s) && take 2 s /= "--"
+
diff --git a/src-2.9/GF/Conversion/GFC.hs b/src-2.9/GF/Conversion/GFC.hs
new file mode 100644
index 000000000..354bdea65
--- /dev/null
+++ b/src-2.9/GF/Conversion/GFC.hs
@@ -0,0 +1,157 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/01 09:53:18 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.14 $
+--
+-- All conversions from GFC 
+-----------------------------------------------------------------------------
+
+module GF.Conversion.GFC
+    (module GF.Conversion.GFC,
+     SGrammar, EGrammar, MGrammar, CGrammar) where
+
+import GF.Infra.Option
+import GF.Canon.GFC (CanonGrammar)
+import GF.Infra.Ident (Ident, identC)
+import qualified GF.Infra.Modules as M
+
+import GF.Formalism.GCFG (Rule(..), Abstract(..))
+import GF.Formalism.SimpleGFC (decl2cat)
+import GF.Formalism.CFG (CFRule(..))
+import GF.Formalism.Utilities (symbol, name2fun)
+import GF.Conversion.Types
+
+import qualified GF.Conversion.GFCtoSimple as G2S
+import qualified GF.Conversion.SimpleToFinite as S2Fin
+import qualified GF.Conversion.RemoveSingletons as RemSing
+import qualified GF.Conversion.RemoveErasing as RemEra
+import qualified GF.Conversion.RemoveEpsilon as RemEps
+import qualified GF.Conversion.SimpleToMCFG as S2M
+import qualified GF.Conversion.MCFGtoCFG as M2C
+
+import GF.Infra.Print
+
+import GF.System.Tracing
+
+----------------------------------------------------------------------
+-- * GFC -> MCFG & CFG, using options to decide which conversion is used
+
+convertGFC :: Options -> (CanonGrammar, Ident)
+           -> (SGrammar, (EGrammar, (MGrammar, CGrammar)))
+convertGFC opts = \g -> let s = g2s g
+                            e = s2e s 
+                            m = e2m e
+                        in trace2 "Options" (show opts) (s, (e, (m, e2c e)))
+    where e2c = M2C.convertGrammar
+	  e2m = case getOptVal opts firstCat of
+		  Just cat -> flip erasing [identC cat]
+		  Nothing  -> flip erasing []
+	  s2e = case getOptVal opts gfcConversion of
+		  Just "strict"            -> strict
+		  Just "finite-strict"     -> strict
+		  Just "epsilon"           -> epsilon . nondet
+		  _                        -> nondet
+	  g2s = case getOptVal opts gfcConversion of
+		  Just "finite"            -> finite . simple
+		  Just "finite2"           -> finite . finite . simple
+		  Just "finite3"           -> finite . finite . finite . simple
+		  Just "singletons"        -> single . simple
+		  Just "finite-singletons" -> single . finite . simple
+		  Just "finite-strict"     -> finite . simple
+		  _                        -> simple
+
+          simple  = G2S.convertGrammar
+          strict  = S2M.convertGrammarStrict
+          nondet  = S2M.convertGrammarNondet
+          epsilon = RemEps.convertGrammar
+          finite  = S2Fin.convertGrammar
+          single  = RemSing.convertGrammar
+          erasing = RemEra.convertGrammar
+
+gfc2simple :: Options -> (CanonGrammar, Ident) -> SGrammar
+gfc2simple opts = fst . convertGFC opts 
+
+gfc2mcfg :: Options -> (CanonGrammar, Ident) -> MGrammar
+gfc2mcfg opts g = mcfg
+  where
+    (mcfg, _) = snd (snd (convertGFC opts g))
+
+gfc2cfg :: Options -> (CanonGrammar, Ident) -> CGrammar
+gfc2cfg opts g = cfg
+  where
+    (_, cfg) = snd (snd (convertGFC opts g))
+
+
+----------------------------------------------------------------------
+-- * single step conversions
+
+{-
+gfc2simple :: (CanonGrammar, Ident) -> SGrammar
+gfc2simple = G2S.convertGrammar
+
+simple2finite :: SGrammar -> SGrammar
+simple2finite = S2Fin.convertGrammar
+
+removeSingletons :: SGrammar -> SGrammar
+removeSingletons = RemSing.convertGrammar
+
+simple2mcfg_nondet :: SGrammar -> EGrammar
+simple2mcfg_nondet = 
+
+simple2mcfg_strict :: SGrammar -> EGrammar
+simple2mcfg_strict = S2M.convertGrammarStrict
+
+mcfg2cfg :: EGrammar -> CGrammar
+mcfg2cfg = M2C.convertGrammar
+
+removeErasing :: EGrammar -> [SCat] -> MGrammar
+removeErasing = RemEra.convertGrammar 
+
+removeEpsilon :: EGrammar -> EGrammar
+removeEpsilon = RemEps.convertGrammar 
+-}
+
+----------------------------------------------------------------------
+-- * converting to some obscure formats
+
+gfc2abstract :: (CanonGrammar, Ident) -> [Abstract SCat Fun]
+gfc2abstract gr = [ Abs (decl2cat decl) (map decl2cat decls) (name2fun name) |
+		    Rule (Abs decl decls name) _ <- G2S.convertGrammar gr ]
+
+abstract2skvatt :: [Abstract SCat Fun] -> String
+abstract2skvatt gr = skvatt_hdr ++ concatMap abs2pl gr
+    where abs2pl (Abs cat [] fun) = prtQuoted cat ++ " ---> " ++ 
+				    "\"" ++ prt fun ++ "\".\n"
+	  abs2pl (Abs cat cats fun) =
+	      prtQuoted cat ++ " ---> " ++
+	      "\"(" ++ prt fun ++ "\"" ++
+	      prtBefore ", \" \", " (map prtQuoted cats) ++ ", \")\".\n"
+
+cfg2skvatt :: CGrammar -> String
+cfg2skvatt gr = skvatt_hdr ++ concatMap cfg2pl gr
+    where cfg2pl (CFRule cat syms _name) =
+	      prtQuoted cat ++ " ---> " ++
+	      if null syms then "\"\".\n" else
+	      prtSep ", " (map (symbol prtQuoted prTok) syms) ++ ".\n"
+	  prTok tok = "\"" ++ tok ++ " \""
+
+skvatt_hdr = ":- use_module(library(skvatt)).\n" ++ 
+	     ":- use_module(library(utils), [repeat/1]).\n" ++
+	     "corpus(File, StartCat, Depth, Size) :- \n" ++
+	     "        set_flag(gendepth, Depth),\n" ++ 
+	     "        tell(File), repeat(Size),\n" ++
+	     "        generate_words(StartCat, String), format('~s~n~n', [String]),\n" ++
+	     "        write(user_error, '.'),\n" ++ 
+	     "        fail ; told.\n\n"
+
+prtQuoted :: Print a => a -> String
+prtQuoted a = "'" ++ prt a ++ "'"
+
+
+
+
diff --git a/src-2.9/GF/Conversion/GFCtoSimple.hs b/src-2.9/GF/Conversion/GFCtoSimple.hs
new file mode 100644
index 000000000..b6a34a8ce
--- /dev/null
+++ b/src-2.9/GF/Conversion/GFCtoSimple.hs
@@ -0,0 +1,175 @@
+---------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/07 11:24:51 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.15 $
+--
+-- Converting GFC to SimpleGFC
+--
+-- the conversion might fail if the GFC grammar has dependent or higher-order types,
+-- or if the grammar contains bound pattern variables
+-- (use -optimize=values/share/none when importing)
+--
+-- TODO: lift all functions to the 'Err' monad
+-----------------------------------------------------------------------------
+
+module GF.Conversion.GFCtoSimple
+    (convertGrammar) where
+
+import qualified GF.Canon.AbsGFC as A
+import qualified GF.Infra.Ident as I
+import GF.Formalism.GCFG
+import GF.Formalism.SimpleGFC 
+import GF.Formalism.Utilities
+import GF.Conversion.Types
+
+import GF.UseGrammar.Linear (expandLinTables)
+import GF.Canon.GFC (CanonGrammar)
+import GF.Canon.MkGFC (grammar2canon)
+import GF.Canon.Subexpressions (unSubelimCanon)
+import qualified GF.Canon.Look as Look (lookupLin, allParamValues, lookupLincat)
+import qualified GF.Canon.CMacros as CMacros (defLinType)
+import GF.Data.Operations (err, errVal)
+--import qualified Modules as M
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+
+type Env = (CanonGrammar, I.Ident)
+
+convertGrammar :: Env -> SGrammar
+convertGrammar (g,i) = trace2 "GFCtoSimple - concrete language" (prt (snd gram)) $
+		        tracePrt "GFCtoSimple - simpleGFC rules" (prt . length) $
+		         [ convertAbsFun gram fun typing |
+			  A.Mod (A.MTAbs modname) _ _ _ defs <- modules,
+			  A.AbsDFun fun typing _ <- defs ]
+    where A.Gr modules = grammar2canon (fst gram)
+          gram = (unSubelimCanon g,i)
+
+convertAbsFun :: Env -> I.Ident -> A.Exp -> SRule
+convertAbsFun gram fun typing = -- trace2 "GFCtoSimple - converting function" (prt fun) $
+                                Rule abs cnc
+    where abs = convertAbstract [] fun typing
+	  cnc = convertConcrete gram abs
+
+----------------------------------------------------------------------
+-- abstract definitions
+
+convertAbstract :: [SDecl] -> Fun -> A.Exp -> Abstract SDecl Name
+convertAbstract env fun (A.EProd x a b) 
+    = convertAbstract (convertAbsType x' [] a : env) fun b
+    where x' = if x==I.identC "h_" then anyVar else x
+convertAbstract env fun a 
+    = Abs (convertAbsType anyVar [] a) (reverse env) name
+    where name = Name fun [ Unify [n] | n <- [0 .. length env-1] ]
+
+convertAbsType :: Var -> [FOType SCat] -> A.Exp -> SDecl
+convertAbsType x args (A.EProd _ a b) = convertAbsType x (convertType [] a : args) b
+convertAbsType x args a = Decl x (reverse args ::--> convertType [] a)
+
+convertType :: [TTerm] -> A.Exp -> FOType SCat
+convertType args (A.EApp a b) = convertType (convertExp [] b : args) a
+convertType args (A.EAtom at) = convertCat at ::@ reverse args
+convertType args (A.EProd _ _ b) = convertType args b ---- AR 7/10 workaround
+convertType args exp          = error $ "GFCtoSimple.convertType: " ++ prt exp
+
+{- Exp from GF/Canon/GFC.cf:
+EApp.   Exp1 ::= Exp1 Exp2 ;
+EProd.  Exp  ::= "(" Ident ":" Exp ")" "->" Exp ;
+EAbs.   Exp  ::= "\\" Ident "->" Exp ;
+EAtom.  Exp2 ::= Atom ;
+EData.  Exp2 ::= "data" ;
+-}
+
+convertExp :: [TTerm] -> A.Exp -> TTerm
+convertExp args (A.EAtom at) = convertAtom args at
+convertExp args (A.EApp a b) = convertExp (convertExp [] b : args) a
+convertExp args exp          = error $ "GFCtoSimple.convertExp: " ++ prt exp
+
+convertAtom :: [TTerm] -> A.Atom -> TTerm
+convertAtom args (A.AC con) = con :@ reverse args
+-- A.AD: is this correct???
+convertAtom args (A.AD con) = con :@ args
+convertAtom []   (A.AV var) = TVar var
+convertAtom args atom       = error $ "GFCtoSimple.convertAtom: " ++ prt args ++ " " ++ show atom
+
+convertCat :: A.Atom -> SCat
+convertCat (A.AC (A.CIQ _ cat)) = cat
+convertCat atom                 = error $ "GFCtoSimple.convertCat: " ++ show atom
+
+----------------------------------------------------------------------
+-- concrete definitions
+
+convertConcrete :: Env -> Abstract SDecl Name -> Concrete SLinType (Maybe STerm)
+convertConcrete gram (Abs decl args name) = Cnc ltyp largs term
+    where term = fmap (convertTerm gram . expandTerm gram) $ lookupLin gram $ name2fun name
+	  ltyp : largs = map (convertCType gram . lookupCType gram) (decl : args)
+
+expandTerm :: Env -> A.Term -> A.Term
+expandTerm gram term = -- tracePrt "expanded term" prt $
+		       err error id $ expandLinTables (fst gram) $
+		       -- tracePrt "initial term" prt $ 
+		       term
+
+convertCType :: Env -> A.CType -> SLinType
+convertCType gram (A.RecType rec) = RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ]
+convertCType gram (A.Table pt vt) = TblT (enumerateTerms Nothing (convertCType gram pt)) (convertCType gram vt)
+convertCType gram ct@(A.Cn con)   = ConT $ map (convertTerm gram) $ groundTerms gram ct
+convertCType gram (A.TStr)        = StrT
+convertCType gram (A.TInts n)     = error "GFCtoSimple.convertCType: cannot handle 'TInts' constructor"
+
+convertTerm :: Env -> A.Term -> STerm
+convertTerm gram (A.Arg arg)       = convertArgVar arg
+convertTerm gram (A.Par con terms) = con :^ map (convertTerm gram) terms
+-- convertTerm gram (A.LI var)        = Var var
+convertTerm gram (A.R rec)         = Rec [ (lbl, convertTerm gram term) | A.Ass lbl term <- rec ]
+convertTerm gram (A.P term lbl)    = convertTerm gram term +. lbl
+convertTerm gram (A.V ctype terms) = Tbl [ (convertTerm gram pat, convertTerm gram term) |
+					  (pat, term) <- zip (groundTerms gram ctype) terms ]
+convertTerm gram (A.T ctype tbl)   = Tbl [ (convertPatt pat, convertTerm gram term) |
+					   A.Cas pats term <- tbl, pat <- pats ]
+convertTerm gram (A.S term sel)    = convertTerm gram term :! convertTerm gram sel
+convertTerm gram (A.C term1 term2) = convertTerm gram term1 ?++ convertTerm gram term2
+convertTerm gram (A.FV terms)      = variants (map (convertTerm gram) terms)
+convertTerm gram (A.E)             = Empty
+convertTerm gram (A.K (A.KS tok))  = Token tok
+-- 'pre' tokens are converted to variants (over-generating):
+convertTerm gram (A.K (A.KP strs vars))
+                                   = variants $ map conc $ strs : [ vs | A.Var vs _ <- vars ]
+    where conc [] = Empty
+	  conc ts = foldr1 (?++) $ map Token ts
+convertTerm gram (A.I con)         = error "GFCtoSimple.convertTerm: cannot handle 'I' constructor"
+convertTerm gram (A.EInt int)      = error "GFCtoSimple.convertTerm: cannot handle 'EInt' constructor"
+
+convertArgVar :: A.ArgVar -> STerm
+convertArgVar (A.A cat nr)           = Arg (fromInteger nr) cat emptyPath
+convertArgVar (A.AB cat bindings nr) = Arg (fromInteger nr) cat emptyPath
+
+convertPatt (A.PC con pats) = con :^ map convertPatt pats
+-- convertPatt (A.PV x)        = Var x
+-- convertPatt (A.PW)          = Wildcard
+convertPatt (A.PR rec)      = Rec [ (lbl, convertPatt pat) | A.PAss lbl pat <- rec ]
+convertPatt (A.PI n)        = error "GFCtoSimple.convertPatt: cannot handle 'PI' constructor"
+convertPatt p               = error $ "GFCtoSimple.convertPatt: cannot handle " ++ show p
+
+----------------------------------------------------------------------
+
+lookupLin :: Env -> Fun -> Maybe A.Term
+lookupLin gram fun = err fail Just $
+		     Look.lookupLin (fst gram) (A.CIQ (snd gram) fun)
+
+lookupCType :: Env -> SDecl -> A.CType
+lookupCType env decl
+    = errVal CMacros.defLinType $ 
+      Look.lookupLincat (fst env) (A.CIQ (snd env) (decl2cat decl))
+
+groundTerms :: Env -> A.CType -> [A.Term]
+groundTerms gram ctype = err error id $
+			 Look.allParamValues (fst gram) ctype
+
diff --git a/src-2.9/GF/Conversion/Haskell.hs b/src-2.9/GF/Conversion/Haskell.hs
new file mode 100644
index 000000000..abe651e1e
--- /dev/null
+++ b/src-2.9/GF/Conversion/Haskell.hs
@@ -0,0 +1,71 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/11 14:11:46 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Converting/Printing different grammar formalisms in Haskell-readable format
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.Haskell where
+
+import GF.Formalism.GCFG
+import GF.Formalism.SimpleGFC
+import GF.Formalism.MCFG
+import GF.Formalism.CFG
+import GF.Formalism.Utilities
+import GF.Conversion.Types
+import GF.Data.Operations ((++++), (+++++))
+import GF.Infra.Print
+
+import Data.List (intersperse)
+
+-- | SimpleGFC to Haskell
+prtSGrammar :: SGrammar -> String
+prtSGrammar rules = "-- Simple GFC grammar as a Haskell file" ++++
+                    "-- Autogenerated from the Grammatical Framework" +++++
+                    "import GF.Formalism.GCFG" ++++
+                    "import GF.Formalism.SimpleGFC" ++++
+                    "import GF.Formalism.Utilities" ++++
+                    "import GF.Canon.AbsGFC (CIdent(..), Label(..))" ++++
+                    "import GF.Infra.Ident (Ident(..))" +++++
+                    "grammar :: SimpleGrammar Ident (NameProfile Ident) String" ++++
+                    "grammar = \n\t[ " ++ 
+                    concat (intersperse "\n\t, " (map show rules)) ++ "\n\t]\n\n"
+
+-- | MCFG to Haskell
+prtMGrammar :: MGrammar -> String
+prtMGrammar rules = "-- Multiple context-free grammar as a Haskell file" ++++
+		    "-- Autogenerated from the Grammatical Framework" +++++
+		    "import GF.Formalism.GCFG" ++++
+		    "import GF.Formalism.MCFG" ++++
+                    "import GF.Formalism.Utilities" +++++
+                    "grammar :: MCFGrammar String (NameProfile String) String String" ++++
+		    "grammar = \n\t[ " ++ 
+		    concat (intersperse "\n\t, " (map prtMRule rules)) ++ "\n\t]\n\n" 
+    where prtMRule (Rule (Abs cat cats (Name fun profiles)) (Cnc lcat lcats lins)) 
+	      = show (Rule (Abs (prt cat) (map prt cats) (Name (prt fun) (map cnvProfile profiles)))
+		           (Cnc (map prt lcat) (map (map prt) lcats) (map cnvLin lins)))
+	  cnvLin (Lin lbl syms) = Lin (prt lbl) (map (mapSymbol prtMArg id) syms)
+	  prtMArg  (cat, lbl, nr) = (prt cat, prt lbl, nr)
+
+-- | CFG to Haskell
+prtCGrammar :: CGrammar -> String
+prtCGrammar rules = "-- Context-free grammar as a Haskell file" ++++
+		    "-- autogenerated from the Grammatical Framework" +++++
+		    "import GF.Formalism.CFG" ++++ 
+                    "import GF.Formalism.Utilities" ++++
+                    "\ngrammar :: CFGrammar String (NameProfile String) String" ++++
+		    "grammar = \n\t[ " ++ 
+		    concat (intersperse "\n\t, " (map prtCRule rules)) ++ "\n\t]\n\n" 
+    where prtCRule (CFRule cat syms (Name fun profiles)) 
+	      = show (CFRule (prt cat) (map (mapSymbol prt id) syms) 
+	                     (Name (prt fun) (map cnvProfile profiles)))
+
+cnvProfile (Unify args) = Unify args
+cnvProfile (Constant forest) = Constant (fmap prt forest)
diff --git a/src-2.9/GF/Conversion/MCFGtoCFG.hs b/src-2.9/GF/Conversion/MCFGtoCFG.hs
new file mode 100644
index 000000000..a58c31d37
--- /dev/null
+++ b/src-2.9/GF/Conversion/MCFGtoCFG.hs
@@ -0,0 +1,53 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.6 $
+--
+-- Converting MCFG grammars to (possibly overgenerating) CFG
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.MCFGtoCFG
+    (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import Control.Monad
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.CFG
+import GF.Conversion.Types
+
+----------------------------------------------------------------------
+-- * converting (possibly erasing) MCFG grammars
+
+convertGrammar :: EGrammar -> CGrammar
+convertGrammar gram = tracePrt "MCFGtoCFG - context-free rules" (prt.length) $
+		       concatMap convertRule gram
+
+convertRule :: ERule -> [CRule]
+convertRule (Rule (Abs cat args (Name fun mprofile)) (Cnc _ _ record)) 
+    = [ CFRule (CCat cat lbl) rhs (Name fun profile) |
+	Lin lbl lin <- record,
+	let rhs = map (mapSymbol convertArg id) lin,
+	let cprofile = map (Unify . argPlaces lin) [0 .. length args-1],
+	let profile = mprofile `composeProfiles` cprofile
+      ]
+
+convertArg :: (ECat, ELabel, Int) -> CCat
+convertArg (cat, lbl, _) = CCat cat lbl
+
+argPlaces :: [Symbol (cat, lbl, Int) tok] -> Int -> [Int]
+argPlaces lin nr  = [ place | (nr', place) <- zip linArgs [0..], nr == nr' ]
+    where linArgs = [ nr' | (_, _, nr') <- filterCats lin ]
+
+
+
+
diff --git a/src-2.9/GF/Conversion/MCFGtoFCFG.hs b/src-2.9/GF/Conversion/MCFGtoFCFG.hs
new file mode 100644
index 000000000..70aa4644d
--- /dev/null
+++ b/src-2.9/GF/Conversion/MCFGtoFCFG.hs
@@ -0,0 +1,51 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.6 $
+--
+-- Converting MCFG grammars to equivalent optimized FCFG
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.MCFGtoFCFG
+    (convertGrammar) where
+
+import Control.Monad
+import List (elemIndex)
+import Array
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.FCFG
+import GF.Conversion.Types
+import GF.Data.SortedList (nubsort)
+
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+-- * converting MCFG to optimized FCFG
+
+convertGrammar :: MGrammar -> FGrammar
+convertGrammar gram = [ FRule (Abs (fcat cat) (map fcat cats) name) (fcnc cnc) |
+                        Rule (Abs cat cats name) cnc <- gram ]
+    where mcats = nubsort [ mc | Rule (Abs mcat mcats _) _ <- gram, mc <- mcat:mcats ]
+
+          fcat mcat@(MCat (ECat scat ecns) mlbls) 
+              = case elemIndex mcat mcats of
+                  Just catid -> FCat catid scat mlbls ecns
+                  Nothing -> error ("MCFGtoFCFG.fcat " ++ prt mcat)
+
+          fcnc (Cnc  _ arglbls lins) = listArray (0, length lins-1) (map flin lins)
+              where flin (Lin _ syms) = listArray (0, length syms-1) (map fsym syms)
+                    fsym (Tok tok) = FSymTok tok
+                    fsym (Cat (cat,lbl,arg)) = FSymCat (fcat cat) (flbl arg lbl) arg
+                    flbl arg lbl = case elemIndex lbl (arglbls !! arg) of
+                                     Just lblid -> lblid
+                                     Nothing -> error ("MCFGtoFCFG.flbl " ++ prt arg ++ " " ++ prt lbl)
+ 
diff --git a/src-2.9/GF/Conversion/Prolog.hs b/src-2.9/GF/Conversion/Prolog.hs
new file mode 100644
index 000000000..b930cb476
--- /dev/null
+++ b/src-2.9/GF/Conversion/Prolog.hs
@@ -0,0 +1,205 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/14 09:51:18 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.4 $
+--
+-- Converting/Printing different grammar formalisms in Prolog-readable format
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.Prolog (prtSGrammar, prtSMulti, prtSHeader, prtSRule,
+                             prtMGrammar, prtMMulti, prtMHeader, prtMRule,
+                             prtCGrammar, prtCMulti, prtCHeader, prtCRule) where
+
+import GF.Formalism.GCFG
+import GF.Formalism.SimpleGFC
+import GF.Formalism.MCFG
+import GF.Formalism.CFG
+import GF.Formalism.Utilities
+import GF.Conversion.Types
+import qualified GF.Conversion.GFC as Cnv
+
+import GF.Data.Operations ((++++), (+++++))
+import GF.Infra.Print
+import qualified GF.Infra.Modules as Mod
+import qualified GF.Infra.Option as Option
+import GF.Data.Operations (okError)
+import GF.Canon.AbsGFC (Flag(..))
+import GF.Canon.GFC (CanonGrammar)
+import GF.Infra.Ident (Ident(..))
+
+import Data.Maybe (maybeToList, listToMaybe)
+import Data.Char (isLower, isAlphaNum)
+
+import GF.System.Tracing
+
+----------------------------------------------------------------------
+-- | printing multiple languages at the same time
+
+prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String
+prtSMulti = prtMulti prtSHeader prtSRule Cnv.gfc2simple "gfc_"
+prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg "mcfg_"
+prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg "cfg_"
+
+-- code and ideas stolen from GF.CFGM.PrintCFGrammar
+
+prtMulti prtHeader prtRule conversion prefix opts gr
+    = prtHeader ++++ unlines
+      [ "\n\n" ++ prtLine ++++
+        "%% Language module: " ++ prtQ langmod +++++
+        unlines (map (prtRule langmod) rules) |
+        lang <- maybe [] (Mod.allConcretes gr) (Mod.greatestAbstract gr),
+        let Mod.ModMod (Mod.Module{Mod.flags=fs}) = okError (Mod.lookupModule gr lang),
+        let cnvopts = Option.Opts $ map Option.gfcConversion $ getFlag fs "conversion",
+        let rules = conversion cnvopts (gr, lang),
+        let langmod = (let IC lg = lang in prefix ++ lg) ]
+
+getFlag :: [Flag] -> String -> [String]
+getFlag fs x = [v | Flg (IC k) (IC v) <- fs, k == x]
+
+----------------------------------------------------------------------
+-- | SimpleGFC to Prolog
+--
+-- assumes that the profiles in the Simple GFC names are trivial
+prtSGrammar :: SGrammar -> String
+prtSGrammar rules = prtSHeader +++++ unlines (map (prtSRule "") rules)
+
+prtSHeader :: String
+prtSHeader = prtLine ++++
+             "%% Simple GFC grammar in Prolog-readable format" ++++
+             "%% Autogenerated from the Grammatical Framework" +++++
+             "%% The following predicate is defined:" ++++
+             "%% \t rule(Fun, Cat, c(Cat,...), LinTerm)"
+
+prtSRule :: String -> SRule -> String
+prtSRule lang (Rule (Abs cat cats (Name fun _prof)) (Cnc _ _ mterm)) 
+    = (if null lang then "" else prtQ lang ++ " : ") ++ 
+      prtFunctor "rule" [plfun, plcat, plcats, plcnc] ++ "."
+    where plfun  = prtQ fun
+          plcat  = prtSDecl cat
+          plcats = prtFunctor "c" (map prtSDecl cats) 
+	  plcnc  = "\n\t" ++ prtSTerm (maybe Empty id mterm)
+
+prtSTerm (Arg n c p)    = prtFunctor "arg" [prtQ c, prt (n+1), prtSPath p]
+-- prtSTerm (c :^ [])   = prtQ c
+prtSTerm (c :^ ts)      = prtOper "^" (prtQ c) (prtPList (map prtSTerm ts))
+prtSTerm (Rec rec)      = prtFunctor "rec" [prtPList [ prtOper "=" (prtQ l) (prtSTerm t) | (l, t) <- rec ]]
+prtSTerm (Tbl tbl)      = prtFunctor "tbl" [prtPList [ prtOper "=" (prtSTerm p) (prtSTerm t) | (p, t) <- tbl ]]
+prtSTerm (Variants ts)  = prtFunctor "variants" [prtPList (map prtSTerm ts)]
+prtSTerm (t1 :++ t2)    = prtOper "+" (prtSTerm t1) (prtSTerm t2)
+prtSTerm (Token t)      = prtFunctor "tok" [prtQ t]
+prtSTerm (Empty)        = "empty"
+prtSTerm (term :. lbl)  = prtOper "*" (prtSTerm term) (prtQ lbl)
+prtSTerm (term :! sel)  = prtOper "/" (prtSTerm term) (prtSTerm sel)
+-- prtSTerm (Wildcard)  = "wildcard"
+-- prtSTerm (Var var)   = prtFunctor "var" [prtQ var]
+
+prtSPath (Path path) = prtPList (map (either prtQ prtSTerm) path)
+
+prtSDecl (Decl var typ) | var == anyVar = prtSAbsType typ
+                        | otherwise     = "_" ++ prtVar var ++ ":" ++ prtSAbsType typ
+
+
+prtSAbsType ([]   ::--> typ) = prtSFOType typ
+prtSAbsType (args ::--> typ) = prtOper ":->" (prtPList (map prtSFOType args)) (prtSFOType typ)
+
+prtSFOType (cat ::@ args) = prtFunctor (prtQ cat) (map prtSTTerm args)
+
+prtSTTerm (con :@ args) = prtFunctor (prtQ con) (map prtSTTerm args)
+prtSTTerm (TVar var)    = "_" ++ prtVar var
+
+----------------------------------------------------------------------
+-- | MCFG to Prolog
+prtMGrammar :: MGrammar -> String
+prtMGrammar rules = prtMHeader +++++ unlines (map (prtMRule "") rules)
+
+prtMHeader :: String
+prtMHeader = prtLine ++++
+             "%% Multiple context-free grammar in Prolog-readable format" ++++
+             "%% Autogenerated from the Grammatical Framework" +++++
+             "%% The following predicate is defined:" ++++
+             "%% \t rule(Profile, Cat, c(Cat,...), [Lbl=Symbols,...])" 
+
+prtMRule :: String -> MRule -> String
+prtMRule lang (Rule (Abs cat cats name) (Cnc _lcat _lcats lins)) 
+    = (if null lang then "" else prtQ lang ++ " : ") ++ 
+      prtFunctor "rule" [plname, plcat, plcats, pllins] ++ "."
+    where plname = prtName name
+          plcat  = prtQ cat
+          plcats = prtFunctor "c" (map prtQ cats) 
+          pllins = "\n\t[ " ++ prtSep "\n\t, " (map prtMLin lins) ++ " ]"
+
+prtMLin (Lin lbl lin) = prtOper "=" (prtQ lbl) (prtPList (map prtMSymbol lin))
+
+prtMSymbol (Cat (cat, lbl, nr)) = prtFunctor "arg" [prtQ cat, show (nr+1), prtQ lbl]
+prtMSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
+
+----------------------------------------------------------------------
+-- | CFG to Prolog
+prtCGrammar :: CGrammar -> String
+prtCGrammar rules = prtCHeader +++++ unlines (map (prtCRule "") rules)
+
+prtCHeader :: String
+prtCHeader = prtLine ++++
+             "%% Context-free grammar in Prolog-readable format" ++++
+             "%% Autogenerated from the Grammatical Framework" +++++
+             "%% The following predicate is defined:" ++++
+             "%% \t rule(Profile, Cat, [Symbol,...])"
+
+prtCRule :: String -> CRule -> String
+prtCRule lang (CFRule cat syms name)
+    = (if null lang then "" else prtQ lang ++ " : ") ++ 
+      prtFunctor "cfgrule" [plname, plcat, plsyms] ++ "."
+    where plname = prtName name
+          plcat  = prtQ cat
+          plsyms = prtPList (map prtCSymbol syms) 
+
+prtCSymbol (Cat cat) = prtFunctor "cat" [prtQ cat]
+prtCSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
+
+----------------------------------------------------------------------
+-- profiles, quoted strings and more
+
+prtFunctor f xs = f ++ if null xs then "" else "(" ++ prtSep ", " xs ++ ")"
+prtPList     xs = "[" ++ prtSep ", " xs ++ "]"
+prtOper   f x y = "(" ++ x ++ " " ++ f ++ " " ++ y ++ ")"
+
+prtName name@(Name fun profiles)
+    | name == coercionName = "1"
+    | and (zipWith (==) profiles (map (Unify . return) [0..])) = prtQ fun
+    | otherwise = prtFunctor (prtQ fun) (map prtProfile profiles) 
+
+prtProfile (Unify []) = " ? "
+prtProfile (Unify args) = foldr1 (prtOper "=") (map (show . succ) args)
+prtProfile (Constant forest) = prtForest forest
+
+prtForest (FMeta) = " ? "
+prtForest (FNode fun [fs]) = prtFunctor (prtQ fun) (map prtForest fs)
+prtForest (FNode fun fss) = prtPList [ prtFunctor (prtQ fun) (map prtForest fs) |
+                                       fs <- fss ]
+
+prtQ atom = prtQStr (prt atom)
+
+prtQStr atom@(x:xs) 
+    | isLower x && all isAlphaNumUnder xs = atom
+    where isAlphaNumUnder '_' = True
+          isAlphaNumUnder x = isAlphaNum x
+prtQStr atom =  "'" ++ concatMap esc (prt atom) ++ "'"
+    where esc '\'' = "\\'"
+          esc '\n' = "\\n"
+          esc '\t' = "\\t"
+          esc c = [c]
+
+prtVar var = reprime (prt var)
+    where reprime "" = ""
+          reprime ('\'' : cs) = "_0" ++ reprime cs
+          reprime (c:cs) = c : reprime cs
+
+prtLine = replicate 70 '%'
+
+
diff --git a/src-2.9/GF/Conversion/RemoveEpsilon.hs b/src-2.9/GF/Conversion/RemoveEpsilon.hs
new file mode 100644
index 000000000..0e5dafb38
--- /dev/null
+++ b/src-2.9/GF/Conversion/RemoveEpsilon.hs
@@ -0,0 +1,46 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/30 08:11:32 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.3 $
+--
+-- Removing epsilon linearizations from MCF grammars
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.RemoveEpsilon where
+--    (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import Control.Monad
+import Data.List (mapAccumL)
+import Data.Maybe (mapMaybe)
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Conversion.Types
+import GF.Data.Assoc
+import GF.Data.SortedList
+import GF.Data.GeneralDeduction
+
+convertGrammar :: EGrammar -> EGrammar
+convertGrammar grammar = trace2 "RemoveEpsilon: initialEmpties" (prt initialEmpties) $
+			 trace2 "RemoveEpsilon: emptyCats" (prt emptyCats) $
+			 grammar 
+    where initialEmpties  = nubsort [ (cat, lbl)  | 
+				      Rule (Abs cat _ _) (Cnc _ _ lins) <- grammar,
+				      Lin lbl [] <- lins ]
+	  emptyCats       = limitEmpties initialEmpties
+	  limitEmpties es = if es==es' then es else limitEmpties es'
+	      where es'   = nubsort [ (cat, lbl) | Rule (Abs cat _ _) (Cnc _ _ lins) <- grammar, 
+				      Lin lbl rhs <- lins,
+				      all (symbol (\(c,l,n) -> (c,l) `elem` es) (const False)) rhs ]
+
+
+
diff --git a/src-2.9/GF/Conversion/RemoveErasing.hs b/src-2.9/GF/Conversion/RemoveErasing.hs
new file mode 100644
index 000000000..1dc2560fc
--- /dev/null
+++ b/src-2.9/GF/Conversion/RemoveErasing.hs
@@ -0,0 +1,113 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.3 $
+--
+-- Removing erasingness from MCFG grammars (as in Ljunglöf 2004, sec 4.5.1)
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.RemoveErasing
+    (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import Control.Monad 
+import Data.List (mapAccumL)
+import Data.Maybe (mapMaybe)
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Conversion.Types
+import GF.Data.Assoc
+import GF.Data.SortedList
+import GF.Data.GeneralDeduction
+
+convertGrammar :: EGrammar -> [SCat] -> MGrammar
+convertGrammar grammar starts = newGrammar
+    where newGrammar  = tracePrt "RemoveErasing - nonerasing rules" (prt . length) $
+			[ rule | NR rule <- chartLookup finalChart True ]
+	  finalChart  = tracePrt "RemoveErasing - nonerasing cats" 
+			(prt . length . flip chartLookup False) $
+			buildChart keyof [newRules rulesByCat] $
+			tracePrt "RemoveErasing - initial ne-cats" (prt . length) $
+			initialCats
+	  initialCats = trace2 "RemoveErasing - starting categories" (prt starts) $
+			if null starts 
+			  then trace2 "RemoveErasing" "initialCatsBU" $
+			       initialCatsBU rulesByCat
+			  else trace2 "RemoveErasing" ("initialCatsTD: " ++ prt starts) $
+			       initialCatsTD rulesByCat starts
+	  rulesByCat  = trace2 "RemoveErasing - erasing rules" (prt $ length grammar) $
+			accumAssoc id [ (cat, rule) | rule@(Rule (Abs cat _ _) _) <- grammar ]
+
+data Item r c = NR r | NC c deriving (Eq, Ord, Show)
+
+keyof (NR _) = True
+keyof (NC _) = False
+
+newRules grammar chart (NR (Rule (Abs _ cats _) _))
+    = [ NC cat | cat@(MCat _ lbls) <- cats, not (null lbls) ]
+newRules grammar chart (NC newCat@(MCat cat lbls))
+    = do Rule (Abs _ args (Name fun profile)) (Cnc _ _ lins0) <- grammar ? cat
+
+         lins <- selectLins lins0 lbls 
+	 -- let lins = [ lin | lin@(Lin lbl _) <- lins0, 
+	 -- 	      lbl `elem` lbls ]
+
+	 let argsInLin = listAssoc $
+			 map (\((n,c),l) -> (n, MCat c l)) $
+			 groupPairs $ nubsort $
+			 [ ((nr, cat), lbl) | 
+			   Lin _ lin <- lins, 
+			   Cat (cat, lbl, nr) <- lin ] 
+
+	     newArgs = mapMaybe (lookupAssoc argsInLin) [0 .. length args-1]
+	     argLbls = [ lbls | MCat _ lbls <- newArgs ]
+
+	     newLins = [ Lin lbl newLin | Lin lbl lin <- lins,
+			 let newLin = map (mapSymbol cnvCat id) lin ]
+	     cnvCat (cat, lbl, nr) = (mcat, lbl, nr')
+		 where Just mcat = lookupAssoc argsInLin nr
+		       Unify [nr'] = newProfile !! nr
+	     nonEmptyCat (Cat (MCat _ [], _, _)) = False
+	     nonEmptyCat _ = True
+
+	     newProfile = snd $ mapAccumL accumProf 0 $
+			  map (lookupAssoc argsInLin) [0 .. length args-1]
+	     accumProf nr = maybe (nr, Unify []) $ const (nr+1, Unify [nr])
+	     newName = -- tracePrt "newName" (prtNewName profile newProfile) $
+                       Name fun (profile `composeProfiles` newProfile)
+
+         guard $ all (not . null) argLbls
+	 return $ NR (Rule (Abs newCat newArgs newName) (Cnc lbls argLbls newLins))
+
+selectLins lins0 = mapM selectLbl
+    where selectLbl lbl = [ lin | lin@(Lin lbl' _) <- lins0, lbl == lbl' ] 
+
+
+prtNewName :: [Profile (SyntaxForest Fun)] -> [Profile (SyntaxForest Fun)] -> Name -> String
+prtNewName p p' n = prt p ++ " .o. " ++ prt p' ++ " : " ++ prt n
+
+
+initialCatsTD grammar starts =
+    [ cat | cat@(NC (MCat (ECat start _) _)) <- initialCatsBU grammar,
+      start `elem` starts ]
+
+initialCatsBU grammar 
+    = [ NC (MCat cat [lbl]) | (cat, rules) <- aAssocs grammar, 
+	let Rule _ (Cnc lbls _ _) = head rules,
+	lbl <- lbls ]
+
+
+
+
+
+
+
diff --git a/src-2.9/GF/Conversion/RemoveSingletons.hs b/src-2.9/GF/Conversion/RemoveSingletons.hs
new file mode 100644
index 000000000..4b9992a4d
--- /dev/null
+++ b/src-2.9/GF/Conversion/RemoveSingletons.hs
@@ -0,0 +1,82 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/11 10:28:16 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- Instantiating all types which only have one single element.
+--
+-- Should be merged into 'GF.Conversion.FiniteToSimple'
+-----------------------------------------------------------------------------
+
+module GF.Conversion.RemoveSingletons where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+import GF.Formalism.SimpleGFC
+import GF.Conversion.Types
+
+import GF.Data.SortedList
+import GF.Data.Assoc
+
+import Data.List (mapAccumL)
+
+convertGrammar :: SGrammar -> SGrammar
+convertGrammar grammar = if singles == emptyAssoc then grammar
+			 else tracePrt "RemoveSingletons - non-singleton rules" (prt . length) $
+			      map (convertRule singles) grammar
+    where singles = calcSingletons grammar
+
+convertRule :: Assoc SCat (SyntaxForest Fun, Maybe STerm) -> SRule -> SRule
+convertRule singles rule@(Rule (Abs _ decls _) _)
+    = if all (Nothing ==) singleArgs then rule
+      else instantiateSingles singleArgs rule
+    where singleArgs = map (lookupAssoc singles . decl2cat) decls
+
+instantiateSingles :: [Maybe (SyntaxForest Fun, Maybe STerm)] -> SRule -> SRule
+instantiateSingles singleArgs (Rule (Abs decl decls (Name fun profile)) (Cnc lcat lcats lterm))
+    = Rule (Abs decl decls' (Name fun profile')) (Cnc lcat lcats' lterm')
+    where (decls', lcats') = unzip [ (d, l) | (Nothing, d, l) <- zip3 singleArgs decls lcats ]
+	  profile'  = map (fmap fst) exProfile `composeProfiles` profile
+	  newArgs   = map (fmap snd) exProfile
+	  lterm'    = fmap (instantiateLin newArgs) lterm
+	  exProfile = snd $ mapAccumL mkProfile 0 singleArgs
+	  mkProfile nr (Just trm) = (nr, Constant trm)
+	  mkProfile nr (Nothing)  = (nr+1, Unify [nr])
+
+instantiateLin :: [Profile (Maybe STerm)] -> STerm -> STerm
+instantiateLin newArgs = inst
+    where inst (Arg nr cat path) 
+	      = case newArgs !! nr of
+		  Unify [nr']          -> Arg nr' cat path
+		  Constant (Just term) -> termFollowPath path term
+		  Constant Nothing     -> error "RemoveSingletons.instantiateLin: This should not happen (argument has no linearization)"
+	  inst (cn :^ terms) = cn :^ map inst terms
+	  inst (Rec rec)     = Rec [ (lbl, inst term) | (lbl, term) <- rec ]
+	  inst (term :. lbl) = inst term +. lbl
+	  inst (Tbl tbl)     = Tbl [ (pat, inst term) | (pat, term) <- tbl ]
+	  inst (term :! sel) = inst term +! inst sel
+	  inst (Variants ts) = variants (map inst ts)
+	  inst (t1 :++ t2)   = inst t1 ?++ inst t2
+	  inst term          = term
+
+----------------------------------------------------------------------
+
+calcSingletons :: SGrammar -> Assoc SCat (SyntaxForest Fun, Maybe STerm)
+calcSingletons rules = listAssoc singleCats
+    where singleCats = tracePrt "RemoveSingletons - singleton cats" (prtSep " ") $
+		       [ (cat, (constantNameToForest name, lin)) | 
+			 (cat, [([], name, lin)]) <- rulesByCat ]
+	  rulesByCat = groupPairs $ nubsort
+		       [ (decl2cat cat, (args, name, lin)) | 
+			 Rule (Abs cat args name) (Cnc _ _ lin) <- rules ]
+
+
+
diff --git a/src-2.9/GF/Conversion/SimpleToFCFG.hs b/src-2.9/GF/Conversion/SimpleToFCFG.hs
new file mode 100644
index 000000000..4ff5781f9
--- /dev/null
+++ b/src-2.9/GF/Conversion/SimpleToFCFG.hs
@@ -0,0 +1,536 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Conversion.SimpleToFCFG
+    (convertConcrete) where
+
+import GF.Infra.PrintClass
+
+import Control.Monad
+
+import GF.Formalism.Utilities
+import GF.Formalism.FCFG
+
+import GF.GFCC.Macros --hiding (prt)
+import GF.GFCC.DataGFCC
+import GF.GFCC.CId
+
+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 Data.Array
+import Data.Maybe
+
+----------------------------------------------------------------------
+-- 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,Exp))] -> TermMap -> TermMap -> ([(CId,(Type,Exp))],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 " ++ prt 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 = CId "_Var"
+
+      catName :: (Int,CId) -> CId
+      catName (0,c) = c
+      catName (n,CId c) = CId ("_" ++ show n ++ c)
+
+      funName :: (Int,CId) -> CId
+      funName (n,CId c) = CId ("__" ++ show n ++ c)
+
+      varFunName :: CId -> CId
+      varFunName (CId c) = CId ("_Var_" ++ 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) args cat lins | FRule n args cat lins <- rs], cs)
+  where fixName (Name (CId ('_':'_':_)) p) = Name (CId "_B") p
+        fixName (Name (CId n) p) | "_Var_" `List.isPrefixOf` n = Name wildCId p
+        fixName n = n
+
+convert :: [(CId,(Type,Exp))] -> 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,       Unify []          )
+              accumProf nr (_           ,xpaths) = (nr+cnt+1, Unify [nr..nr+cnt])
+                where cnt = length xpaths
+
+          rule = FRule (Name 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 = symbol (\(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 fcat (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 Env     = (ProtoFCat, [(ProtoFCat,[FPath])], Term, [Term])
+type LinRec  = [(FPath, [Symbol (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,Tok str : lin) : lins)
+convertTerm cnc_defs selector (K (KP strs vars))((lbl_path,lin) : lins) = 
+  do projectHead lbl_path
+     toks <- member (strs:[strs' | Var strs' _ <- vars])
+     return ((lbl_path, map Tok toks ++ lin) : lins)
+convertTerm cnc_defs selector (RP _ term)                    lins  = convertTerm cnc_defs selector term 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, GF.Formalism.Utilities.Cat (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 (RP alias _) = evalTerm cnc_defs path alias
+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 (RP alias _) = unifyPType nr path alias
+
+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)
+selectTerm path         (RP _ term) = selectTerm path term
+
+
+----------------------------------------------------------------------
+-- 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 (CId "String") [[0]] [] $
+                              ins fcatInt    (CId "Int")    [[0]] [] $
+                              ins fcatFloat  (CId "Float")  [[0]] [] $
+                              ins fcatVar    (CId "_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 (Name (CId "_") [Unify [0]]) [fcat_arg] fcat
+                                                    (listArray (0,length rcs-1) [listArray (0,0) [FSymCat fcat_arg 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 (RP _ term)   path acc = gen_tcs term path 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: "++prt 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 st          (RP _ t)   = loop path st t
+    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: "++prt 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-2.9/GF/Conversion/SimpleToFinite.hs b/src-2.9/GF/Conversion/SimpleToFinite.hs
new file mode 100644
index 000000000..bbd3ae355
--- /dev/null
+++ b/src-2.9/GF/Conversion/SimpleToFinite.hs
@@ -0,0 +1,178 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/01 09:53:19 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.7 $
+--
+-- Calculating the finiteness of each type in a grammar
+-----------------------------------------------------------------------------
+
+module GF.Conversion.SimpleToFinite
+    (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import GF.Formalism.GCFG
+import GF.Formalism.SimpleGFC
+import GF.Formalism.Utilities 
+import GF.Conversion.Types
+
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.Data.BacktrackM
+import GF.Data.Utilities (lookupList)
+
+import GF.Infra.Ident (Ident(..))
+
+type CnvMonad a = BacktrackM () a
+
+convertGrammar :: SGrammar -> SGrammar
+convertGrammar rules = tracePrt "SimpleToFinie - nr. 'finite' rules" (prt . length) $
+		       solutions cnvMonad ()
+    where split = calcSplitable rules
+	  cnvMonad = member rules >>= convertRule split
+
+convertRule :: Splitable -> SRule -> CnvMonad SRule
+convertRule split (Rule abs cnc) 
+    = do newAbs <- convertAbstract split abs
+	 return $ Rule newAbs cnc
+
+{-
+-- old code
+convertAbstract :: Splitable -> Abstract SDecl Name
+		-> CnvMonad (Abstract SDecl Name)
+convertAbstract split (Abs decl decls name)
+    = case splitableFun split (name2fun name) of
+        Just cat' -> return $ Abs (Decl anyVar (mergeFun (name2fun name) cat') []) decls name
+	Nothing -> expandTyping split name [] decl decls []
+
+
+expandTyping :: Splitable -> Name -> [(Var, SCat)] -> SDecl -> [SDecl] -> [SDecl] 
+	     -> CnvMonad (Abstract SDecl Name)
+expandTyping split name env (Decl x cat args) [] decls 
+    = return $ Abs decl (reverse decls) name
+    where decl = substArgs split x env cat args []
+expandTyping split name env typ (Decl x xcat xargs : declsToDo) declsDone
+    = do (x', xcat', env') <- calcNewEnv
+         let decl = substArgs split x' env xcat' xargs []
+	 expandTyping split name env' typ declsToDo (decl : declsDone)
+    where calcNewEnv = case splitableCat split xcat of
+		         Just newFuns -> do newFun <- member newFuns
+                                            let newCat  = mergeFun newFun xcat
+		         -- Just newCats -> do newCat <- member newCats
+					    return (anyVar, newCat, (x,newCat) : env)
+			 Nothing -> return (x, xcat, env)
+-}
+
+-- new code
+convertAbstract :: Splitable -> Abstract SDecl Name
+		-> CnvMonad (Abstract SDecl Name)
+convertAbstract split (Abs decl decls name)
+    = case splitableFun split fun of
+        Just cat' -> return $ Abs (Decl anyVar ([] ::--> (mergeFun fun cat' ::@ []))) decls name
+	Nothing -> expandTyping split [] fun profiles [] decl decls []
+    where Name fun profiles = name
+
+expandTyping :: Splitable -> [(Var, SCat)]
+             -> Fun -> [Profile (SyntaxForest Fun)] -> [Profile (SyntaxForest Fun)] 
+             -> SDecl -> [SDecl] -> [SDecl] 
+	     -> CnvMonad (Abstract SDecl Name)
+expandTyping split env fun [] profiles (Decl x (typargs ::--> (cat ::@ args))) [] decls 
+    = return $ Abs decl (reverse decls) (Name fun (reverse profiles))
+    where decl = substArgs split x env typargs cat args []
+expandTyping split env fun (prof:profiles) profsDone typ 
+                 (Decl x (xtypargs ::--> (xcat ::@ xargs)) : declsToDo) declsDone
+    = do (x', xcat', env', prof') <- calcNewEnv
+         let decl = substArgs split x' env xtypargs xcat' xargs []
+	 expandTyping split env' fun profiles (prof' : profsDone) typ declsToDo (decl : declsDone)
+    where calcNewEnv = case splitableCat split xcat of
+			 Nothing      -> return (x, xcat, env, prof)
+		         Just newFuns -> do newFun <- member newFuns
+                                            let newCat  = mergeFun newFun xcat
+                                                newProf = Constant (FNode newFun [[]])
+                                            -- should really be using some kind of
+                                            -- "profile unification"
+					    return (anyVar, newCat, (x,newCat) : env, newProf)
+
+substArgs :: Splitable -> Var -> [(Var, SCat)] -> [FOType SCat]
+	  -> SCat -> [TTerm] -> [TTerm] -> SDecl
+substArgs split x env typargs cat [] args = Decl x (typargs ::--> (cat ::@ reverse args))
+substArgs split x env typargs cat (arg:argsToDo) argsDone
+    = case argLookup split env arg of
+        Just newCat -> substArgs split x env typargs (mergeArg cat newCat) argsToDo argsDone
+	Nothing     -> substArgs split x env typargs cat argsToDo (arg : argsDone)
+
+argLookup split env (TVar x)   = lookup x env 
+argLookup split env (con :@ _) = fmap (mergeFun fun) (splitableFun split fun)
+    where fun = constr2fun con
+      
+
+----------------------------------------------------------------------
+-- splitable categories (finite, no dependencies)
+-- they should also be used as some dependency
+
+type Splitable = (Assoc SCat [Fun], Assoc Fun SCat)
+
+splitableCat :: Splitable -> SCat -> Maybe [Fun]
+splitableCat = lookupAssoc . fst 
+
+splitableFun :: Splitable -> Fun -> Maybe SCat
+splitableFun = lookupAssoc . snd
+
+calcSplitable :: [SRule] -> Splitable
+calcSplitable rules = (listAssoc splitableCat2Funs, listAssoc splitableFun2Cat)
+    where splitableCat2Funs = groupPairs $ nubsort splitableCatFuns
+
+	  splitableFun2Cat = nubsort
+			     [ (fun, cat) | (cat, fun) <- splitableCatFuns ]
+
+          -- cat-fun pairs that are splitable
+	  splitableCatFuns = tracePrt "SimpleToFinite - splitable functions" prt $
+                             [ (cat, name2fun name) |
+			       Rule (Abs (Decl _ ([] ::--> (cat ::@ []))) [] name) _ <- rules,
+			       splitableCats ?= cat ]
+
+          -- all cats that are splitable
+          splitableCats = listSet $
+			  tracePrt "SimpleToFinite - finite categories to split" prt $
+			  (nondepCats <**> depCats) <\\> resultCats
+
+          -- all result cats for some pure function
+	  resultCats = tracePrt "SimpleToFinite - result cats" prt $
+                       nubsort [ cat | Rule (Abs (Decl _ (_ ::--> (cat ::@ _))) decls _) _ <- rules,
+				 not (null decls) ]
+
+          -- all cats in constants without dependencies
+          nondepCats = tracePrt "SimpleToFinite - nondep cats" prt $
+                       nubsort [ cat | Rule (Abs (Decl _ ([] ::--> (cat ::@ []))) [] _) _ <- rules ]
+
+          -- all cats occurring as some dependency of another cat
+	  depCats = tracePrt "SimpleToFinite - dep cats" prt $
+                    nubsort [ cat | Rule (Abs decl decls _) _ <- rules,
+			      cat <- varCats [] (decls ++ [decl]) ]
+
+	  varCats _ [] = []
+	  varCats env (Decl x (xargs ::--> xtyp@(xcat ::@ _)) : decls)
+	      = varCats ((x,xcat) : env) decls ++
+		[ cat | (_::@args) <- (xtyp:xargs), arg <- args, 
+                  y <- varsInTTerm arg, cat <- lookupList y env ]
+
+
+----------------------------------------------------------------------
+-- utilities
+-- mergeing categories
+
+mergeCats :: String -> String -> String -> SCat -> SCat -> SCat
+mergeCats before middle after (IC cat) (IC arg) 
+    = IC (before ++ cat ++ middle ++ arg ++ after)
+
+mergeFun, mergeArg :: SCat -> SCat -> SCat
+mergeFun = mergeCats "{" ":" "}"
+mergeArg = mergeCats "" "" ""
+
+
diff --git a/src-2.9/GF/Conversion/SimpleToMCFG.hs b/src-2.9/GF/Conversion/SimpleToMCFG.hs
new file mode 100644
index 000000000..8f23c905d
--- /dev/null
+++ b/src-2.9/GF/Conversion/SimpleToMCFG.hs
@@ -0,0 +1,26 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/18 14:55:32 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.3 $
+--
+-- All different conversions from SimpleGFC to MCFG
+-----------------------------------------------------------------------------
+
+module GF.Conversion.SimpleToMCFG where
+
+import GF.Formalism.SimpleGFC 
+import GF.Conversion.Types
+
+import qualified GF.Conversion.SimpleToMCFG.Strict as Strict
+import qualified GF.Conversion.SimpleToMCFG.Nondet as Nondet
+import qualified GF.Conversion.SimpleToMCFG.Coercions as Coerce
+
+convertGrammarNondet, convertGrammarStrict :: SGrammar -> EGrammar
+convertGrammarNondet = Coerce.addCoercions . Nondet.convertGrammar
+convertGrammarStrict = Strict.convertGrammar
+
diff --git a/src-2.9/GF/Conversion/SimpleToMCFG/Coercions.hs b/src-2.9/GF/Conversion/SimpleToMCFG/Coercions.hs
new file mode 100644
index 000000000..319b99dcb
--- /dev/null
+++ b/src-2.9/GF/Conversion/SimpleToMCFG/Coercions.hs
@@ -0,0 +1,63 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- Adding coercion functions to a MCFG if necessary.
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.SimpleToMCFG.Coercions
+    (addCoercions) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Conversion.Types 
+import GF.Data.SortedList
+import Data.List (groupBy)
+
+----------------------------------------------------------------------
+
+addCoercions :: EGrammar -> EGrammar
+addCoercions rules = coercions ++ rules
+    where (allHeads, allArgs) = unzip [ ((head, lbls), nubsort args) | 
+					Rule (Abs head args _) (Cnc lbls _ _) <- rules ]
+	  allHeadSet = nubsort allHeads
+	  allArgSet  = union   allArgs <\\> map fst allHeadSet
+	  coercions = tracePrt "SimpleToMCFG.Coercions - MCFG coercions" (prt . length) $
+		      concat $
+		      tracePrt "SimpleToMCFG.Coercions - MCFG coercions per category" 
+				   (prtList . map length) $
+		      combineCoercions 
+		        (groupBy sameECatFst allHeadSet) 
+			(groupBy sameECat    allArgSet)
+	  sameECatFst a b = sameECat (fst a) (fst b)
+
+
+combineCoercions [] _ = []
+combineCoercions _ [] = []
+combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs) 
+    = case compare (ecat2scat $ fst $ head heads) (ecat2scat $ head args) of
+        LT -> combineCoercions allHeads  allArgs'
+	GT -> combineCoercions allHeads' allArgs
+	EQ -> makeCoercion heads args : combineCoercions allHeads allArgs
+
+
+makeCoercion heads args
+    = [ Rule (Abs arg [head] coercionName) (Cnc lbls [lbls] lins)  |
+	(head@(ECat _ headCns), lbls) <- heads, 
+	let lins = [ Lin lbl [Cat (head, lbl, 0)] | lbl <- lbls ],
+	arg@(ECat _ argCns) <- args,
+	argCns `subset` headCns ]
+
+
+
diff --git a/src-2.9/GF/Conversion/SimpleToMCFG/Nondet.hs b/src-2.9/GF/Conversion/SimpleToMCFG/Nondet.hs
new file mode 100644
index 000000000..d6ff052f5
--- /dev/null
+++ b/src-2.9/GF/Conversion/SimpleToMCFG/Nondet.hs
@@ -0,0 +1,256 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/17 08:27:29 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.7 $
+--
+-- Converting SimpleGFC grammars to MCFG grammars, nondeterministically.
+-- Afterwards, the grammar has to be extended with coercion functions,
+-- from the module 'GF.Conversion.SimpleToMCFG.Coercions'
+--
+-- the resulting grammars might be /very large/
+--
+-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.SimpleToMCFG.Nondet
+    (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import Control.Monad
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG 
+import GF.Formalism.MCFG 
+import GF.Formalism.SimpleGFC 
+import GF.Conversion.Types
+
+import GF.Data.BacktrackM
+import GF.Data.Utilities (notLongerThan, updateNthM)
+
+------------------------------------------------------------
+-- type declarations
+
+type CnvMonad a = BacktrackM Env a
+
+type Env    = (ECat, [ECat], LinRec, [SLinType]) -- variable bindings: [(Var, STerm)]
+type LinRec = [Lin SCat MLabel Token]
+
+
+----------------------------------------------------------------------
+-- main conversion function
+
+maxNrRules :: Int
+maxNrRules = 5000
+
+convertGrammar :: SGrammar -> EGrammar 
+convertGrammar rules = traceCalcFirst rules' $
+		       tracePrt "SimpleToMCFG.Nondet - MCFG rules" (prt . length) $
+		       rules'
+    where rules' = rules >>= convertRule
+--		       solutions conversion undefined
+--    where conversion = member rules >>= convertRule
+
+convertRule :: SRule -> [ERule] -- CnvMonad ERule
+convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term))) =
+--    | prt(name2fun fun) `elem` 
+--      words "UseCl PosTP TPast ASimul SPredV IndefOneNP DefOneNP UseN2 mother_N2 jump_V" =
+    if notLongerThan maxNrRules rules 
+       then tracePrt ("SimpeToMCFG.Nondet - MCFG rules for " ++ prt fun) (prt . length) $
+	    rules
+       else trace2 "SimpeToMCFG.Nondet - TOO MANY RULES, function not converted" 
+		("More than " ++ show maxNrRules ++ " MCFG rules for " ++ prt fun) $
+            []
+    where rules = flip solutions undefined $
+		  do let cat : args = map decl2cat (decl : decls)
+		     writeState (initialECat cat, map initialECat args, [], ctypes)
+		     rterm <- simplifyTerm term
+		     reduceTerm ctype emptyPath rterm
+		     (newCat, newArgs, linRec, _) <- readState
+		     let newLinRec = map (instantiateArgs newArgs) linRec
+			 catPaths : argsPaths = map (lintype2paths emptyPath) (ctype : ctypes)
+		     -- checkLinRec argsPaths catPaths newLinRec
+		     return $ Rule (Abs newCat newArgs fun) (Cnc catPaths argsPaths newLinRec) 
+convertRule _ = [] -- failure
+
+
+----------------------------------------------------------------------
+-- "type-checking" the resulting linearization
+-- should not be necessary, if the algorithms (type-checking and conversion) are correct
+
+checkLinRec args lbls = mapM (checkLin args lbls) 
+
+checkLin args lbls (Lin lbl lin) 
+    | lbl `elem` lbls = mapM (symbol (checkArg args) (const (return ()))) lin
+    | otherwise = trace2 "SimpleToMCFG.Nondet - ERROR" "Label mismatch" $
+		  failure
+
+checkArg args (_cat, lbl, nr) 
+    | lbl `elem` (args !! nr) = return ()
+--    | otherwise = trace2 "SimpleToMCFG.Nondet - ERROR" ("Label mismatch in arg " ++ prt nr) $
+--		  failure
+    | otherwise = trace2 ("SimpleToMCFG.Nondet - ERROR: Label mismatch in arg " ++ prt nr) 
+		  (prt lbl ++ " `notElem` " ++ prt (args!!nr)) $
+		  failure
+
+
+----------------------------------------------------------------------
+-- term simplification
+
+simplifyTerm :: STerm -> CnvMonad STerm
+simplifyTerm (term :! sel)      
+    = do sterm <- simplifyTerm term
+	 ssel <- simplifyTerm sel
+	 case sterm of
+	   Tbl table  -> do (pat, val) <- member table
+			    pat =?= ssel
+			    return val
+	   _ -> do sel' <- expandTerm ssel
+		   return (sterm +! sel')
+-- simplifyTerm (Var x)           = readBinding x
+simplifyTerm (con :^ terms)    = liftM (con :^) $ mapM simplifyTerm terms
+simplifyTerm (Rec record)      = liftM Rec      $ mapM simplifyAssign record
+simplifyTerm (term :. lbl)     = liftM (+. lbl) $      simplifyTerm term
+simplifyTerm (Tbl table)       = liftM Tbl      $ mapM simplifyCase table
+simplifyTerm (Variants terms)  = liftM Variants $ mapM simplifyTerm terms
+simplifyTerm (term1 :++ term2) = liftM2 (:++) (simplifyTerm term1) (simplifyTerm term2)
+simplifyTerm term              = return term
+
+simplifyAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
+simplifyAssign (lbl, term) = liftM ((,) lbl) $ simplifyTerm term
+
+simplifyCase :: (STerm, STerm) -> CnvMonad (STerm, STerm)
+simplifyCase (pat, term) = liftM2 (,) (simplifyTerm pat) (simplifyTerm term)
+
+
+------------------------------------------------------------
+-- reducing simplified terms, collecting MCF rules
+
+reduceTerm :: SLinType -> SPath -> STerm -> CnvMonad ()
+--reduceTerm ctype path (Variants terms) 
+--    = member terms >>= reduceTerm ctype path
+reduceTerm (StrT)   path term = updateLin (path, term)
+reduceTerm (ConT _) path term = do pat <- expandTerm term
+				   updateHead (path, pat)
+reduceTerm (RecT rtype) path term
+    = sequence_ [ reduceTerm ctype (path ++. lbl) (term  +. lbl) | (lbl, ctype) <- rtype ]
+reduceTerm (TblT pats vtype) path table 
+    = sequence_ [ reduceTerm vtype (path ++! pat) (table +! pat) | pat <- pats ]
+
+
+------------------------------------------------------------
+-- expanding a term to ground terms
+
+expandTerm :: STerm -> CnvMonad STerm
+expandTerm arg@(Arg nr _ path) 
+    = do ctypes <- readArgCTypes
+	 unifyPType arg $ lintypeFollowPath path $ ctypes !! nr
+-- expandTerm arg@(Arg nr _ path) 
+--     = do ctypes <- readArgCTypes
+-- 	 pat <- member $ enumeratePatterns $ lintypeFollowPath path $ ctypes !! nr
+-- 	 pat =?= arg
+-- 	 return pat
+expandTerm (con :^ terms)   = liftM (con :^) $ mapM expandTerm terms
+expandTerm (Rec record)     = liftM  Rec     $ mapM expandAssign record
+--expandTerm (Variants terms) = liftM Variants $ mapM expandTerm terms  
+expandTerm (Variants terms) = member terms >>= expandTerm  
+expandTerm term = error $ "expandTerm: " ++ prt term
+
+expandAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
+expandAssign (lbl, term) = liftM ((,) lbl) $ expandTerm term
+
+unifyPType :: STerm -> SLinType -> CnvMonad STerm
+unifyPType arg (RecT prec) = 
+    liftM Rec $
+    sequence [ liftM ((,) lbl) $
+	       unifyPType (arg +. lbl) ptype |
+	       (lbl, ptype) <- prec ]
+unifyPType (Arg nr _ path) (ConT terms) = 
+    do (_, args, _, _) <- readState
+       case lookup path (ecatConstraints (args !! nr)) of
+         Just term -> return term
+         Nothing -> do term <- member terms
+		       updateArg nr (path, term)
+		       return term
+
+------------------------------------------------------------
+-- unification of patterns and selection terms
+
+(=?=) :: STerm -> STerm -> CnvMonad ()
+-- Wildcard      =?= _               = return ()
+-- Var x         =?= term            = addBinding x term
+Rec precord   =?= arg@(Arg _ _ _) = sequence_ [ pat =?= (arg +. lbl) |
+						(lbl, pat) <- precord ]
+pat           =?= Arg nr _ path   = updateArg nr (path, pat)
+(con :^ pats) =?= (con' :^ terms) = do guard (con==con' && length pats==length terms)
+				       sequence_ $ zipWith (=?=) pats terms
+Rec precord   =?= Rec record      = sequence_ [ maybe mzero (pat =?=) mterm |
+						(lbl, pat) <- precord,
+						let mterm = lookup lbl record ]
+-- variants are not allowed in patterns, but in selection terms:
+term =?= Variants terms = member terms >>= (term =?=)
+pat =?= term = error $ "(=?=): " ++ prt pat ++ " =?= " ++ prt term
+
+----------------------------------------------------------------------
+-- variable bindings (does not work correctly)
+{-
+addBinding x term = do (a, b, c, d, bindings) <- readState
+		       writeState (a, b, c, d, (x,term):bindings)
+
+readBinding x = do (_, _, _, _, bindings) <- readState
+		   return $ maybe (Var x) id $ lookup x bindings
+-}
+
+------------------------------------------------------------
+-- updating the MCF rule
+
+readArgCTypes :: CnvMonad [SLinType]
+readArgCTypes = do (_, _, _, env) <- readState
+		   return env
+
+updateArg :: Int -> Constraint -> CnvMonad ()
+updateArg arg cn
+    = do (head, args, lins, env) <- readState 
+	 args' <- updateNthM (addToECat cn) arg args
+	 writeState (head, args', lins, env)
+
+updateHead :: Constraint -> CnvMonad ()
+updateHead cn
+    = do (head, args, lins, env) <- readState
+	 head' <- addToECat cn head
+	 writeState (head', args, lins, env)
+
+updateLin :: Constraint -> CnvMonad ()
+updateLin (path, term) 
+    = do let newLins = term2lins term
+	 (head, args, lins, env) <- readState
+	 let lins' = lins ++ map (Lin path) newLins
+	 writeState (head, args, lins', env)
+
+term2lins :: STerm -> [[Symbol (SCat, SPath, Int) Token]]
+term2lins (Arg nr cat path) = return [Cat (cat, path, nr)]
+term2lins (Token str)       = return [Tok str]
+term2lins (t1 :++ t2)       = liftM2 (++) (term2lins t1) (term2lins t2)
+term2lins (Empty)           = return []
+term2lins (Variants terms)  = terms >>= term2lins
+term2lins term = error $ "term2lins: " ++ show term
+
+addToECat :: Constraint -> ECat -> CnvMonad ECat
+addToECat cn (ECat cat cns) = liftM (ECat cat) $ addConstraint cn cns
+
+addConstraint :: Constraint -> [Constraint] -> CnvMonad [Constraint]
+addConstraint cn0 (cn : cns)
+    | fst cn0 >  fst cn = liftM (cn:) (addConstraint cn0 cns)
+    | fst cn0 == fst cn = guard (snd cn0 == snd cn) >>
+			  return (cn : cns)
+addConstraint cn0 cns   = return (cn0 : cns)
+
+
+
diff --git a/src-2.9/GF/Conversion/SimpleToMCFG/Strict.hs b/src-2.9/GF/Conversion/SimpleToMCFG/Strict.hs
new file mode 100644
index 000000000..a5519fcd8
--- /dev/null
+++ b/src-2.9/GF/Conversion/SimpleToMCFG/Strict.hs
@@ -0,0 +1,129 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- Converting SimpleGFC grammars to MCFG grammars, deterministic.
+--
+-- the resulting grammars might be /very large/
+--
+-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.SimpleToMCFG.Strict
+    (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import Control.Monad
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG 
+import GF.Formalism.MCFG 
+import GF.Formalism.SimpleGFC 
+import GF.Conversion.Types
+
+import GF.Data.BacktrackM
+import GF.Data.SortedList
+
+----------------------------------------------------------------------
+-- main conversion function
+
+type CnvMonad a = BacktrackM () a
+
+convertGrammar :: SGrammar -> EGrammar 
+convertGrammar rules = tracePrt "SimpleToMCFG.Strict - MCFG rules" (prt . length) $
+		       solutions conversion undefined
+    where conversion = member rules >>= convertRule
+
+convertRule :: SRule -> CnvMonad ERule
+convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term)))
+    = do let cat : args  = map decl2cat (decl : decls)
+	     args_ctypes = zip3 [0..] args ctypes
+	 instArgs <- mapM enumerateArg args_ctypes
+	 let instTerm = substitutePaths instArgs term
+	 newCat <- extractECat cat ctype instTerm
+	 newArgs <- mapM (extractArg instArgs) args_ctypes
+	 let linRec = strPaths ctype instTerm >>= extractLin newArgs
+	 let newLinRec = map (instantiateArgs newArgs) linRec
+	     catPaths : argsPaths = map (lintype2paths emptyPath) (ctype : ctypes)
+	 return $ Rule (Abs newCat newArgs fun) (Cnc catPaths argsPaths newLinRec) 
+convertRule _ = failure
+
+----------------------------------------------------------------------
+-- category extraction
+
+extractArg :: [STerm] -> (Int, SCat, SLinType) -> CnvMonad ECat
+extractArg args (nr, cat, ctype) = extractECat cat ctype (args !! nr)
+
+extractECat :: SCat -> SLinType -> STerm -> CnvMonad ECat
+extractECat cat ctype term = member $ map (ECat cat) $ parPaths ctype term
+
+enumerateArg :: (Int, SCat, SLinType) -> CnvMonad STerm
+enumerateArg (nr, cat, ctype) = member $ enumerateTerms (Just (Arg nr cat emptyPath)) ctype
+
+----------------------------------------------------------------------
+-- Substitute each instantiated parameter path for its instantiation
+
+substitutePaths :: [STerm] -> STerm -> STerm
+substitutePaths arguments = subst 
+    where subst (Arg nr _ path)  = termFollowPath path (arguments !! nr)
+	  subst (con :^ terms)   = con :^ map subst terms
+	  subst (Rec record)     = Rec [ (lbl, subst term) | (lbl, term) <- record ]
+	  subst (term :. lbl)    = subst term +. lbl
+	  subst (Tbl table)      = Tbl [ (pat, subst term) | 
+				      (pat, term) <- table ]
+	  subst (term :! select) = subst term +! subst select
+	  subst (term :++ term') = subst term ?++ subst term'
+	  subst (Variants terms) = Variants $ map subst terms
+	  subst term = term
+
+----------------------------------------------------------------------
+-- term paths extaction
+
+termPaths :: SLinType -> STerm -> [(SPath, (SLinType, STerm))]
+termPaths ctype (Variants terms) = terms >>= termPaths ctype
+termPaths (RecT rtype) (Rec record) 
+    = [ (path ++. lbl, value) |
+	(lbl, term) <- record,
+	let Just ctype = lookup lbl rtype,
+	(path, value) <- termPaths ctype term ]
+termPaths (TblT _ ctype) (Tbl table)
+    = [ (path ++! pat, value) |
+	(pat, term) <- table,
+	(path, value) <- termPaths ctype term ]
+termPaths ctype term | isBaseType ctype = [ (emptyPath, (ctype, term)) ]
+
+{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
+{a=a1; b=b1}  | {a=a2; b=b2}   ==>  {a=a1|a2; b=b1|b2}
+[p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
+-}
+
+parPaths :: SLinType -> STerm -> [[(SPath, STerm)]]
+parPaths ctype term = mapM (uncurry (map . (,))) $ groupPairs $
+		      nubsort [ (path, value) | 
+				(path, (ConT _, value)) <- termPaths ctype term ]
+
+strPaths :: SLinType -> STerm -> [(SPath, STerm)]
+strPaths ctype term = [ (path, variants values) | (path, values) <- groupPairs paths ]
+    where paths = nubsort [ (path, value) | (path, (StrT, value)) <- termPaths ctype term ]
+
+----------------------------------------------------------------------
+-- linearization extraction
+
+extractLin :: [ECat] -> (SPath, STerm) -> [Lin ECat MLabel Token]
+extractLin args (path, term) = map (Lin path) (convertLin term)
+    where convertLin (t1 :++ t2) = liftM2 (++) (convertLin t1) (convertLin t2)
+	  convertLin (Empty) = [[]]
+	  convertLin (Token tok) = [[Tok tok]]
+	  convertLin (Variants terms) = concatMap convertLin terms
+	  convertLin (Arg nr _ path) = [[Cat (args !! nr, path, nr)]]
+	  convertLin t = error $ "convertLin: " ++ prt t ++ "  " ++ prt (args, path)
+
diff --git a/src-2.9/GF/Conversion/TypeGraph.hs b/src-2.9/GF/Conversion/TypeGraph.hs
new file mode 100644
index 000000000..62ee9726e
--- /dev/null
+++ b/src-2.9/GF/Conversion/TypeGraph.hs
@@ -0,0 +1,58 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/16 10:21:21 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.2 $
+--
+-- Printing the type hierarchy of an abstract module in GraphViz format
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.TypeGraph (prtTypeGraph, prtFunctionGraph) where
+
+import GF.Formalism.GCFG
+import GF.Formalism.SimpleGFC
+import GF.Formalism.Utilities
+import GF.Conversion.Types
+
+import GF.Data.Operations ((++++), (+++++))
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+-- | SimpleGFC to TypeGraph
+--
+-- assumes that the profiles in the Simple GFC names are trivial
+
+prtTypeGraph :: SGrammar -> String
+prtTypeGraph rules = "digraph TypeGraph {" ++++ 
+                     "concentrate=true;" ++++
+                     "node [shape=ellipse];" +++++
+                     unlines (map prtTypeGraphRule rules) +++++
+                     "}"
+
+prtTypeGraphRule :: SRule -> String
+prtTypeGraphRule (Rule abs@(Abs cat cats (Name fun _prof)) _)
+    = "// " ++ prt abs ++++
+      unlines [ prtSCat c ++ " -> " ++ prtSCat cat ++ ";" | c <- cats ]
+
+prtFunctionGraph :: SGrammar -> String
+prtFunctionGraph rules = "digraph FunctionGraph {" ++++ 
+                         "node [shape=ellipse];" +++++
+                         unlines (map prtFunctionGraphRule rules) +++++
+                         "}"
+
+prtFunctionGraphRule :: SRule -> String
+prtFunctionGraphRule (Rule abs@(Abs cat cats (Name fun _prof)) _)
+    = "// " ++ prt abs ++++
+      pfun ++ " [label=\"" ++ prt fun ++ "\", shape=box, style=dashed];" ++++
+      pfun ++ " -> " ++ prtSCat cat ++ ";" ++++
+      unlines [ prtSCat c ++ " -> " ++ pfun ++ ";" | c <- cats ]
+    where pfun = "GF_FUNCTION_" ++ prt fun
+
+prtSCat decl = prt (decl2cat decl)
+
+
diff --git a/src-2.9/GF/Conversion/Types.hs b/src-2.9/GF/Conversion/Types.hs
new file mode 100644
index 000000000..97c2ace05
--- /dev/null
+++ b/src-2.9/GF/Conversion/Types.hs
@@ -0,0 +1,146 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/11 14:11:46 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.10 $
+--
+-- All possible instantiations of different grammar formats used in conversion from GFC
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.Types where
+
+---import GF.Conversion.FTypes
+
+import qualified GF.Infra.Ident as Ident (Ident(..), wildIdent, isWildIdent)
+import qualified GF.Canon.AbsGFC as AbsGFC (CIdent(..), Label(..))
+import qualified GF.GFCC.CId
+import qualified GF.Grammar.Grammar as Grammar (Term)
+
+import GF.Formalism.GCFG
+import GF.Formalism.SimpleGFC
+import GF.Formalism.MCFG
+import GF.Formalism.FCFG
+import GF.Formalism.CFG
+import GF.Formalism.Utilities
+import GF.Infra.Print
+import GF.Data.Assoc
+
+import Control.Monad (foldM)
+import Data.Array
+
+----------------------------------------------------------------------
+-- * basic (leaf) types
+
+-- ** input tokens
+
+type Token = String
+
+-- ** function names
+
+type Fun  = Ident.Ident
+type Name = NameProfile Fun
+
+
+----------------------------------------------------------------------
+-- * Simple GFC
+
+type SCat = Ident.Ident
+
+constr2fun :: Constr -> Fun
+constr2fun (AbsGFC.CIQ _ fun) = fun
+
+-- ** grammar types
+
+type SGrammar = SimpleGrammar SCat Name Token
+type SRule    = SimpleRule    SCat Name Token
+
+type SPath    = Path    SCat Token
+type STerm    = Term    SCat Token
+type SLinType = LinType SCat Token
+type SDecl    = Decl    SCat
+
+----------------------------------------------------------------------
+-- * erasing MCFG
+
+type EGrammar = MCFGrammar ECat Name ELabel Token
+type ERule    = MCFRule    ECat Name ELabel Token
+data ECat     = ECat SCat [Constraint]   deriving (Eq, Ord, Show)
+type ELabel   = SPath
+
+type Constraint = (SPath, STerm)
+
+-- ** type coercions etc
+
+initialECat :: SCat -> ECat
+initialECat cat = ECat cat []
+
+ecat2scat :: ECat -> SCat
+ecat2scat (ECat cat _) = cat
+
+ecatConstraints :: ECat -> [Constraint]
+ecatConstraints (ECat _ cns) = cns
+
+sameECat :: ECat -> ECat -> Bool
+sameECat ec1 ec2 = ecat2scat ec1 == ecat2scat ec2
+
+coercionName :: Name
+coercionName = Name Ident.wildIdent [Unify [0]]
+
+isCoercion :: Name -> Bool
+isCoercion (Name fun [Unify [0]]) = Ident.isWildIdent fun
+isCoercion _ = False
+
+----------------------------------------------------------------------
+-- * nonerasing MCFG
+
+type MGrammar = MCFGrammar MCat Name MLabel Token
+type MRule    = MCFRule    MCat Name MLabel Token
+data MCat     = MCat ECat [ELabel]   deriving (Eq, Ord, Show)
+type MLabel   = ELabel
+
+mcat2ecat :: MCat -> ECat
+mcat2ecat (MCat cat _) = cat
+
+mcat2scat :: MCat -> SCat
+mcat2scat = ecat2scat . mcat2ecat
+
+----------------------------------------------------------------------
+-- * fast nonerasing MCFG
+
+---- moved to FTypes by AR 20/9/2007
+
+
+----------------------------------------------------------------------
+-- * CFG
+
+type CGrammar = CFGrammar CCat Name Token
+type CRule    = CFRule    CCat Name Token
+data CCat     = CCat      ECat ELabel  deriving (Eq, Ord, Show)
+
+ccat2ecat :: CCat -> ECat
+ccat2ecat (CCat cat _) = cat
+
+ccat2scat :: CCat -> SCat
+ccat2scat = ecat2scat . ccat2ecat
+
+----------------------------------------------------------------------
+-- * pretty-printing
+
+instance Print ECat where
+    prt (ECat cat constrs) = prt cat ++ "{" ++ 
+			     concat [ prt path ++ "=" ++ prt term ++ ";" |
+				      (path, term) <- constrs ] ++ "}"
+
+instance Print MCat where
+    prt (MCat cat labels) = prt cat ++ prt labels
+
+instance Print CCat where
+    prt (CCat cat label) = prt cat ++ prt label
+
+---- instance Print FCat where ---- FCat
+
diff --git a/src-2.9/GF/Data/Assoc.hs b/src-2.9/GF/Data/Assoc.hs
new file mode 100644
index 000000000..f775319ea
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Data/BacktrackM.hs b/src-2.9/GF/Data/BacktrackM.hs
new file mode 100644
index 000000000..790d11a83
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Data/Compos.hs b/src-2.9/GF/Data/Compos.hs
new file mode 100644
index 000000000..7d46fc5a2
--- /dev/null
+++ b/src-2.9/GF/Data/Compos.hs
@@ -0,0 +1,37 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+module GF.Data.Compos (Compos(..),composOp,composM,composM_,composFold) where
+
+import Control.Applicative (Applicative(..), Const(..), WrappedMonad(..))
+import Data.Monoid (Monoid(..))
+
+class Compos t where
+  compos :: Applicative f => (forall a. t a -> f (t a)) -> t c -> f (t c)
+
+composOp :: Compos t => (forall a. t a -> t a) -> t c -> t c
+composOp f = runIdentity . compos (Identity . f)
+
+composFold :: (Monoid o, Compos t) => (forall a. t a -> o) -> t c -> o
+composFold f = getConst . compos (Const . f)
+
+composM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t c -> m (t c)
+composM f = unwrapMonad . compos (WrapMonad . f)
+
+composM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t c -> m ()
+composM_ f = unwrapMonad_ . composFold (WrapMonad_ . f)
+
+
+newtype Identity a = Identity { runIdentity :: a }
+
+instance Functor Identity where
+  fmap f (Identity x) = Identity (f x)
+
+instance Applicative Identity where
+  pure                       = Identity
+  Identity f <*> Identity x  = Identity (f x)
+
+
+newtype WrappedMonad_ m = WrapMonad_ { unwrapMonad_ :: m () }
+
+instance Monad m => Monoid (WrappedMonad_ m) where
+  mempty  = WrapMonad_ (return ())
+  WrapMonad_ x `mappend` WrapMonad_ y = WrapMonad_  (x >> y)
diff --git a/src-2.9/GF/Data/ErrM.hs b/src-2.9/GF/Data/ErrM.hs
new file mode 100644
index 000000000..e8cea12d4
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Data/GeneralDeduction.hs b/src-2.9/GF/Data/GeneralDeduction.hs
new file mode 100644
index 000000000..137212e5c
--- /dev/null
+++ b/src-2.9/GF/Data/GeneralDeduction.hs
@@ -0,0 +1,121 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:01 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.3 $
+--
+-- Simple implementation of deductive chart parsing
+-----------------------------------------------------------------------------
+
+module GF.Data.GeneralDeduction
+    (-- * Type definition
+     ParseChart,
+     -- * Main functions
+     chartLookup,
+     buildChart, buildChartM,
+     -- * Probably not needed
+     emptyChart,
+     chartMember,
+     chartInsert, chartInsertM,
+     chartList, chartKeys, chartAssocs,
+     addToChart, addToChartM
+    ) where
+
+-- import Trace 
+
+import GF.Data.RedBlackSet
+import Control.Monad (foldM)
+
+----------------------------------------------------------------------
+-- main functions
+
+chartLookup :: (Ord item, Ord key) => ParseChart item key -> key -> [item]
+chartList   :: (Ord item, Ord key) => ParseChart item key -> [item]
+chartKeys   :: (Ord item, Ord key) => ParseChart item key -> [key]
+chartAssocs :: (Ord item, Ord key) => ParseChart item key -> [(key,item)]
+buildChart  :: (Ord item, Ord key) => 
+	       (item -> key)                           -- ^ key lookup function
+	    -> [ParseChart item key -> item -> [item]] -- ^ list of inference rules as functions 
+						       -- from triggering items to lists of items
+	    -> [item]                                  -- ^ initial chart
+	    -> ParseChart item key                     -- ^ final chart
+buildChartM :: (Ord item, Ord key) => 
+	       (item -> [key])                         -- ^ many-valued key lookup function
+	    -> [ParseChart item key -> item -> [item]] -- ^ list of inference rules as functions 
+						       -- from triggering items to lists of items
+	    -> [item]                                  -- ^ initial chart
+	    -> ParseChart item key                     -- ^ final chart
+
+buildChart keyof rules axioms     = addItems axioms emptyChart
+    where addItems []             = id
+	  addItems (item:items)   = addItems items . addItem item
+          -- addItem item | trace ("+ "++show item++"\n") False = undefined
+          addItem item            = addToChart item (keyof item) 
+				    (\chart -> foldr (consequence item) chart rules)
+          consequence item rule chart = addItems (rule chart item) chart
+
+buildChartM keysof rules axioms   = addItems axioms emptyChart
+    where addItems []             = id
+	  addItems (item:items)   = addItems items . addItem item
+          -- addItem item | trace ("+ "++show item++"\n") False = undefined
+          addItem item            = addToChartM item (keysof item) 
+				    (\chart -> foldr (consequence item) chart rules)
+          consequence item rule chart = addItems (rule chart item) chart
+
+-- probably not needed
+
+emptyChart   :: (Ord item, Ord key) => ParseChart item key
+chartMember  :: (Ord item, Ord key) => ParseChart item key
+	     -> item -> key -> Bool
+chartInsert  :: (Ord item, Ord key) => ParseChart item key
+	     -> item -> key -> Maybe (ParseChart item key)
+chartInsertM :: (Ord item, Ord key) => ParseChart item key
+	     -> item -> [key] -> Maybe (ParseChart item key)
+
+addToChart  :: (Ord item, Ord key) => item -> key 
+	    -> (ParseChart item key -> ParseChart item key) 
+	    ->  ParseChart item key -> ParseChart item key
+addToChart item keys after chart = maybe chart after (chartInsert chart item keys)
+
+addToChartM :: (Ord item, Ord key) => item -> [key] 
+	    -> (ParseChart item key -> ParseChart item key) 
+	    ->  ParseChart item key -> ParseChart item key
+addToChartM item keys after chart = maybe chart after (chartInsertM chart item keys)
+
+
+--------------------------------------------------------------------------------
+-- key charts as red/black trees
+
+newtype ParseChart    item key = KC (RedBlackMap key item)
+    deriving Show
+
+emptyChart                     = KC rbmEmpty
+chartMember (KC tree) item key = rbmElem key item tree
+chartLookup (KC tree)      key = rbmLookup key tree
+chartList   (KC tree)          = concatMap snd (rbmList tree)
+chartKeys   (KC tree)          = map fst (rbmList tree)
+chartAssocs (KC tree)          = [(key,item) | (key,items) <- rbmList tree, item <- items]
+chartInsert (KC tree) item key = fmap KC (rbmInsert key item tree)
+
+chartInsertM (KC tree) item keys = fmap KC (foldM insertItem tree keys)
+    where insertItem tree key    = rbmInsert key item tree
+
+--------------------------------------------------------------------------------}
+
+
+{--------------------------------------------------------------------------------
+-- key charts as unsorted association lists -- OBSOLETE!
+
+newtype Chart          item key = SC [(key, item)]
+
+emptyChart = SC []
+chartMember (SC chart) item key = (key,item) `elem` chart
+chartInsert (SC chart) item key = if (key,item) `elem` chart then Nothing else Just (SC ((key,item):chart))
+chartLookup (SC chart)      key = [ item | (key',item) <- chart, key == key' ]
+chartList   (SC chart)          = map snd chart
+--------------------------------------------------------------------------------}
+
diff --git a/src-2.9/GF/Data/Glue.hs b/src-2.9/GF/Data/Glue.hs
new file mode 100644
index 000000000..4f276222b
--- /dev/null
+++ b/src-2.9/GF/Data/Glue.hs
@@ -0,0 +1,30 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Glue
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:02 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.7 $
+--
+-- AR 8-11-2003, using Markus Forsberg's implementation of Huet's @unglue@
+-----------------------------------------------------------------------------
+
+module GF.Data.Glue (decomposeSimple) where
+
+import GF.Data.Trie2
+import GF.Data.Operations
+import Data.List
+
+decomposeSimple :: Trie Char a -> [Char] -> Err [[Char]]
+decomposeSimple t s = do
+  let ss = map (decompose t) $ words s
+  if any null ss
+    then Bad "unknown word in input"
+    else return $ concat [intersperse "&+" ws | ws <- ss]
+
+exTrie = tcompile (zip ws ws) where 
+  ws = words "ett tv\229 tre tjugo trettio hundra tusen"
+
diff --git a/src-2.9/GF/Data/IncrementalDeduction.hs b/src-2.9/GF/Data/IncrementalDeduction.hs
new file mode 100644
index 000000000..d119610c1
--- /dev/null
+++ b/src-2.9/GF/Data/IncrementalDeduction.hs
@@ -0,0 +1,67 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.3 $
+--
+-- Implementation of /incremental/ deductive parsing,
+-- i.e. parsing one word at the time.
+-----------------------------------------------------------------------------
+
+module GF.Data.IncrementalDeduction
+    (-- * Type definitions
+     IncrementalChart,
+     -- * Functions
+     chartLookup,
+     buildChart,
+     chartList, chartKeys
+    ) where
+
+import Data.Array
+import GF.Data.SortedList
+import GF.Data.Assoc
+
+----------------------------------------------------------------------
+-- main functions 
+
+chartLookup :: (Ord item, Ord key) =>
+	       IncrementalChart item key
+	    -> Int -> key -> SList item
+
+buildChart :: (Ord item, Ord key) => 
+	      (item -> key)               -- ^ key lookup function
+	   -> (Int -> item -> SList item) -- ^ all inference rules for position k, collected
+	   -> (Int ->         SList item) -- ^ all axioms for position k, collected
+	   -> (Int, Int)                  -- ^ input bounds
+	   -> IncrementalChart item key
+
+chartList :: (Ord item, Ord key) => 
+	     IncrementalChart item key    -- ^ the final chart
+	  -> (Int -> item -> edge)        -- ^ function building an edge from 
+					  -- the position and the item
+	  -> [edge]
+
+chartKeys :: (Ord item, Ord key) => IncrementalChart item key -> Int -> [key]
+
+type IncrementalChart item key = Array Int (Assoc key (SList item))
+
+----------
+
+chartLookup chart k key = (chart ! k) ? key
+
+buildChart keyof rules axioms bounds = finalChartArray
+    where buildState k     = limit (rules k) $ axioms k
+	  finalChartList   = map buildState [fst bounds .. snd bounds]
+	  finalChartArray  = listArray bounds $ map stateAssoc finalChartList
+	  stateAssoc state = accumAssoc id [ (keyof item, item) | item <- state ]
+
+chartList chart combine = [ combine k item | 
+			    (k, state) <- assocs chart, 
+			    item <- concatMap snd $ aAssocs state ]
+
+chartKeys chart k = aElems (chart ! k)
+
diff --git a/src-2.9/GF/Data/Map.hs b/src-2.9/GF/Data/Map.hs
new file mode 100644
index 000000000..c86c9ab55
--- /dev/null
+++ b/src-2.9/GF/Data/Map.hs
@@ -0,0 +1,61 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Map
+-- Maintainer  : Markus Forsberg
+-- Stability   : Stable
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/04/21 16:22:04 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Data.Map (
+           Map,
+           empty,
+           isEmpty,	   
+	   (!), 
+	   (!+),
+	   (|->),   
+	   (|->+), 
+	   (<+>),   
+	   flatten
+	   ) where
+
+import GF.Data.RedBlack
+
+type Map key el = Tree key el
+
+infixl 6 |->
+infixl 6 |->+
+infixl 5 !
+infixl 5 !+
+infixl 4 <+>
+
+empty :: Map key el
+empty = emptyTree
+
+-- | lookup operator.
+(!) :: Ord key => Map key el -> key -> Maybe el
+(!) fm e = lookupTree e fm
+
+-- | lookupMany operator.
+(!+) :: Ord key => Map key el -> [key] -> [Maybe el]
+fm !+    []  = []
+fm !+ (e:es) = (lookupTree e fm): (fm !+ es)
+
+-- | insert operator.
+(|->) :: Ord key => (key,el) -> Map key el -> Map key el
+(x,y) |-> fm = insertTree (x,y) fm
+
+-- | insertMany operator.
+(|->+) :: Ord key => [(key,el)] -> Map key el -> Map key el
+[]         |->+ fm = fm
+((x,y):xs) |->+ fm = xs |->+ (insertTree (x,y) fm)
+
+-- | union operator.
+(<+>) :: Ord key => Map key el -> Map key el -> Map key el
+(<+>) fm1 fm2 =  xs |->+ fm2
+ where xs = flatten fm1
diff --git a/src-2.9/GF/Data/Operations.hs b/src-2.9/GF/Data/Operations.hs
new file mode 100644
index 000000000..1b2033d69
--- /dev/null
+++ b/src-2.9/GF/Data/Operations.hs
@@ -0,0 +1,658 @@
+----------------------------------------------------------------------
+-- |
+-- 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, 
+		   
+		   -- ** 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))
+
+-- | 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-2.9/GF/Data/OrdMap2.hs b/src-2.9/GF/Data/OrdMap2.hs
new file mode 100644
index 000000000..3590f0584
--- /dev/null
+++ b/src-2.9/GF/Data/OrdMap2.hs
@@ -0,0 +1,127 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : OrdMap2
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : Obsolete
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/04/21 16:22:05 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- The class of finite maps, as described in
+-- \"Pure Functional Parsing\", section 2.2.2
+-- and an example implementation,
+-- derived from appendix A.2
+--
+-- /OBSOLETE/! this is only used in module "ChartParser"
+-----------------------------------------------------------------------------
+
+module GF.Data.OrdMap2 (OrdMap(..), Map) where
+
+import Data.List (intersperse)
+
+
+--------------------------------------------------
+-- the class of ordered finite maps
+
+class OrdMap m where
+  emptyMap     :: Ord s => m s a
+  (|->)        :: Ord s => s -> a -> m s a
+  isEmptyMap   :: Ord s => m s a -> Bool
+  (?)          :: Ord s => m s a -> s -> Maybe a
+  lookupWith   :: Ord s => a -> m s a -> s -> a
+  mergeWith    :: Ord s => (a -> a -> a) -> m s a -> m s a -> m s a
+  unionMapWith :: Ord s => (a -> a -> a) -> [m s a] -> m s a
+  makeMapWith  :: Ord s => (a -> a -> a) -> [(s,a)] -> m s a
+  assocs       :: Ord s => m s a -> [(s,a)]
+  ordMap       :: Ord s => [(s,a)] -> m s a
+  mapMap       :: Ord s => (a -> b) -> m s a -> m s b
+
+  lookupWith z m s = case m ? s of
+		       Just a  -> a
+		       Nothing -> z
+
+  unionMapWith join = union
+    where union []   = emptyMap
+	  union [xs] = xs
+	  union xyss = mergeWith join (union xss) (union yss)
+	    where (xss, yss)       = split xyss
+		  split (x:y:xyss) = let (xs, ys) = split xyss in (x:xs, y:ys)
+		  split xs         = (xs, [])
+
+
+--------------------------------------------------
+-- finite maps as ordered associaiton lists, 
+-- paired with binary search trees
+
+data Map s a = Map [(s,a)] (TreeMap s a)
+
+instance (Eq s, Eq a) => Eq (Map s a) where
+  Map xs _ == Map ys _ = xs == ys
+
+instance (Show s, Show a) => Show (Map s a) where
+  show (Map ass _) = "{" ++ concat (intersperse "," (map show' ass)) ++ "}"
+    where show' (s,a) = show s ++ "|->" ++ show a
+
+instance OrdMap Map where
+  emptyMap = Map []      (makeTree [])
+  s |-> a  = Map [(s,a)] (makeTree [(s,a)])
+
+  isEmptyMap (Map ass _) = null ass
+  
+  Map _ tree ? s = lookupTree s tree
+
+  mergeWith join (Map xss _) (Map yss _) = Map xyss (makeTree xyss)
+    where xyss          = merge xss yss
+	  merge []  yss = yss
+	  merge xss []  = xss
+	  merge xss@(x@(s,x'):xss') yss@(y@(t,y'):yss')
+		= case compare s t of
+		    LT -> x : merge xss' yss
+		    GT -> y : merge xss  yss'
+		    EQ -> (s, join x' y') : merge xss' yss'
+
+  makeMapWith join []      = emptyMap
+  makeMapWith join [(s,a)] = s |-> a
+  makeMapWith join xyss    = mergeWith join (makeMapWith join xss) (makeMapWith join yss)
+    where (xss, yss)       = split xyss
+	  split (x:y:xys)  = let (xs, ys) = split xys in (x:xs, y:ys)
+	  split xs         = (xs, [])
+
+  assocs (Map xss _) = xss
+  ordMap xss         = Map xss (makeTree xss)
+
+  mapMap f (Map ass atree) = Map [ (s,f a) | (s,a) <- ass ] (mapTree f atree)
+
+
+--------------------------------------------------
+-- binary search trees
+-- for logarithmic lookup time
+
+data TreeMap s a = Nil | Node (TreeMap s a) s a (TreeMap s a)
+
+makeTree ass = tree
+  where
+    (tree,[])            = sl2bst (length ass) ass
+    sl2bst 0 ass         = (Nil, ass)
+    sl2bst 1 ((s,a):ass) = (Node Nil s a Nil, ass)
+    sl2bst n ass         = (Node ltree s a rtree, css)
+      where llen = (n-1) `div` 2
+            rlen = n - 1 - llen
+            (ltree, (s,a):bss) = sl2bst llen ass
+            (rtree, css)       = sl2bst rlen bss
+
+lookupTree s Nil = Nothing
+lookupTree s (Node left s' a right) 
+    = case compare s s' of
+        LT -> lookupTree s left 
+        GT -> lookupTree s right 
+        EQ -> Just a
+
+mapTree f Nil = Nil
+mapTree f (Node left s a right) = Node (mapTree f left) s (f a) (mapTree f right)
+
+
+
+
diff --git a/src-2.9/GF/Data/OrdSet.hs b/src-2.9/GF/Data/OrdSet.hs
new file mode 100644
index 000000000..34eb0705d
--- /dev/null
+++ b/src-2.9/GF/Data/OrdSet.hs
@@ -0,0 +1,120 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : OrdSet
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : Obsolete
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/04/21 16:22:06 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- The class of ordered sets, as described in
+-- \"Pure Functional Parsing\", section 2.2.1,
+-- and an example implementation
+-- derived from appendix A.1
+--
+-- /OBSOLETE/! this is only used in module "ChartParser"
+-----------------------------------------------------------------------------
+
+module GF.Data.OrdSet (OrdSet(..), Set) where
+
+import Data.List (intersperse)
+
+
+--------------------------------------------------
+-- the class of ordered sets
+
+class OrdSet m where
+  emptySet  :: Ord a => m a
+  unitSet   :: Ord a => a -> m a
+  isEmpty   :: Ord a => m a -> Bool
+  elemSet   :: Ord a => a -> m a -> Bool
+  (<++>)    :: Ord a => m a -> m a -> m a
+  (<\\>)    :: Ord a => m a -> m a -> m a
+  plusMinus :: Ord a => m a -> m a -> (m a, m a)
+  union     :: Ord a => [m a] -> m a
+  makeSet   :: Ord a => [a] -> m a
+  elems     :: Ord a => m a -> [a]
+  ordSet    :: Ord a => [a] -> m a
+  limit     :: Ord a => (a -> m a) -> m a -> m a
+
+  xs <++> ys      = fst (plusMinus xs ys)
+  xs <\\> ys      = snd (plusMinus xs ys)
+  plusMinus xs ys = (xs <++> ys, xs <\\> ys)
+
+  union []   = emptySet
+  union [xs] = xs
+  union xyss = union xss <++> union yss
+    where (xss, yss)       = split xyss
+	  split (x:y:xyss) = let (xs, ys) = split xyss in (x:xs, y:ys)
+	  split xs         = (xs, [])
+
+  makeSet xs = union (map unitSet xs)
+
+  limit more start = limit' (start, start)
+    where limit' (old, new)
+	      | isEmpty new' = old
+	      | otherwise    = limit' (plusMinus new' old)
+	    where new'       = union (map more (elems new))
+
+
+--------------------------------------------------
+-- sets as ordered lists, 
+-- paired with a binary tree
+
+data Set a = Set [a] (TreeSet a)
+
+instance Eq a => Eq (Set a) where
+  Set xs _ == Set ys _ = xs == ys
+
+instance Ord a => Ord (Set a) where
+  compare (Set xs _) (Set ys _) = compare xs ys
+
+instance Show a => Show (Set a) where
+  show (Set xs _) = "{" ++ concat (intersperse "," (map show xs)) ++ "}"
+
+instance OrdSet Set where
+  emptySet  = Set []  (makeTree [])
+  unitSet a = Set [a] (makeTree [a])
+
+  isEmpty   (Set xs _) = null xs
+  elemSet a (Set _ xt) = elemTree a xt
+
+  plusMinus (Set xs _) (Set ys _) = (Set ps (makeTree ps), Set ms (makeTree ms))
+    where (ps, ms) = plm xs ys
+	  plm [] ys = (ys, [])
+	  plm xs [] = (xs, xs)
+	  plm xs@(x:xs') ys@(y:ys') = case compare x y of
+				        LT -> let (ps, ms) = plm xs' ys  in (x:ps, x:ms)
+					GT -> let (ps, ms) = plm xs  ys' in (y:ps,   ms)
+					EQ -> let (ps, ms) = plm xs' ys' in (x:ps,   ms)
+
+  elems (Set xs _) = xs
+  ordSet xs        = Set xs (makeTree xs)
+
+
+--------------------------------------------------
+-- binary search trees
+-- for logarithmic lookup time
+
+data TreeSet a = Nil | Node (TreeSet a) a (TreeSet a)
+
+makeTree xs = tree
+  where (tree,[])       = sl2bst (length xs) xs
+	sl2bst 0 xs     = (Nil, xs)
+	sl2bst 1 (a:xs) = (Node Nil a Nil, xs)
+	sl2bst n xs     = (Node ltree a rtree, zs)
+          where llen    = (n-1) `div` 2
+                rlen    = n - 1 - llen
+                (ltree, a:ys) = sl2bst llen xs
+                (rtree, zs)   = sl2bst rlen ys
+
+elemTree a Nil = False
+elemTree a (Node ltree x rtree) 
+    = case compare a x of
+        LT -> elemTree a ltree 
+        GT -> elemTree a rtree 
+        EQ -> True
+
+
diff --git a/src-2.9/GF/Data/Parsers.hs b/src-2.9/GF/Data/Parsers.hs
new file mode 100644
index 000000000..f9bf02598
--- /dev/null
+++ b/src-2.9/GF/Data/Parsers.hs
@@ -0,0 +1,196 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Parsers
+-- Maintainer  : Aarne Ranta
+-- Stability   : Almost Obsolete
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/04/21 16:22:06 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- some parser combinators a la Wadler and Hutton.
+-- no longer used in many places in GF
+-- (only used in module "EBNF")
+-----------------------------------------------------------------------------
+
+module GF.Data.Parsers (-- * Main types and functions
+		Parser, parseResults, parseResultErr,
+		-- * Basic combinators (on any token type)
+		(...), (.>.), (|||), (+||), literal, (***),
+		succeed, fails, (+..), (..+), (<<<), (|>),
+		many, some, longestOfMany, longestOfSome,
+		closure,
+		-- * Specific combinators (for @Char@ token type)
+		pJunk, pJ, jL, pTList, pTJList, pElem,
+		(....), item, satisfy, literals, lits,
+		pParenth, pCommaList, pOptCommaList,
+		pArgList, pArgList2,
+		pIdent, pLetter, pDigit, pLetters,
+		pAlphanum, pAlphaPlusChar,
+		pQuotedString, pIntc
+	       ) where
+
+import GF.Data.Operations
+import Data.Char
+import Data.List
+
+
+infixr 2 |||, +||
+infixr 3 ***
+infixr 5 .>.
+infixr 5 ...
+infixr 5 ....
+infixr 5 +..
+infixr 5 ..+
+infixr 6 |>
+infixr 3 <<<
+
+
+type Parser a b = [a] -> [(b,[a])]
+
+parseResults :: Parser a b -> [a] -> [b]
+parseResults p s = [x | (x,r) <- p s, null r]
+
+parseResultErr :: Show a => Parser a b -> [a] -> Err b
+parseResultErr p s = case parseResults p s of
+  [x] -> return x
+  []  -> case 
+       maximumBy (\x y -> compare (length y) (length x)) (s:[r | (_,r) <- p s]) of
+    r -> Bad $ "\nno parse; reached" ++++ take 300 (show r)
+  _   -> Bad "ambiguous"
+
+(...) :: Parser a b -> Parser a c -> Parser a (b,c)
+(p ... q) s = [((x,y),r) | (x,t) <- p s, (y,r) <- q t]
+
+(.>.) :: Parser a b -> (b -> Parser a c) -> Parser a c
+(p .>. f) s = [(c,r) | (x,t) <- p s, (c,r) <- f x t]
+
+(|||) :: Parser a b -> Parser a b -> Parser a b
+(p ||| q) s = p s ++ q s
+
+(+||) :: Parser a b -> Parser a b -> Parser a b
+p1 +|| p2 = take 1 . (p1 ||| p2)
+
+literal :: (Eq a) => a -> Parser a a
+literal x (c:cs) = [(x,cs) | x == c]
+literal _ _ = []
+
+(***) :: Parser a b -> (b -> c) -> Parser a c
+(p *** f) s = [(f x,r) | (x,r) <- p s] 
+
+succeed :: b -> Parser a b
+succeed v s = [(v,s)]
+
+fails :: Parser a b
+fails s = []
+
+(+..) :: Parser a b -> Parser a c -> Parser a c
+p1 +.. p2 = p1 ... p2 *** snd
+
+(..+) :: Parser a b -> Parser a c -> Parser a b
+p1 ..+ p2 = p1 ... p2 *** fst
+
+(<<<) :: Parser a b -> c -> Parser a c  -- return
+p <<< v = p *** (\x -> v)
+
+(|>) :: Parser a b -> (b -> Bool) -> Parser a b
+p |> b = p .>. (\x -> if b x then succeed x else fails)
+
+many :: Parser a b -> Parser a [b]
+many p = (p ... many p *** uncurry (:)) +|| succeed []
+
+some :: Parser a b -> Parser a [b]
+some p = (p ... many p) *** uncurry (:)
+
+longestOfMany :: Parser a b -> Parser a [b]
+longestOfMany p = p .>. (\x -> longestOfMany p *** (x:)) +|| succeed []
+
+closure :: (b -> Parser a b) -> (b -> Parser a b)
+closure p v = p v .>. closure p ||| succeed v
+
+pJunk   :: Parser Char String
+pJunk = longestOfMany (satisfy (\x -> elem x "\n\t "))
+
+pJ :: Parser Char a -> Parser Char a
+pJ p = pJunk +.. p ..+ pJunk
+
+pTList  :: String -> Parser Char a -> Parser Char [a]
+pTList t p = p .... many (jL t +.. p) *** (\ (x,y) -> x:y) -- mod. AR 5/1/1999
+
+pTJList  :: String -> String -> Parser Char a -> Parser Char [a]
+pTJList t1 t2 p = p .... many (literals t1 +.. jL t2 +.. p) *** (uncurry (:))
+
+pElem   :: [String] -> Parser Char String
+pElem l = foldr (+||) fails (map literals l)
+
+(....) :: Parser Char b -> Parser Char c -> Parser Char (b,c)
+p1 .... p2 = p1 ... pJunk +.. p2
+
+item :: Parser a a
+item (c:cs) = [(c,cs)]
+item [] = []
+
+satisfy :: (a -> Bool) -> Parser a a
+satisfy b = item |> b
+
+literals :: (Eq a,Show a) => [a] -> Parser a [a]
+literals l = case l of 
+  []  -> succeed [] 
+  a:l -> literal a ... literals l *** (\ (x,y) -> x:y)
+
+lits :: (Eq a,Show a) => [a] -> Parser a [a]
+lits ts = literals ts
+
+jL :: String -> Parser Char String
+jL = pJ . lits
+
+pParenth :: Parser Char a -> Parser Char a
+pParenth p = literal '(' +.. pJunk +.. p ..+ pJunk ..+ literal ')'
+
+-- | p,...,p
+pCommaList :: Parser Char a -> Parser Char [a]
+pCommaList p = pTList "," (pJ p)                      
+
+-- | the same or nothing
+pOptCommaList :: Parser Char a -> Parser Char [a]
+pOptCommaList p = pCommaList p ||| succeed []            
+
+-- | (p,...,p), poss. empty
+pArgList :: Parser Char a -> Parser Char [a]
+pArgList p = pParenth (pCommaList p) ||| succeed [] 
+
+-- | min. 2 args
+pArgList2 :: Parser Char a -> Parser Char [a]
+pArgList2 p = pParenth (p ... jL "," +.. pCommaList p) *** uncurry (:) 
+
+longestOfSome :: Parser a b -> Parser a [b]
+longestOfSome p = (p ... longestOfMany p) *** (\ (x,y) -> x:y)
+
+pIdent :: Parser Char String
+pIdent = pLetter ... longestOfMany pAlphaPlusChar *** uncurry (:)
+  where alphaPlusChar c = isAlphaNum c || c=='_' || c=='\''
+
+pLetter, pDigit :: Parser Char Char
+pLetter = satisfy (`elem` (['A'..'Z'] ++ ['a'..'z'] ++ 
+                           ['\192' .. '\255'])) -- no such in Char
+pDigit  = satisfy isDigit
+
+pLetters :: Parser Char String
+pLetters = longestOfSome pLetter
+
+pAlphanum, pAlphaPlusChar :: Parser Char Char
+pAlphanum      = pDigit ||| pLetter
+pAlphaPlusChar = pAlphanum ||| satisfy (`elem` "_'")
+
+pQuotedString :: Parser Char String
+pQuotedString = literal '"' +.. pEndQuoted where
+ pEndQuoted =
+       literal '"' *** (const [])
+   +|| (literal '\\' +.. item .>. \ c -> pEndQuoted *** (c:))
+   +|| item .>. \ c -> pEndQuoted *** (c:)
+
+pIntc :: Parser Char Int
+pIntc = some (satisfy numb) *** read
+         where numb x = elem x ['0'..'9']
+
diff --git a/src-2.9/GF/Data/RedBlack.hs b/src-2.9/GF/Data/RedBlack.hs
new file mode 100644
index 000000000..fd70dba63
--- /dev/null
+++ b/src-2.9/GF/Data/RedBlack.hs
@@ -0,0 +1,64 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : RedBlack
+-- Maintainer  : Markus Forsberg
+-- Stability   : Stable
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/04/21 16:22:07 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- Modified version of Osanaki's implementation.
+-----------------------------------------------------------------------------
+
+module GF.Data.RedBlack (
+                emptyTree,
+		isEmpty,		
+		Tree,
+		lookupTree,
+		insertTree,
+		flatten
+		) where
+
+data Color = R | B
+ deriving (Show,Read)
+
+data Tree key el = E | T Color (Tree key el) (key,el) (Tree key el)
+ deriving (Show,Read)
+
+balance :: Color -> Tree a b -> (a,b) -> Tree a b -> Tree a b  
+balance B (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d)
+balance B (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)
+balance B a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d)
+balance B a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)
+balance color a x b = T color a x b
+
+emptyTree :: Tree key el
+emptyTree = E
+
+isEmpty :: Tree key el -> Bool
+isEmpty (E) = True
+isEmpty _   = False
+
+lookupTree :: Ord a => a -> Tree a b -> Maybe b
+lookupTree _ E = Nothing
+lookupTree x (T _ a (y,z) b)
+   | x < y      = lookupTree x a
+   | x > y      = lookupTree x b
+   | otherwise  = return z
+   
+insertTree :: Ord a => (a,b) -> Tree a b -> Tree a b
+insertTree (key,el) tree = T B a y b
+  where 
+    T _ a y b = ins tree
+    ins E = T R E (key,el) E
+    ins (T color a y@(key',el') b)
+      | key < key'    = balance color (ins a) y b
+      | key > key'    = balance color a y (ins b)
+      | otherwise     = T color a (key',el) b
+
+flatten :: Tree a b -> [(a,b)]
+flatten E = []
+flatten (T _ left (key,e) right) 
+  = (flatten left) ++ ((key,e):(flatten right))
diff --git a/src-2.9/GF/Data/RedBlackSet.hs b/src-2.9/GF/Data/RedBlackSet.hs
new file mode 100644
index 000000000..8a1b8a743
--- /dev/null
+++ b/src-2.9/GF/Data/RedBlackSet.hs
@@ -0,0 +1,150 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : RedBlackSet
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : Stable
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/03/21 14:17:39 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Modified version of Okasaki's red-black trees
+-- incorporating sets and set-valued maps
+----------------------------------------------------------------------
+
+module GF.Data.RedBlackSet ( -- * Red-black sets
+		     RedBlackSet,
+		     rbEmpty,
+		     rbList,
+		     rbElem,
+		     rbLookup,
+		     rbInsert,
+		     rbMap,
+		     rbOrdMap,
+		     -- * Red-black finite maps
+		     RedBlackMap,
+		     rbmEmpty,
+		     rbmList,
+		     rbmElem,
+		     rbmLookup,
+		     rbmInsert,
+		     rbmOrdMap
+		   ) where
+
+--------------------------------------------------------------------------------
+-- sets
+
+data Color = R | B   deriving (Eq, Show)
+data RedBlackSet a = E | T Color (RedBlackSet a) a (RedBlackSet a)
+		     deriving (Eq, Show)
+
+rbBalance B (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d)
+rbBalance B (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)
+rbBalance B a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d)
+rbBalance B a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)
+rbBalance color a x b = T color a x b
+
+rbBlack (T _ a x b) = T B a x b
+
+-- | the empty set
+rbEmpty :: RedBlackSet a
+rbEmpty = E
+
+-- | the elements of a set as a sorted list
+rbList :: RedBlackSet a -> [a]
+rbList tree = rbl tree []
+  where rbl E = id
+	rbl (T _ left a right) = rbl right . (a:) . rbl left
+
+-- | checking for containment
+rbElem :: Ord a => a -> RedBlackSet a -> Bool
+rbElem _ E = False
+rbElem a (T _ left a' right)
+    = case compare a a' of
+        LT -> rbElem a left
+	GT -> rbElem a right
+	EQ -> True
+
+-- | looking up a key in a set of keys and values
+rbLookup :: Ord k => k -> RedBlackSet (k, a) -> Maybe a
+rbLookup _ E = Nothing
+rbLookup a (T _ left (a',b) right)
+    = case compare a a' of
+        LT -> rbLookup a left
+	GT -> rbLookup a right
+	EQ -> Just b
+
+-- | inserting a new element.
+-- returns 'Nothing' if the element is already contained
+rbInsert :: Ord a => a -> RedBlackSet a -> Maybe (RedBlackSet a)
+rbInsert value tree = fmap rbBlack (rbins tree)
+  where rbins E = Just (T R E value E)
+	rbins (T color left value' right)
+	    = case compare value value' of
+                LT -> do left' <- rbins left
+			 return (rbBalance color left' value' right)
+		GT -> do right' <- rbins right
+			 return (rbBalance color left value' right')
+		EQ -> Nothing
+
+-- | mapping each value of a key-value set 
+rbMap :: (a -> b) -> RedBlackSet (k, a) -> RedBlackSet (k, b)
+rbMap f E = E
+rbMap f (T color left (key, value) right) 
+    = T color (rbMap f left) (key, f value) (rbMap f right)
+
+-- | mapping each element to another type.
+-- /observe/ that the mapping function needs to preserve 
+-- the order between objects
+rbOrdMap :: (a -> b) -> RedBlackSet a -> RedBlackSet b
+rbOrdMap f E = E
+rbOrdMap f (T color left value right) 
+    = T color (rbOrdMap f left) (f value) (rbOrdMap f right)
+
+----------------------------------------------------------------------
+-- finite maps
+
+type RedBlackMap k a = RedBlackSet (k, RedBlackSet a)
+
+-- | the empty map
+rbmEmpty :: RedBlackMap k a
+rbmEmpty = E
+
+-- | converting a map to a key-value list, sorted on the keys,
+-- and for each key, a sorted list of values
+rbmList :: RedBlackMap k a -> [(k, [a])]
+rbmList tree = [ (k, rbList sub) | (k, sub) <- rbList tree ]
+
+-- | checking whether a key-value pair is contained in the map
+rbmElem :: (Ord k, Ord a) => k -> a -> RedBlackMap k a -> Bool
+rbmElem key value = maybe False (rbElem value) . rbLookup key 
+
+-- | looking up a key, returning a (sorted) list of all matching values
+rbmLookup :: Ord k => k -> RedBlackMap k a -> [a]
+rbmLookup key = maybe [] rbList . rbLookup key 
+
+-- | inserting a key-value pair.
+-- returns 'Nothing' if the pair is already contained in the map
+rbmInsert :: (Ord k, Ord a) => k -> a -> RedBlackMap k a -> Maybe (RedBlackMap k a)
+rbmInsert key value tree = fmap rbBlack (rbins tree)
+  where rbins E = Just (T R E (key, T B E value E) E)
+	rbins (T color left item@(key', vtree) right)
+	    = case compare key key' of
+                LT -> do left' <- rbins left
+			 return (rbBalance color left' item right)
+		GT -> do right' <- rbins right
+			 return (rbBalance color left item right')
+		EQ -> do vtree' <- rbInsert value vtree
+			 return (T color left (key', vtree') right)
+
+-- | mapping each value to another type.
+-- /observe/ that the mapping function needs to preserve
+-- order between objects
+rbmOrdMap :: (a -> b) -> RedBlackMap k a -> RedBlackMap k b
+rbmOrdMap f E = E
+rbmOrdMap f (T color left (key, tree) right) 
+    = T color (rbmOrdMap f left) (key, rbOrdMap f tree) (rbmOrdMap f right)
+
+
+
diff --git a/src-2.9/GF/Data/SharedString.hs b/src-2.9/GF/Data/SharedString.hs
new file mode 100644
index 000000000..9d037b512
--- /dev/null
+++ b/src-2.9/GF/Data/SharedString.hs
@@ -0,0 +1,19 @@
+
+module GF.Data.SharedString (shareString) where
+
+import Data.HashTable as H
+import System.IO.Unsafe (unsafePerformIO)
+
+{-# NOINLINE stringPool #-}
+stringPool :: HashTable String String
+stringPool = unsafePerformIO $ new (==) hashString
+
+{-# NOINLINE shareString #-}
+shareString :: String -> String
+shareString s = unsafePerformIO $ do
+    mv <- H.lookup stringPool s
+    case mv of
+	    Just s' -> return s'
+	    Nothing -> do
+		       H.insert stringPool s s
+		       return s
diff --git a/src-2.9/GF/Data/SortedList.hs b/src-2.9/GF/Data/SortedList.hs
new file mode 100644
index 000000000..d77ff68d4
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Data/Str.hs b/src-2.9/GF/Data/Str.hs
new file mode 100644
index 000000000..6f65764c7
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Data/Trie.hs b/src-2.9/GF/Data/Trie.hs
new file mode 100644
index 000000000..9fb5daa27
--- /dev/null
+++ b/src-2.9/GF/Data/Trie.hs
@@ -0,0 +1,129 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Trie
+-- Maintainer  : Markus Forsberg
+-- Stability   : Obsolete
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/04/21 16:22:09 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Data.Trie (
+             tcompile,
+	     collapse,
+             Trie,
+	     trieLookup,
+	     decompose,
+             Attr,
+             atW, atP, atWP
+	    ) where
+
+import GF.Data.Map
+
+--- data Attr = W | P | WP deriving Eq
+type Attr = Int
+
+atW, atP, atWP :: Attr
+(atW,atP,atWP) = (0,1,2)
+
+newtype TrieT = TrieT ([(Char,TrieT)],[(Attr,String)])
+
+newtype Trie = Trie (Map Char Trie, [(Attr,String)])
+
+emptyTrie = TrieT ([],[])
+
+optimize :: TrieT -> Trie
+optimize (TrieT (xs,res)) = Trie ([(c,optimize t) | (c,t) <- xs] |->+ empty,
+				  res)
+
+collapse :: Trie -> [(String,[(Attr,String)])]
+collapse trie = collapse' trie []
+  where collapse' (Trie (map,(x:xs))) s = if (isEmpty map) then [(reverse s,(x:xs))]
+	                                   else (reverse s,(x:xs)):
+					    concat [ collapse' trie (c:s) | (c,trie) <- flatten map]
+	collapse' (Trie (map,[])) s
+	 = concat [ collapse' trie (c:s) | (c,trie) <- flatten map]
+
+tcompile :: [(String,[(Attr,String)])] -> Trie
+tcompile xs = optimize $ build xs emptyTrie
+
+build :: [(String,[(Attr,String)])] -> TrieT -> TrieT
+build []     trie = trie
+build (x:xs) trie = build xs (insert x trie)
+ where 
+  insert ([],ys)     (TrieT (xs,res)) = TrieT (xs,ys ++ res)
+  insert ((s:ss),ys) (TrieT (xs,res)) 
+    = case (span (\(s',_) -> s' /= s) xs) of
+       (xs,[])          -> TrieT (((s,(insert (ss,ys) emptyTrie)):xs),res)
+       (xs,(y,trie):zs) -> TrieT (xs ++ ((y,insert (ss,ys) trie):zs),res)
+
+trieLookup :: Trie -> String -> (String,[(Attr,String)])
+trieLookup trie s = apply trie s s
+
+apply :: Trie -> String -> String -> (String,[(Attr,String)])
+apply (Trie (_,res)) [] inp = (inp,res)
+apply (Trie (map,_)) (s:ss) inp
+ = case map ! s of
+    Just trie -> apply trie ss inp
+    Nothing   -> (inp,[])
+
+-- Composite analysis (Huet's unglue algorithm)
+-- only legaldecompositions are accepted.
+-- With legal means that the composite forms are ordered correctly
+-- with respect to the attributes W,P and WP.
+
+-- Composite analysis
+
+testTrie = tcompile [("flick",[(atP,"P")]),("knopp",[(atW,"W")]),("flaggstångs",[(atWP,"WP")])]
+
+decompose :: Trie -> String -> [String]
+decompose trie sentence = legal trie $ backtrack [(sentence,[])] trie
+
+--  The function legal checks if the decomposition is in fact a possible one.
+
+legal :: Trie -> [String] -> [String]
+legal _    []    = []
+legal trie input = if (test (map ((map fst).snd.(trieLookup trie)) input)) then input else []
+ where
+  test []       = False
+  test [xs]     = elem atW xs || elem atWP xs
+  test (xs:xss) = (elem atP xs || elem atWP xs) && test xss
+
+react :: String -> [String] -> [(String,[String])] -> String -> Trie -> Trie -> [String]
+react input output back occ (Trie (arcs,res)) init = 
+    case res of -- Accept = non-empty res.
+     [] -> continue back
+     _ -> let pushout = (occ:output)
+	    in case input of 
+	        [] -> reverse $ map reverse pushout
+		_ -> let pushback = ((input,pushout):back)
+		      in continue pushback
+ where continue cont = case input of
+		        []       -> backtrack cont init
+			(l:rest) -> case arcs ! l of
+				     Just trie -> 
+					 react rest output cont (l:occ) trie init
+				     Nothing -> backtrack cont init
+
+backtrack :: [(String,[String])] -> Trie -> [String]
+backtrack [] _  = []
+backtrack ((input,output):back) trie 
+    = react input output back [] trie trie
+
+{-
+--  The function legal checks if the decomposition is in fact a possible one.
+legal :: Trie -> [String] -> [String]
+legal _    []    = [] 
+legal trie input 
+  | test $ 
+     map ((map fst).snd.(trieLookup trie)) input =  input
+  | otherwise                                    = []
+ where -- test checks that the Attrs are in the correct order.
+  test []       = False -- This case should never happen.
+  test [xs]     = elem W xs || elem WP xs 
+  test (xs:xss) = (elem P xs || elem WP xs) && test xss
+-}
diff --git a/src-2.9/GF/Data/Trie2.hs b/src-2.9/GF/Data/Trie2.hs
new file mode 100644
index 000000000..36fcc3221
--- /dev/null
+++ b/src-2.9/GF/Data/Trie2.hs
@@ -0,0 +1,120 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Trie2
+-- Maintainer  : Markus Forsberg
+-- Stability   : Stable
+-- Portability : Haskell 98
+--
+-- > CVS $Date: 2005/04/21 16:22:10 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.7 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Data.Trie2 (
+             tcompile,
+	     collapse,
+             Trie,
+	     trieLookup,
+	     decompose,
+            --- Attr, atW, atP, atWP,
+             emptyTrie
+	    ) where
+
+import GF.Data.Map
+import Data.List
+
+newtype TrieT a b = TrieT ([(a,TrieT a b)],[b])
+
+newtype Trie a b = Trie (Map a (Trie a b), [b])
+
+emptyTrieT = TrieT ([],[])
+
+emptyTrie :: Trie a b
+emptyTrie = Trie (empty,[])
+
+optimize :: (Ord a,Eq b) => TrieT a b -> Trie a b
+optimize (TrieT (xs,res)) = Trie ([(c,optimize t) | (c,t) <- xs] |->+ empty,
+				  nub res) --- nub by AR
+
+collapse :: Ord a => Trie a b -> [([a],[b])]
+collapse trie = collapse' trie []
+  where collapse' (Trie (map,(x:xs))) s = if (isEmpty map) then [(reverse s,(x:xs))]
+	                                   else (reverse s,(x:xs)):
+					    concat [ collapse' trie (c:s) | (c,trie) <- flatten map]
+	collapse' (Trie (map,[])) s
+	 = concat [ collapse' trie (c:s) | (c,trie) <- flatten map]
+
+tcompile :: (Ord a,Eq b) => [([a],[b])] -> Trie a b
+tcompile xs = optimize $ build xs emptyTrieT
+
+build :: Ord a => [([a],[b])] -> TrieT a b -> TrieT a b
+build []     trie = trie
+build (x:xs) trie = build xs (insert x trie)
+ where 
+  insert ([],ys)     (TrieT (xs,res)) = TrieT (xs,ys ++ res)
+  insert ((s:ss),ys) (TrieT (xs,res)) 
+    = case (span (\(s',_) -> s' /= s) xs) of
+       (xs,[])          -> TrieT (((s,(insert (ss,ys) emptyTrieT)):xs),res)
+       (xs,(y,trie):zs) -> TrieT (xs ++ ((y,insert (ss,ys) trie):zs),res)
+
+trieLookup :: Ord a => Trie a b -> [a] -> ([a],[b])
+trieLookup trie s = apply trie s s
+
+apply :: Ord a => Trie a b -> [a] -> [a] -> ([a],[b])
+apply (Trie (_,res)) [] inp = (inp,res)
+apply (Trie (map,_)) (s:ss) inp
+ = case map ! s of
+    Just trie -> apply trie ss inp
+    Nothing   -> (inp,[])
+
+-----------------------------
+-- from Trie for strings; simplified for GF by making binding always possible (AR)
+
+decompose :: Ord a => Trie a b -> [a] -> [[a]]
+decompose trie sentence = backtrack [(sentence,[])] trie
+
+react :: Ord a => [a] -> [[a]] -> [([a],[[a]])] -> 
+                    [a] -> Trie a b -> Trie a b -> [[a]]
+-- String -> [String] -> [(String,[String])] -> String -> Trie -> Trie -> [String]
+react input output back occ (Trie (arcs,res)) init = 
+    case res of -- Accept = non-empty res.
+     [] -> continue back
+     _ -> let pushout = (occ:output)
+	    in case input of 
+	        [] -> reverse $ map reverse pushout
+		_ -> let pushback = ((input,pushout):back)
+		      in continue pushback
+ where continue cont = case input of
+		        []       -> backtrack cont init
+			(l:rest) -> case arcs ! l of
+				     Just trie -> 
+					 react rest output cont (l:occ) trie init
+				     Nothing -> backtrack cont init
+
+backtrack :: Ord a => [([a],[[a]])] -> Trie a b -> [[a]]
+backtrack [] _  = []
+backtrack ((input,output):back) trie 
+    = react input output back [] trie trie
+
+
+{- so this is not needed from the original
+type Attr = Int
+
+atW, atP, atWP :: Attr
+(atW,atP,atWP) = (0,1,2)
+
+decompose :: Ord a => Trie a (Int,b) -> [a] -> [[a]]
+decompose trie sentence = legal trie $ backtrack [(sentence,[])] trie
+
+--  The function legal checks if the decomposition is in fact a possible one.
+
+legal :: Ord a => Trie a (Int,b) -> [[a]] -> [[a]]
+legal _    []    = []
+legal trie input = if (test (map ((map fst).snd.(trieLookup trie)) input)) then input else []
+ where
+  test []       = False
+  test [xs]     = elem atW xs || elem atWP xs
+  test (xs:xss) = (elem atP xs || elem atWP xs) && test xss
+-}
diff --git a/src-2.9/GF/Data/Utilities.hs b/src-2.9/GF/Data/Utilities.hs
new file mode 100644
index 000000000..74d3ef81e
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Data/XML.hs b/src-2.9/GF/Data/XML.hs
new file mode 100644
index 000000000..a1807adcc
--- /dev/null
+++ b/src-2.9/GF/Data/XML.hs
@@ -0,0 +1,57 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : XML
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- 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 '<'  = "&lt;"
+  escChar '>'  = "&gt;"
+  escChar '&'  = "&amp;"
+  escChar '"'  = "&quot;"
+  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-2.9/GF/Data/Zipper.hs b/src-2.9/GF/Data/Zipper.hs
new file mode 100644
index 000000000..a4491f76e
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Devel/AbsCompute.hs b/src-2.9/GF/Devel/AbsCompute.hs
new file mode 100644
index 000000000..a55fbc83f
--- /dev/null
+++ b/src-2.9/GF/Devel/AbsCompute.hs
@@ -0,0 +1,145 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : AbsCompute
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/02 20:50:19 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.8 $
+--
+-- computation in abstract syntax w.r.t. explicit definitions.
+--
+-- old GF computation; to be updated
+-----------------------------------------------------------------------------
+
+module GF.Devel.AbsCompute (LookDef,
+		   compute, 
+		   computeAbsTerm, 
+		   computeAbsTermIn, 
+		   beta
+		  ) where
+
+import GF.Data.Operations
+
+import GF.Grammar.Abstract
+import GF.Grammar.PrGrammar
+import GF.Grammar.LookAbs
+import GF.Devel.Compute
+
+import Debug.Trace
+import Data.List(intersperse)
+import Control.Monad (liftM, liftM2)
+
+-- for debugging
+tracd m t = t 
+-- tracd = trace
+
+compute :: GFCGrammar -> Exp -> Err Exp
+compute = computeAbsTerm
+
+computeAbsTerm :: GFCGrammar -> Exp -> Err Exp
+computeAbsTerm gr = computeAbsTermIn (lookupAbsDef gr) []
+
+-- | a hack to make compute work on source grammar as well
+type LookDef = Ident -> Ident -> Err (Maybe Term)
+
+computeAbsTermIn :: LookDef -> [Ident] -> Exp -> Err Exp
+computeAbsTermIn lookd xs e = errIn ("computing" +++ prt e) $ compt xs e where
+  compt vv t = case t of
+--    Prod x a b  -> liftM2 (Prod x) (compt vv a) (compt (x:vv) b)
+--    Abs x b     -> liftM  (Abs  x)              (compt (x:vv) b)
+    _ -> do
+      let t' = beta vv t
+      (yy,f,aa) <- termForm t'
+      let vv' = yy ++ vv
+      aa'    <- mapM (compt vv') aa
+      case look f of
+        Just (Eqs eqs) -> tracd ("\nmatching" +++ prt f) $ 
+                          case findMatch eqs aa' of
+          Ok (d,g) -> do
+            --- let (xs,ts) = unzip g
+            --- ts' <- alphaFreshAll vv' ts
+            let g' = g --- zip xs ts'
+            d' <- compt vv' $ substTerm vv' g' d
+            tracd ("by Egs:" +++ prt d') $ return $ mkAbs yy $ d'
+          _ -> tracd ("no match" +++ prt t') $ 
+               do
+            let v = mkApp f aa'
+            return $ mkAbs yy $ v
+        Just d -> tracd ("define" +++ prt t') $ do
+          da <- compt vv' $ mkApp d aa' 
+          return $ mkAbs yy $ da
+        _ -> do
+          let t2 = mkAbs yy $ mkApp f aa'
+          tracd ("not defined" +++ prt_ t2) $ return t2
+
+  look t = case t of
+     (Q m f) -> case lookd m f of
+       Ok (Just EData) -> Nothing  -- canonical --- should always be QC
+       Ok md -> md
+       _ -> Nothing
+     Eqs _ -> return t ---- for nested fn
+     _ -> Nothing
+
+beta :: [Ident] -> Exp -> Exp
+beta vv c = case c of
+  Let (x,(_,a)) b -> beta vv $ substTerm vv [(x,beta vv a)] (beta (x:vv) b) 
+  App f         a -> 
+    let (a',f') = (beta vv a, beta vv f) in 
+    case f' of
+      Abs x b -> beta vv $ substTerm vv [(x,a')] (beta (x:vv) b) 
+      _ ->               (if a'==a && f'==f then id else beta vv) $ App f' a'
+  Prod x a b      -> Prod x (beta vv a) (beta (x:vv) b)
+  Abs x b         -> Abs x (beta (x:vv) b)
+  _               -> c
+
+-- special version of pattern matching, to deal with comp under lambda
+
+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 (tracd ("value" +++ prt_ val) val, concat substs)
+     _         -> findMatch cc terms
+
+tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
+tryMatch (p,t) = do 
+  t' <- termForm t
+  trym p t'
+ where
+
+  trym p t' = err (\s -> tracd s (Bad s)) (\t -> tracd (prtm p t) (return t)) $ ---- 
+              case (p,t') of
+    (PV IW, _) | notMeta t -> return [] -- optimization with wildcard
+    (PV x,  _) | notMeta t -> 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?
+    (PP q p pp, ([], QC r f, tt)) | 
+       p `eqStrIdent` f && length pp == length tt -> do
+         matches <- mapM tryMatch (zip pp tt)
+         return (concat matches)
+    (PP q p pp, ([], Q r f, tt)) | 
+       p `eqStrIdent` f && length pp == length tt -> do
+         matches <- mapM tryMatch (zip pp tt)
+         return (concat matches)
+    (PT _ p',_) -> trym p' t'
+    (_, ([],Alias _ _ d,[])) -> tryMatch (p,d)
+    (PAs x p',_) -> do
+       subst <- trym p' t'
+       return $ (x,t) : subst
+    _ -> Bad ("no match in pattern" +++ prt p +++ "for" +++ prt t)
+
+  notMeta e = case e of
+    Meta _  -> False
+    App f a -> notMeta f &&  notMeta a  
+    Abs _ b -> notMeta b
+    _ -> True
+
+  prtm p g = 
+    prt p +++ ":" ++++ unwords ["  " ++ prt_ x +++ "=" +++ prt_ y +++ ";" | (x,y) <- g]
diff --git a/src-2.9/GF/Devel/Arch.hs b/src-2.9/GF/Devel/Arch.hs
new file mode 100644
index 000000000..dedb1b4f5
--- /dev/null
+++ b/src-2.9/GF/Devel/Arch.hs
@@ -0,0 +1,89 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Arch
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/10 14:55:01 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- architecture\/compiler dependent definitions for unix\/hbc
+-----------------------------------------------------------------------------
+
+module GF.Devel.Arch (
+ myStdGen, prCPU, selectLater, modifiedFiles, ModTime, getModTime,getNowTime,
+ welcomeArch, laterModTime) where
+
+import System.Time
+import System.Random
+import System.CPUTime
+import Control.Monad (filterM)
+import System.Directory
+
+
+---- import qualified UnicodeF as U --(fudlogueWrite)
+
+-- architecture/compiler dependent definitions for unix/hbc
+
+myStdGen :: Int -> IO StdGen ---
+--- myStdGen _ = newStdGen --- gives always the same result
+myStdGen int0 = do
+  t0  <- getClockTime 
+  cal <- toCalendarTime t0 
+  let int = int0 + ctSec cal + fromInteger (div (ctPicosec cal) 10000000)
+  return $ mkStdGen int
+
+prCPU :: Integer -> IO Integer
+prCPU cpu = do 
+  cpu' <- getCPUTime
+  putStrLn (show ((cpu' - cpu) `div` 1000000000) ++ " msec")
+  return cpu'
+
+welcomeArch :: String
+welcomeArch = "This is the system compiled with ghc."
+
+-- | selects the one with the later modification time of two
+selectLater :: FilePath -> FilePath -> IO FilePath
+selectLater x y = do
+  ex <- doesFileExist x
+  if not ex 
+    then return y --- which may not exist
+    else do
+      ey <- doesFileExist y
+      if not ey 
+        then return x
+        else do 
+          tx <- getModificationTime x
+          ty <- getModificationTime y
+          return $ if tx < ty then y else x
+
+-- | a file is considered modified also if it has not been read yet
+--
+-- new 23\/2\/2004: the environment ofs has just module names
+modifiedFiles :: [(FilePath,ModTime)] -> [FilePath] -> IO [FilePath]
+modifiedFiles ofs fs = do
+  filterM isModified fs
+ where
+  isModified file = case lookup (justModName file) ofs of
+    Just to -> do
+      t <- getModificationTime file
+      return $ to < t
+    _ -> return True
+
+  justModName = 
+    reverse . takeWhile (/='/') . tail . dropWhile (/='.') . reverse
+
+type ModTime = ClockTime
+
+laterModTime :: ModTime -> ModTime -> Bool
+laterModTime = (>)
+
+getModTime :: FilePath -> IO (Maybe ModTime)
+getModTime f = do
+  b <- doesFileExist f
+  if b then (getModificationTime f >>= return . Just) else return Nothing
+
+getNowTime :: IO ModTime
+getNowTime = getClockTime
diff --git a/src-2.9/GF/Devel/CheckGrammar.hs b/src-2.9/GF/Devel/CheckGrammar.hs
new file mode 100644
index 000000000..0910802d1
--- /dev/null
+++ b/src-2.9/GF/Devel/CheckGrammar.hs
@@ -0,0 +1,1090 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.CheckGrammar (
+  showCheckModule, justCheckLTerm, allOperDependencies, topoSortOpers) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Modules
+import GF.Grammar.Refresh ----
+
+import GF.Devel.TypeCheck
+import GF.Grammar.Values (cPredefAbs) ---
+
+import GF.Grammar.PrGrammar
+import GF.Grammar.Lookup
+import GF.Grammar.LookAbs
+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)
+
+-- | 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@(Module mt st fs me ops js) -> do
+    checkRestrictedInheritance ms (name, mo)
+    js' <- case mt of
+      MTAbstract -> mapMTree (checkAbsInfo gr name) js
+
+      MTTransfer a b -> mapMTree (checkAbsInfo gr name) js
+
+      MTResource -> mapMTree (checkResInfo gr name) js
+
+      MTConcrete a -> do
+        checkErr $ topoSortOpers $ allOperDependencies name js
+        ModMod abs <- checkErr $ lookupModule gr a
+        js1 <- checkCompleteGrammar abs mo
+        mapMTree (checkCncInfo gr name (a,abs)) js1
+
+      MTInterface -> mapMTree (checkResInfo gr name) js
+
+      MTInstance a -> do
+        ModMod abs <- checkErr $ lookupModule gr a
+        -- checkCompleteInstance abs mo -- this is done in Rebuild
+        mapMTree (checkResInfo gr name) js
+
+    return $ (name, ModMod (Module mt st fs me ops 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 -> (Ident,Info) -> Check (Ident,Info)
+checkAbsInfo st m (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 $ prtBad (unlines ss ++++ "in" +++ cat) c
+   ---- temporary solution when tc of defs is incomplete
+   mkCheckWarn cat ss = case ss of
+     [] -> return (c,info)
+     ["[]"] -> return (c,info) ----
+     _  -> checkWarn (unlines ss ++++ "in" +++ cat +++ prt c) >> return (c,info)
+   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 -> (Ident,Info) -> Check (Ident,Info)
+checkResInfo gr mo (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 tysts -> chIn "overloading" $ do
+      tysts' <- mapM (uncurry $ flip check) tysts
+      let tysts2 = [(y,x) | (x,y) <- tysts']
+      --- 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 tysts2)
+
+    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 +++ ":")
+   comp = computeLType gr
+
+   checkUniq xss = case xss of
+     x:y:xs 
+      | x == y -> raise $ "ambiguous for argument list" +++ 
+                         unwords (map (prtType gr) x)  
+      | otherwise -> checkUniq $ y:xs
+     _ -> return ()
+
+
+checkCncInfo :: SourceGrammar -> Ident -> (Ident,SourceAbs) -> 
+                (Ident,Info) -> Check (Ident,Info)
+checkCncInfo gr m (a,abs) (c,info) = do
+  checkReservedId c
+  case info of
+
+    CncFun _ (Yes trm) mpr -> chIn "linearization of" $ do
+      typ        <- checkErr $ lookupFunTypeSrc 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 $ lookupCatContextSrc 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 (c,info)
+
+ where
+   env = gr
+   infer = inferLType gr
+   comp = computeLType gr 
+   check = checkLType gr
+   chIn cat = checkIn ("Happened in" +++ cat +++ prt 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
+
+    App (Q (IC "Predef") (IC "Ints")) _ -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Int")          -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Float")        -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Error")        -> return ty ---- shouldn't be needed
+
+    Q m c | elem c [cPredef,cPredefAbs] -> return ty
+    Q m c | elem c [zIdent "Int"] -> 
+      return $ linTypeInt
+    Q m c | elem c [zIdent "Float",zIdent "String"] -> return defLinType ----
+
+    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' = sortBy (\x y -> compare (fst x) (fst y)) 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 (sortBy (\ x y -> compare (fst x) (fst y)) 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
+     ,
+{-
+     do
+       over <- getOverload gr Nothing trm
+       case over of
+         Just trty -> return trty
+         _ -> prtFail "not overloaded" trm
+     ,
+-}
+     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 checkWarn ("WARNING: space in token \"" ++ s ++ 
+                        "\". Lexical analysis may fail.")
+        else return ()
+     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 (IC "#conflict") : ts) -> 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 t = case appForm t 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
+
+     case [vf | vf@(v,f) <- vfs, matchVal mt v] of
+       [(val,fun)] -> return (mkApp fun tts, val)
+       [] -> 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
+
+      ----  ++++ "DEBUG" +++ unwords (map show tys) +++ ";" 
+      ----  ++++ unlines (map (show . fst) typs) ----
+
+       vfs' -> case [(v,f) | (v,f) <- vfs', noProd v] of
+         [(val,fun)] -> do
+           checkWarn $ "WARNING: overloading of" +++ prt f +++ 
+             "resolved by excluding partial applications:" ++++
+             unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
+           return (mkApp fun tts, val)
+
+         _ -> raise $ "ambiguous overloading of" +++ prt f +++
+           "for" +++ unwords (map (prtType env) tys) ++++ "with alternatives" ++++ 
+           unlines [prtType env ty | (ty,_) <- vfs']
+
+   matchVal mt v = elem mt ([Nothing,Just v] ++ unlocked) where
+     unlocked = case v of
+       RecType fs -> [Just $ RecType $ filter (not . isLockLabel . fst) fs]
+       _ -> []
+   ---- TODO: accept subtypes
+   ---- TODO: use a trie
+   lookupOverloadInstance tys typs = 
+     [(mkFunType rest val, t) | 
+       let lt = length tys,
+       (ty,(val,t)) <- typs, length ty >= lt,
+       let (pre,rest) = splitAt lt ty, 
+       pre == tys
+     ]
+
+   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
+     (_,Q (IC "Predef") (IC "Error")) -> 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
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        Q (IC "Predef") (IC "Int"))                 -> True ---- check size!
+     
+     (Q (IC "Predef") (IC "Int"),  ---- why this ???? AR 11/12/2005
+        App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
+
+     ---- 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-2.9/GF/Devel/CheckM.hs b/src-2.9/GF/Devel/CheckM.hs
new file mode 100644
index 000000000..d26dbc07c
--- /dev/null
+++ b/src-2.9/GF/Devel/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.Devel.CheckM (Check,
+	       checkError, checkCond, checkWarn, checkUpdate, checkInContext,
+	       checkUpdates, checkReset, checkResets, checkGetContext, 
+	       checkLookup, checkStart, checkErr, checkVal, checkIn, 
+	       prtFail
+	      ) where
+
+import GF.Data.Operations
+import GF.Devel.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Devel.Grammar.PrGF
+
+-- | 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-2.9/GF/Devel/Compile.hs b/src-2.9/GF/Devel/Compile.hs
new file mode 100644
index 000000000..0655913e1
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile.hs
@@ -0,0 +1,203 @@
+module GF.Devel.Compile (batchCompile) where
+
+-- the main compiler passes
+import GF.Devel.GetGrammar
+import GF.Compile.Extend
+import GF.Compile.Rebuild
+import GF.Compile.Rename
+import GF.Grammar.Refresh
+import GF.Devel.CheckGrammar
+import GF.Devel.Optimize
+--import GF.Compile.Evaluate ----
+import GF.Devel.OptimizeGF
+--import GF.Canon.Share
+--import GF.Canon.Subexpressions (elimSubtermsMod,unSubelimModule)
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Infra.CompactPrint
+import GF.Devel.PrGrammar
+import GF.Compile.Update
+import GF.Grammar.Lookup
+import GF.Infra.Modules
+import GF.Devel.ReadFiles
+
+import GF.Source.GrammarToSource
+import qualified GF.Source.AbsGF as A
+import qualified GF.Source.PrintGF as P
+
+import GF.Data.Operations
+import GF.Devel.UseIO
+import GF.Devel.Arch
+
+import Control.Monad
+import System.Directory
+import System.FilePath
+import System.Time
+import qualified Data.Map as Map
+
+batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
+batchCompile opts files = do
+  (_,gr,_) <- foldM (compileModule defOpts) emptyCompileEnv files
+  return gr
+  where
+    defOpts = addOptions opts (options [emitCode])
+
+-- to output an intermediate stage
+intermOut :: Options -> Option -> String -> IOE ()
+intermOut opts opt s = if oElem opt opts then 
+  ioeIO (putStrLn ("\n\n--#" +++ prOpt opt) >> putStrLn s) 
+  else return ()
+
+prMod :: SourceModule -> String
+prMod = compactPrint . prModule
+
+
+-- | 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 -> CompileEnv -> FilePath -> IOE CompileEnv
+compileModule opts1 env file = do
+  opts0 <- ioeIO $ getOptionsFromFile file
+  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
+  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
+  let opts = addOptions opts1 opts0 
+  let fpath = dropFileName file
+  ps0 <- ioeIO $ pathListOpts opts fpath
+
+  let ps1 = if (useFileOpt && not useLineOpt) 
+              then (ps0 ++ map (combine fpath) ps0)
+              else ps0
+  ps <- ioeIO $ extendPathEnv ps1
+  let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
+  ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
+  let (_,sgr,rfs) = env
+  let file' = if useFileOpt then takeFileName file else file -- to find file itself
+  files <- getAllFiles opts ps rfs file'
+  ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
+  let names = map justModuleName files
+  ioeIOIf $ putStrLn $ "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 putp s = putPointE opts s
+  let putpp = putPointEsil opts
+  let putpOpt v m act
+       | oElem beVerbose opts =  putp v act
+       | oElem beSilent opts  =  putpp v act
+       | otherwise = ioeIO (putStrFlush m) >> 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 <- putp ("+ reading" +++ file) $ getSourceModule opts file
+       let sm1 = unsubexpModule sm0
+       sm <- {- putp "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  <- putpp "  generating code... " $ generateModuleCode opts gfo sm1
+          -- sm is optimized before generation, but not in the env
+       extendCompileEnvInt env k' 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 opts
+      putpp = putPointEsil opts
+      mos   = modules gr
+
+  mo1   <- ioeErr $ rebuildModule mos mo
+  intermOut opts (iOpt "show_rebuild") (prMod mo1)
+
+  mo1b  <- ioeErr $ extendModule mos mo1
+  intermOut opts (iOpt "show_extend") (prMod 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 (iOpt "show_rename") (prMod mo2)
+
+      (mo3:_,warnings) <- putpp "  type checking" $ ioeErr $ showCheckModule mos mo2
+      if null warnings then return () else putp warnings $ return ()
+      intermOut opts (iOpt "show_typecheck") (prMod mo3)
+
+
+      (k',mo3r:_) <- putpp "  refreshing " $ ioeErr $ refreshModule (k,mos) mo3
+      intermOut opts (iOpt "show_refresh") (prMod 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])
+  putp ("  wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out
+  return minfo1
+ where
+   putp  = putPointE opts
+   putpp = putPointEsil opts
+
+
+-- auxiliaries
+
+pathListOpts :: Options -> FileName -> IO [InitPath]
+pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
+
+reverseModules (MGrammar ms) = MGrammar $ reverse ms
+
+emptyCompileEnv :: CompileEnv
+emptyCompileEnv = (0,emptyMGrammar,Map.empty)
+
+extendCompileEnvInt (_,MGrammar ss,menv) k file sm = do
+  let (mod,imps) = importsOfModule (trModule sm)
+  t <- ioeIO $ getModificationTime file
+  return (k,MGrammar (sm:ss),Map.insert mod (t,imps) menv) --- reverse later
+
+extendCompileEnv e@(k,_,_) file sm = extendCompileEnvInt e k file sm
+
+
diff --git a/src-2.9/GF/Devel/Compile/AbsGF.hs b/src-2.9/GF/Devel/Compile/AbsGF.hs
new file mode 100644
index 000000000..d053a3fa1
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/AbsGF.hs
@@ -0,0 +1,274 @@
+module GF.Devel.Compile.AbsGF where
+
+-- Haskell module generated by the BNF converter
+
+newtype PIdent = PIdent ((Int,Int),String) deriving (Eq,Ord,Show)
+newtype LString = LString String deriving (Eq,Ord,Show)
+data Grammar =
+   Gr [ModDef]
+  deriving (Eq,Ord,Show)
+
+data ModDef =
+   MModule ComplMod ModType ModBody
+  deriving (Eq,Ord,Show)
+
+data ModType =
+   MAbstract PIdent
+ | MResource PIdent
+ | MGrammar PIdent
+ | MInterface PIdent
+ | MConcrete PIdent PIdent
+ | MInstance PIdent PIdent
+  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
+ | OQual PIdent PIdent
+  deriving (Eq,Ord,Show)
+
+data ComplMod =
+   CMCompl
+ | CMIncompl
+  deriving (Eq,Ord,Show)
+
+data Included =
+   IAll PIdent
+ | ISome PIdent [PIdent]
+ | IMinus PIdent [PIdent]
+  deriving (Eq,Ord,Show)
+
+data TopDef =
+   DefCat [CatDef]
+ | DefFun [FunDef]
+ | DefFunData [FunDef]
+ | DefDef [Def]
+ | DefData [DataDef]
+ | DefPar [ParDef]
+ | DefOper [Def]
+ | DefLincat [Def]
+ | DefLindef [Def]
+ | DefLin [Def]
+ | DefPrintCat [Def]
+ | DefPrintFun [Def]
+ | DefFlag [Def]
+ | DefPrintOld [Def]
+ | DefLintype [Def]
+ | DefPattern [Def]
+ | DefPackage PIdent [TopDef]
+ | DefVars [Def]
+ | DefTokenizer 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 FunDef =
+   FDecl [Name] Exp
+  deriving (Eq,Ord,Show)
+
+data CatDef =
+   SimpleCatDef PIdent [DDecl]
+ | ListCatDef PIdent [DDecl]
+ | ListSizeCatDef PIdent [DDecl] Integer
+  deriving (Eq,Ord,Show)
+
+data DataDef =
+   DataDef Name [DataConstr]
+  deriving (Eq,Ord,Show)
+
+data DataConstr =
+   DataId PIdent
+ | DataQId PIdent PIdent
+  deriving (Eq,Ord,Show)
+
+data ParDef =
+   ParDefDir PIdent [ParConstr]
+ | ParDefAbs PIdent
+  deriving (Eq,Ord,Show)
+
+data ParConstr =
+   ParConstr PIdent [DDecl]
+  deriving (Eq,Ord,Show)
+
+data Name =
+   PIdentName 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 =
+   EPIdent 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]
+ | 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 =
+   LPIdent 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 =
+   BPIdent 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
+ | FPIdent PIdent
+ | FSlash FileName
+ | FDot FileName
+ | FMinus FileName
+ | FAddId PIdent FileName
+  deriving (Eq,Ord,Show)
+
diff --git a/src-2.9/GF/Devel/Compile/CheckGrammar.hs b/src-2.9/GF/Devel/Compile/CheckGrammar.hs
new file mode 100644
index 000000000..30ea0a70e
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/CheckGrammar.hs
@@ -0,0 +1,1089 @@
+----------------------------------------------------------------------
+-- |
+-- 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 -- 6/12/2007
+--
+-- 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
+--
+--  - overloading is resolved
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.CheckGrammar (
+  showCheckModule, 
+  justCheckLTerm, 
+  allOperDependencies, 
+  topoSortOpers
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.PrGF
+import GF.Devel.Grammar.Lookup
+
+import GF.Infra.Ident
+
+--import GF.Grammar.Refresh ----
+
+--import GF.Grammar.TypeCheck
+--import GF.Grammar.Values (cPredefAbs) ---
+
+
+--import GF.Grammar.LookAbs
+--import GF.Grammar.ReservedWords ----
+import GF.Devel.Grammar.PatternMatch (testOvershadow)
+import GF.Devel.Grammar.AppPredefined
+--import GF.Grammar.Lockfield (isLockLabel)
+
+import GF.Devel.CheckM
+
+import GF.Data.Operations
+
+import Data.List
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Control.Monad
+import Debug.Trace ---
+
+
+showCheckModule :: GF -> SourceModule -> Err (SourceModule,String)
+showCheckModule mos m = do
+  (st,(_,msg)) <- checkStart $ checkModule mos m
+  return (st, unlines $ reverse msg)
+
+checkModule :: GF -> SourceModule -> Check SourceModule
+checkModule gf0 (name,mo) = checkIn ("checking module" +++ prt name) $ do
+  let gr = gf0 {gfmodules = Map.insert name mo (gfmodules gf0)}
+  ----  checkRestrictedInheritance gr (name, mo)
+  mo1 <- case mtype mo of
+    MTAbstract -> judgementOpModule (checkAbsInfo gr name) mo
+    MTGrammar -> entryOpModule (checkResInfo gr name) mo
+
+    MTConcrete aname -> do
+      checkErr $ topoSortOpers $ allOperDependencies name $ mjments mo
+      abs <- checkErr $ lookupModule gr aname
+      mo1 <- checkCompleteGrammar abs mo
+      entryOpModule (checkCncInfo gr name (aname,abs)) mo1
+
+    MTInterface -> entryOpModule (checkResInfo gr name) mo
+
+    MTInstance iname -> do
+      intf <- checkErr $ lookupModule gr iname
+      entryOpModule  (checkResInfo gr name) mo
+
+  return $ (name, mo1)
+
+{- ----
+-- 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 :: GF -> Term -> Err Term
+justCheckLTerm src t = do
+  ((t',_),_) <- checkStart (inferLType src t)
+  return t'
+
+checkAbsInfo :: GF -> Ident -> Judgement -> Check Judgement
+checkAbsInfo st m info = return info ----
+
+{-
+checkAbsInfo st m (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 $ prtBad (unlines ss ++++ "in" +++ cat) c
+   ---- temporary solution when tc of defs is incomplete
+   mkCheckWarn cat ss = case ss of
+     [] -> return (c,info)
+     ["[]"] -> return (c,info) ----
+     _  -> checkWarn (unlines ss ++++ "in" +++ cat +++ prt c) >> return (c,info)
+   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 :: Module -> Module -> Check Module
+checkCompleteGrammar abs cnc = do
+  let js = mjments cnc
+  let fs = Map.assocs $ mjments abs
+  js' <- foldM checkOne js fs
+  return $ cnc {mjments = js'}
+ where
+   checkOne js i@(c, ju) = case jform ju of
+     JFun -> case Map.lookup c js of
+       Just j | jform j == JLin -> return js
+       _ -> do
+         checkWarn $ "WARNING: no linearization of" +++ prt c
+         return js
+     JCat -> case Map.lookup c js of
+       Just j | jform ju == JLincat -> return js  
+       _ -> do        ---- TODO: other things to check here
+         checkWarn $ 
+           "Warning: no linearization type for" +++ prt c ++ 
+           ", inserting default {s : Str}" 
+         return $ Map.insert c (cncCat defLinType) js
+     _ -> return js
+
+checkResInfo :: GF -> Ident -> Ident -> Judgement -> Check Judgement
+checkResInfo gr mo c info = do
+  ----  checkReservedId c
+  trace (show info) (return ())
+  case jform info of
+    JOper -> chIn "operation" $ case (jtype info, jdef info) of
+      _ | isConstructor info -> return info
+      (_,Meta _) -> do
+        checkWarn "No definition given to oper"
+        return info
+      (Meta _,de) -> do
+        (de',ty') <- infer de
+        ---- trace ("inferred" +++ prt de' +++ ":" +++ prt ty') $ 
+        return (resOper ty' de')
+      (ty, de) -> do
+        ty'     <- check ty typeType >>= comp . fst
+        (de',_) <- check de ty'
+        return (resOper ty' de')
+{- ----
+    ResOverload tysts -> chIn "overloading" $ do
+      tysts' <- mapM (uncurry $ flip check) tysts
+      let tysts2 = [(y,x) | (x,y) <- tysts']
+      --- 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, let (xs,t) = prodForm x]
+      return (c,ResOverload tysts2)
+-}
+{- ----
+    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 info
+ where
+   infer = inferLType gr
+   check = checkLType gr
+   chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ ":")
+   comp = computeLType gr
+
+   checkUniq xss = case xss of
+     x:y:xs 
+      | x == y -> raise $ "ambiguous for argument list" +++ 
+                         unwords (map (prtType gr) x)  
+      | otherwise -> checkUniq $ y:xs
+     _ -> return ()
+
+
+checkCncInfo :: GF -> Ident -> SourceModule -> 
+                Ident -> Judgement -> Check Judgement
+checkCncInfo gr cnc (a,abs) c info = do
+  ----  checkReservedId c
+  case jform info of
+    JFun -> chIn "linearization of" $ do
+      typ        <- checkErr $ lookupFunType gr a c
+      cat0       <- checkErr $ valCat typ
+      (cont,val) <- linTypeOfType gr cnc typ     -- creates arg vars
+      let lintyp = mkFunType (map snd cont) val
+      (trm',_)   <- check (jdef info) lintyp     -- erases arg vars
+      checkPrintname gr (jprintname info)
+      cat        <- return $ snd cat0
+      return (info {jdef = trm'})
+      ---- return (c, CncFun (Just (cat,(cont,val))) (Yes trm') mpr)
+                                                   -- cat for cf, typ for pe
+
+    JCat -> chIn "linearization type of" $ do
+      checkErr $ lookupCatContext gr a c
+      typ'  <- checkIfLinType gr (jtype info)
+    {- ----
+      mdef' <- case mdef of
+        Yes def -> do
+          (def',_) <- checkLType gr def (mkFunType [typeStr] typ)
+          return $ Yes def'
+        _ -> return mdef
+    -}
+      checkPrintname gr (jprintname info)
+      return (info {jtype = typ'})
+
+    _ -> checkResInfo gr cnc c info
+
+ where
+   env = gr
+   infer = inferLType gr
+   comp = computeLType gr 
+   check = checkLType gr
+   chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ ":")
+
+
+checkIfParType :: GF -> 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 :: GF -> Type -> Check Type
+checkIfLinType st typ0 = do
+  typ <- computeLType st typ0
+  case typ of
+    RecType r -> return ()
+    _ -> prtFail "a linearization type must be a record type instead of" typ
+  return typ
+
+computeLType :: GF -> 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
+
+    App (Q (IC "Predef") (IC "Ints")) _ -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Int")          -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Float")        -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Error")        -> return ty ---- shouldn't be needed
+
+    Q m c | elem c [cPredef,cPredefAbs] -> return ty
+    Q m c | elem c [identC "Int"] -> 
+      return $ defLinType
+----      let ints k = App (Q (IC "Predef") (IC "Ints")) (EInt k) in
+----      RecType [
+----        (LIdent "last",ints 9),(LIdent "s", typeStr), (LIdent "size",ints 1)]
+    Q m c | elem c [identC "Float",identC "String"] -> return defLinType ----
+
+    Q m ident -> checkIn ("module" +++ prt m) $ do
+      ty' <- checkErr (lookupOperDef 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' = sortBy (\x y -> compare (fst x) (fst y)) fs
+      liftM RecType $ mapPairsM comp fs'
+
+    _ | ty == typeTok -> return typeStr  ---- deprecated
+    _ | isPredefConstant ty -> return ty
+
+    _ -> composOp comp ty
+
+checkPrintname :: GF -> 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 (sortBy (\ x y -> compare (fst x) (fst y)) ts)) [0..]
+
+-- the underlying algorithms
+
+inferLType :: GF -> 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 (lookupOperType gr m ident) >>= comp
+     ,
+     checkErr (lookupOperDef gr m ident) >>= infer
+     ,
+{-
+     do
+       over <- getOverload gr Nothing trm
+       case over of
+         Just trty -> return trty
+         _ -> prtFail "not overloaded" trm
+     ,
+-}
+     prtFail "cannot infer type of constant" trm
+     ]
+
+   QC m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
+
+   QC m ident -> checks [
+       termWith trm $ checkErr (lookupOperType gr m ident) >>= comp
+--       ,checkErr (lookupOperDef 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 checkWarn ("WARNING: space in token \"" ++ s ++ 
+                        "\". Lexical analysis may fail.")
+        else return ()
+     return (trm, typeStr)
+
+   EInt i -> return (trm, typeInt)
+
+   EFloat i -> return (trm, typeFloat)
+
+   Empty -> return (trm, typeStr)
+
+   EParam _ cos -> return (trm, typePType) ---- check cos
+
+   C s1 s2 -> 
+     check2 (flip justCheck typeStr) C s1 s2 typeStr
+
+   Glue s1 s2 -> 
+     check2 (flip justCheck typeStr) Glue s1 s2 typeStr
+
+---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
+----   Strs (Cn (IC "#conflict") : ts) -> 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
+
+
+   Alts (t,aa) -> do
+     t'  <- justCheck t typeStr
+     aa' <- flip mapM aa (\ (c,v) -> do
+        c' <- justCheck c typeStr 
+        v' <- justCheck v typeStr
+        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
+     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
+     PChar -> True
+     PChars _ -> True
+     _ -> False
+
+   inferPatt p = case p of
+     PP q c ps | q /= cPredef -> 
+       checkErr $ lookupOperType gr q c >>= return . snd . prodForm
+     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 :: GF -> Maybe Type -> Term -> Check (Maybe (Term,Type))
+getOverload env@gr mt t = case appForm t 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
+
+     case [vf | vf@(v,f) <- vfs, matchVal mt v] of
+       [(val,fun)] -> return (mkApp fun tts, val)
+       [] -> 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
+
+      ----  ++++ "DEBUG" +++ unwords (map show tys) +++ ";" 
+      ----  ++++ unlines (map (show . fst) typs) ----
+
+       vfs' -> case [(v,f) | (v,f) <- vfs', noProd v] of
+         [(val,fun)] -> do
+           checkWarn $ "WARNING: overloading of" +++ prt f +++ 
+             "resolved by excluding partial applications:" ++++
+             unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
+           return (mkApp fun tts, val)
+
+         _ -> raise $ "ambiguous overloading of" +++ prt f +++
+           "for" +++ unwords (map (prtType env) tys) ++++ "with alternatives" ++++ 
+           unlines [prtType env ty | (ty,_) <- vfs']
+
+   matchVal mt v = elem mt ([Nothing,Just v] ++ unlocked) where
+     unlocked = case v of
+       RecType fs -> [Just $ RecType $ fs] ---- filter (not . isLockLabel . fst) fs]
+       _ -> []
+   ---- TODO: accept subtypes
+   ---- TODO: use a trie
+   lookupOverloadInstance tys typs = 
+     [(mkFunType rest val, t) | 
+       let lt = length tys,
+       (ty,(val,t)) <- typs, length ty >= lt,
+       let (pre,rest) = splitAt lt ty, 
+       pre == tys
+     ]
+
+   noProd ty = case ty of
+     Prod _ _ _ -> False
+     _ -> True
+
+checkLType :: GF -> Term -> Type -> Check (Term, Type)
+checkLType env trm typ0 = do
+  trace (show trm) (return ())
+
+  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'
+
+    EData -> return (trm,typ)
+
+    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 <- return [] ---- 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 $ lookupOperType cnc q c
+    let (cont,v) = prodForm 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 = GF
+
+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
+     (_,Q (IC "Predef") (IC "Error")) -> True
+
+     -- unknown type unifies with any type ----
+     (_,Meta _) -> 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
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        Q (IC "Predef") (IC "Int"))                 -> True ---- check size!
+     
+     (Q (IC "Predef") (IC "Int"),  ---- why this ???? AR 11/12/2005
+        App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
+
+     ---- 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 (const False) ls ---- 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 ""
+
+   ---- to revise
+   allExtendsPlus _ n = [n]
+
+   sTypes = [typeStr, typeString, typeTok] ---- Tok deprecated
+   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 :: GF -> 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 <- 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 -> Map.Map Ident Judgement -> [(Ident,[Ident])]
+allOperDependencies m = allDependencies (==m)
+
+allDependencies :: (Ident -> Bool) -> Map.Map Ident Judgement -> [(Ident,[Ident])]
+allDependencies ism b = 
+  [(f, nub (concatMap opersIn (pts i))) | (f,i) <- Map.assocs b]
+  where
+    opersIn t = case t of
+      Q n c | ism n -> [c]
+      QC n c | ism n -> [c]
+      _ -> collectOp opersIn t
+    pts i = [jtype i, jdef i]
+    ----  AbsFun pty ptr -> [pty] --- ptr is def, which can be mutual
+ 
+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-2.9/GF/Devel/Compile/Compile.hs b/src-2.9/GF/Devel/Compile/Compile.hs
new file mode 100644
index 000000000..07e059ed4
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/Compile.hs
@@ -0,0 +1,205 @@
+module GF.Devel.Compile.Compile (batchCompile) where
+
+-- the main compiler passes
+import GF.Devel.Compile.GetGrammar
+import GF.Devel.Compile.Extend
+import GF.Devel.Compile.Rename
+import GF.Devel.Compile.CheckGrammar
+import GF.Devel.Compile.Refresh
+import GF.Devel.Compile.Optimize
+import GF.Devel.Compile.Factorize
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Infra.Ident
+import GF.Devel.Grammar.PrGF
+----import GF.Devel.Grammar.Lookup
+import GF.Devel.Infra.ReadFiles
+
+import GF.Infra.Option ----
+import GF.Data.Operations
+import GF.Devel.UseIO
+import GF.Devel.Arch
+
+import Control.Monad
+import System.Directory
+
+batchCompile :: Options -> [FilePath] -> IO GF
+batchCompile opts files = do
+  let defOpts = addOptions opts (options [emitCode])
+  egr <- appIOE $ foldM (compileModule defOpts) emptyCompileEnv files 
+  case egr of
+    Ok (_,gr) -> return gr
+    Bad s -> error s
+
+-- to output an intermediate stage
+intermOut :: Options -> Option -> String -> IOE ()
+intermOut opts opt s = 
+  if oElem opt opts || oElem (iOpt "show_all") opts
+  then 
+    ioeIO (putStrLn ("\n\n--#" +++ prOpt opt) >> putStrLn s) 
+  else 
+    return ()
+
+prMod :: SourceModule -> String
+prMod = prModule
+
+-- | the environment
+type CompileEnv = (Int,GF)
+
+-- | 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 -> CompileEnv -> FilePath -> IOE CompileEnv
+compileModule opts1 env file = do
+  opts0 <- ioeIO $ getOptionsFromFile file
+  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
+  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
+  let opts = addOptions opts1 opts0 
+  let fpath = dropFileName file
+  ps0 <- ioeIO $ pathListOpts opts fpath
+
+  let ps1 = if (useFileOpt && not useLineOpt) 
+              then (ps0 ++ map (combine fpath) ps0)
+              else ps0
+  ps <- ioeIO $ extendPathEnv ps1
+  let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
+  ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
+  let sgr = snd env
+  let rfs = [] ---- files already in memory and their read times
+  let file' = if useFileOpt then takeFileName file else file -- find file itself
+  files <- getAllFiles opts ps rfs file'
+  ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
+  let names = map justModuleName files
+  ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
+  let sgr2 = sgr ----MGrammar [m | m@(i,_) <- modules sgr, 
+                     ----      notElem (prt i) $ map dropExtension names]
+  let env0 = (0,sgr2)
+  (e,mm) <- foldIOE (compileOne opts) env0 files
+  maybe (return ()) putStrLnE mm
+  return e
+
+
+compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
+compileOne opts env@(_,srcgr) file = do
+
+  let putp s = putPointE opts ("\n" ++ s) 
+  let putpp = putPointEsil opts
+  let putpOpt v m act
+       | oElem beVerbose opts =  putp v act
+       | oElem beSilent opts  =  putpp v act
+       | otherwise = ioeIO (putStrFlush ("\n" ++ m)) >> act
+
+  let gf   = takeExtensions file
+  let path = dropFileName file
+  let name = dropExtension file
+  let mos  = gfmodules srcgr
+
+  case gf of
+
+    -- for compiled gf, read the file and update environment
+    -- also undo common subexp optimization, to enable normal computations
+
+    ".gfn" -> do
+       sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
+       let sm1 = unsubexpModule sm0
+       sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule srcgr sm1
+       extendCompileEnv env sm
+
+    -- for gf source, do full compilation and generate code
+    _ -> do
+
+      let modu = dropExtension file
+      b1 <- ioeIO $ doesFileExist file
+      if not b1
+        then compileOne opts env $ gfoFile $ modu 
+        else do
+
+       sm0 <- 
+         putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ 
+                                                      getSourceModule opts file
+       (k',sm) <- compileSourceModule opts env sm0
+       let sm1 = sm ---- 
+----             if isConcr sm then shareModule sm else sm -- cannot expand Str
+       if oElem (iOpt "doemit") opts 
+         then putpp "  generating code... " $ generateModuleCode opts path sm1
+         else return ()
+----          -- sm is optimized before generation, but not in the env
+----       let cm2 = unsubexpModule cm
+       extendCompileEnvInt env (k',sm) ---- 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
+
+  intermOut opts (iOpt "show_gf") (prMod mo)
+
+  let putp  = putPointE opts
+      putpp = putPointEsil opts
+      stopIf n comp m = 
+        if any (\k -> oElem (iOpt (show k)) opts) [1..n] then return m else comp m
+      stopIfV v n comp m = 
+        if any (\k -> oElem (iOpt (show k)) opts) [1..n] then return (m,v) else comp m
+
+  moe <- stopIf 1 (putpp "  extending" . ioeErr . extendModule gr) mo
+  intermOut opts (iOpt "show_extend") (prMod moe)
+
+  mor <- stopIf 2 (putpp "  renaming" . ioeErr . renameModule gr) moe
+  intermOut opts (iOpt "show_rename") (prMod mor)
+
+  (moc,warnings) <- 
+    stopIfV [] 3 (putpp "  type checking" . ioeErr . showCheckModule gr) mor
+  if null warnings then return () else putp warnings $ return ()
+  intermOut opts (iOpt "show_typecheck") (prMod moc)
+
+  (mox,k') <- stopIfV k 4 (putpp "  refreshing " . ioeErr . refreshModule k) moc
+  intermOut opts (iOpt "show_refresh") (prMod mox)
+
+  moo <- stopIf 5 (putpp "  optimizing " . ioeErr . optimizeModule opts gr) mox
+  intermOut opts (iOpt "show_optimize") (prMod moo)
+
+  mof <- stopIf 6 (putpp "  factorizing " . ioeErr . optimizeModule opts gr) moo
+  intermOut opts (iOpt "show_factorize") (prMod mof)
+
+  return (k',moo) ----
+
+
+generateModuleCode :: Options -> InitPath -> SourceModule -> IOE ()
+generateModuleCode opts path minfo@(name,info) = do
+
+  let pname  = combine path (prt name)
+  let minfo0 = minfo 
+  let minfo1 = subexpModule minfo0
+  let minfo2 = minfo1
+
+  let (file,out) = (gfoFile pname, prGF (gfModules [minfo2]))
+  putp ("  wrote file" +++ file) $ ioeIO $ writeFile file $ out
+
+  return () ----- minfo2
+ where 
+   putp  = putPointE opts
+   putpp = putPointEsil opts
+
+-- auxiliaries
+
+pathListOpts :: Options -> FileName -> IO [InitPath]
+pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
+
+----reverseModules (MGrammar ms) = MGrammar $ reverse ms
+
+emptyCompileEnv :: CompileEnv
+emptyCompileEnv = (0,emptyGF)
+
+extendCompileEnvInt (_,gf) (k,(s,m)) = return (k, addModule s m gf)
+
+extendCompileEnv e@(k,_) sm = extendCompileEnvInt e (k,sm)
+
+
diff --git a/src-2.9/GF/Devel/Compile/ErrM.hs b/src-2.9/GF/Devel/Compile/ErrM.hs
new file mode 100644
index 000000000..9cad4e252
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/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.Devel.Compile.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-2.9/GF/Devel/Compile/Extend.hs b/src-2.9/GF/Devel/Compile/Extend.hs
new file mode 100644
index 000000000..2f1aae65b
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/Extend.hs
@@ -0,0 +1,154 @@
+----------------------------------------------------------------------
+-- |
+-- 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
+-- 4/12/2007 this module is still very very messy... ----
+--
+-- The top-level function 'extendModule'
+-- extends a module symbol table by indirections to the module it extends
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.Extend (
+  extendModule
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.PrGF
+import GF.Devel.Grammar.Lookup
+import GF.Devel.Grammar.Macros
+
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Data.List (nub)
+import Data.Map
+import Control.Monad
+
+extendModule :: GF -> SourceModule -> Err SourceModule
+extendModule gf nmo0 = do
+  (name,mo) <- rebuildModule gf nmo0
+  case mtype mo 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
+    MTConcrete _ | not (isCompleteModule mo) -> return (name,mo)
+    _  -> do
+      mo' <- foldM (extOne name) mo (mextends mo) 
+      return (name, mo') 
+ where
+   extOne name mo (n,cond) = do
+     mo0 <- lookupModule gf n
+
+     -- test that the module types match
+     testErr True ---- (legalExtension mo mo0) 
+                    ("illegal extension type to module" +++ prt name)
+
+     -- find out if the old is complete
+     let isCompl = isCompleteModule mo0
+
+     -- if incomplete, remove it from extension list --- because??
+     let me' = (if isCompl then id else (Prelude.filter ((/=n) . fst))) 
+                 (mextends mo) 
+
+     -- build extension depending on whether the old module is complete
+     js0 <- extendMod isCompl n (isInherited cond) name (mjments mo0) (mjments mo)
+
+     return $ mo {mextends = me', mjments = js0}
+
+-- | 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 -> 
+             Map Ident Judgement -> Map Ident Judgement -> 
+             Err (Map Ident Judgement)
+extendMod isCompl name cond base old new = foldM try new $ assocs 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 -> Judgement -> Judgement
+indirInfo n ju = case jform ju of
+  JLink -> ju -- original link is passed
+  _     -> linkInherited (isConstructor ju) n
+
+extendAnyInfo :: Bool -> Ident -> Ident -> Judgement -> Judgement -> Err Judgement
+extendAnyInfo isc n o i j = 
+  errIn ("building extension for" +++ prt n +++ "in" +++ prt o) $ 
+  unifyJudgement i j
+
+tryInsert :: Ord a => (b -> b -> Err b) -> (b -> b) ->
+             Map a b -> (a,b) -> Err (Map a b)
+tryInsert unif indir tree z@(x, info) = case Data.Map.lookup x tree of
+  Just info0 -> do
+    info1 <- unif info info0
+    return $ insert x info1 tree 
+  _ -> return $ insert x (indir info) tree
+
+-- | rebuilding instance + interface, and "with" modules, prior to renaming. 
+-- AR 24/10/2003
+rebuildModule :: GF -> SourceModule -> Err SourceModule
+rebuildModule gr mo@(i,mi) = case mtype mi of
+
+  -- copy interface contents to instance
+  MTInstance i0 -> do
+    m0 <- lookupModule gr i0
+    testErr (isInterface m0) ("not an interface:" +++ prt i0)
+    js1 <- extendMod False i0 (const True) i (mjments m0) (mjments mi)
+
+    --- to avoid double inclusions, in instance J of I0 = J0 ** ...
+    case mextends mi of
+      [] -> return $ (i,mi {mjments = js1})
+      es -> do 
+        mes <- mapM (lookupModule gr . fst) es ---- restricted?? 12/2007
+        let notInExts c _  = all (notMember c . mjments) mes
+        let js2 = filterWithKey notInExts js1
+        return $ (i,mi {
+          mjments = js2
+          })
+
+  -- copy functor contents to instantiation, and also add opens
+  _ -> case minstances mi of
+    [((ext,incl),ops)] -> do
+      let interfs  = Prelude.map fst ops
+
+      -- test that all interfaces are instantiated
+      let isCompl = Prelude.null [i | (_,i) <- minterfaces mi, notElem i interfs]
+      testErr isCompl ("module" +++ prt i +++ "remains incomplete")
+
+      -- look up the functor and build new opens set
+      mi0 <- lookupModule gr ext
+      let 
+        ops1 = nub $
+             mopens mi   -- own opens; N.B. mi0 has been name-resolved already
+          ++ ops         -- instantiating opens
+          ++ [(n,o) | 
+               (n,o) <- mopens mi0, notElem o interfs] -- ftor's non-if opens
+          ++ [(i,i) | i <- Prelude.map snd ops] ----   -- insts w. real names
+
+      -- combine flags; new flags have priority
+      let fs1 = union (mflags mi) (mflags mi0)  
+      
+      -- copy inherited functor judgements
+      let js0 = [ci | ci@(c,_) <- assocs (mjments mi0), isInherited incl c]
+      let js1 = fromList (assocs (mjments mi) ++ js0)
+
+      return $ (i,mi {
+          mflags = fs1, 
+          mextends = mextends mi,  -- extends of instantiation
+          mopens = ops1,
+          mjments = js1
+          })
+    _ -> return (i,mi)
+
diff --git a/src-2.9/GF/Devel/Compile/Factorize.hs b/src-2.9/GF/Devel/Compile/Factorize.hs
new file mode 100644
index 000000000..7386f3ed5
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/Factorize.hs
@@ -0,0 +1,251 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.Compile.Factorize (
+  optModule,
+  unshareModule,
+  unsubexpModule,
+  unoptModule,
+  subexpModule,
+  shareModule
+  ) where 
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.PrGF (prt)
+import qualified GF.Devel.Grammar.Macros as C
+
+import GF.Devel.Grammar.Lookup
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.List
+
+optModule :: SourceModule -> SourceModule
+optModule = subexpModule . shareModule
+
+shareModule = processModule optim
+
+unoptModule :: GF -> SourceModule -> SourceModule
+unoptModule gr = unshareModule gr . unsubexpModule
+
+unshareModule :: GF -> SourceModule -> SourceModule
+unshareModule gr = processModule (const (unoptim gr))
+
+processModule :: (Ident -> Term -> Term) -> SourceModule -> SourceModule
+processModule opt (i,mo) = 
+  (i, mo {mjments = Map.map (shareInfo (opt i)) (mjments mo)})
+
+shareInfo :: (Term -> Term) -> Judgement -> Judgement
+shareInfo opt ju = ju {jdef = opt (jdef ju)}
+
+-- 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 ----
+-- 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... 
+
+qqIdent c i = identC ("_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 :: GF -> Term -> Term
+unoptim gr = unfactor gr
+
+unfactor :: GF -> 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 (m,mo) = errVal (m,mo) $ case mtype mo of
+  MTAbstract -> return (m,mo)
+  _ -> do
+    let js = listJudgements mo
+    (tree,_) <- appSTM (getSubtermsMod m js) (Map.empty,0)
+    js2 <- addSubexpConsts m tree js
+    return (m, mo{mjments = Map.fromList js2})
+
+unsubexpModule :: SourceModule -> SourceModule
+unsubexpModule (m,mo) = (m, mo{mjments = rebuild (mjments mo)})
+  where
+    unparInfo (c, ju) = case jtype ju of
+      EInt 8 -> [] -- subexp-generated opers
+      _ -> [(c, ju {jdef = unparTerm (jdef ju)})]
+    unparTerm t = case t of
+      Q _ c@(IC ('_':'A':_)) -> --- name convention of subexp opers
+        maybe t (unparTerm . jdef) $ Map.lookup c (mjments mo)
+      _ -> C.composSafeOp unparTerm t
+    rebuild = Map.fromList . concat . map unparInfo . Map.assocs
+
+-- 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,Judgement)] -> Err [(Ident,Judgement)]
+addSubexpConsts mo tree lins = do
+  let opers = [oper id trm | (trm,(_,id)) <- list]
+  mapM mkOne $ opers ++ lins
+ where
+
+   mkOne (f, def) = return (f, def {jdef = recomp f (jdef def)})
+   recomp f t = case Map.lookup t tree of
+     Just (_,id) | ident id /= f -> Q mo (ident id)
+     _ -> C.composSafeOp (recomp f) t
+
+   list = Map.toList tree
+
+   oper id trm = (ident id, resOper (EInt 8) trm)
+   --- impossible type encoding generated opers
+
+getSubtermsMod :: Ident -> [(Ident,Judgement)] -> 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@(_,i) = do
+     get (jdef i)    
+     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
+
+ident :: Int -> Ident
+ident i = identC ("_A" ++ show i) ---
+
diff --git a/src-2.9/GF/Devel/Compile/GF.cf b/src-2.9/GF/Devel/Compile/GF.cf
new file mode 100644
index 000000000..3edbdf347
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/GF.cf
@@ -0,0 +1,326 @@
+-- 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, --%
+  Exp ; -- let's see if more are needed
+
+comment "--" ;
+comment "{-" "-}" ;
+
+
+-- identifiers
+
+position token PIdent ('_' | letter) (letter | digit | '_' | '\'')* ;
+
+-- the top-level grammar
+
+Gr. Grammar ::= [ModDef] ;
+
+-- semicolon after module is permitted but not obligatory
+
+terminator ModDef "" ;
+_. ModDef ::= ModDef ";" ;
+
+-- the individual modules
+
+MModule. ModDef ::= ComplMod ModType "=" ModBody ;
+
+MAbstract.  ModType ::= "abstract"  PIdent ;
+MResource.  ModType ::= "resource"  PIdent ;
+MGrammar.   ModType ::= "grammar"   PIdent ;
+MInterface. ModType ::= "interface" PIdent ;
+MConcrete.  ModType ::= "concrete"  PIdent "of" PIdent ;
+MInstance.  ModType ::= "instance"  PIdent "of" PIdent ;
+
+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 ::= "(" PIdent ")" ; --%
+OQual.   Open ::= "(" PIdent "=" PIdent ")" ;
+
+CMCompl.   ComplMod ::= ;
+CMIncompl. ComplMod ::= "incomplete" ;
+
+separator Included "," ;
+
+IAll.   Included ::= PIdent ;
+ISome.  Included ::= PIdent "[" [PIdent] "]" ;
+IMinus. Included ::= PIdent "-" "[" [PIdent] "]" ;
+
+-- top-level definitions
+
+DefCat.    TopDef ::= "cat" [CatDef] ;
+DefFun.    TopDef ::= "fun" [FunDef] ;
+DefFunData.TopDef ::= "data" [FunDef] ;
+DefDef.    TopDef ::= "def" [Def] ;
+DefData.   TopDef ::= "data" [DataDef] ;
+
+DefPar.    TopDef ::= "param" [ParDef] ;
+DefOper.   TopDef ::= "oper"  [Def] ;
+
+DefLincat. TopDef ::= "lincat" [Def] ;
+DefLindef. TopDef ::= "lindef" [Def] ;
+DefLin.    TopDef ::= "lin"    [Def] ;
+
+DefPrintCat. TopDef ::= "printname" "cat" [Def] ;
+DefPrintFun. TopDef ::= "printname" "fun" [Def] ;
+DefFlag.     TopDef ::= "flags" [Def] ;
+
+-- definitions after most keywords
+
+DDecl.  Def ::= [Name] ":" Exp ;
+DDef.   Def ::= [Name] "=" Exp ;
+DPatt.  Def ::= Name [Patt] "=" Exp ;  -- non-empty pattern list
+DFull.  Def ::= [Name] ":" Exp "=" Exp ;
+
+FDecl.  FunDef ::= [Name] ":" Exp ;
+
+SimpleCatDef.   CatDef ::= PIdent [DDecl] ;
+ListCatDef.     CatDef ::= "[" PIdent [DDecl] "]" ;
+ListSizeCatDef. CatDef ::= "[" PIdent [DDecl] "]" "{" Integer "}" ;
+
+DataDef.   DataDef    ::= Name "=" [DataConstr] ;
+DataId.    DataConstr ::= PIdent ;
+DataQId.   DataConstr ::= PIdent "." PIdent ;
+separator DataConstr "|" ;
+
+ParDefDir.   ParDef ::= PIdent "=" [ParConstr] ;
+ParDefAbs.   ParDef ::= PIdent ;
+
+ParConstr. ParConstr ::= PIdent [DDecl] ;
+
+terminator nonempty Def ";" ;
+terminator nonempty FunDef ";" ;
+terminator nonempty CatDef ";" ;
+terminator nonempty DataDef ";" ;
+terminator nonempty ParDef ";" ;
+
+separator ParConstr "|" ;
+
+separator nonempty PIdent "," ;
+
+-- names of categories and functions in definition LHS
+
+PIdentName. 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
+
+EPIdent.   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] "}" ;
+EPre.      Exp4 ::= "pre" "{" Exp ";" [Altern] "}" ;
+EStrs.     Exp4 ::= "strs" "{" [Exp] "}" ; --%
+
+EPatt.     Exp4 ::= "pattern" Patt2 ;
+EPattType. Exp4 ::= "pattern" "type" 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
+
+LPIdent. 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
+
+BPIdent. 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 ";" ; --%
+
+FPIdent. 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" [Def] ; --%
+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 ";" ; --%
diff --git a/src-2.9/GF/Devel/Compile/GFC.hs b/src-2.9/GF/Devel/Compile/GFC.hs
new file mode 100644
index 000000000..f60ec9380
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/GFC.hs
@@ -0,0 +1,72 @@
+module GF.Devel.Compile.GFC (mainGFC) where
+-- module Main where
+
+import GF.Devel.Compile.Compile
+import GF.Devel.Compile.GFtoGFCC
+import GF.Devel.PrintGFCC
+import GF.GFCC.OptimizeGFCC
+import GF.GFCC.CheckGFCC
+import GF.GFCC.DataGFCC
+import GF.GFCC.Raw.ParGFCCRaw
+import GF.GFCC.Raw.ConvertGFCC
+import GF.Devel.UseIO
+import GF.Infra.Option
+import GF.GFCC.API
+import GF.Data.ErrM
+
+mainGFC :: [String] -> IO ()
+mainGFC xx = do
+  let (opts,fs) = getOptions "-" xx
+  case opts of
+    _ | oElem (iOpt "help") opts -> putStrLn usageMsg
+    _ | oElem (iOpt "-make") opts -> do
+      gr <- batchCompile opts fs
+      let name = justModuleName (last fs)
+      let (abs,gc0) = mkCanon2gfcc opts name gr
+      gc1 <- checkGFCCio gc0
+      let gc = if oElem (iOpt "noopt") opts then gc1 else optGFCC gc1
+      let target = targetName opts abs
+      let gfccFile =  target ++ ".gfcc"
+      writeFile gfccFile (printGFCC gc)
+      putStrLn $ "wrote file " ++ gfccFile
+      mapM_ (alsoPrint opts target gc) printOptions
+
+    -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
+    _ | all ((==".gfcc") . takeExtensions) fs -> do
+      gfccs <- mapM file2gfcc fs
+      let gfcc = foldl1 unionGFCC gfccs
+      let abs = printCId $ absname gfcc
+      let target = targetName opts abs
+      let gfccFile =  target ++ ".gfcc"
+      writeFile gfccFile (printGFCC gfcc)
+      putStrLn $ "wrote file " ++ gfccFile
+      mapM_ (alsoPrint opts target gfcc) printOptions
+      
+    _ -> do
+      mapM_ (batchCompile opts) (map return fs)
+      putStrLn "Done."
+
+targetName opts abs = case getOptVal opts (aOpt "target") of
+  Just n -> n
+  _ -> abs
+
+---- TODO: nicer and richer print options
+
+alsoPrint opts abs gr (opt,name) = do
+  if oElem (iOpt opt) opts 
+    then do
+      let outfile = name
+      let output = prGFCC opt gr
+      writeFile outfile output
+      putStrLn $ "wrote file " ++ outfile
+    else return ()
+
+printOptions = [
+  ("haskell","GSyntax.hs"),
+  ("haskell_gadt","GSyntax.hs"),
+  ("js","grammar.js"),
+  ("jsref","grammarReference.js")
+  ]
+
+usageMsg = 
+  "usage: gfc (-h | --make (-noopt) (-target=PREFIX) (-js | -jsref | -haskell | -haskell_gadt)) (-src) FILES"
diff --git a/src-2.9/GF/Devel/Compile/GFtoGFCC.hs b/src-2.9/GF/Devel/Compile/GFtoGFCC.hs
new file mode 100644
index 000000000..81f33e11a
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/GFtoGFCC.hs
@@ -0,0 +1,542 @@
+module GF.Devel.Compile.GFtoGFCC (prGrammar2gfcc,mkCanon2gfcc) where
+
+import GF.Devel.Compile.Factorize (unshareModule)
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import qualified GF.Devel.Grammar.Lookup as Look
+
+import qualified GF.Devel.Grammar.Grammar as A ----
+import qualified GF.Devel.Grammar.Grammar as M ----
+import qualified GF.Devel.Grammar.Macros as GM
+--import qualified GF.Grammar.Compute as Compute
+
+import GF.Devel.Grammar.PrGF
+--import GF.Devel.ModDeps
+import GF.Infra.Ident
+
+import GF.Devel.PrintGFCC
+import qualified GF.GFCC.Macros as CM
+import qualified GF.GFCC.DataGFCC as C
+import qualified GF.GFCC.DataGFCC as D
+import GF.GFCC.CId
+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 Debug.Trace ----
+
+-- the main function: generate GFCC from GF.
+
+prGrammar2gfcc :: Options -> String -> GF -> (String,String)
+prGrammar2gfcc opts cnc gr = (abs, printGFCC gc) where
+  (abs,gc) = mkCanon2gfcc opts cnc gr 
+
+mkCanon2gfcc :: Options -> String -> GF -> (String,D.GFCC)
+mkCanon2gfcc opts cnc gr = 
+  (prIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon abs) gr)
+  where
+    abs = err error id $ Look.abstractOfConcrete gr (identC cnc)
+    pars = mkParamLincat gr
+
+-- Generate GFCC from GFCM.
+-- this assumes a grammar translated by canon2canon
+
+canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> GF -> D.GFCC
+canon2gfcc opts pars cgr =  
+  (if (oElem (iOpt "show_canon") opts) then trace (prt cgr) else id) $
+     D.GFCC an cns gflags abs cncs 
+ where
+  -- recognize abstract and concretes
+  ([(a,abm)],cms) = 
+    partition ((== MTAbstract) . mtype . snd) (Map.toList (gfmodules cgr))
+
+  -- abstract
+  an  = (i2i a)
+  cns = map (i2i . fst) cms
+  abs = D.Abstr aflags funs cats catfuns
+  gflags = Map.fromList [(CId fg,x) | Just x <- [getOptVal opts (aOpt fg)]] 
+                                          where fg = "firstlang"
+  aflags = Map.fromList [(CId f,x) | (IC f,x) <- Map.toList (M.mflags abm)]
+  mkDef pty = case pty of
+    Meta _ -> CM.primNotion
+    t -> mkExp t
+
+  funs = Map.fromAscList lfuns
+  cats = Map.fromAscList lcats
+
+  lfuns = [(i2i f, (mkType (jtype ju), mkDef (jdef ju))) | 
+                      (f,ju) <- listJudgements abm, jform ju == JFun]
+  lcats = [(i2i c, mkContext (GM.contextOfType (jtype ju))) |
+                      (c,ju) <- listJudgements abm, jform ju == JCat]
+  catfuns = Map.fromList 
+    [(cat,[f | (f, (C.DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
+
+  -- concretes
+  cncs  = Map.fromList [mkConcr lang (i2i lang) mo | (lang,mo) <- cms]
+  mkConcr lang0 lang mo = 
+      (lang,D.Concr flags lins opers lincats lindefs printnames params fcfg)
+    where
+      js = listJudgements mo
+      flags = Map.fromList [(CId f,x) | (IC f,x) <- Map.toList (M.mflags mo)]
+      opers = Map.fromAscList [] -- opers will be created as optimization
+      utf   = if elem (IC "coding","utf8") (Map.assocs (M.mflags mo)) ---- 
+                  then D.convertStringsInTerm decodeUTF8 else id
+      lins    = Map.fromAscList 
+        [(i2i f, utf (mkTerm (jdef ju))) | (f,ju) <- js, jform ju == JLin]
+      lincats = Map.fromAscList 
+        [(i2i c, utf (mkTerm (jtype ju))) | (c,ju) <- js, jform ju == JLincat]
+      lindefs = Map.fromAscList 
+        [(i2i c, utf (mkTerm (jdef ju))) | (c,ju) <- js, jform ju == JLincat]
+      printnames = Map.fromAscList 
+        [(i2i c, utf (mkTerm (jprintname ju))) | 
+                     (c,ju) <- js, elem (jform ju) [JLincat,JLin]]
+      params = Map.fromAscList 
+        [(i2i c, pars lang0 c) | (c,ju) <- js, jform ju == JLincat] ---- c ??
+      fcfg = Nothing
+
+i2i :: Ident -> CId
+i2i = CId . prIdent
+
+mkType :: A.Type -> C.Type
+mkType t = case GM.typeForm t of
+  (hyps,(Q _ cat),args) -> C.DTyp (mkContext hyps) (i2i cat) (map mkExp args)
+
+mkExp :: A.Term -> C.Exp
+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
+    (xx,c,args) -> C.DTr [i2i x | x <- xx] (mkAt c) (map mkExp args) 
+ where
+  mkAt c = case c of 
+    Q _ c  -> C.AC $ i2i c
+    QC _ c -> C.AC $ i2i c
+    Vr x   -> C.AV $ i2i x
+    EInt i -> C.AI i
+    EFloat f -> C.AF f
+    K s    -> C.AS s
+    Meta i -> C.AM $ toInteger i
+    _ -> C.AM 0
+  mkPatt p = uncurry CM.tree $ case p of
+    A.PP _ c ps -> (C.AC (i2i c), map mkPatt ps)
+    A.PV x      -> (C.AV (i2i x), [])
+    A.PW        -> (C.AV CM.wildCId, [])
+    A.PInt i    -> (C.AI 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 (IC s) | isDigit (last s) -> 
+    C.V (read (reverse (takeWhile (/='_') (reverse 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))
+  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.Var (strings u) (strings v) | (u,v) <- tvs])
+  _ -> prtTrace tr $ C.S [C.K (C.KS (prt tr +++ "66662"))] ---- for debugging
+ where
+   mkLab (LIdent l) = case l of
+     '_':ds -> (read ds) :: Int
+     _ -> prtTrace tr $ 66663
+   strings t = case t of
+     K s -> [s]
+     C u v -> strings u ++ strings v
+     FV ss -> concatMap strings ss
+     _ -> prtTrace tr $ ["66660"]
+   flats t = case t of
+     C.S ts -> concatMap flats ts
+     _ -> [t]
+
+-- encoding GFCC-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 "Str"        -> C.S [] --- Str only
+  App (Q (IC "Predef") (IC "Ints")) (EInt i) -> C.C $ fromInteger i
+  _ -> error  $ "mkCType " ++ show t
+
+-- encoding showable lincats (as in source gf) as terms
+mkParamLincat :: GF -> 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 "Str" -> 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 -> GF -> GF
+reorder abs cg = emptyGF {
+  gfabsname = Just abs,
+  gfcncnames = (map fst cncs),
+  gfmodules = Map.fromList ((abs,absm) : map mkCnc cncs)
+  } 
+ where
+    absm = emptyModule {
+      mtype = MTAbstract,
+      mflags = aflags,
+      mjments = adefs
+      }
+    mkCnc (c,cnc) = (c,emptyModule {
+      mtype = MTConcrete abs,
+      mflags = fst cnc,
+      mjments = snd cnc
+      })
+       
+    mos = Map.toList $ gfmodules cg
+       
+    adefs = Map.fromAscList $ sortIds $
+                 predefADefs ++ Look.allOrigJudgements cg abs
+    predefADefs = 
+      [(IC c, absCat []) | c <- ["Float","Int","String"]]
+    aflags = Map.fromList $ nubByFst $ concat 
+      [Map.toList (M.mflags mo) | (_,mo) <- mos, mtype mo == MTAbstract] ----toom
+
+    cncs = sortIds [(lang, concr lang) | lang <- Look.allConcretes cg abs]
+    concr la = (
+      Map.fromList (nubByFst flags), 
+      Map.fromList (sortIds (predefCDefs ++ jments))
+      ) where 
+        jments = Look.allOrigJudgements cg la
+        flags  = Look.lookupFlags cg la
+                  ----concat [M.mflags mo | 
+                  ----  (i,mo) <- mos, M.isModCnc mo, 
+                  ----  Just r <- [lookup i (M.allExtendSpecs cg la)]]
+
+    predefCDefs = [(IC c, cncCat GM.defLinType) | 
+                       ---- lindef,printname 
+                         c <- ["Float","Int","String"]]
+
+    sortIds = sortBy (\ (f,_) (g,_) -> compare f g) 
+    
+nubByFst = nubBy (\ (f,_) (g,_) -> f == g)
+
+
+-- one grammar per language - needed for symtab generation
+repartition :: Ident -> GF -> [GF]
+repartition abs cg = [Look.partOfGrammar cg (lang,mo) | 
+  let mos = gfmodules cg,
+  lang   <- Look.allConcretes cg abs,
+  let mo = errVal 
+       (error ("no module found for " ++ prt lang)) $ Look.lookupModule cg lang
+  ]
+ 
+
+-- translate tables and records to arrays, parameters and labels to indices
+
+canon2canon :: Ident -> GF -> GF
+canon2canon abs gf = errVal gf $ GM.termOpGF t2t gf where
+  t2t = return . term2term gf pv
+  ty2ty = type2type gf pv
+  pv@(labels,untyps,typs) = paramValues gf
+  ---- should be done lang for lang
+  ---- ty2ty should be used for types, t2t only in concrete
+
+{- ----
+  gfModules . nubModules . map cl2cl . repartition abs . purgeGrammar abs  
+ where    
+  nubModules = Map.fromList . nubByFst . concatMap (Map.toList . gfmodules)
+
+  cl2cl gf = errVal gf $ GM.moduleOpGF (js2js . map (GM.judgementOpModule p2p)) gf
+    
+  js2js ms = map (GM.judgementOpModule (j2j (gfModules ms))) ms
+
+  j2j cg (f,j) = case jform j of
+    JLin -> (f, j{jdef = t2t (jdef j)})
+    JLincat -> (f, j{jdef = t2t (jdef j), jtype = ty2ty (jtype j)})
+    _ -> (f,j)
+   where
+      t2t = term2term cg pv
+      ty2ty = type2type cg pv
+      pv@(labels,untyps,typs) = paramValues cg ---trs $ paramValues cg
+
+    -- flatten record arguments of param constructors
+  p2p (f,j) = case jform j of
+    ---- JParam ->
+      ----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 = trace (tr v) v
+
+  tr (labels,untyps,typs) =
+     ("labels:" ++++
+       unlines [prt c ++ "." ++ unwords (map prt l) +++ "=" +++ show i  | 
+       ((c,l),i) <- Map.toList labels]) ++
+     ("untyps:" ++++ unlines [prt t +++ "=" +++ show i  | 
+       (t,i) <- Map.toList untyps]) ++
+     ("typs:" ++++ unlines [prt t | 
+       (t,_) <- Map.toList typs])
+----
+-}
+
+purgeGrammar :: Ident -> GF -> GF
+purgeGrammar abstr gr = gr {
+  gfmodules = treat gr
+  }
+ where
+  treat = 
+    Map.fromList . map unopt . filter complete . purge . Map.toList . gfmodules
+  purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
+  needed = 
+     nub $ concatMap (Look.allDepsModule gr) $ 
+           ---- (requiredCanModules True gr) $
+           [mo | m <- abstr : Look.allConcretes gr abstr, 
+                 Ok mo <- [Look.lookupModule gr m]]
+
+  complete (i,mo) = isCompleteModule mo
+  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 :: GF -> ParamEnv
+paramValues cgr = (labels,untyps,typs) where
+
+  jments = [(m,j) | 
+    (m,mo) <- Map.toList (gfmodules cgr), 
+    j <- Map.toList (mjments mo)]
+
+  partyps = nub $ [ty | 
+    (_,(_,ju)) <- jments,
+    jform ju == JLincat,
+    RecType ls <- [jtype ju],
+    ty0 <- [ty | (_, ty) <- unlockTyp ls],
+    ty  <- typsFrom ty0
+   ] ++ [Q m ty | 
+    (m,(ty,ju)) <- jments,
+    jform ju == JParam
+   ] ++ [ty | 
+    (_,(_,ju)) <- jments,
+    jform ju == JLin,
+    ty  <- err (const []) snd $ appSTM (typsFromTrm (jdef ju)) []
+   ]
+  params = [(ty, errVal [] $ Look.allParamValues cgr ty) | ty <- partyps]
+  typsFrom ty = case ty of
+    Table p t  -> typsFrom p ++ typsFrom t
+    RecType ls -> RecType (sort (unlockTyp ls)) : concat [typsFrom t | (_, t) <- ls]
+    _ -> [ty]
+ 
+  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
+
+  typs = 
+    Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params]
+  untyps = 
+    Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs]
+  lincats = 
+    [(IC cat,[(LIdent "s",typeStr)]) | cat <- ["Int", "Float", "String"]] ++
+    reverse ---- TODO: really those lincats that are reached
+            ---- reverse is enough to expel overshadowed ones... 
+      [(cat,(unlockTyp ls)) |
+        (_,(cat,ju)) <- jments,
+        jform ju == JLincat,
+        RecType ls <- [jtype ju]
+       ] 
+  labels = Map.fromList $ concat 
+    [((cat,[lab]),(typ,i)): 
+      [((cat,[lab,lab2]),(ty,j)) | 
+        rs <- getRec typ, ((lab2, ty),j) <- zip rs [0..]] 
+      | 
+        (cat,ls) <- lincats, ((lab, typ),i) <- zip ls [0..]]
+    -- go to tables recursively
+    ---- TODO: even go to deeper records
+   where
+     getRec typ = case typ of
+       RecType rs -> [rs]
+       Table _ t  -> getRec t
+       _ -> []
+
+type2type :: GF -> 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 :: GF -> 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..] (sort (unlock rs))]
+  P  t l   -> r2r tr
+  PI t l i -> EInt $ toInteger i
+  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: errVal t $ Compute.computeConcreteRec cgr t
+   comp 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 (V typ ts) v0 -> err error id $ do
+       let v = comp v0 
+       return $ maybe t (comp . (ts !!) . fromInteger) $ Map.lookup v untyps
+     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 $ 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 $ prt ty
+             _ -> error $ prt tr
+       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 ((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 (IC s) -> return (identC cat,[]) where
+       cat = 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] -> trace (unwords (map prt (Map.keys typs))) $ 
+                  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 (("_" ++ 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
+     _ -> True
+unlockTyp = filter notlock where
+  notlock (l, t) = case t of --- need not look at l
+     RecType [] -> False
+     _ -> True
+
+prtTrace tr n = 
+  trace ("-- INTERNAL COMPILER ERROR" +++ prt tr ++++ show n) n
+prTrace  tr n = trace ("-- OBSERVE" +++ prt tr +++ show n +++ show tr) n
+
diff --git a/src-2.9/GF/Devel/Compile/GetGrammar.hs b/src-2.9/GF/Devel/Compile/GetGrammar.hs
new file mode 100644
index 000000000..b90bd912c
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/GetGrammar.hs
@@ -0,0 +1,56 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.Compile.GetGrammar where
+
+import GF.Devel.UseIO
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+----import GF.Devel.PrGrammar
+import GF.Devel.Compile.SourceToGF
+---- import Macros
+---- import Rename
+--- import Custom
+import GF.Devel.Compile.ParGF
+import qualified GF.Devel.Compile.LexGF as L
+
+import GF.Data.Operations
+import qualified GF.Devel.Compile.ErrM as E ----
+import GF.Infra.Option ----
+import GF.Devel.ReadFiles ----
+
+import Data.Char (toUpper)
+import Data.List (nub)
+import Control.Monad (foldM)
+import System (system)
+
+getSourceModule :: Options -> FilePath -> IOE SourceModule
+getSourceModule opts file0 = do
+  file <- case getOptVal opts usePreprocessor of
+    Just p -> do
+      let tmp = "_gf_preproc.tmp"
+          cmd = p +++ file0 ++ ">" ++ tmp
+      ioeIO $ system cmd
+      -- ioeIO $ putStrLn $ "preproc" +++ cmd
+      return tmp
+    _ -> return file0
+  string    <- readFileIOE file
+  let tokens = myLexer string
+  mo1  <- ioeErr $ err2err $ pModDef tokens
+  ioeErr $ transModDef mo1
+
+err2err e = case e of
+  E.Ok v -> Ok v
+  E.Bad s -> Bad s
+
diff --git a/src-2.9/GF/Devel/Compile/LexGF.hs b/src-2.9/GF/Devel/Compile/LexGF.hs
new file mode 100644
index 000000000..ff8386f49
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/LexGF.hs
@@ -0,0 +1,343 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LINE 3 "GF/Devel/Compile/LexGF.x" #-}
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Devel.Compile.LexGF 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\x26\x00\x00\x00\x27\x00\x00\x00\x13\x00\x00\x00\x9c\x00\x00\x00\x6c\x01\x00\x00\x3c\x02\x00\x00\x0c\x03\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\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\x17\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\x16\x00\x16\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\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x1b\x00\xff\xff\x00\x00\x00\x00\x14\x00\x1b\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\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\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x1c\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\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\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x1c\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x14\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x00\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x14\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\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# "\x13\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\xff\xff\xff\xff\xff\xff\x18\x00\x18\x00\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_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[],[],[(AlexAcc (alex_action_7))],[],[],[],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_9))],[],[],[]]
+{-# LINE 36 "GF/Devel/Compile/LexGF.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_PIdent !String
+ | T_LString !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_PIdent s) -> s
+  PT _ (T_LString 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 "lin" (b "def" (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 "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "let" N N)))) (b "resource" (b "oper" (b "lintype" (b "lindef" (b "lincat" N N) N) (b "open" (b "of" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "type" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" 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_3 = tok (\p s -> PT p (TS $ share s)) 
+alex_action_4 = tok (\p s -> PT p (eitherResIdent (T_PIdent . share) s)) 
+alex_action_5 = tok (\p s -> PT p (eitherResIdent (T_LString . 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 -> 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-2.9/GF/Devel/Compile/Optimize.hs b/src-2.9/GF/Devel/Compile/Optimize.hs
new file mode 100644
index 000000000..746b47b90
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/Optimize.hs
@@ -0,0 +1,333 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.Compile.Optimize (optimizeModule) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+--import GF.Devel.Grammar.PrGF
+import GF.Devel.Grammar.Compute
+
+--import GF.Infra.Ident
+
+import GF.Devel.Grammar.Lookup
+--import GF.Grammar.Refresh
+
+--import GF.Compile.BackOpt
+import GF.Devel.Compile.CheckGrammar
+--import GF.Compile.Update
+
+
+--import GF.Infra.CheckM
+import GF.Infra.Option ----
+
+import GF.Data.Operations
+
+import Control.Monad
+import Data.List
+import qualified Data.Map as Map
+
+import Debug.Trace
+
+
+optimizeModule :: Options -> GF -> SourceModule -> Err SourceModule
+optimizeModule opts gf0 sm@(m,mo) = case mtype mo of
+  MTConcrete _ -> opt sm 
+  MTInstance _ -> optr sm
+  MTGrammar   -> optr sm
+  _ -> return sm
+ where
+   gf = gf0 {gfmodules = Map.insert m mo (gfmodules gf0)}
+   opt (m,mo) = do
+     mo' <- termOpModule (computeTerm gf) mo
+     return (m,mo')
+
+   optr (m,mo)= do
+     let deps = allOperDependencies m $ mjments mo
+     ids <- topoSortOpers deps
+     gf' <- foldM evalOp gf ids
+     mo' <- lookupModule gf' m
+     return $ (m,mo')
+    where
+     evalOp gf i = do
+       ju   <- lookupJudgement gf m i
+       def' <- computeTerm gf (jdef ju)
+       updateJudgement m i (ju {jdef = def'}) gf
+
+
+
+
+{-
+
+-- 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 -- 7/12/2007
+
+type EEnv = () --- not used
+
+-- only do this for resource: concrete is optimized in gfc form
+
+
+
+ =mse@(ms,eenv) mo@(_,mi) = case mi of
+  ModMod m0@(Module mt st fs me ops js) | 
+    st == MSComplete && isModRes m0 && not (oElem oEval oopts)-> do
+      (mo1,_) <- evalModule oopts mse mo
+      let 
+       mo2 = 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
+      return (mo2,eenv)
+  _ -> evalModule oopts mse mo
+ where
+   oopts = addOptions opts (iOpts (flagsModule mo))
+   optim = maybe "all" id $ getOptVal oopts useOptimizer
+
+evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> 
+               Err ((Ident,SourceModInfo),EEnv)
+evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
+
+  ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
+    _ | isModRes m0 && not (oElem oEval oopts) -> do
+      let deps = allOperDependencies name js
+      ids <- topoSortOpers deps
+      MGrammar (mod' : _) <- foldM evalOp gr ids
+      return $ (mod',eenv)
+
+    MTConcrete a -> do
+      js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
+      return $ ((name, ModMod (Module mt st fs me ops 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 = 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) = do
+
+ seq (prtIf (oElem beVerbose opts) 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 ([(strVar, typeStr)], typ) de
+      (Yes typ, Nope)   -> 
+        liftM yes $ mkLinDefault gr typ >>= partEval noOptions gr ([(strVar, 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 | notNewEval -> 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 +++ ":")
+   notNewEval = not (oElem oEval opts)
+
+-- | 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 subst trm1 >>= outCase subst
+             else etaExpand subst trm1
+  return $ mkAbs vars trm3
+
+ where 
+
+   globalTable = oElem showAll opts --- i -all
+
+   comp g t = ---- refreshTerm t >>= 
+              computeTerm gr g t
+
+   etaExpand su t = do
+     t' <- comp su t 
+     case t' of
+       R _ | rightType t' -> comp su t' --- return t' wo noexpand...
+       _ -> recordExpand val t' >>= comp su
+   -- don't eta expand records of right length (correct by type checking)
+   rightType t = case (t,val) of
+     (R rs, RecType ts) -> length rs == length ts
+     _ -> False
+
+   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 strVar . 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 strVar
+     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-2.9/GF/Devel/Compile/ParGF.hs b/src-2.9/GF/Devel/Compile/ParGF.hs
new file mode 100644
index 000000000..ce474e418
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/ParGF.hs
@@ -0,0 +1,3210 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
+module GF.Devel.Compile.ParGF where
+import GF.Devel.Compile.AbsGF
+import GF.Devel.Compile.LexGF
+import GF.Devel.Compile.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 (() -> ())
+happyIn7 :: (Integer) -> (HappyAbsSyn )
+happyIn7 x = unsafeCoerce# x
+{-# INLINE happyIn7 #-}
+happyOut7 :: (HappyAbsSyn ) -> (Integer)
+happyOut7 x = unsafeCoerce# x
+{-# INLINE happyOut7 #-}
+happyIn8 :: (String) -> (HappyAbsSyn )
+happyIn8 x = unsafeCoerce# x
+{-# INLINE happyIn8 #-}
+happyOut8 :: (HappyAbsSyn ) -> (String)
+happyOut8 x = unsafeCoerce# x
+{-# INLINE happyOut8 #-}
+happyIn9 :: (Double) -> (HappyAbsSyn )
+happyIn9 x = unsafeCoerce# x
+{-# INLINE happyIn9 #-}
+happyOut9 :: (HappyAbsSyn ) -> (Double)
+happyOut9 x = unsafeCoerce# x
+{-# INLINE happyOut9 #-}
+happyIn10 :: (PIdent) -> (HappyAbsSyn )
+happyIn10 x = unsafeCoerce# x
+{-# INLINE happyIn10 #-}
+happyOut10 :: (HappyAbsSyn ) -> (PIdent)
+happyOut10 x = unsafeCoerce# x
+{-# INLINE happyOut10 #-}
+happyIn11 :: (LString) -> (HappyAbsSyn )
+happyIn11 x = unsafeCoerce# x
+{-# INLINE happyIn11 #-}
+happyOut11 :: (HappyAbsSyn ) -> (LString)
+happyOut11 x = unsafeCoerce# x
+{-# INLINE happyOut11 #-}
+happyIn12 :: (Grammar) -> (HappyAbsSyn )
+happyIn12 x = unsafeCoerce# x
+{-# INLINE happyIn12 #-}
+happyOut12 :: (HappyAbsSyn ) -> (Grammar)
+happyOut12 x = unsafeCoerce# x
+{-# INLINE happyOut12 #-}
+happyIn13 :: ([ModDef]) -> (HappyAbsSyn )
+happyIn13 x = unsafeCoerce# x
+{-# INLINE happyIn13 #-}
+happyOut13 :: (HappyAbsSyn ) -> ([ModDef])
+happyOut13 x = unsafeCoerce# x
+{-# INLINE happyOut13 #-}
+happyIn14 :: (ModDef) -> (HappyAbsSyn )
+happyIn14 x = unsafeCoerce# x
+{-# INLINE happyIn14 #-}
+happyOut14 :: (HappyAbsSyn ) -> (ModDef)
+happyOut14 x = unsafeCoerce# x
+{-# INLINE happyOut14 #-}
+happyIn15 :: (ModType) -> (HappyAbsSyn )
+happyIn15 x = unsafeCoerce# x
+{-# INLINE happyIn15 #-}
+happyOut15 :: (HappyAbsSyn ) -> (ModType)
+happyOut15 x = unsafeCoerce# x
+{-# INLINE happyOut15 #-}
+happyIn16 :: (ModBody) -> (HappyAbsSyn )
+happyIn16 x = unsafeCoerce# x
+{-# INLINE happyIn16 #-}
+happyOut16 :: (HappyAbsSyn ) -> (ModBody)
+happyOut16 x = unsafeCoerce# x
+{-# INLINE happyOut16 #-}
+happyIn17 :: ([TopDef]) -> (HappyAbsSyn )
+happyIn17 x = unsafeCoerce# x
+{-# INLINE happyIn17 #-}
+happyOut17 :: (HappyAbsSyn ) -> ([TopDef])
+happyOut17 x = unsafeCoerce# x
+{-# INLINE happyOut17 #-}
+happyIn18 :: (Extend) -> (HappyAbsSyn )
+happyIn18 x = unsafeCoerce# x
+{-# INLINE happyIn18 #-}
+happyOut18 :: (HappyAbsSyn ) -> (Extend)
+happyOut18 x = unsafeCoerce# x
+{-# INLINE happyOut18 #-}
+happyIn19 :: ([Open]) -> (HappyAbsSyn )
+happyIn19 x = unsafeCoerce# x
+{-# INLINE happyIn19 #-}
+happyOut19 :: (HappyAbsSyn ) -> ([Open])
+happyOut19 x = unsafeCoerce# x
+{-# INLINE happyOut19 #-}
+happyIn20 :: (Opens) -> (HappyAbsSyn )
+happyIn20 x = unsafeCoerce# x
+{-# INLINE happyIn20 #-}
+happyOut20 :: (HappyAbsSyn ) -> (Opens)
+happyOut20 x = unsafeCoerce# x
+{-# INLINE happyOut20 #-}
+happyIn21 :: (Open) -> (HappyAbsSyn )
+happyIn21 x = unsafeCoerce# x
+{-# INLINE happyIn21 #-}
+happyOut21 :: (HappyAbsSyn ) -> (Open)
+happyOut21 x = unsafeCoerce# x
+{-# INLINE happyOut21 #-}
+happyIn22 :: (ComplMod) -> (HappyAbsSyn )
+happyIn22 x = unsafeCoerce# x
+{-# INLINE happyIn22 #-}
+happyOut22 :: (HappyAbsSyn ) -> (ComplMod)
+happyOut22 x = unsafeCoerce# x
+{-# INLINE happyOut22 #-}
+happyIn23 :: ([Included]) -> (HappyAbsSyn )
+happyIn23 x = unsafeCoerce# x
+{-# INLINE happyIn23 #-}
+happyOut23 :: (HappyAbsSyn ) -> ([Included])
+happyOut23 x = unsafeCoerce# x
+{-# INLINE happyOut23 #-}
+happyIn24 :: (Included) -> (HappyAbsSyn )
+happyIn24 x = unsafeCoerce# x
+{-# INLINE happyIn24 #-}
+happyOut24 :: (HappyAbsSyn ) -> (Included)
+happyOut24 x = unsafeCoerce# x
+{-# INLINE happyOut24 #-}
+happyIn25 :: (TopDef) -> (HappyAbsSyn )
+happyIn25 x = unsafeCoerce# x
+{-# INLINE happyIn25 #-}
+happyOut25 :: (HappyAbsSyn ) -> (TopDef)
+happyOut25 x = unsafeCoerce# x
+{-# INLINE happyOut25 #-}
+happyIn26 :: (Def) -> (HappyAbsSyn )
+happyIn26 x = unsafeCoerce# x
+{-# INLINE happyIn26 #-}
+happyOut26 :: (HappyAbsSyn ) -> (Def)
+happyOut26 x = unsafeCoerce# x
+{-# INLINE happyOut26 #-}
+happyIn27 :: (FunDef) -> (HappyAbsSyn )
+happyIn27 x = unsafeCoerce# x
+{-# INLINE happyIn27 #-}
+happyOut27 :: (HappyAbsSyn ) -> (FunDef)
+happyOut27 x = unsafeCoerce# x
+{-# INLINE happyOut27 #-}
+happyIn28 :: (CatDef) -> (HappyAbsSyn )
+happyIn28 x = unsafeCoerce# x
+{-# INLINE happyIn28 #-}
+happyOut28 :: (HappyAbsSyn ) -> (CatDef)
+happyOut28 x = unsafeCoerce# x
+{-# INLINE happyOut28 #-}
+happyIn29 :: (DataDef) -> (HappyAbsSyn )
+happyIn29 x = unsafeCoerce# x
+{-# INLINE happyIn29 #-}
+happyOut29 :: (HappyAbsSyn ) -> (DataDef)
+happyOut29 x = unsafeCoerce# x
+{-# INLINE happyOut29 #-}
+happyIn30 :: (DataConstr) -> (HappyAbsSyn )
+happyIn30 x = unsafeCoerce# x
+{-# INLINE happyIn30 #-}
+happyOut30 :: (HappyAbsSyn ) -> (DataConstr)
+happyOut30 x = unsafeCoerce# x
+{-# INLINE happyOut30 #-}
+happyIn31 :: ([DataConstr]) -> (HappyAbsSyn )
+happyIn31 x = unsafeCoerce# x
+{-# INLINE happyIn31 #-}
+happyOut31 :: (HappyAbsSyn ) -> ([DataConstr])
+happyOut31 x = unsafeCoerce# x
+{-# INLINE happyOut31 #-}
+happyIn32 :: (ParDef) -> (HappyAbsSyn )
+happyIn32 x = unsafeCoerce# x
+{-# INLINE happyIn32 #-}
+happyOut32 :: (HappyAbsSyn ) -> (ParDef)
+happyOut32 x = unsafeCoerce# x
+{-# INLINE happyOut32 #-}
+happyIn33 :: (ParConstr) -> (HappyAbsSyn )
+happyIn33 x = unsafeCoerce# x
+{-# INLINE happyIn33 #-}
+happyOut33 :: (HappyAbsSyn ) -> (ParConstr)
+happyOut33 x = unsafeCoerce# x
+{-# INLINE happyOut33 #-}
+happyIn34 :: ([Def]) -> (HappyAbsSyn )
+happyIn34 x = unsafeCoerce# x
+{-# INLINE happyIn34 #-}
+happyOut34 :: (HappyAbsSyn ) -> ([Def])
+happyOut34 x = unsafeCoerce# x
+{-# INLINE happyOut34 #-}
+happyIn35 :: ([FunDef]) -> (HappyAbsSyn )
+happyIn35 x = unsafeCoerce# x
+{-# INLINE happyIn35 #-}
+happyOut35 :: (HappyAbsSyn ) -> ([FunDef])
+happyOut35 x = unsafeCoerce# x
+{-# INLINE happyOut35 #-}
+happyIn36 :: ([CatDef]) -> (HappyAbsSyn )
+happyIn36 x = unsafeCoerce# x
+{-# INLINE happyIn36 #-}
+happyOut36 :: (HappyAbsSyn ) -> ([CatDef])
+happyOut36 x = unsafeCoerce# x
+{-# INLINE happyOut36 #-}
+happyIn37 :: ([DataDef]) -> (HappyAbsSyn )
+happyIn37 x = unsafeCoerce# x
+{-# INLINE happyIn37 #-}
+happyOut37 :: (HappyAbsSyn ) -> ([DataDef])
+happyOut37 x = unsafeCoerce# x
+{-# INLINE happyOut37 #-}
+happyIn38 :: ([ParDef]) -> (HappyAbsSyn )
+happyIn38 x = unsafeCoerce# x
+{-# INLINE happyIn38 #-}
+happyOut38 :: (HappyAbsSyn ) -> ([ParDef])
+happyOut38 x = unsafeCoerce# x
+{-# INLINE happyOut38 #-}
+happyIn39 :: ([ParConstr]) -> (HappyAbsSyn )
+happyIn39 x = unsafeCoerce# x
+{-# INLINE happyIn39 #-}
+happyOut39 :: (HappyAbsSyn ) -> ([ParConstr])
+happyOut39 x = unsafeCoerce# x
+{-# INLINE happyOut39 #-}
+happyIn40 :: ([PIdent]) -> (HappyAbsSyn )
+happyIn40 x = unsafeCoerce# x
+{-# INLINE happyIn40 #-}
+happyOut40 :: (HappyAbsSyn ) -> ([PIdent])
+happyOut40 x = unsafeCoerce# x
+{-# INLINE happyOut40 #-}
+happyIn41 :: (Name) -> (HappyAbsSyn )
+happyIn41 x = unsafeCoerce# x
+{-# INLINE happyIn41 #-}
+happyOut41 :: (HappyAbsSyn ) -> (Name)
+happyOut41 x = unsafeCoerce# x
+{-# INLINE happyOut41 #-}
+happyIn42 :: ([Name]) -> (HappyAbsSyn )
+happyIn42 x = unsafeCoerce# x
+{-# INLINE happyIn42 #-}
+happyOut42 :: (HappyAbsSyn ) -> ([Name])
+happyOut42 x = unsafeCoerce# x
+{-# INLINE happyOut42 #-}
+happyIn43 :: (LocDef) -> (HappyAbsSyn )
+happyIn43 x = unsafeCoerce# x
+{-# INLINE happyIn43 #-}
+happyOut43 :: (HappyAbsSyn ) -> (LocDef)
+happyOut43 x = unsafeCoerce# x
+{-# INLINE happyOut43 #-}
+happyIn44 :: ([LocDef]) -> (HappyAbsSyn )
+happyIn44 x = unsafeCoerce# x
+{-# INLINE happyIn44 #-}
+happyOut44 :: (HappyAbsSyn ) -> ([LocDef])
+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 :: (Exp) -> (HappyAbsSyn )
+happyIn46 x = unsafeCoerce# x
+{-# INLINE happyIn46 #-}
+happyOut46 :: (HappyAbsSyn ) -> (Exp)
+happyOut46 x = unsafeCoerce# x
+{-# INLINE happyOut46 #-}
+happyIn47 :: (Exp) -> (HappyAbsSyn )
+happyIn47 x = unsafeCoerce# x
+{-# INLINE happyIn47 #-}
+happyOut47 :: (HappyAbsSyn ) -> (Exp)
+happyOut47 x = unsafeCoerce# x
+{-# INLINE happyOut47 #-}
+happyIn48 :: (Exp) -> (HappyAbsSyn )
+happyIn48 x = unsafeCoerce# x
+{-# INLINE happyIn48 #-}
+happyOut48 :: (HappyAbsSyn ) -> (Exp)
+happyOut48 x = unsafeCoerce# x
+{-# INLINE happyOut48 #-}
+happyIn49 :: (Exp) -> (HappyAbsSyn )
+happyIn49 x = unsafeCoerce# x
+{-# INLINE happyIn49 #-}
+happyOut49 :: (HappyAbsSyn ) -> (Exp)
+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 #-}
+happyIn52 :: ([Exp]) -> (HappyAbsSyn )
+happyIn52 x = unsafeCoerce# x
+{-# INLINE happyIn52 #-}
+happyOut52 :: (HappyAbsSyn ) -> ([Exp])
+happyOut52 x = unsafeCoerce# x
+{-# INLINE happyOut52 #-}
+happyIn53 :: (Exps) -> (HappyAbsSyn )
+happyIn53 x = unsafeCoerce# x
+{-# INLINE happyIn53 #-}
+happyOut53 :: (HappyAbsSyn ) -> (Exps)
+happyOut53 x = unsafeCoerce# x
+{-# INLINE happyOut53 #-}
+happyIn54 :: (Patt) -> (HappyAbsSyn )
+happyIn54 x = unsafeCoerce# x
+{-# INLINE happyIn54 #-}
+happyOut54 :: (HappyAbsSyn ) -> (Patt)
+happyOut54 x = unsafeCoerce# x
+{-# INLINE happyOut54 #-}
+happyIn55 :: (Patt) -> (HappyAbsSyn )
+happyIn55 x = unsafeCoerce# x
+{-# INLINE happyIn55 #-}
+happyOut55 :: (HappyAbsSyn ) -> (Patt)
+happyOut55 x = unsafeCoerce# x
+{-# INLINE happyOut55 #-}
+happyIn56 :: (Patt) -> (HappyAbsSyn )
+happyIn56 x = unsafeCoerce# x
+{-# INLINE happyIn56 #-}
+happyOut56 :: (HappyAbsSyn ) -> (Patt)
+happyOut56 x = unsafeCoerce# x
+{-# INLINE happyOut56 #-}
+happyIn57 :: (PattAss) -> (HappyAbsSyn )
+happyIn57 x = unsafeCoerce# x
+{-# INLINE happyIn57 #-}
+happyOut57 :: (HappyAbsSyn ) -> (PattAss)
+happyOut57 x = unsafeCoerce# x
+{-# INLINE happyOut57 #-}
+happyIn58 :: (Label) -> (HappyAbsSyn )
+happyIn58 x = unsafeCoerce# x
+{-# INLINE happyIn58 #-}
+happyOut58 :: (HappyAbsSyn ) -> (Label)
+happyOut58 x = unsafeCoerce# x
+{-# INLINE happyOut58 #-}
+happyIn59 :: (Sort) -> (HappyAbsSyn )
+happyIn59 x = unsafeCoerce# x
+{-# INLINE happyIn59 #-}
+happyOut59 :: (HappyAbsSyn ) -> (Sort)
+happyOut59 x = unsafeCoerce# x
+{-# INLINE happyOut59 #-}
+happyIn60 :: ([PattAss]) -> (HappyAbsSyn )
+happyIn60 x = unsafeCoerce# x
+{-# INLINE happyIn60 #-}
+happyOut60 :: (HappyAbsSyn ) -> ([PattAss])
+happyOut60 x = unsafeCoerce# x
+{-# INLINE happyOut60 #-}
+happyIn61 :: ([Patt]) -> (HappyAbsSyn )
+happyIn61 x = unsafeCoerce# x
+{-# INLINE happyIn61 #-}
+happyOut61 :: (HappyAbsSyn ) -> ([Patt])
+happyOut61 x = unsafeCoerce# x
+{-# INLINE happyOut61 #-}
+happyIn62 :: (Bind) -> (HappyAbsSyn )
+happyIn62 x = unsafeCoerce# x
+{-# INLINE happyIn62 #-}
+happyOut62 :: (HappyAbsSyn ) -> (Bind)
+happyOut62 x = unsafeCoerce# x
+{-# INLINE happyOut62 #-}
+happyIn63 :: ([Bind]) -> (HappyAbsSyn )
+happyIn63 x = unsafeCoerce# x
+{-# INLINE happyIn63 #-}
+happyOut63 :: (HappyAbsSyn ) -> ([Bind])
+happyOut63 x = unsafeCoerce# x
+{-# INLINE happyOut63 #-}
+happyIn64 :: (Decl) -> (HappyAbsSyn )
+happyIn64 x = unsafeCoerce# x
+{-# INLINE happyIn64 #-}
+happyOut64 :: (HappyAbsSyn ) -> (Decl)
+happyOut64 x = unsafeCoerce# x
+{-# INLINE happyOut64 #-}
+happyIn65 :: (TupleComp) -> (HappyAbsSyn )
+happyIn65 x = unsafeCoerce# x
+{-# INLINE happyIn65 #-}
+happyOut65 :: (HappyAbsSyn ) -> (TupleComp)
+happyOut65 x = unsafeCoerce# x
+{-# INLINE happyOut65 #-}
+happyIn66 :: (PattTupleComp) -> (HappyAbsSyn )
+happyIn66 x = unsafeCoerce# x
+{-# INLINE happyIn66 #-}
+happyOut66 :: (HappyAbsSyn ) -> (PattTupleComp)
+happyOut66 x = unsafeCoerce# x
+{-# INLINE happyOut66 #-}
+happyIn67 :: ([TupleComp]) -> (HappyAbsSyn )
+happyIn67 x = unsafeCoerce# x
+{-# INLINE happyIn67 #-}
+happyOut67 :: (HappyAbsSyn ) -> ([TupleComp])
+happyOut67 x = unsafeCoerce# x
+{-# INLINE happyOut67 #-}
+happyIn68 :: ([PattTupleComp]) -> (HappyAbsSyn )
+happyIn68 x = unsafeCoerce# x
+{-# INLINE happyIn68 #-}
+happyOut68 :: (HappyAbsSyn ) -> ([PattTupleComp])
+happyOut68 x = unsafeCoerce# x
+{-# INLINE happyOut68 #-}
+happyIn69 :: (Case) -> (HappyAbsSyn )
+happyIn69 x = unsafeCoerce# x
+{-# INLINE happyIn69 #-}
+happyOut69 :: (HappyAbsSyn ) -> (Case)
+happyOut69 x = unsafeCoerce# x
+{-# INLINE happyOut69 #-}
+happyIn70 :: ([Case]) -> (HappyAbsSyn )
+happyIn70 x = unsafeCoerce# x
+{-# INLINE happyIn70 #-}
+happyOut70 :: (HappyAbsSyn ) -> ([Case])
+happyOut70 x = unsafeCoerce# x
+{-# INLINE happyOut70 #-}
+happyIn71 :: (Equation) -> (HappyAbsSyn )
+happyIn71 x = unsafeCoerce# x
+{-# INLINE happyIn71 #-}
+happyOut71 :: (HappyAbsSyn ) -> (Equation)
+happyOut71 x = unsafeCoerce# x
+{-# INLINE happyOut71 #-}
+happyIn72 :: ([Equation]) -> (HappyAbsSyn )
+happyIn72 x = unsafeCoerce# x
+{-# INLINE happyIn72 #-}
+happyOut72 :: (HappyAbsSyn ) -> ([Equation])
+happyOut72 x = unsafeCoerce# x
+{-# INLINE happyOut72 #-}
+happyIn73 :: (Altern) -> (HappyAbsSyn )
+happyIn73 x = unsafeCoerce# x
+{-# INLINE happyIn73 #-}
+happyOut73 :: (HappyAbsSyn ) -> (Altern)
+happyOut73 x = unsafeCoerce# x
+{-# INLINE happyOut73 #-}
+happyIn74 :: ([Altern]) -> (HappyAbsSyn )
+happyIn74 x = unsafeCoerce# x
+{-# INLINE happyIn74 #-}
+happyOut74 :: (HappyAbsSyn ) -> ([Altern])
+happyOut74 x = unsafeCoerce# x
+{-# INLINE happyOut74 #-}
+happyIn75 :: (DDecl) -> (HappyAbsSyn )
+happyIn75 x = unsafeCoerce# x
+{-# INLINE happyIn75 #-}
+happyOut75 :: (HappyAbsSyn ) -> (DDecl)
+happyOut75 x = unsafeCoerce# x
+{-# INLINE happyOut75 #-}
+happyIn76 :: ([DDecl]) -> (HappyAbsSyn )
+happyIn76 x = unsafeCoerce# x
+{-# INLINE happyIn76 #-}
+happyOut76 :: (HappyAbsSyn ) -> ([DDecl])
+happyOut76 x = unsafeCoerce# x
+{-# INLINE happyOut76 #-}
+happyIn77 :: (OldGrammar) -> (HappyAbsSyn )
+happyIn77 x = unsafeCoerce# x
+{-# INLINE happyIn77 #-}
+happyOut77 :: (HappyAbsSyn ) -> (OldGrammar)
+happyOut77 x = unsafeCoerce# x
+{-# INLINE happyOut77 #-}
+happyIn78 :: (Include) -> (HappyAbsSyn )
+happyIn78 x = unsafeCoerce# x
+{-# INLINE happyIn78 #-}
+happyOut78 :: (HappyAbsSyn ) -> (Include)
+happyOut78 x = unsafeCoerce# x
+{-# INLINE happyOut78 #-}
+happyIn79 :: (FileName) -> (HappyAbsSyn )
+happyIn79 x = unsafeCoerce# x
+{-# INLINE happyIn79 #-}
+happyOut79 :: (HappyAbsSyn ) -> (FileName)
+happyOut79 x = unsafeCoerce# x
+{-# INLINE happyOut79 #-}
+happyIn80 :: ([FileName]) -> (HappyAbsSyn )
+happyIn80 x = unsafeCoerce# x
+{-# INLINE happyIn80 #-}
+happyOut80 :: (HappyAbsSyn ) -> ([FileName])
+happyOut80 x = unsafeCoerce# x
+{-# INLINE happyOut80 #-}
+happyInTok :: Token -> (HappyAbsSyn )
+happyInTok x = unsafeCoerce# x
+{-# INLINE happyInTok #-}
+happyOutTok :: (HappyAbsSyn ) -> Token
+happyOutTok x = unsafeCoerce# x
+{-# INLINE happyOutTok #-}
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\x00\x00\x34\x04\x2a\x04\xe9\x00\x0d\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x04\x90\x01\x6f\x00\x37\x04\xfa\x03\x35\x04\x00\x00\x31\x04\xe7\x03\xfe\xff\x1c\x00\xe7\x03\x00\x00\xe9\x00\x29\x00\xe7\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x30\x04\x63\x02\x06\x00\x00\x03\x2f\x04\x2e\x04\x58\x02\x2d\x04\x00\x00\x00\x00\x00\x00\x00\x00\xdc\x03\x00\x00\xf9\xff\x01\x00\x6e\x08\x00\x00\xdc\x03\x4e\x00\x2c\x04\x1c\x04\xc6\x03\xc6\x03\xc6\x03\xc6\x03\xc6\x03\xc6\x03\x00\x00\x00\x00\xf9\xff\x13\x04\x00\x00\xf9\xff\xf9\xff\xf9\xff\xf6\x07\xe9\x00\x17\x01\xeb\x02\x9b\x00\xc4\x03\x4d\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x03\x04\x00\x00\xc3\x03\xeb\x02\xc1\x03\x00\x00\xeb\x02\xc0\x03\x00\x00\x0a\x02\x06\x04\x39\x00\x0a\x04\xdb\x03\xb1\x03\x1b\x00\x16\x03\xd4\x03\x00\x00\x00\x00\xf3\x03\xdf\x03\x77\x00\x00\x00\xee\x03\xf0\x03\xe2\x03\x43\x02\xeb\x03\xff\x01\x00\x00\xd6\x00\xea\x03\xe5\x03\xf4\x01\x8d\x02\xe8\x03\x4d\x00\x37\x01\x4d\x00\x37\x01\x37\x01\x37\x01\x4d\x00\xe1\x03\xd6\x03\xef\xff\x00\x00\x00\x00\x96\x03\x8d\x03\x00\x00\xf4\x01\xf4\x01\xf4\x01\x00\x00\xf4\x01\x7b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x03\x8d\x03\xd3\x03\x4d\x00\x00\x00\xa6\x01\xd0\x03\x89\x03\x00\x00\x89\x03\x00\x00\x00\x00\x4d\x00\x4d\x00\xbe\x03\x4d\x00\x77\x00\xd2\x03\x16\x03\xbc\x03\xd1\x03\xcc\x03\x00\x00\xc7\x03\x4d\x00\x84\x03\x4d\x00\x4d\x00\xbd\x03\xa7\x03\xb1\x02\xa3\x03\x00\x00\xf9\x00\xad\x03\x99\x03\x16\x03\xa8\x03\x7a\x02\xe8\x01\xae\x03\xa9\x03\xa0\x03\x54\x03\xa1\x03\x9e\x03\x93\x03\x83\x03\x87\x02\x5f\x01\x8a\x03\x86\x03\xeb\x02\x4d\x00\x81\x03\x00\x00\x2b\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x34\x03\x34\x03\x28\x00\x02\x00\x34\x03\x28\x00\x00\x00\x00\x00\x00\x00\xf9\xff\x00\x00\x00\x00\x00\x00\x4b\x03\x00\x00\x49\x03\x00\x00\x18\x00\x2f\x02\x00\x00\x46\x03\x78\x03\x30\x00\x32\x03\x32\x03\x32\x03\x32\x03\x00\x00\x00\x00\x76\x03\x00\x00\xd6\x02\x33\x00\x25\x03\x72\x03\x00\x00\x28\x00\x28\x00\x00\x00\x6e\x03\x6a\x03\x00\x00\x57\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x03\x00\x00\x64\x03\x4a\x03\x00\x00\x00\x00\x53\x03\x00\x00\x00\x00\x87\x00\x00\x00\x4f\x03\x00\x00\xfc\x02\x00\x00\x40\x03\x44\x03\x00\x00\xc7\x02\xc7\x02\xc7\x02\x4d\x00\x00\x00\xf6\x02\x16\x03\x00\x00\x4d\x00\x4d\x00\x00\x00\x00\x00\xf6\x02\xc7\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x02\x00\x00\xf6\x02\x42\x03\x00\x00\x00\x00\x00\x00\x14\x03\x00\x00\x16\x03\x4d\x00\x00\x00\xc7\x02\x00\x00\x00\x00\x4d\x00\x24\x03\x00\x00\x00\x00\x00\x00\xb4\x01\x00\x00\x00\x00\x38\x03\x00\x00\x30\x03\x00\x00\x2e\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x03\x00\x00\x00\x00\x4d\x00\x4d\x00\x00\x00\x00\x00\xf9\x00\x00\x00\x0b\x03\x20\x03\x1a\x03\x00\x00\x00\x00\x16\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x9b\x01\xe4\x02\xfa\xff\xfa\xff\x4d\x00\xfa\xff\x19\x03\xd9\x02\xd9\x02\x00\x00\x00\x00\x00\x00\x0e\x03\x4d\x00\x4d\x00\x10\x03\xfa\xff\x00\x00\x00\x00\x00\x00\x11\x03\x00\x00\xbc\x02\x0a\x00\xbc\x02\x07\x03\x0a\x00\xb9\x02\xfb\x02\xb3\x02\xf7\x02\x00\x00\xcb\x02\xf3\x02\xa9\x02\x00\x00\xaa\x02\xee\x02\x00\x00\x00\x00\x4d\x00\xe3\x02\x00\x00\x00\x00\x00\x00\xda\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x02\x00\x00\xd7\x02\xd2\x02\x00\x00\x00\x00\x00\x00\xfe\xff\x00\x00\x42\x01\x00\x00\x00\x00\x4d\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdb\x02\xcf\x02\x82\x02\x82\x02\x91\x03\x82\x02\x9b\x01\x4d\x00\x00\x00\xa0\x02\x0a\x00\x71\x03\xcd\x02\x0a\x00\x00\x00\x00\x00\xbe\x02\x00\x00\x00\x00\x6e\x02\x00\x00\xc4\x02\xb8\x02\x00\x00\x00\x00\xb5\x02\x00\x00\x00\x00\x4d\x00\x69\x02\xa7\x02\xa2\x02\x00\x00\x00\x00\x6f\x02\x97\x02\x00\x00\x9a\x02\x51\x03\x00\x00\x00\x00\x00\x00\x00\x00\x31\x03\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\x78\x00\x22\x02\x8b\x01\x9e\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x03\x54\x04\x3c\x01\x96\x02\x00\x00\x17\x04\xca\x00\x93\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x07\x00\x00\x00\x00\xf2\x07\x6f\x03\x3c\x02\x00\x00\x00\x00\xd3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x02\x19\x00\x00\x00\x81\x02\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x6d\x02\x6b\x02\x6a\x02\x5f\x02\x5d\x02\x5b\x02\x00\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x22\x00\x13\x00\x07\x00\x4b\x02\xc8\x04\x00\x00\x4d\x01\x64\x07\x59\x02\xac\x04\x46\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x01\x46\x02\x50\x02\x00\x00\x0c\x03\x47\x02\x00\x00\xe7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x03\x44\x02\xf3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x07\x00\x00\x00\x00\x00\x00\x00\x00\x44\x04\x00\x00\x00\x00\x2a\x07\xc3\x02\x0c\x07\xbc\x07\xad\x07\x2b\x03\xf0\x06\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x1c\x02\x1d\x03\x00\x00\x28\x04\x28\x04\x28\x04\x00\x00\x28\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x00\x08\x02\x00\x00\xd2\x06\x00\x00\xcb\x07\x00\x00\x9b\x02\x00\x00\x07\x02\x00\x00\x00\x00\xfb\x03\xb6\x06\x00\x00\x98\x06\x5d\x00\x00\x00\xcb\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x06\x00\x01\x5e\x06\x42\x06\x00\x00\x00\x00\x67\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x67\x01\x00\x00\x00\x00\x00\x00\xc0\x01\x8e\x04\x00\x00\x00\x00\x91\x01\xf4\x07\x77\x08\x75\x08\x69\x08\x64\x08\x5e\x08\x53\x08\x50\x08\x47\x08\xea\x01\x69\x01\x42\x08\x3d\x08\xdf\x01\x39\x08\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x01\x00\x00\x00\x00\xd4\x01\x00\x00\x00\x00\xd5\x01\x8a\x01\xc2\x01\xa0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x41\x01\x00\x00\x95\x01\x00\x00\x00\x00\x2c\x08\xa0\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x01\x00\x00\x00\x00\x87\x01\x00\x00\x00\x00\x00\x00\x00\x00\xd5\x00\xed\x03\x7d\x02\x24\x06\x00\x00\x7c\x01\x37\x00\x00\x00\x72\x04\xdd\x03\x00\x00\x00\x00\xd7\x01\x24\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x02\x00\x00\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x08\x06\x00\x00\x84\x00\x00\x00\x00\x00\xea\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x05\xb0\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x01\x6c\x01\xad\x00\x47\x01\xa6\x00\x0d\x01\x94\x05\x26\x08\x00\x00\xb3\x00\x59\x01\x00\x00\x00\x00\x00\x00\x00\x00\x76\x05\x5a\x05\x00\x00\xa2\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x01\xab\x02\x90\x00\x00\x00\x2d\x02\xcd\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x01\x26\x01\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x05\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x11\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x04\x00\x00\xad\x00\x00\x00\x00\x00\xbf\x03\x20\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xf4\x00\xdb\x00\xfc\x00\xad\x00\x02\x05\x00\x00\xd3\x00\xcd\x01\xbc\x00\x00\x00\x99\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xda\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe6\x04\xcb\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x8d\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x53\x00\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\xf5\xff\xd8\xff\x17\xff\x00\x00\x00\x00\xfb\xff\x8e\xff\x8f\xff\x8d\xff\x93\xff\x82\xff\x7e\xff\x73\xff\x6e\xff\x60\xff\x61\xff\x00\x00\x6c\xff\x90\xff\x00\x00\x96\xff\x34\xff\x00\x00\x00\x00\x8c\xff\x2d\xff\x34\xff\x00\x00\x3f\xff\x3d\xff\x3c\xff\x3e\xff\x40\xff\x00\x00\x8a\xff\x00\x00\x00\x00\x96\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xff\xf9\xff\xf8\xff\xf7\xff\x00\x00\xe3\xff\x00\x00\x00\x00\x00\x00\xd7\xff\x00\x00\xd8\xff\xf4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\xff\x15\xff\x14\xff\x00\x00\x16\xff\x00\x00\x00\x00\x00\x00\x18\xff\x5f\xff\x00\x00\x96\xff\x00\x00\x00\x00\x5f\xff\x00\x00\x52\xff\x50\xff\x51\xff\x55\xff\x75\xff\x3b\xff\x00\x00\x00\x00\x5a\xff\x2a\xff\x00\x00\x56\xff\x00\x00\x9f\xff\x00\x00\x95\xff\x00\x00\x96\xff\x00\x00\x23\xff\x00\x00\x72\xff\x36\xff\x33\xff\x00\x00\x34\xff\x35\xff\x2f\xff\x2c\xff\x00\x00\x00\x00\x00\x00\x5c\xff\x8b\xff\x93\xff\x00\x00\x00\x00\x00\x00\x9f\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\xff\x00\x00\x42\xff\x81\xff\x00\x00\x96\xff\x67\xff\x70\xff\x71\xff\x6f\xff\x6b\xff\x6e\xff\x60\xff\x6d\xff\x68\xff\x87\xff\x92\xff\x00\x00\x00\x00\x93\xff\x00\x00\x83\xff\x5c\xff\x00\x00\x96\xff\x88\xff\x00\x00\x91\xff\x86\xff\x2d\xff\x00\x00\x00\x00\x00\x00\x34\xff\x00\x00\x38\xff\x00\x00\x22\xff\x00\x00\x62\xff\x00\x00\x00\x00\x96\xff\x00\x00\x00\x00\x74\xff\x58\xff\x55\xff\x47\xff\x44\xff\x2e\xff\x29\xff\x00\x00\x00\x00\x00\x00\x00\x00\x9f\xff\x00\x00\x3a\xff\x00\x00\x00\x00\x00\x00\x5e\xff\x00\x00\x00\x00\x9f\xff\x00\x00\x26\xff\x00\x00\x00\x00\x5f\xff\x00\x00\xe2\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\x13\xff\x12\xff\x11\xff\x0f\xff\x10\xff\xf0\xff\xee\xff\x00\x00\xef\xff\x00\x00\xf1\xff\xd6\xff\xd3\xff\xf2\xff\xdc\xff\xea\xff\xd5\xff\x00\x00\xd6\xff\x00\x00\x00\x00\x0e\xff\x9d\xff\x00\x00\xbf\xff\x9b\xff\x00\x00\x00\x00\x00\x00\xc3\xff\x00\x00\x00\x00\xc1\xff\xae\xff\x00\x00\xcb\xff\x00\x00\xca\xff\xc2\xff\xc8\xff\xc9\xff\xc7\xff\x00\x00\xcf\xff\x9b\xff\x00\x00\xc4\xff\xcd\xff\x00\x00\xce\xff\xcc\xff\x9b\xff\x1a\xff\x00\x00\xd0\xff\x00\x00\x78\xff\x00\x00\x00\x00\x7c\xff\x00\x00\x00\x00\x00\x00\x00\x00\x4c\xff\x00\x00\x00\x00\x76\xff\x5f\xff\x1f\xff\x53\xff\x4f\xff\x3b\xff\x00\x00\x54\xff\x4d\xff\x59\xff\x48\xff\x4e\xff\x2a\xff\x4a\xff\x00\x00\x99\xff\x98\xff\x94\xff\x65\xff\x00\x00\x63\xff\x23\xff\x00\x00\x37\xff\x00\x00\x32\xff\x6a\xff\x00\x00\x00\x00\x2f\xff\x2b\xff\x7f\xff\x9f\xff\x89\xff\x5b\xff\x00\x00\x85\xff\x00\x00\x9e\xff\x00\x00\x41\xff\x64\xff\x80\xff\x31\xff\x84\xff\x69\xff\x00\x00\x24\xff\x21\xff\x00\x00\x00\x00\x57\xff\x28\xff\x43\xff\x39\xff\x00\x00\x1e\xff\x00\x00\x5d\xff\x49\xff\x53\xff\x27\xff\x45\xff\x46\xff\x25\xff\x7b\xff\x7a\xff\x1a\xff\xa8\xff\xb8\xff\xb2\xff\x00\x00\xa6\xff\x00\x00\xaa\xff\x00\x00\xa4\xff\xa2\xff\xc5\xff\xc6\xff\xbe\xff\x00\x00\x00\x00\x00\x00\x00\x00\xac\xff\xec\xff\xed\xff\xe4\xff\xd5\xff\xe5\xff\xd6\xff\xdf\xff\xe1\xff\x00\x00\xdf\xff\x00\x00\x00\x00\x00\x00\x00\x00\xda\xff\x00\x00\xde\xff\x00\x00\xe3\xff\x00\x00\xe9\xff\xd4\xff\xab\xff\x00\x00\xbd\xff\xbc\xff\x9c\xff\x1a\xff\xa1\xff\xaf\xff\xa3\xff\xe3\xff\xa9\xff\xb9\xff\xa5\xff\x00\x00\x9a\xff\xb4\xff\xb1\xff\xb5\xff\x1b\xff\x19\xff\x34\xff\xa7\xff\x00\x00\x4b\xff\x77\xff\x1f\xff\x00\x00\x97\xff\x66\xff\x79\xff\x20\xff\x1d\xff\xb7\xff\x00\x00\xb2\xff\x00\x00\x00\x00\xa2\xff\xad\xff\x00\x00\xbb\xff\xdc\xff\xdf\xff\x00\x00\x00\x00\xdf\xff\xdb\xff\xd2\xff\x00\x00\xd1\xff\xdd\xff\x00\x00\xeb\xff\xe7\xff\x00\x00\xba\xff\xa0\xff\x00\x00\xb3\xff\xb0\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xff\xe3\xff\xdc\xff\x00\x00\xd9\xff\x00\x00\x00\x00\x1c\xff\xb6\xff\xe8\xff\xe3\xff\x00\x00\xe6\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\x03\x00\x01\x00\x09\x00\x0b\x00\x07\x00\x0d\x00\x09\x00\x01\x00\x03\x00\x03\x00\x09\x00\x1d\x00\x0f\x00\x10\x00\x11\x00\x01\x00\x07\x00\x03\x00\x03\x00\x01\x00\x17\x00\x03\x00\x1e\x00\x0a\x00\x1b\x00\x01\x00\x03\x00\x03\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x01\x00\x26\x00\x03\x00\x0a\x00\x29\x00\x0d\x00\x27\x00\x2c\x00\x07\x00\x09\x00\x2f\x00\x01\x00\x2d\x00\x03\x00\x09\x00\x34\x00\x0f\x00\x09\x00\x02\x00\x06\x00\x00\x00\x01\x00\x02\x00\x03\x00\x02\x00\x3e\x00\x3f\x00\x4f\x00\x0c\x00\x17\x00\x43\x00\x44\x00\x33\x00\x1b\x00\x0c\x00\x4d\x00\x49\x00\x4f\x00\x4f\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x48\x00\x03\x00\x4f\x00\x3a\x00\x52\x00\x07\x00\x4f\x00\x09\x00\x48\x00\x49\x00\x4f\x00\x42\x00\x48\x00\x0f\x00\x10\x00\x11\x00\x47\x00\x03\x00\x48\x00\x49\x00\x03\x00\x17\x00\x12\x00\x2f\x00\x4f\x00\x4d\x00\x4d\x00\x48\x00\x4f\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x4f\x00\x26\x00\x05\x00\x48\x00\x29\x00\x4f\x00\x4f\x00\x2c\x00\x4f\x00\x4b\x00\x2f\x00\x05\x00\x06\x00\x31\x00\x05\x00\x34\x00\x13\x00\x14\x00\x00\x00\x01\x00\x02\x00\x03\x00\x19\x00\x02\x00\x0d\x00\x3e\x00\x3f\x00\x06\x00\x13\x00\x14\x00\x43\x00\x44\x00\x1b\x00\x03\x00\x37\x00\x38\x00\x49\x00\x37\x00\x38\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x12\x00\x52\x00\x11\x00\x07\x00\x03\x00\x09\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x17\x00\x2f\x00\x30\x00\x31\x00\x03\x00\x17\x00\x18\x00\x4a\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0a\x00\x26\x00\x3e\x00\x3f\x00\x29\x00\x03\x00\x4f\x00\x2c\x00\x22\x00\x23\x00\x2f\x00\x00\x00\x19\x00\x03\x00\x12\x00\x34\x00\x03\x00\x03\x00\x1f\x00\x26\x00\x2f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x3e\x00\x3f\x00\x36\x00\x06\x00\x03\x00\x43\x00\x44\x00\x0d\x00\x34\x00\x0c\x00\x21\x00\x49\x00\x40\x00\x41\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x12\x00\x21\x00\x21\x00\x07\x00\x44\x00\x09\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x17\x00\x37\x00\x38\x00\x03\x00\x2f\x00\x30\x00\x31\x00\x0e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x15\x00\x26\x00\x03\x00\x03\x00\x29\x00\x3e\x00\x3f\x00\x2c\x00\x1a\x00\x09\x00\x2f\x00\x0b\x00\x03\x00\x0a\x00\x20\x00\x34\x00\x10\x00\x11\x00\x09\x00\x21\x00\x2f\x00\x16\x00\x24\x00\x25\x00\x45\x00\x3e\x00\x3f\x00\x36\x00\x2f\x00\x1e\x00\x43\x00\x44\x00\x03\x00\x22\x00\x0a\x00\x36\x00\x49\x00\x40\x00\x41\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x10\x00\x11\x00\x01\x00\x07\x00\x03\x00\x09\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x03\x00\x09\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x03\x00\x45\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x03\x00\x26\x00\x17\x00\x18\x00\x29\x00\x03\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x03\x00\x0e\x00\x21\x00\x03\x00\x2f\x00\x24\x00\x25\x00\x1a\x00\x15\x00\x3e\x00\x3f\x00\x36\x00\x19\x00\x20\x00\x43\x00\x44\x00\x2f\x00\x30\x00\x31\x00\x03\x00\x49\x00\x15\x00\x19\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x1f\x00\x1d\x00\x03\x00\x3e\x00\x3f\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x03\x00\x45\x00\x2f\x00\x07\x00\x03\x00\x09\x00\x10\x00\x11\x00\x03\x00\x36\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x03\x00\x09\x00\x0c\x00\x15\x00\x0e\x00\x18\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x1d\x00\x09\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0f\x00\x10\x00\x11\x00\x04\x00\x29\x00\x06\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x03\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x03\x00\x46\x00\x47\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x03\x00\x0c\x00\x03\x00\x0e\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x0d\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x04\x00\x03\x00\x06\x00\x2f\x00\x30\x00\x31\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x21\x00\x26\x00\x2f\x00\x07\x00\x03\x00\x09\x00\x3e\x00\x3f\x00\x03\x00\x36\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x34\x00\x09\x00\x32\x00\x03\x00\x03\x00\x35\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x2f\x00\x09\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0f\x00\x10\x00\x11\x00\x00\x00\x29\x00\x21\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x07\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x32\x00\x03\x00\x0f\x00\x35\x00\x29\x00\x00\x00\x01\x00\x02\x00\x03\x00\x09\x00\x0c\x00\x0b\x00\x0e\x00\x00\x00\x01\x00\x02\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x01\x00\x00\x00\x01\x00\x02\x00\x03\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x0d\x00\x01\x00\x0f\x00\x2f\x00\x30\x00\x31\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x03\x00\x12\x00\x03\x00\x07\x00\x03\x00\x09\x00\x03\x00\x2f\x00\x30\x00\x31\x00\x03\x00\x0f\x00\x10\x00\x11\x00\x07\x00\x2f\x00\x09\x00\x03\x00\x03\x00\x3b\x00\x03\x00\x3d\x00\x0f\x00\x10\x00\x11\x00\x2f\x00\x30\x00\x31\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x00\x00\x01\x00\x02\x00\x03\x00\x29\x00\x08\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x0e\x00\x08\x00\x03\x00\x04\x00\x29\x00\x06\x00\x07\x00\x15\x00\x09\x00\x04\x00\x0a\x00\x06\x00\x0d\x00\x0e\x00\x03\x00\x10\x00\x11\x00\x03\x00\x0d\x00\x14\x00\x15\x00\x03\x00\x03\x00\x08\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x3a\x00\x08\x00\x04\x00\x2f\x00\x30\x00\x03\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x03\x00\x4c\x00\x01\x00\x0c\x00\x07\x00\x0e\x00\x09\x00\x03\x00\x21\x00\x4f\x00\x0d\x00\x24\x00\x25\x00\x10\x00\x11\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x0a\x00\x05\x00\x03\x00\x1a\x00\x1b\x00\x1c\x00\x07\x00\x02\x00\x09\x00\x4f\x00\x0b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x10\x00\x11\x00\x03\x00\x3a\x00\x0c\x00\x06\x00\x07\x00\x03\x00\x09\x00\x0e\x00\x1a\x00\x1b\x00\x02\x00\x0d\x00\x02\x00\x10\x00\x11\x00\x0e\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x03\x00\x2c\x00\x1a\x00\x1b\x00\x07\x00\x05\x00\x09\x00\x4b\x00\x0b\x00\x34\x00\x4f\x00\x06\x00\x2f\x00\x10\x00\x11\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x0a\x00\x4f\x00\x03\x00\x09\x00\x1a\x00\x1b\x00\x07\x00\x4f\x00\x09\x00\x03\x00\x4f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x10\x00\x11\x00\x02\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x06\x00\x0a\x00\x03\x00\x1a\x00\x1b\x00\x03\x00\x07\x00\x04\x00\x09\x00\x03\x00\x01\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x10\x00\x11\x00\x4f\x00\x1e\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x1a\x00\x1b\x00\x04\x00\x4f\x00\x04\x00\x04\x00\x12\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x2f\x00\x30\x00\x31\x00\x21\x00\x03\x00\x08\x00\x24\x00\x25\x00\x2f\x00\x02\x00\x4f\x00\x46\x00\x3b\x00\x04\x00\x3d\x00\x0a\x00\x4f\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x01\x00\x26\x00\x27\x00\x28\x00\x01\x00\x04\x00\x0c\x00\x01\x00\x27\x00\x02\x00\x29\x00\x2a\x00\x2b\x00\x21\x00\x2d\x00\x34\x00\x24\x00\x25\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x35\x00\x36\x00\x37\x00\x38\x00\x06\x00\x01\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x02\x00\x40\x00\x03\x00\x01\x00\x4f\x00\x04\x00\x45\x00\x01\x00\x27\x00\x48\x00\x29\x00\x2a\x00\x2b\x00\x05\x00\x2d\x00\x03\x00\x3a\x00\x4f\x00\x39\x00\x4f\x00\x39\x00\x04\x00\x35\x00\x36\x00\x37\x00\x38\x00\x04\x00\x01\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x21\x00\x40\x00\x0f\x00\x24\x00\x25\x00\x04\x00\x45\x00\x04\x00\x27\x00\x48\x00\x29\x00\x2a\x00\x2b\x00\x21\x00\x2d\x00\x01\x00\x24\x00\x25\x00\x01\x00\x4f\x00\x04\x00\x03\x00\x35\x00\x36\x00\x37\x00\x38\x00\x01\x00\x12\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x02\x00\x40\x00\x0a\x00\x06\x00\x0d\x00\x13\x00\x45\x00\x14\x00\x27\x00\x48\x00\x29\x00\x2a\x00\x2b\x00\x1b\x00\x2d\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x22\x00\x23\x00\x35\x00\x36\x00\x37\x00\x38\x00\x0d\x00\x04\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x04\x00\x40\x00\x01\x00\x4f\x00\x18\x00\x03\x00\x45\x00\x19\x00\x4f\x00\x48\x00\x0a\x00\x08\x00\x4f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x4c\x00\x0d\x00\x03\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x0c\x00\x08\x00\x34\x00\x12\x00\x0a\x00\x06\x00\x18\x00\x39\x00\x06\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x4f\x00\x42\x00\x43\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2f\x00\x01\x00\x06\x00\x39\x00\x4d\x00\x4f\x00\x0d\x00\x34\x00\x4f\x00\x4f\x00\x01\x00\x4f\x00\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x2f\x00\x30\x00\x02\x00\x42\x00\x43\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x01\x00\x52\x00\x34\x00\x03\x00\x03\x00\x03\x00\x03\x00\x39\x00\x3a\x00\x4f\x00\x3c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x18\x00\x15\x00\x34\x00\x52\x00\x16\x00\x26\x00\x27\x00\x39\x00\x3a\x00\x0d\x00\x3c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x4c\x00\x30\x00\xff\xff\x34\x00\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x34\x00\xff\xff\xff\xff\x37\x00\x38\x00\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x34\x00\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\x37\x00\x38\x00\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x03\x00\xff\xff\xff\xff\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x13\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\xff\xff\x1b\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\x22\x00\x23\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\x34\x00\x26\x00\x27\x00\x28\x00\xff\xff\x39\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\x26\x00\x27\x00\x28\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x34\x00\x26\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x03\x00\xff\xff\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x26\x00\x34\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x2e\x00\xff\xff\x14\x00\xff\xff\x16\x00\xff\xff\x34\x00\x26\x00\x27\x00\xff\xff\x1c\x00\xff\xff\x1e\x00\xff\xff\xff\xff\xff\xff\x22\x00\x23\x00\x26\x00\x27\x00\xff\xff\x34\x00\xff\xff\x27\x00\xff\xff\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x34\x00\x26\x00\x27\x00\x03\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x03\x00\xff\xff\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x34\x00\x40\x00\xff\xff\xff\xff\xff\xff\x14\x00\x45\x00\x03\x00\xff\xff\x48\x00\x13\x00\x03\x00\xff\xff\x1c\x00\xff\xff\xff\xff\x03\x00\xff\xff\x1b\x00\x22\x00\x23\x00\x03\x00\xff\xff\x13\x00\xff\xff\x22\x00\x23\x00\x13\x00\xff\xff\xff\xff\x03\x00\x1b\x00\x13\x00\x03\x00\xff\xff\x1b\x00\xff\xff\x13\x00\x22\x00\x23\x00\x1b\x00\xff\xff\x22\x00\x23\x00\x03\x00\x1b\x00\x13\x00\x22\x00\x23\x00\x13\x00\x03\x00\xff\xff\x22\x00\x23\x00\x1b\x00\x03\x00\xff\xff\x1b\x00\xff\xff\xff\xff\x13\x00\x22\x00\x23\x00\xff\xff\x22\x00\x23\x00\x13\x00\x03\x00\x1b\x00\x03\x00\xff\xff\xff\xff\x14\x00\xff\xff\x1b\x00\x22\x00\x23\x00\xff\xff\xff\xff\xff\xff\x1c\x00\x22\x00\x23\x00\x13\x00\xff\xff\x13\x00\x22\x00\x23\x00\xff\xff\xff\xff\xff\xff\x1b\x00\xff\xff\x1b\x00\x25\x00\xff\xff\xff\xff\x28\x00\x22\x00\x23\x00\x22\x00\x23\x00\xff\xff\x2e\x00\xff\xff\xff\xff\xff\xff\x32\x00\x33\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\x41\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"#
+
+happyTable :: HappyAddr
+happyTable = HappyA# "\x00\x00\x15\x00\x40\x00\xf4\x00\x45\x00\x16\x00\x46\x00\x17\x00\x40\x00\x61\x00\x41\x00\xf4\x00\x84\x00\x18\x00\x19\x00\x1a\x00\x40\x00\x83\x01\x41\x00\x81\x00\x40\x00\x1b\x00\x41\x00\x47\x00\xd2\x01\x6a\x00\x40\x00\xe0\xff\x41\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x40\x00\x22\x00\x41\x00\x71\x00\x23\x00\x81\x00\xf7\x00\x24\x00\x37\x00\x10\x01\x75\x00\x40\x00\xf8\x00\x41\x00\xf4\x00\x26\x00\x33\x00\x10\x01\x6e\x01\x77\x01\x4f\x00\x50\x00\x51\x00\x52\x00\xab\x00\x27\x00\x28\x00\x2e\x00\x6f\x01\x69\x00\x29\x00\x2a\x00\x82\x00\x6a\x00\xac\x00\x2c\x00\x2b\x00\x2e\x00\x2e\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xd8\x00\x15\x00\x2e\x00\xe0\xff\xff\xff\x16\x00\x2e\x00\x17\x00\x42\x00\xed\x00\x2e\x00\xea\x00\xd9\x00\x18\x00\x19\x00\x1a\x00\xeb\x00\x65\x00\x42\x00\x43\x00\x65\x00\x1b\x00\xc7\x00\x56\x01\x2e\x00\x2c\x00\x2c\x00\xda\x00\x2e\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x2e\x00\x22\x00\x7b\x00\xdc\x00\x23\x00\x2e\x00\x2e\x00\x24\x00\x2e\x00\x78\x01\x25\x00\x35\x00\x36\x00\x35\x00\x7b\x00\x26\x00\x7c\x00\x7d\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x7e\x00\x62\x01\xcc\x01\x27\x00\x28\x00\x63\x01\x7c\x00\x7d\x00\x29\x00\x2a\x00\x6a\x00\xe4\x00\x66\x00\x34\x01\x2b\x00\x66\x00\x9e\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\xc7\x00\xf6\xff\x84\x01\x16\x00\x96\x01\x17\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xee\x00\x18\x00\x19\x00\x1a\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x1b\x00\xaf\x00\xb0\x00\xc1\x00\xf9\x00\x97\x01\xc2\x01\x7f\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xcd\x01\x22\x00\xc2\x00\x49\x01\x23\x00\x5c\x00\x2e\x00\x24\x00\x04\x01\x95\x01\x75\x00\xc5\x01\xfa\x00\x65\x00\xc7\x00\x26\x00\x5c\x00\x5c\x00\x8f\x01\x99\x01\xa2\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x27\x00\x28\x00\xa3\x00\x36\xff\xca\x01\x29\x00\x2a\x00\xbd\x01\x12\x00\x36\xff\xb7\x01\x2b\x00\xa4\x00\x4b\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\xc7\x00\x7e\x01\x41\x01\x16\x00\x9a\x01\x17\x00\x4f\x00\x50\x00\x51\x00\x52\x00\xc1\x01\x18\x00\x19\x00\x1a\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x8c\x01\x1b\x00\x66\x00\x67\x00\x5c\x00\xaf\x00\xb0\x00\xc1\x00\x16\x01\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x17\x01\x22\x00\xee\x00\xe4\x00\x23\x00\xc2\x00\x5b\x01\x24\x00\x8d\x01\xe5\x00\x25\x00\xe6\x00\xc5\x00\xab\x01\xbf\x01\x26\x00\xe7\x00\xe8\x00\xc6\x00\x5d\x00\xa2\x00\x08\x01\x5e\x00\x2c\x01\xad\x01\x27\x00\x28\x00\xa3\x00\xa2\x00\x93\x01\x29\x00\x2a\x00\xe4\x00\x94\x01\xb2\x01\x9e\x01\x2b\x00\xa4\x00\xa5\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\x86\x01\x74\x01\x6e\x00\x4c\x00\x6f\x00\x17\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x98\x00\x18\x00\x19\x00\x1a\x00\x9c\x01\x96\x01\x17\x00\xa8\x01\x4f\x00\x50\x00\x51\x00\xc0\x00\x4d\x00\x19\x00\x1a\x00\xb3\x01\x9d\x01\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x8c\x01\x22\x00\x97\x01\x98\x01\x23\x00\x4e\x01\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x23\x00\xf9\x00\x16\x01\x5d\x00\x0c\x01\xa2\x00\x5e\x00\x76\x00\x8d\x01\x17\x01\x27\x00\x28\x00\x6f\x01\x18\x01\x8e\x01\x29\x00\x2a\x00\xaf\x00\xb0\x00\xc1\x00\x57\x01\x2b\x00\x0d\x01\xfa\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xfb\x00\x9c\x01\x5e\x01\xc2\x00\xc3\x00\xe4\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\x0c\x01\x60\x01\xa2\x00\x4c\x00\x6c\x01\x17\x00\x73\x01\x74\x01\x7f\x01\x18\x01\x98\x00\x18\x00\x19\x00\x1a\x00\x9c\x01\x71\x01\x17\x00\xb9\x01\x0d\x01\x81\x01\x30\xff\x98\x00\x4d\x00\x19\x00\x1a\x00\x4c\x00\x0e\x01\x17\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4d\x00\x19\x00\x1a\x00\x90\x00\x23\x00\x91\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x23\x00\x72\x01\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x23\x00\x7f\x01\x2f\x00\x30\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x75\x01\xbc\x01\x5c\x00\x81\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x79\x01\xf4\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x23\x01\xfc\x00\x91\x00\xaf\x00\xb0\x00\xc1\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x15\x00\xb8\x00\x49\x00\xa2\x00\x4c\x00\x1e\x01\x17\x00\xc2\x00\x12\x01\xb7\x00\x32\x01\x98\x00\x18\x00\x19\x00\x1a\x00\x4c\x00\x12\x00\x17\x00\xb9\x00\x3a\x01\x40\x01\x51\x01\x15\x00\x4d\x00\x19\x00\x1a\x00\x4c\x00\x25\x01\x17\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x18\x00\x19\x00\x1a\x00\x43\x01\x23\x00\xb8\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x23\x00\x32\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xb9\x00\x7f\x01\x33\x00\xba\x00\x23\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x7c\x01\x80\x01\x7d\x01\x81\x01\x4f\x00\x50\x00\x51\x00\x52\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xa6\x00\x4f\x00\x50\x00\x51\x00\xae\x00\xad\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x9a\x00\xb5\x00\x9b\x00\xaf\x00\xb0\x00\x50\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x4b\x00\xbf\x00\xc7\x00\xdd\x00\x4c\x00\xde\x00\x17\x00\xdf\x00\xaf\x00\xb0\x00\xb1\x00\x15\x00\x4d\x00\x19\x00\x1a\x00\x4c\x00\x53\x00\x17\x00\xe0\x00\xe1\x00\xb2\x00\xe2\x00\x4f\x01\x18\x00\x19\x00\x1a\x00\xaf\x00\xb0\x00\xb6\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x23\x00\x24\x01\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x16\x01\x38\x00\x55\x00\x90\x00\x23\x00\x91\x00\x56\x00\x17\x01\x57\x00\x90\x00\x47\x00\x91\x00\x1a\x01\x55\xff\x64\x00\x58\x00\x59\x00\x6d\x00\x92\x00\x55\xff\x55\xff\xd2\x01\x3b\x01\xcc\x01\x55\xff\x5a\x00\x5b\x00\x1b\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x7b\x01\xcf\x01\xd0\x01\xaf\x00\x59\x01\x7f\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x55\x00\x06\x00\xc8\x01\x85\x01\x56\x00\x81\x01\x57\x00\xc9\x01\x5d\x00\x2e\x00\x1a\x01\x5e\x00\x76\x00\x58\x00\x59\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xb9\x01\xca\x01\x55\x00\x5a\x00\x5b\x00\x1b\x01\x56\x00\xbb\x01\x57\x00\x2e\x00\xb5\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x58\x00\x59\x00\x55\x00\x7b\x01\xc4\x01\x63\x01\x56\x00\xc5\x01\x57\x00\xaa\x01\x5a\x00\x5b\x00\x62\x01\xab\x01\xaf\x01\x58\x00\x59\x00\xad\x01\x0b\x00\x0c\x00\x8a\x00\x8b\x00\x8c\x00\x55\x00\x11\x00\x5a\x00\x5b\x00\x56\x00\xb1\x01\x57\x00\xb2\x01\xb5\x00\x12\x00\x2e\x00\xb5\x01\xb6\x01\x58\x00\x59\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\xb7\x01\x2e\x00\x55\x00\x7e\x01\x5a\x00\x5b\x00\x56\x00\x2e\x00\x57\x00\x84\x01\x2e\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x58\x00\x59\x00\x89\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x77\x01\x8c\x01\x55\x00\x5a\x00\x5b\x00\x91\x01\x56\x00\xa0\x01\x57\x00\x5c\x00\xa1\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\x58\x00\x59\x00\x2e\x00\xa2\x01\xa5\x01\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x5a\x00\x5b\x00\x45\x01\x2e\x00\x46\x01\xd4\x01\x48\x01\x06\x00\x2c\x00\x2d\x00\x2e\x00\xaf\x00\xb0\x00\xb1\x00\x5d\x00\x5c\x00\x47\x01\x5e\x00\x42\x01\x4d\x01\x4e\x01\x2e\x00\x5c\x00\xb2\x00\x5d\x01\xb3\x00\x5e\x01\x2e\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\x60\x01\x0b\x00\x0c\x00\x86\x00\x64\x01\xd1\x01\x65\x01\x66\x01\xc9\x00\x67\x01\xca\x00\xcb\x00\xcc\x00\x5d\x00\xcd\x00\x12\x00\x5e\x00\xa7\x00\x06\x00\x2c\x00\x2d\x00\x2e\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x63\x01\x68\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x69\x01\xd6\x00\x5c\x00\x6c\x01\x2e\x00\xbc\x01\xd7\x00\x71\x01\xc9\x00\xd8\x00\xca\x00\xcb\x00\xcc\x00\x79\x01\xcd\x00\x75\x00\x7b\x01\x2e\x00\xec\x00\x2e\x00\xed\x00\x11\x01\xce\x00\xcf\x00\xd0\x00\xd1\x00\x14\x01\x15\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x5d\x00\xd6\x00\x9b\x00\x5e\x00\x5f\x00\xc1\x01\xd7\x00\x1c\x01\xc9\x00\xd8\x00\xca\x00\xcb\x00\xcc\x00\x5d\x00\xcd\x00\x1d\x01\x5e\x00\x76\x00\x1e\x01\x2e\x00\x20\x01\xee\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x21\x01\x27\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x22\x01\xd6\x00\x25\x01\x28\x01\x2a\x01\xef\x00\xd7\x00\x29\x01\xc9\x00\xd8\x00\xca\x00\xcb\x00\xcc\x00\x87\x01\xcd\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xf1\x00\xf2\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\x81\x00\x2f\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x30\x01\xd6\x00\x31\x01\x2e\x00\x32\x01\x34\x01\xd7\x00\x37\x01\x2e\x00\xd8\x00\x3d\x01\x40\x01\x2e\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x06\x00\x81\x00\x85\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x52\x01\x11\x00\x8f\x00\x4f\x00\x50\x00\x51\x00\xae\x00\x94\x00\x95\x00\x12\x00\x9c\x00\x99\x00\x9d\x00\xa0\x00\x13\x00\xa1\x00\x9e\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x2e\x00\x53\x01\xa6\x01\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x52\x01\x11\x00\xa9\x00\xaa\x00\x91\x00\xa2\x00\x2c\x00\x2e\x00\xbc\x00\x12\x00\x2e\x00\x2e\x00\xdc\x00\x2e\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xaf\x00\x5a\x01\xe4\x00\x53\x01\x54\x01\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x38\x01\x11\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x40\x00\xff\xff\x12\x00\x49\x00\x4e\x00\x4f\x00\x63\x00\x13\x00\x6b\x00\x2e\x00\x39\x01\x06\x00\x07\x00\x08\x00\x71\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x6a\x00\x11\x00\x06\x00\x07\x00\x08\x00\x92\x00\x0a\x00\x78\x00\x79\x00\x12\x00\xff\xff\x7a\x00\x0b\x00\x7f\x00\x13\x00\x6b\x00\x81\x00\x6c\x00\x06\x00\x07\x00\x08\x00\x71\x00\x0a\x00\x06\x00\x32\x00\x00\x00\x12\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x72\x00\x11\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x61\x00\x12\x00\x00\x00\x00\x00\x66\x00\xa8\x01\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x12\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x72\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x66\x00\x73\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbd\x00\x11\x00\x55\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbd\x00\x11\x00\x11\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbd\x00\x11\x00\xbe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbd\x00\x11\x00\xc6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xc6\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbe\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xa5\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xaf\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x89\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x8a\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x92\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xa2\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xa3\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x48\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x4a\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x58\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x2a\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x2b\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x2d\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x35\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x37\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x3e\x01\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x85\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x89\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x8d\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xbc\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x72\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xee\x00\x00\x00\x00\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x63\x00\x11\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\xef\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x69\x01\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\xf1\x00\xf2\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x12\x00\x0b\x00\x0c\x00\x87\x00\x00\x00\x13\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x0b\x00\x0c\x00\x88\x00\x00\x00\x00\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x95\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\xee\x00\x00\x00\x3d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x95\x00\x12\x00\x00\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x96\x00\x00\x00\x02\x01\x00\x00\x08\x01\x00\x00\x12\x00\x0b\x00\xac\x00\x00\x00\x09\x01\x00\x00\x0a\x01\x00\x00\x00\x00\x00\x00\x0b\x01\x05\x01\x0b\x00\x61\x00\x00\x00\x12\x00\x00\x00\xc9\x00\x00\x00\xca\x00\xcb\x00\xcc\x00\x00\x00\xcd\x00\x00\x00\x00\x00\x12\x00\x0b\x00\x7f\x00\xee\x00\x00\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xee\x00\x00\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\x12\x00\xd6\x00\x00\x00\x00\x00\x00\x00\x02\x01\xd7\x00\xee\x00\x00\x00\xd8\x00\xef\x00\xee\x00\x00\x00\x91\x01\x00\x00\x00\x00\xee\x00\x00\x00\x6a\x01\x04\x01\x05\x01\xee\x00\x00\x00\xef\x00\x00\x00\xf1\x00\xf2\x00\xef\x00\x00\x00\x00\x00\xee\x00\xf0\x00\xef\x00\xee\x00\x00\x00\xf5\x00\x00\x00\xef\x00\xf1\x00\xf2\x00\xf8\x00\x00\x00\xf1\x00\xf2\x00\xee\x00\xfd\x00\xef\x00\xf1\x00\xf2\x00\xef\x00\xee\x00\x00\x00\xf1\x00\xf2\x00\xfe\x00\xee\x00\x00\x00\xff\x00\x00\x00\x00\x00\xef\x00\xf1\x00\xf2\x00\x00\x00\xf1\x00\xf2\x00\xef\x00\xee\x00\x00\x01\xee\x00\x00\x00\x00\x00\x02\x01\x00\x00\x01\x01\xf1\x00\xf2\x00\x00\x00\x00\x00\x00\x00\x03\x01\xf1\x00\xf2\x00\xef\x00\x00\x00\xef\x00\x04\x01\x05\x01\x00\x00\x00\x00\x00\x00\x06\x01\x00\x00\x07\x01\x3a\x00\x00\x00\x00\x00\x3b\x00\xf1\x00\xf2\x00\xf1\x00\xf2\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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 (4, 241) [
+	(4 , happyReduce_4),
+	(5 , happyReduce_5),
+	(6 , happyReduce_6),
+	(7 , happyReduce_7),
+	(8 , happyReduce_8),
+	(9 , happyReduce_9),
+	(10 , happyReduce_10),
+	(11 , happyReduce_11),
+	(12 , happyReduce_12),
+	(13 , happyReduce_13),
+	(14 , happyReduce_14),
+	(15 , happyReduce_15),
+	(16 , happyReduce_16),
+	(17 , happyReduce_17),
+	(18 , happyReduce_18),
+	(19 , happyReduce_19),
+	(20 , happyReduce_20),
+	(21 , happyReduce_21),
+	(22 , happyReduce_22),
+	(23 , happyReduce_23),
+	(24 , happyReduce_24),
+	(25 , happyReduce_25),
+	(26 , happyReduce_26),
+	(27 , happyReduce_27),
+	(28 , happyReduce_28),
+	(29 , happyReduce_29),
+	(30 , happyReduce_30),
+	(31 , happyReduce_31),
+	(32 , happyReduce_32),
+	(33 , happyReduce_33),
+	(34 , happyReduce_34),
+	(35 , happyReduce_35),
+	(36 , happyReduce_36),
+	(37 , happyReduce_37),
+	(38 , happyReduce_38),
+	(39 , happyReduce_39),
+	(40 , happyReduce_40),
+	(41 , happyReduce_41),
+	(42 , happyReduce_42),
+	(43 , happyReduce_43),
+	(44 , happyReduce_44),
+	(45 , happyReduce_45),
+	(46 , happyReduce_46),
+	(47 , happyReduce_47),
+	(48 , happyReduce_48),
+	(49 , happyReduce_49),
+	(50 , happyReduce_50),
+	(51 , happyReduce_51),
+	(52 , happyReduce_52),
+	(53 , happyReduce_53),
+	(54 , happyReduce_54),
+	(55 , happyReduce_55),
+	(56 , happyReduce_56),
+	(57 , happyReduce_57),
+	(58 , happyReduce_58),
+	(59 , happyReduce_59),
+	(60 , happyReduce_60),
+	(61 , happyReduce_61),
+	(62 , happyReduce_62),
+	(63 , happyReduce_63),
+	(64 , happyReduce_64),
+	(65 , happyReduce_65),
+	(66 , happyReduce_66),
+	(67 , happyReduce_67),
+	(68 , happyReduce_68),
+	(69 , happyReduce_69),
+	(70 , happyReduce_70),
+	(71 , happyReduce_71),
+	(72 , happyReduce_72),
+	(73 , happyReduce_73),
+	(74 , happyReduce_74),
+	(75 , happyReduce_75),
+	(76 , happyReduce_76),
+	(77 , happyReduce_77),
+	(78 , happyReduce_78),
+	(79 , happyReduce_79),
+	(80 , happyReduce_80),
+	(81 , happyReduce_81),
+	(82 , happyReduce_82),
+	(83 , happyReduce_83),
+	(84 , happyReduce_84),
+	(85 , happyReduce_85),
+	(86 , happyReduce_86),
+	(87 , happyReduce_87),
+	(88 , happyReduce_88),
+	(89 , happyReduce_89),
+	(90 , happyReduce_90),
+	(91 , happyReduce_91),
+	(92 , happyReduce_92),
+	(93 , happyReduce_93),
+	(94 , happyReduce_94),
+	(95 , happyReduce_95),
+	(96 , happyReduce_96),
+	(97 , happyReduce_97),
+	(98 , happyReduce_98),
+	(99 , happyReduce_99),
+	(100 , happyReduce_100),
+	(101 , happyReduce_101),
+	(102 , happyReduce_102),
+	(103 , happyReduce_103),
+	(104 , happyReduce_104),
+	(105 , happyReduce_105),
+	(106 , happyReduce_106),
+	(107 , happyReduce_107),
+	(108 , happyReduce_108),
+	(109 , happyReduce_109),
+	(110 , happyReduce_110),
+	(111 , happyReduce_111),
+	(112 , happyReduce_112),
+	(113 , happyReduce_113),
+	(114 , happyReduce_114),
+	(115 , happyReduce_115),
+	(116 , happyReduce_116),
+	(117 , happyReduce_117),
+	(118 , happyReduce_118),
+	(119 , happyReduce_119),
+	(120 , happyReduce_120),
+	(121 , happyReduce_121),
+	(122 , happyReduce_122),
+	(123 , happyReduce_123),
+	(124 , happyReduce_124),
+	(125 , happyReduce_125),
+	(126 , happyReduce_126),
+	(127 , happyReduce_127),
+	(128 , happyReduce_128),
+	(129 , happyReduce_129),
+	(130 , happyReduce_130),
+	(131 , happyReduce_131),
+	(132 , happyReduce_132),
+	(133 , happyReduce_133),
+	(134 , happyReduce_134),
+	(135 , happyReduce_135),
+	(136 , happyReduce_136),
+	(137 , happyReduce_137),
+	(138 , happyReduce_138),
+	(139 , happyReduce_139),
+	(140 , happyReduce_140),
+	(141 , happyReduce_141),
+	(142 , happyReduce_142),
+	(143 , happyReduce_143),
+	(144 , happyReduce_144),
+	(145 , happyReduce_145),
+	(146 , happyReduce_146),
+	(147 , happyReduce_147),
+	(148 , happyReduce_148),
+	(149 , happyReduce_149),
+	(150 , happyReduce_150),
+	(151 , happyReduce_151),
+	(152 , happyReduce_152),
+	(153 , happyReduce_153),
+	(154 , happyReduce_154),
+	(155 , happyReduce_155),
+	(156 , happyReduce_156),
+	(157 , happyReduce_157),
+	(158 , happyReduce_158),
+	(159 , happyReduce_159),
+	(160 , happyReduce_160),
+	(161 , happyReduce_161),
+	(162 , happyReduce_162),
+	(163 , happyReduce_163),
+	(164 , happyReduce_164),
+	(165 , happyReduce_165),
+	(166 , happyReduce_166),
+	(167 , happyReduce_167),
+	(168 , happyReduce_168),
+	(169 , happyReduce_169),
+	(170 , happyReduce_170),
+	(171 , happyReduce_171),
+	(172 , happyReduce_172),
+	(173 , happyReduce_173),
+	(174 , happyReduce_174),
+	(175 , happyReduce_175),
+	(176 , happyReduce_176),
+	(177 , happyReduce_177),
+	(178 , happyReduce_178),
+	(179 , happyReduce_179),
+	(180 , happyReduce_180),
+	(181 , happyReduce_181),
+	(182 , happyReduce_182),
+	(183 , happyReduce_183),
+	(184 , happyReduce_184),
+	(185 , happyReduce_185),
+	(186 , happyReduce_186),
+	(187 , happyReduce_187),
+	(188 , happyReduce_188),
+	(189 , happyReduce_189),
+	(190 , happyReduce_190),
+	(191 , happyReduce_191),
+	(192 , happyReduce_192),
+	(193 , happyReduce_193),
+	(194 , happyReduce_194),
+	(195 , happyReduce_195),
+	(196 , happyReduce_196),
+	(197 , happyReduce_197),
+	(198 , happyReduce_198),
+	(199 , happyReduce_199),
+	(200 , happyReduce_200),
+	(201 , happyReduce_201),
+	(202 , happyReduce_202),
+	(203 , happyReduce_203),
+	(204 , happyReduce_204),
+	(205 , happyReduce_205),
+	(206 , happyReduce_206),
+	(207 , happyReduce_207),
+	(208 , happyReduce_208),
+	(209 , happyReduce_209),
+	(210 , happyReduce_210),
+	(211 , happyReduce_211),
+	(212 , happyReduce_212),
+	(213 , happyReduce_213),
+	(214 , happyReduce_214),
+	(215 , happyReduce_215),
+	(216 , happyReduce_216),
+	(217 , happyReduce_217),
+	(218 , happyReduce_218),
+	(219 , happyReduce_219),
+	(220 , happyReduce_220),
+	(221 , happyReduce_221),
+	(222 , happyReduce_222),
+	(223 , happyReduce_223),
+	(224 , happyReduce_224),
+	(225 , happyReduce_225),
+	(226 , happyReduce_226),
+	(227 , happyReduce_227),
+	(228 , happyReduce_228),
+	(229 , happyReduce_229),
+	(230 , happyReduce_230),
+	(231 , happyReduce_231),
+	(232 , happyReduce_232),
+	(233 , happyReduce_233),
+	(234 , happyReduce_234),
+	(235 , happyReduce_235),
+	(236 , happyReduce_236),
+	(237 , happyReduce_237),
+	(238 , happyReduce_238),
+	(239 , happyReduce_239),
+	(240 , happyReduce_240),
+	(241 , happyReduce_241)
+	]
+
+happy_n_terms = 83 :: Int
+happy_n_nonterms = 74 :: Int
+
+happyReduce_4 = happySpecReduce_1  0# 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  1# happyReduction_5
+happyReduction_5 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> 
+	happyIn8
+		 (happy_var_1
+	)}
+
+happyReduce_6 = happySpecReduce_1  2# happyReduction_6
+happyReduction_6 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> 
+	happyIn9
+		 ((read happy_var_1) :: Double
+	)}
+
+happyReduce_7 = happySpecReduce_1  3# happyReduction_7
+happyReduction_7 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn10
+		 (PIdent (mkPosToken happy_var_1)
+	)}
+
+happyReduce_8 = happySpecReduce_1  4# happyReduction_8
+happyReduction_8 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (T_LString happy_var_1)) -> 
+	happyIn11
+		 (LString (happy_var_1)
+	)}
+
+happyReduce_9 = happySpecReduce_1  5# happyReduction_9
+happyReduction_9 happy_x_1
+	 =  case happyOut13 happy_x_1 of { happy_var_1 -> 
+	happyIn12
+		 (Gr (reverse happy_var_1)
+	)}
+
+happyReduce_10 = happySpecReduce_0  6# happyReduction_10
+happyReduction_10  =  happyIn13
+		 ([]
+	)
+
+happyReduce_11 = happySpecReduce_2  6# happyReduction_11
+happyReduction_11 happy_x_2
+	happy_x_1
+	 =  case happyOut13 happy_x_1 of { happy_var_1 -> 
+	case happyOut14 happy_x_2 of { happy_var_2 -> 
+	happyIn13
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_12 = happySpecReduce_2  7# happyReduction_12
+happyReduction_12 happy_x_2
+	happy_x_1
+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> 
+	happyIn14
+		 (happy_var_1
+	)}
+
+happyReduce_13 = happyReduce 4# 7# happyReduction_13
+happyReduction_13 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut22 happy_x_1 of { happy_var_1 -> 
+	case happyOut15 happy_x_2 of { happy_var_2 -> 
+	case happyOut16 happy_x_4 of { happy_var_4 -> 
+	happyIn14
+		 (MModule happy_var_1 happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_14 = happySpecReduce_2  8# happyReduction_14
+happyReduction_14 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (MAbstract happy_var_2
+	)}
+
+happyReduce_15 = happySpecReduce_2  8# happyReduction_15
+happyReduction_15 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (MResource happy_var_2
+	)}
+
+happyReduce_16 = happySpecReduce_2  8# happyReduction_16
+happyReduction_16 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (MGrammar happy_var_2
+	)}
+
+happyReduce_17 = happySpecReduce_2  8# happyReduction_17
+happyReduction_17 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (MInterface happy_var_2
+	)}
+
+happyReduce_18 = happyReduce 4# 8# happyReduction_18
+happyReduction_18 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn15
+		 (MConcrete happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_19 = happyReduce 4# 8# happyReduction_19
+happyReduction_19 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn15
+		 (MInstance happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_20 = happyReduce 5# 9# happyReduction_20
+happyReduction_20 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut18 happy_x_1 of { happy_var_1 -> 
+	case happyOut20 happy_x_2 of { happy_var_2 -> 
+	case happyOut17 happy_x_4 of { happy_var_4 -> 
+	happyIn16
+		 (MBody happy_var_1 happy_var_2 (reverse happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_21 = happySpecReduce_1  9# happyReduction_21
+happyReduction_21 happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	happyIn16
+		 (MNoBody happy_var_1
+	)}
+
+happyReduce_22 = happySpecReduce_3  9# happyReduction_22
+happyReduction_22 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_3 of { happy_var_3 -> 
+	happyIn16
+		 (MWith happy_var_1 happy_var_3
+	)}}
+
+happyReduce_23 = happyReduce 8# 9# happyReduction_23
+happyReduction_23 (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 happyOut24 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_3 of { happy_var_3 -> 
+	case happyOut20 happy_x_5 of { happy_var_5 -> 
+	case happyOut17 happy_x_7 of { happy_var_7 -> 
+	happyIn16
+		 (MWithBody happy_var_1 happy_var_3 happy_var_5 (reverse happy_var_7)
+	) `HappyStk` happyRest}}}}
+
+happyReduce_24 = happyReduce 5# 9# 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 happyOut23 happy_x_1 of { happy_var_1 -> 
+	case happyOut24 happy_x_3 of { happy_var_3 -> 
+	case happyOut19 happy_x_5 of { happy_var_5 -> 
+	happyIn16
+		 (MWithE happy_var_1 happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_25 = happyReduce 10# 9# happyReduction_25
+happyReduction_25 (happy_x_10 `HappyStk`
+	happy_x_9 `HappyStk`
+	happy_x_8 `HappyStk`
+	happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut23 happy_x_1 of { happy_var_1 -> 
+	case happyOut24 happy_x_3 of { happy_var_3 -> 
+	case happyOut19 happy_x_5 of { happy_var_5 -> 
+	case happyOut20 happy_x_7 of { happy_var_7 -> 
+	case happyOut17 happy_x_9 of { happy_var_9 -> 
+	happyIn16
+		 (MWithEBody happy_var_1 happy_var_3 happy_var_5 happy_var_7 (reverse happy_var_9)
+	) `HappyStk` happyRest}}}}}
+
+happyReduce_26 = happySpecReduce_2  9# happyReduction_26
+happyReduction_26 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn16
+		 (MReuse happy_var_2
+	)}
+
+happyReduce_27 = happySpecReduce_2  9# happyReduction_27
+happyReduction_27 happy_x_2
+	happy_x_1
+	 =  case happyOut23 happy_x_2 of { happy_var_2 -> 
+	happyIn16
+		 (MUnion happy_var_2
+	)}
+
+happyReduce_28 = happySpecReduce_0  10# happyReduction_28
+happyReduction_28  =  happyIn17
+		 ([]
+	)
+
+happyReduce_29 = happySpecReduce_2  10# happyReduction_29
+happyReduction_29 happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	case happyOut25 happy_x_2 of { happy_var_2 -> 
+	happyIn17
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_30 = happySpecReduce_2  11# happyReduction_30
+happyReduction_30 happy_x_2
+	happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	happyIn18
+		 (Ext happy_var_1
+	)}
+
+happyReduce_31 = happySpecReduce_0  11# happyReduction_31
+happyReduction_31  =  happyIn18
+		 (NoExt
+	)
+
+happyReduce_32 = happySpecReduce_0  12# happyReduction_32
+happyReduction_32  =  happyIn19
+		 ([]
+	)
+
+happyReduce_33 = happySpecReduce_1  12# happyReduction_33
+happyReduction_33 happy_x_1
+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
+	happyIn19
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_34 = happySpecReduce_3  12# happyReduction_34
+happyReduction_34 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_3 of { happy_var_3 -> 
+	happyIn19
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_35 = happySpecReduce_0  13# happyReduction_35
+happyReduction_35  =  happyIn20
+		 (NoOpens
+	)
+
+happyReduce_36 = happySpecReduce_3  13# happyReduction_36
+happyReduction_36 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut19 happy_x_2 of { happy_var_2 -> 
+	happyIn20
+		 (OpenIn happy_var_2
+	)}
+
+happyReduce_37 = happySpecReduce_1  14# happyReduction_37
+happyReduction_37 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 (OName happy_var_1
+	)}
+
+happyReduce_38 = happyReduce 5# 14# 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 happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn21
+		 (OQual happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_39 = happySpecReduce_0  15# happyReduction_39
+happyReduction_39  =  happyIn22
+		 (CMCompl
+	)
+
+happyReduce_40 = happySpecReduce_1  15# happyReduction_40
+happyReduction_40 happy_x_1
+	 =  happyIn22
+		 (CMIncompl
+	)
+
+happyReduce_41 = happySpecReduce_0  16# happyReduction_41
+happyReduction_41  =  happyIn23
+		 ([]
+	)
+
+happyReduce_42 = happySpecReduce_1  16# happyReduction_42
+happyReduction_42 happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_43 = happySpecReduce_3  16# happyReduction_43
+happyReduction_43 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	case happyOut23 happy_x_3 of { happy_var_3 -> 
+	happyIn23
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_44 = happySpecReduce_1  17# happyReduction_44
+happyReduction_44 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn24
+		 (IAll happy_var_1
+	)}
+
+happyReduce_45 = happyReduce 4# 17# happyReduction_45
+happyReduction_45 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut40 happy_x_3 of { happy_var_3 -> 
+	happyIn24
+		 (ISome happy_var_1 happy_var_3
+	) `HappyStk` happyRest}}
+
+happyReduce_46 = happyReduce 5# 17# 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 happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut40 happy_x_4 of { happy_var_4 -> 
+	happyIn24
+		 (IMinus happy_var_1 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_47 = happySpecReduce_2  18# happyReduction_47
+happyReduction_47 happy_x_2
+	happy_x_1
+	 =  case happyOut36 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefCat happy_var_2
+	)}
+
+happyReduce_48 = happySpecReduce_2  18# happyReduction_48
+happyReduction_48 happy_x_2
+	happy_x_1
+	 =  case happyOut35 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefFun happy_var_2
+	)}
+
+happyReduce_49 = happySpecReduce_2  18# happyReduction_49
+happyReduction_49 happy_x_2
+	happy_x_1
+	 =  case happyOut35 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefFunData happy_var_2
+	)}
+
+happyReduce_50 = happySpecReduce_2  18# happyReduction_50
+happyReduction_50 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefDef happy_var_2
+	)}
+
+happyReduce_51 = happySpecReduce_2  18# happyReduction_51
+happyReduction_51 happy_x_2
+	happy_x_1
+	 =  case happyOut37 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefData happy_var_2
+	)}
+
+happyReduce_52 = happySpecReduce_2  18# happyReduction_52
+happyReduction_52 happy_x_2
+	happy_x_1
+	 =  case happyOut38 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefPar happy_var_2
+	)}
+
+happyReduce_53 = happySpecReduce_2  18# happyReduction_53
+happyReduction_53 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefOper happy_var_2
+	)}
+
+happyReduce_54 = happySpecReduce_2  18# happyReduction_54
+happyReduction_54 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefLincat happy_var_2
+	)}
+
+happyReduce_55 = happySpecReduce_2  18# happyReduction_55
+happyReduction_55 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefLindef happy_var_2
+	)}
+
+happyReduce_56 = happySpecReduce_2  18# happyReduction_56
+happyReduction_56 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefLin happy_var_2
+	)}
+
+happyReduce_57 = happySpecReduce_3  18# happyReduction_57
+happyReduction_57 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_3 of { happy_var_3 -> 
+	happyIn25
+		 (DefPrintCat happy_var_3
+	)}
+
+happyReduce_58 = happySpecReduce_3  18# happyReduction_58
+happyReduction_58 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_3 of { happy_var_3 -> 
+	happyIn25
+		 (DefPrintFun happy_var_3
+	)}
+
+happyReduce_59 = happySpecReduce_2  18# happyReduction_59
+happyReduction_59 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefFlag happy_var_2
+	)}
+
+happyReduce_60 = happySpecReduce_2  18# happyReduction_60
+happyReduction_60 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefPrintOld happy_var_2
+	)}
+
+happyReduce_61 = happySpecReduce_2  18# happyReduction_61
+happyReduction_61 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefLintype happy_var_2
+	)}
+
+happyReduce_62 = happySpecReduce_2  18# happyReduction_62
+happyReduction_62 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefPattern happy_var_2
+	)}
+
+happyReduce_63 = happyReduce 7# 18# happyReduction_63
+happyReduction_63 (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 happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut17 happy_x_5 of { happy_var_5 -> 
+	happyIn25
+		 (DefPackage happy_var_2 (reverse happy_var_5)
+	) `HappyStk` happyRest}}
+
+happyReduce_64 = happySpecReduce_2  18# happyReduction_64
+happyReduction_64 happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefVars happy_var_2
+	)}
+
+happyReduce_65 = happySpecReduce_3  18# happyReduction_65
+happyReduction_65 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn25
+		 (DefTokenizer happy_var_2
+	)}
+
+happyReduce_66 = happySpecReduce_3  19# happyReduction_66
+happyReduction_66 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn26
+		 (DDecl happy_var_1 happy_var_3
+	)}}
+
+happyReduce_67 = happySpecReduce_3  19# happyReduction_67
+happyReduction_67 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn26
+		 (DDef happy_var_1 happy_var_3
+	)}}
+
+happyReduce_68 = happyReduce 4# 19# happyReduction_68
+happyReduction_68 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut61 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn26
+		 (DPatt happy_var_1 happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_69 = happyReduce 5# 19# happyReduction_69
+happyReduction_69 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	case happyOut50 happy_x_5 of { happy_var_5 -> 
+	happyIn26
+		 (DFull happy_var_1 happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_70 = happySpecReduce_3  20# happyReduction_70
+happyReduction_70 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn27
+		 (FDecl happy_var_1 happy_var_3
+	)}}
+
+happyReduce_71 = happySpecReduce_2  21# happyReduction_71
+happyReduction_71 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut76 happy_x_2 of { happy_var_2 -> 
+	happyIn28
+		 (SimpleCatDef happy_var_1 (reverse happy_var_2)
+	)}}
+
+happyReduce_72 = happyReduce 4# 21# happyReduction_72
+happyReduction_72 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut76 happy_x_3 of { happy_var_3 -> 
+	happyIn28
+		 (ListCatDef happy_var_2 (reverse happy_var_3)
+	) `HappyStk` happyRest}}
+
+happyReduce_73 = happyReduce 7# 21# happyReduction_73
+happyReduction_73 (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 happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut76 happy_x_3 of { happy_var_3 -> 
+	case happyOut7 happy_x_6 of { happy_var_6 -> 
+	happyIn28
+		 (ListSizeCatDef happy_var_2 (reverse happy_var_3) happy_var_6
+	) `HappyStk` happyRest}}}
+
+happyReduce_74 = happySpecReduce_3  22# happyReduction_74
+happyReduction_74 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut31 happy_x_3 of { happy_var_3 -> 
+	happyIn29
+		 (DataDef happy_var_1 happy_var_3
+	)}}
+
+happyReduce_75 = happySpecReduce_1  23# happyReduction_75
+happyReduction_75 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 (DataId happy_var_1
+	)}
+
+happyReduce_76 = happySpecReduce_3  23# happyReduction_76
+happyReduction_76 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut10 happy_x_3 of { happy_var_3 -> 
+	happyIn30
+		 (DataQId happy_var_1 happy_var_3
+	)}}
+
+happyReduce_77 = happySpecReduce_0  24# happyReduction_77
+happyReduction_77  =  happyIn31
+		 ([]
+	)
+
+happyReduce_78 = happySpecReduce_1  24# happyReduction_78
+happyReduction_78 happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	happyIn31
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_79 = happySpecReduce_3  24# happyReduction_79
+happyReduction_79 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	case happyOut31 happy_x_3 of { happy_var_3 -> 
+	happyIn31
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_80 = happySpecReduce_3  25# happyReduction_80
+happyReduction_80 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut39 happy_x_3 of { happy_var_3 -> 
+	happyIn32
+		 (ParDefDir happy_var_1 happy_var_3
+	)}}
+
+happyReduce_81 = happySpecReduce_1  25# happyReduction_81
+happyReduction_81 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn32
+		 (ParDefAbs happy_var_1
+	)}
+
+happyReduce_82 = happySpecReduce_2  26# happyReduction_82
+happyReduction_82 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut76 happy_x_2 of { happy_var_2 -> 
+	happyIn33
+		 (ParConstr happy_var_1 (reverse happy_var_2)
+	)}}
+
+happyReduce_83 = happySpecReduce_2  27# happyReduction_83
+happyReduction_83 happy_x_2
+	happy_x_1
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_84 = happySpecReduce_3  27# happyReduction_84
+happyReduction_84 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
+	case happyOut34 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_85 = happySpecReduce_2  28# happyReduction_85
+happyReduction_85 happy_x_2
+	happy_x_1
+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	happyIn35
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_86 = happySpecReduce_3  28# happyReduction_86
+happyReduction_86 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn35
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_87 = happySpecReduce_2  29# happyReduction_87
+happyReduction_87 happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	happyIn36
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_88 = happySpecReduce_3  29# happyReduction_88
+happyReduction_88 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	case happyOut36 happy_x_3 of { happy_var_3 -> 
+	happyIn36
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_89 = happySpecReduce_2  30# happyReduction_89
+happyReduction_89 happy_x_2
+	happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	happyIn37
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_90 = happySpecReduce_3  30# happyReduction_90
+happyReduction_90 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn37
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_91 = happySpecReduce_2  31# happyReduction_91
+happyReduction_91 happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	happyIn38
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_92 = happySpecReduce_3  31# happyReduction_92
+happyReduction_92 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	case happyOut38 happy_x_3 of { happy_var_3 -> 
+	happyIn38
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_93 = happySpecReduce_0  32# happyReduction_93
+happyReduction_93  =  happyIn39
+		 ([]
+	)
+
+happyReduce_94 = happySpecReduce_1  32# happyReduction_94
+happyReduction_94 happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	happyIn39
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_95 = happySpecReduce_3  32# happyReduction_95
+happyReduction_95 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	case happyOut39 happy_x_3 of { happy_var_3 -> 
+	happyIn39
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_96 = happySpecReduce_1  33# happyReduction_96
+happyReduction_96 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn40
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_97 = happySpecReduce_3  33# happyReduction_97
+happyReduction_97 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut40 happy_x_3 of { happy_var_3 -> 
+	happyIn40
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_98 = happySpecReduce_1  34# happyReduction_98
+happyReduction_98 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn41
+		 (PIdentName happy_var_1
+	)}
+
+happyReduce_99 = happySpecReduce_3  34# happyReduction_99
+happyReduction_99 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn41
+		 (ListName happy_var_2
+	)}
+
+happyReduce_100 = happySpecReduce_1  35# happyReduction_100
+happyReduction_100 happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	happyIn42
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_101 = happySpecReduce_3  35# happyReduction_101
+happyReduction_101 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 -> 
+	happyIn42
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_102 = happySpecReduce_3  36# happyReduction_102
+happyReduction_102 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn43
+		 (LDDecl happy_var_1 happy_var_3
+	)}}
+
+happyReduce_103 = happySpecReduce_3  36# happyReduction_103
+happyReduction_103 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn43
+		 (LDDef happy_var_1 happy_var_3
+	)}}
+
+happyReduce_104 = happyReduce 5# 36# happyReduction_104
+happyReduction_104 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	case happyOut50 happy_x_5 of { happy_var_5 -> 
+	happyIn43
+		 (LDFull happy_var_1 happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_105 = happySpecReduce_0  37# happyReduction_105
+happyReduction_105  =  happyIn44
+		 ([]
+	)
+
+happyReduce_106 = happySpecReduce_1  37# happyReduction_106
+happyReduction_106 happy_x_1
+	 =  case happyOut43 happy_x_1 of { happy_var_1 -> 
+	happyIn44
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_107 = happySpecReduce_3  37# happyReduction_107
+happyReduction_107 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut43 happy_x_1 of { happy_var_1 -> 
+	case happyOut44 happy_x_3 of { happy_var_3 -> 
+	happyIn44
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_108 = happySpecReduce_1  38# happyReduction_108
+happyReduction_108 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (EPIdent happy_var_1
+	)}
+
+happyReduce_109 = happySpecReduce_3  38# happyReduction_109
+happyReduction_109 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (EConstr happy_var_2
+	)}
+
+happyReduce_110 = happySpecReduce_3  38# happyReduction_110
+happyReduction_110 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (ECons happy_var_2
+	)}
+
+happyReduce_111 = happySpecReduce_1  38# happyReduction_111
+happyReduction_111 happy_x_1
+	 =  case happyOut59 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (ESort happy_var_1
+	)}
+
+happyReduce_112 = happySpecReduce_1  38# happyReduction_112
+happyReduction_112 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (EString happy_var_1
+	)}
+
+happyReduce_113 = happySpecReduce_1  38# happyReduction_113
+happyReduction_113 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (EInt happy_var_1
+	)}
+
+happyReduce_114 = happySpecReduce_1  38# happyReduction_114
+happyReduction_114 happy_x_1
+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (EFloat happy_var_1
+	)}
+
+happyReduce_115 = happySpecReduce_1  38# happyReduction_115
+happyReduction_115 happy_x_1
+	 =  happyIn45
+		 (EMeta
+	)
+
+happyReduce_116 = happySpecReduce_2  38# happyReduction_116
+happyReduction_116 happy_x_2
+	happy_x_1
+	 =  happyIn45
+		 (EEmpty
+	)
+
+happyReduce_117 = happySpecReduce_1  38# happyReduction_117
+happyReduction_117 happy_x_1
+	 =  happyIn45
+		 (EData
+	)
+
+happyReduce_118 = happyReduce 4# 38# happyReduction_118
+happyReduction_118 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut53 happy_x_3 of { happy_var_3 -> 
+	happyIn45
+		 (EList happy_var_2 happy_var_3
+	) `HappyStk` happyRest}}
+
+happyReduce_119 = happySpecReduce_3  38# happyReduction_119
+happyReduction_119 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut8 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (EStrings happy_var_2
+	)}
+
+happyReduce_120 = happySpecReduce_3  38# happyReduction_120
+happyReduction_120 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut44 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (ERecord happy_var_2
+	)}
+
+happyReduce_121 = happySpecReduce_3  38# happyReduction_121
+happyReduction_121 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut67 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (ETuple happy_var_2
+	)}
+
+happyReduce_122 = happyReduce 4# 38# happyReduction_122
+happyReduction_122 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_3 of { happy_var_3 -> 
+	happyIn45
+		 (EIndir happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_123 = happyReduce 5# 38# happyReduction_123
+happyReduction_123 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut50 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn45
+		 (ETyped happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_124 = happySpecReduce_3  38# happyReduction_124
+happyReduction_124 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut50 happy_x_2 of { happy_var_2 -> 
+	happyIn45
+		 (happy_var_2
+	)}
+
+happyReduce_125 = happySpecReduce_1  38# happyReduction_125
+happyReduction_125 happy_x_1
+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (ELString happy_var_1
+	)}
+
+happyReduce_126 = happySpecReduce_3  39# happyReduction_126
+happyReduction_126 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> 
+	case happyOut58 happy_x_3 of { happy_var_3 -> 
+	happyIn46
+		 (EProj happy_var_1 happy_var_3
+	)}}
+
+happyReduce_127 = happyReduce 5# 39# happyReduction_127
+happyReduction_127 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn46
+		 (EQConstr happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_128 = happyReduce 4# 39# happyReduction_128
+happyReduction_128 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn46
+		 (EQCons happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_129 = happySpecReduce_1  39# happyReduction_129
+happyReduction_129 happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	happyIn46
+		 (happy_var_1
+	)}
+
+happyReduce_130 = happySpecReduce_2  40# happyReduction_130
+happyReduction_130 happy_x_2
+	happy_x_1
+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
+	case happyOut46 happy_x_2 of { happy_var_2 -> 
+	happyIn47
+		 (EApp happy_var_1 happy_var_2
+	)}}
+
+happyReduce_131 = happyReduce 4# 40# happyReduction_131
+happyReduction_131 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut70 happy_x_3 of { happy_var_3 -> 
+	happyIn47
+		 (ETable happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_132 = happyReduce 5# 40# happyReduction_132
+happyReduction_132 (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_2 of { happy_var_2 -> 
+	case happyOut70 happy_x_4 of { happy_var_4 -> 
+	happyIn47
+		 (ETTable happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_133 = happyReduce 5# 40# happyReduction_133
+happyReduction_133 (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_2 of { happy_var_2 -> 
+	case happyOut52 happy_x_4 of { happy_var_4 -> 
+	happyIn47
+		 (EVTable happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_134 = happyReduce 6# 40# happyReduction_134
+happyReduction_134 (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 happyOut50 happy_x_2 of { happy_var_2 -> 
+	case happyOut70 happy_x_5 of { happy_var_5 -> 
+	happyIn47
+		 (ECase happy_var_2 happy_var_5
+	) `HappyStk` happyRest}}
+
+happyReduce_135 = happyReduce 4# 40# happyReduction_135
+happyReduction_135 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut52 happy_x_3 of { happy_var_3 -> 
+	happyIn47
+		 (EVariants happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_136 = happyReduce 6# 40# happyReduction_136
+happyReduction_136 (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 happyOut50 happy_x_3 of { happy_var_3 -> 
+	case happyOut74 happy_x_5 of { happy_var_5 -> 
+	happyIn47
+		 (EPre happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}
+
+happyReduce_137 = happyReduce 4# 40# happyReduction_137
+happyReduction_137 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut52 happy_x_3 of { happy_var_3 -> 
+	happyIn47
+		 (EStrs happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_138 = happySpecReduce_2  40# happyReduction_138
+happyReduction_138 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_2 of { happy_var_2 -> 
+	happyIn47
+		 (EPatt happy_var_2
+	)}
+
+happyReduce_139 = happySpecReduce_3  40# happyReduction_139
+happyReduction_139 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut46 happy_x_3 of { happy_var_3 -> 
+	happyIn47
+		 (EPattType happy_var_3
+	)}
+
+happyReduce_140 = happySpecReduce_1  40# happyReduction_140
+happyReduction_140 happy_x_1
+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> 
+	happyIn47
+		 (happy_var_1
+	)}
+
+happyReduce_141 = happySpecReduce_2  40# happyReduction_141
+happyReduction_141 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn47
+		 (ELin happy_var_2
+	)}
+
+happyReduce_142 = happySpecReduce_3  41# happyReduction_142
+happyReduction_142 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut47 happy_x_3 of { happy_var_3 -> 
+	happyIn48
+		 (ESelect happy_var_1 happy_var_3
+	)}}
+
+happyReduce_143 = happySpecReduce_3  41# happyReduction_143
+happyReduction_143 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut47 happy_x_3 of { happy_var_3 -> 
+	happyIn48
+		 (ETupTyp happy_var_1 happy_var_3
+	)}}
+
+happyReduce_144 = happySpecReduce_3  41# happyReduction_144
+happyReduction_144 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut47 happy_x_3 of { happy_var_3 -> 
+	happyIn48
+		 (EExtend happy_var_1 happy_var_3
+	)}}
+
+happyReduce_145 = happySpecReduce_1  41# happyReduction_145
+happyReduction_145 happy_x_1
+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
+	happyIn48
+		 (happy_var_1
+	)}
+
+happyReduce_146 = happySpecReduce_3  42# happyReduction_146
+happyReduction_146 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut51 happy_x_1 of { happy_var_1 -> 
+	case happyOut49 happy_x_3 of { happy_var_3 -> 
+	happyIn49
+		 (EGlue happy_var_1 happy_var_3
+	)}}
+
+happyReduce_147 = happySpecReduce_1  42# happyReduction_147
+happyReduction_147 happy_x_1
+	 =  case happyOut51 happy_x_1 of { happy_var_1 -> 
+	happyIn49
+		 (happy_var_1
+	)}
+
+happyReduce_148 = happySpecReduce_3  43# happyReduction_148
+happyReduction_148 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut49 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (EConcat happy_var_1 happy_var_3
+	)}}
+
+happyReduce_149 = happyReduce 4# 43# happyReduction_149
+happyReduction_149 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut63 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn50
+		 (EAbstr happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_150 = happyReduce 5# 43# happyReduction_150
+happyReduction_150 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut63 happy_x_3 of { happy_var_3 -> 
+	case happyOut50 happy_x_5 of { happy_var_5 -> 
+	happyIn50
+		 (ECTable happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}
+
+happyReduce_151 = happySpecReduce_3  43# happyReduction_151
+happyReduction_151 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut64 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (EProd happy_var_1 happy_var_3
+	)}}
+
+happyReduce_152 = happySpecReduce_3  43# happyReduction_152
+happyReduction_152 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (ETType happy_var_1 happy_var_3
+	)}}
+
+happyReduce_153 = happyReduce 6# 43# happyReduction_153
+happyReduction_153 (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 happyOut44 happy_x_3 of { happy_var_3 -> 
+	case happyOut50 happy_x_6 of { happy_var_6 -> 
+	happyIn50
+		 (ELet happy_var_3 happy_var_6
+	) `HappyStk` happyRest}}
+
+happyReduce_154 = happyReduce 4# 43# happyReduction_154
+happyReduction_154 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut44 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn50
+		 (ELetb happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_155 = happyReduce 5# 43# happyReduction_155
+happyReduction_155 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut44 happy_x_4 of { happy_var_4 -> 
+	happyIn50
+		 (EWhere happy_var_1 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_156 = happyReduce 4# 43# happyReduction_156
+happyReduction_156 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut72 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (EEqs happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_157 = happySpecReduce_3  43# happyReduction_157
+happyReduction_157 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut46 happy_x_2 of { happy_var_2 -> 
+	case happyOut8 happy_x_3 of { happy_var_3 -> 
+	happyIn50
+		 (EExample happy_var_2 happy_var_3
+	)}}
+
+happyReduce_158 = happySpecReduce_1  43# happyReduction_158
+happyReduction_158 happy_x_1
+	 =  case happyOut49 happy_x_1 of { happy_var_1 -> 
+	happyIn50
+		 (happy_var_1
+	)}
+
+happyReduce_159 = happySpecReduce_1  44# happyReduction_159
+happyReduction_159 happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	happyIn51
+		 (happy_var_1
+	)}
+
+happyReduce_160 = happySpecReduce_0  45# happyReduction_160
+happyReduction_160  =  happyIn52
+		 ([]
+	)
+
+happyReduce_161 = happySpecReduce_1  45# happyReduction_161
+happyReduction_161 happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	happyIn52
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_162 = happySpecReduce_3  45# happyReduction_162
+happyReduction_162 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	case happyOut52 happy_x_3 of { happy_var_3 -> 
+	happyIn52
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_163 = happySpecReduce_0  46# happyReduction_163
+happyReduction_163  =  happyIn53
+		 (NilExp
+	)
+
+happyReduce_164 = happySpecReduce_2  46# happyReduction_164
+happyReduction_164 happy_x_2
+	happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	case happyOut53 happy_x_2 of { happy_var_2 -> 
+	happyIn53
+		 (ConsExp happy_var_1 happy_var_2
+	)}}
+
+happyReduce_165 = happySpecReduce_1  47# happyReduction_165
+happyReduction_165 happy_x_1
+	 =  happyIn54
+		 (PChar
+	)
+
+happyReduce_166 = happySpecReduce_3  47# happyReduction_166
+happyReduction_166 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut8 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PChars happy_var_2
+	)}
+
+happyReduce_167 = happySpecReduce_2  47# happyReduction_167
+happyReduction_167 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PMacro happy_var_2
+	)}
+
+happyReduce_168 = happyReduce 4# 47# happyReduction_168
+happyReduction_168 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	happyIn54
+		 (PM happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_169 = happySpecReduce_1  47# happyReduction_169
+happyReduction_169 happy_x_1
+	 =  happyIn54
+		 (PW
+	)
+
+happyReduce_170 = happySpecReduce_1  47# happyReduction_170
+happyReduction_170 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn54
+		 (PV happy_var_1
+	)}
+
+happyReduce_171 = happySpecReduce_3  47# happyReduction_171
+happyReduction_171 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PCon happy_var_2
+	)}
+
+happyReduce_172 = happySpecReduce_3  47# happyReduction_172
+happyReduction_172 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut10 happy_x_3 of { happy_var_3 -> 
+	happyIn54
+		 (PQ happy_var_1 happy_var_3
+	)}}
+
+happyReduce_173 = happySpecReduce_1  47# happyReduction_173
+happyReduction_173 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn54
+		 (PInt happy_var_1
+	)}
+
+happyReduce_174 = happySpecReduce_1  47# happyReduction_174
+happyReduction_174 happy_x_1
+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> 
+	happyIn54
+		 (PFloat happy_var_1
+	)}
+
+happyReduce_175 = happySpecReduce_1  47# happyReduction_175
+happyReduction_175 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn54
+		 (PStr happy_var_1
+	)}
+
+happyReduce_176 = happySpecReduce_3  47# happyReduction_176
+happyReduction_176 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut60 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PR happy_var_2
+	)}
+
+happyReduce_177 = happySpecReduce_3  47# happyReduction_177
+happyReduction_177 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut68 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (PTup happy_var_2
+	)}
+
+happyReduce_178 = happySpecReduce_3  47# happyReduction_178
+happyReduction_178 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut56 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (happy_var_2
+	)}
+
+happyReduce_179 = happySpecReduce_2  48# happyReduction_179
+happyReduction_179 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut61 happy_x_2 of { happy_var_2 -> 
+	happyIn55
+		 (PC happy_var_1 happy_var_2
+	)}}
+
+happyReduce_180 = happyReduce 4# 48# happyReduction_180
+happyReduction_180 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut10 happy_x_3 of { happy_var_3 -> 
+	case happyOut61 happy_x_4 of { happy_var_4 -> 
+	happyIn55
+		 (PQC happy_var_1 happy_var_3 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_181 = happySpecReduce_2  48# happyReduction_181
+happyReduction_181 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	happyIn55
+		 (PRep happy_var_1
+	)}
+
+happyReduce_182 = happySpecReduce_3  48# happyReduction_182
+happyReduction_182 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut54 happy_x_3 of { happy_var_3 -> 
+	happyIn55
+		 (PAs happy_var_1 happy_var_3
+	)}}
+
+happyReduce_183 = happySpecReduce_2  48# happyReduction_183
+happyReduction_183 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_2 of { happy_var_2 -> 
+	happyIn55
+		 (PNeg happy_var_2
+	)}
+
+happyReduce_184 = happySpecReduce_1  48# happyReduction_184
+happyReduction_184 happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	happyIn55
+		 (happy_var_1
+	)}
+
+happyReduce_185 = happySpecReduce_3  49# happyReduction_185
+happyReduction_185 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
+	case happyOut55 happy_x_3 of { happy_var_3 -> 
+	happyIn56
+		 (PDisj happy_var_1 happy_var_3
+	)}}
+
+happyReduce_186 = happySpecReduce_3  49# happyReduction_186
+happyReduction_186 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
+	case happyOut55 happy_x_3 of { happy_var_3 -> 
+	happyIn56
+		 (PSeq happy_var_1 happy_var_3
+	)}}
+
+happyReduce_187 = happySpecReduce_1  49# happyReduction_187
+happyReduction_187 happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	happyIn56
+		 (happy_var_1
+	)}
+
+happyReduce_188 = happySpecReduce_3  50# happyReduction_188
+happyReduction_188 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut56 happy_x_3 of { happy_var_3 -> 
+	happyIn57
+		 (PA happy_var_1 happy_var_3
+	)}}
+
+happyReduce_189 = happySpecReduce_1  51# happyReduction_189
+happyReduction_189 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn58
+		 (LPIdent happy_var_1
+	)}
+
+happyReduce_190 = happySpecReduce_2  51# happyReduction_190
+happyReduction_190 happy_x_2
+	happy_x_1
+	 =  case happyOut7 happy_x_2 of { happy_var_2 -> 
+	happyIn58
+		 (LVar happy_var_2
+	)}
+
+happyReduce_191 = happySpecReduce_1  52# happyReduction_191
+happyReduction_191 happy_x_1
+	 =  happyIn59
+		 (Sort_Type
+	)
+
+happyReduce_192 = happySpecReduce_1  52# happyReduction_192
+happyReduction_192 happy_x_1
+	 =  happyIn59
+		 (Sort_PType
+	)
+
+happyReduce_193 = happySpecReduce_1  52# happyReduction_193
+happyReduction_193 happy_x_1
+	 =  happyIn59
+		 (Sort_Tok
+	)
+
+happyReduce_194 = happySpecReduce_1  52# happyReduction_194
+happyReduction_194 happy_x_1
+	 =  happyIn59
+		 (Sort_Str
+	)
+
+happyReduce_195 = happySpecReduce_1  52# happyReduction_195
+happyReduction_195 happy_x_1
+	 =  happyIn59
+		 (Sort_Strs
+	)
+
+happyReduce_196 = happySpecReduce_0  53# happyReduction_196
+happyReduction_196  =  happyIn60
+		 ([]
+	)
+
+happyReduce_197 = happySpecReduce_1  53# happyReduction_197
+happyReduction_197 happy_x_1
+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> 
+	happyIn60
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_198 = happySpecReduce_3  53# happyReduction_198
+happyReduction_198 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> 
+	case happyOut60 happy_x_3 of { happy_var_3 -> 
+	happyIn60
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_199 = happySpecReduce_1  54# happyReduction_199
+happyReduction_199 happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	happyIn61
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_200 = happySpecReduce_2  54# happyReduction_200
+happyReduction_200 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	case happyOut61 happy_x_2 of { happy_var_2 -> 
+	happyIn61
+		 ((:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_201 = happySpecReduce_1  55# happyReduction_201
+happyReduction_201 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn62
+		 (BPIdent happy_var_1
+	)}
+
+happyReduce_202 = happySpecReduce_1  55# happyReduction_202
+happyReduction_202 happy_x_1
+	 =  happyIn62
+		 (BWild
+	)
+
+happyReduce_203 = happySpecReduce_0  56# happyReduction_203
+happyReduction_203  =  happyIn63
+		 ([]
+	)
+
+happyReduce_204 = happySpecReduce_1  56# happyReduction_204
+happyReduction_204 happy_x_1
+	 =  case happyOut62 happy_x_1 of { happy_var_1 -> 
+	happyIn63
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_205 = happySpecReduce_3  56# happyReduction_205
+happyReduction_205 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut62 happy_x_1 of { happy_var_1 -> 
+	case happyOut63 happy_x_3 of { happy_var_3 -> 
+	happyIn63
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_206 = happyReduce 5# 57# happyReduction_206
+happyReduction_206 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut63 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn64
+		 (DDec happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_207 = happySpecReduce_1  57# happyReduction_207
+happyReduction_207 happy_x_1
+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
+	happyIn64
+		 (DExp happy_var_1
+	)}
+
+happyReduce_208 = happySpecReduce_1  58# happyReduction_208
+happyReduction_208 happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	happyIn65
+		 (TComp happy_var_1
+	)}
+
+happyReduce_209 = happySpecReduce_1  59# happyReduction_209
+happyReduction_209 happy_x_1
+	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
+	happyIn66
+		 (PTComp happy_var_1
+	)}
+
+happyReduce_210 = happySpecReduce_0  60# happyReduction_210
+happyReduction_210  =  happyIn67
+		 ([]
+	)
+
+happyReduce_211 = happySpecReduce_1  60# happyReduction_211
+happyReduction_211 happy_x_1
+	 =  case happyOut65 happy_x_1 of { happy_var_1 -> 
+	happyIn67
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_212 = happySpecReduce_3  60# happyReduction_212
+happyReduction_212 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut65 happy_x_1 of { happy_var_1 -> 
+	case happyOut67 happy_x_3 of { happy_var_3 -> 
+	happyIn67
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_213 = happySpecReduce_0  61# happyReduction_213
+happyReduction_213  =  happyIn68
+		 ([]
+	)
+
+happyReduce_214 = happySpecReduce_1  61# happyReduction_214
+happyReduction_214 happy_x_1
+	 =  case happyOut66 happy_x_1 of { happy_var_1 -> 
+	happyIn68
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_215 = happySpecReduce_3  61# happyReduction_215
+happyReduction_215 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut66 happy_x_1 of { happy_var_1 -> 
+	case happyOut68 happy_x_3 of { happy_var_3 -> 
+	happyIn68
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_216 = happySpecReduce_3  62# happyReduction_216
+happyReduction_216 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn69
+		 (Case happy_var_1 happy_var_3
+	)}}
+
+happyReduce_217 = happySpecReduce_1  63# happyReduction_217
+happyReduction_217 happy_x_1
+	 =  case happyOut69 happy_x_1 of { happy_var_1 -> 
+	happyIn70
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_218 = happySpecReduce_3  63# happyReduction_218
+happyReduction_218 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut69 happy_x_1 of { happy_var_1 -> 
+	case happyOut70 happy_x_3 of { happy_var_3 -> 
+	happyIn70
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_219 = happySpecReduce_3  64# happyReduction_219
+happyReduction_219 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut61 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn71
+		 (Equ happy_var_1 happy_var_3
+	)}}
+
+happyReduce_220 = happySpecReduce_0  65# happyReduction_220
+happyReduction_220  =  happyIn72
+		 ([]
+	)
+
+happyReduce_221 = happySpecReduce_1  65# happyReduction_221
+happyReduction_221 happy_x_1
+	 =  case happyOut71 happy_x_1 of { happy_var_1 -> 
+	happyIn72
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_222 = happySpecReduce_3  65# happyReduction_222
+happyReduction_222 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut71 happy_x_1 of { happy_var_1 -> 
+	case happyOut72 happy_x_3 of { happy_var_3 -> 
+	happyIn72
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_223 = happySpecReduce_3  66# happyReduction_223
+happyReduction_223 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	case happyOut50 happy_x_3 of { happy_var_3 -> 
+	happyIn73
+		 (Alt happy_var_1 happy_var_3
+	)}}
+
+happyReduce_224 = happySpecReduce_0  67# happyReduction_224
+happyReduction_224  =  happyIn74
+		 ([]
+	)
+
+happyReduce_225 = happySpecReduce_1  67# happyReduction_225
+happyReduction_225 happy_x_1
+	 =  case happyOut73 happy_x_1 of { happy_var_1 -> 
+	happyIn74
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_226 = happySpecReduce_3  67# happyReduction_226
+happyReduction_226 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut73 happy_x_1 of { happy_var_1 -> 
+	case happyOut74 happy_x_3 of { happy_var_3 -> 
+	happyIn74
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_227 = happyReduce 5# 68# happyReduction_227
+happyReduction_227 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut63 happy_x_2 of { happy_var_2 -> 
+	case happyOut50 happy_x_4 of { happy_var_4 -> 
+	happyIn75
+		 (DDDec happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_228 = happySpecReduce_1  68# happyReduction_228
+happyReduction_228 happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	happyIn75
+		 (DDExp happy_var_1
+	)}
+
+happyReduce_229 = happySpecReduce_0  69# happyReduction_229
+happyReduction_229  =  happyIn76
+		 ([]
+	)
+
+happyReduce_230 = happySpecReduce_2  69# happyReduction_230
+happyReduction_230 happy_x_2
+	happy_x_1
+	 =  case happyOut76 happy_x_1 of { happy_var_1 -> 
+	case happyOut75 happy_x_2 of { happy_var_2 -> 
+	happyIn76
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_231 = happySpecReduce_2  70# happyReduction_231
+happyReduction_231 happy_x_2
+	happy_x_1
+	 =  case happyOut78 happy_x_1 of { happy_var_1 -> 
+	case happyOut17 happy_x_2 of { happy_var_2 -> 
+	happyIn77
+		 (OldGr happy_var_1 (reverse happy_var_2)
+	)}}
+
+happyReduce_232 = happySpecReduce_0  71# happyReduction_232
+happyReduction_232  =  happyIn78
+		 (NoIncl
+	)
+
+happyReduce_233 = happySpecReduce_2  71# happyReduction_233
+happyReduction_233 happy_x_2
+	happy_x_1
+	 =  case happyOut80 happy_x_2 of { happy_var_2 -> 
+	happyIn78
+		 (Incl happy_var_2
+	)}
+
+happyReduce_234 = happySpecReduce_1  72# happyReduction_234
+happyReduction_234 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn79
+		 (FString happy_var_1
+	)}
+
+happyReduce_235 = happySpecReduce_1  72# happyReduction_235
+happyReduction_235 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn79
+		 (FPIdent happy_var_1
+	)}
+
+happyReduce_236 = happySpecReduce_2  72# happyReduction_236
+happyReduction_236 happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_2 of { happy_var_2 -> 
+	happyIn79
+		 (FSlash happy_var_2
+	)}
+
+happyReduce_237 = happySpecReduce_2  72# happyReduction_237
+happyReduction_237 happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_2 of { happy_var_2 -> 
+	happyIn79
+		 (FDot happy_var_2
+	)}
+
+happyReduce_238 = happySpecReduce_2  72# happyReduction_238
+happyReduction_238 happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_2 of { happy_var_2 -> 
+	happyIn79
+		 (FMinus happy_var_2
+	)}
+
+happyReduce_239 = happySpecReduce_2  72# happyReduction_239
+happyReduction_239 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut79 happy_x_2 of { happy_var_2 -> 
+	happyIn79
+		 (FAddId happy_var_1 happy_var_2
+	)}}
+
+happyReduce_240 = happySpecReduce_2  73# happyReduction_240
+happyReduction_240 happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_1 of { happy_var_1 -> 
+	happyIn80
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_241 = happySpecReduce_3  73# happyReduction_241
+happyReduction_241 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_1 of { happy_var_1 -> 
+	case happyOut80 happy_x_3 of { happy_var_3 -> 
+	happyIn80
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyNewToken action sts stk [] =
+	happyDoAction 82# 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 "+") -> 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 "Lin") -> cont 31#;
+	PT _ (TS "PType") -> cont 32#;
+	PT _ (TS "Str") -> cont 33#;
+	PT _ (TS "Strs") -> cont 34#;
+	PT _ (TS "Tok") -> cont 35#;
+	PT _ (TS "Type") -> cont 36#;
+	PT _ (TS "abstract") -> cont 37#;
+	PT _ (TS "case") -> cont 38#;
+	PT _ (TS "cat") -> cont 39#;
+	PT _ (TS "concrete") -> cont 40#;
+	PT _ (TS "data") -> cont 41#;
+	PT _ (TS "def") -> cont 42#;
+	PT _ (TS "flags") -> cont 43#;
+	PT _ (TS "fn") -> cont 44#;
+	PT _ (TS "fun") -> cont 45#;
+	PT _ (TS "grammar") -> cont 46#;
+	PT _ (TS "in") -> cont 47#;
+	PT _ (TS "include") -> cont 48#;
+	PT _ (TS "incomplete") -> cont 49#;
+	PT _ (TS "instance") -> cont 50#;
+	PT _ (TS "interface") -> cont 51#;
+	PT _ (TS "let") -> cont 52#;
+	PT _ (TS "lin") -> cont 53#;
+	PT _ (TS "lincat") -> cont 54#;
+	PT _ (TS "lindef") -> cont 55#;
+	PT _ (TS "lintype") -> cont 56#;
+	PT _ (TS "of") -> cont 57#;
+	PT _ (TS "open") -> cont 58#;
+	PT _ (TS "oper") -> cont 59#;
+	PT _ (TS "package") -> cont 60#;
+	PT _ (TS "param") -> cont 61#;
+	PT _ (TS "pattern") -> cont 62#;
+	PT _ (TS "pre") -> cont 63#;
+	PT _ (TS "printname") -> cont 64#;
+	PT _ (TS "resource") -> cont 65#;
+	PT _ (TS "reuse") -> cont 66#;
+	PT _ (TS "strs") -> cont 67#;
+	PT _ (TS "table") -> cont 68#;
+	PT _ (TS "tokenizer") -> cont 69#;
+	PT _ (TS "type") -> cont 70#;
+	PT _ (TS "union") -> cont 71#;
+	PT _ (TS "var") -> cont 72#;
+	PT _ (TS "variants") -> cont 73#;
+	PT _ (TS "where") -> cont 74#;
+	PT _ (TS "with") -> cont 75#;
+	PT _ (TI happy_dollar_dollar) -> cont 76#;
+	PT _ (TL happy_dollar_dollar) -> cont 77#;
+	PT _ (TD happy_dollar_dollar) -> cont 78#;
+	PT _ (T_PIdent _) -> cont 79#;
+	PT _ (T_LString happy_dollar_dollar) -> cont 80#;
+	_ -> cont 81#;
+	_ -> 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 (happyOut12 x))
+
+pModDef tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut14 x))
+
+pOldGrammar tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 2# tks) (\x -> happyReturn (happyOut77 x))
+
+pExp tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 3# tks) (\x -> happyReturn (happyOut50 x))
+
+happySeq = happyDontSeq
+
+
+returnM :: a -> Err a
+returnM = return
+
+thenM :: Err a -> (a -> Err b) -> Err b
+thenM = (>>=)
+
+happyError :: [Token] -> Err a
+happyError ts =
+  Bad $ "syntax error at " ++ tokenPos ts ++ 
+  case ts of
+    [] -> []
+    [Err _] -> " due to lexer error"
+    _ -> " before " ++ unwords (map prToken (take 4 ts))
+
+myLexer = tokens
+{-# LINE 1 "GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
+{-# LINE 1 "<command line>" #-}
+{-# LINE 1 "GenericTemplate.hs" #-}
+-- Id: 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-2.9/GF/Devel/Compile/PrintGF.hs b/src-2.9/GF/Devel/Compile/PrintGF.hs
new file mode 100644
index 000000000..7eb63612a
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/PrintGF.hs
@@ -0,0 +1,481 @@
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Devel.Compile.PrintGF where
+
+-- pretty-printer generated by the BNF converter
+
+import GF.Devel.Compile.AbsGF
+import Char
+
+-- the top-level printing method
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+type Doc = [ShowS] -> [ShowS]
+
+doc :: ShowS -> Doc
+doc = (:)
+
+render :: Doc -> String
+render d = rend 0 (map ($ "") $ d []) "" where
+  rend i ss = case ss of
+    "["      :ts -> showChar '[' . rend i ts
+    "("      :ts -> showChar '(' . rend i ts
+    "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
+    "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
+    "}"      :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
+    ";"      :ts -> showChar ';' . new i . rend i ts
+    t  : "," :ts -> showString t . space "," . rend i ts
+    t  : ")" :ts -> showString t . showChar ')' . rend i ts
+    t  : "]" :ts -> showString t . showChar ']' . rend i ts
+    t        :ts -> space t . rend i ts
+    _            -> id
+  new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
+  space t = showString t . (\s -> if null s then "" else (' ':s))
+
+parenth :: Doc -> Doc
+parenth ss = doc (showChar '(') . ss . doc (showChar ')')
+
+concatS :: [ShowS] -> ShowS
+concatS = foldr (.) id
+
+concatD :: [Doc] -> Doc
+concatD = foldr (.) id
+
+replicateS :: Int -> ShowS -> ShowS
+replicateS n f = concatS (replicate n f)
+
+-- the printer class does the job
+class Print a where
+  prt :: Int -> a -> Doc
+  prtList :: [a] -> Doc
+  prtList = concatD . map (prt 0)
+
+instance Print a => Print [a] where
+  prt _ = prtList
+
+instance Print Char where
+  prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
+  prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
+
+mkEsc :: Char -> Char -> ShowS
+mkEsc q s = case s of
+  _ | s == q -> showChar '\\' . showChar s
+  '\\'-> showString "\\\\"
+  '\n' -> showString "\\n"
+  '\t' -> showString "\\t"
+  _ -> showChar s
+
+prPrec :: Int -> Int -> Doc -> Doc
+prPrec i j = if j<i then parenth else id
+
+
+instance Print Integer where
+  prt _ x = doc (shows x)
+
+
+instance Print Double where
+  prt _ x = doc (shows x)
+
+
+
+instance Print PIdent where
+  prt _ (PIdent (_,i)) = doc (showString i)
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
+
+
+instance Print LString where
+  prt _ (LString i) = doc (showString i)
+
+
+
+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
+   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 ModType where
+  prt i e = case e of
+   MAbstract pident -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 pident])
+   MResource pident -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 pident])
+   MGrammar pident -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 pident])
+   MInterface pident -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 pident])
+   MConcrete pident0 pident -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
+   MInstance pident0 pident -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 pident0 , doc (showString "of") , prt 0 pident])
+
+
+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])
+   OQual pident0 pident -> prPrec i 0 (concatD [doc (showString "(") , 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 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 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])
+   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 defs -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 defs])
+   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 defs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "cat") , prt 0 defs])
+   DefPrintFun defs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "fun") , prt 0 defs])
+   DefFlag defs -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 defs])
+   DefPrintOld defs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 defs])
+   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 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 FunDef where
+  prt i e = case e of
+   FDecl 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 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 DataDef where
+  prt i e = case e of
+   DataDef name dataconstrs -> prPrec i 0 (concatD [prt 0 name , 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])
+   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 Name where
+  prt i e = case e of
+   PIdentName 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
+   EPIdent 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 "}")])
+   EPatt patt -> prPrec i 4 (concatD [doc (showString "pattern") , prt 2 patt])
+   EPattType exp -> prPrec i 4 (concatD [doc (showString "pattern") , doc (showString "type") , 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
+   LPIdent 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
+   BPIdent 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])
+   FPIdent 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-2.9/GF/Devel/Compile/Refresh.hs b/src-2.9/GF/Devel/Compile/Refresh.hs
new file mode 100644
index 000000000..1708761fc
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/Refresh.hs
@@ -0,0 +1,118 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Refresh
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:27 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- make variable names unique by adding an integer index to each
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.Refresh (
+  refreshModule,
+  refreshTerm, 
+  refreshTermN
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Control.Monad
+
+
+-- for concrete and resource in grammar, before optimizing
+
+refreshModule :: Int -> SourceModule -> Err (SourceModule,Int)
+refreshModule k (m,mo) = do
+  (mo',(_,k')) <- appSTM (termOpModule refresh mo) (initIdStateN k)
+  return ((m,mo'),k')
+
+
+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'  <- refVarPlus 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     (refVarPlus 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)
+
diff --git a/src-2.9/GF/Devel/Compile/Rename.hs b/src-2.9/GF/Devel/Compile/Rename.hs
new file mode 100644
index 000000000..9ba704c19
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/Rename.hs
@@ -0,0 +1,239 @@
+----------------------------------------------------------------------
+-- |
+-- 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
+--
+-----------------------------------------------------------------------------
+
+module GF.Devel.Compile.Rename (
+  renameModule
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.PrGF
+import GF.Infra.Ident
+import GF.Devel.Grammar.Lookup
+import GF.Data.Operations
+
+import Control.Monad
+import qualified Data.Map as Map
+import Data.List (nub)
+import Debug.Trace (trace)
+
+{-
+-- | 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 :: GF -> SourceModule -> Err SourceModule
+renameModule gf sm@(name,mo) = case mtype mo of
+  MTInterface -> return sm
+  _ | not (isCompleteModule mo) -> return sm 
+  _ -> errIn ("renaming module" +++ prt name) $ do
+    let gf1 = gf {gfmodules = Map.insert name mo (gfmodules gf)}
+    let rename = renameTerm (gf1,sm) []
+    mo1 <- termOpModule rename mo
+    let mo2 = mo1 {mopens = nub [(i,i) | (_,i) <- mopens mo1]}
+    return (name,mo2)
+
+type RenameEnv = (GF,SourceModule)
+
+renameIdentTerm :: RenameEnv -> Term -> Err Term
+renameIdentTerm (gf, (name,mo)) trm = case trm of
+  Vr i -> looks i
+  Con i -> looks i
+  Q  m i -> getQualified m >>= look i
+  QC m i -> getQualified m >>= look i
+  _ -> return trm
+ where
+   looks i = do
+     let ts = nub [t | m <- pool, Ok t <- [look i m]]
+     case ts of
+       [t] -> return t 
+       [] | elem i [IC "Int",IC "Float",IC "String"] -> ---- do this better
+            return (Q (IC "PredefAbs") i)
+       [] -> prtBad "identifier not found" i
+       t:_ -> 
+         trace (unwords $ "WARNING":"identifier":prt i:"ambiguous:" : map prt ts) 
+               (return t)
+----       _ -> fail $ unwords $ "identifier" : prt i : "ambiguous:" : map prt ts
+   look i m = do
+     ju <- lookupIdent gf m i
+     return $ case jform ju of
+       JLink -> if isConstructor ju then QC (jlink ju) i else Q (jlink ju) i
+       _     -> if isConstructor ju then QC m i else Q m i
+   pool = nub $ name :
+                maybe name id (interfaceName mo) : 
+                IC "Predef" : 
+                map fst (mextends mo) ++ 
+                map snd (mopens mo) 
+   getQualified m = case Map.lookup m qualifMap of
+     Just n -> return n
+     _ -> prtBad "unknown qualifier" m
+   qualifMap = Map.fromList $ 
+     mopens mo ++ 
+     concat [ops | (_,ops) <- minstances mo] ++ 
+     [(m,m) | m <- pool]
+     ---- TODO: check uniqueness of these names
+
+renameTerm :: RenameEnv -> [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
+    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 :: RenameEnv -> 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' <- renid $ Vr c
+    case c' of
+      QC p d -> renp $ PP p d ps
+      Q  p d -> renp $ PP p d ps
+      _ -> prtBad "unresolved pattern" c' ---- (PC c ps', concat vs)
+
+  PP p c ps -> do
+
+    (p', c') <- case renid (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)
+
+  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 :: RenameEnv -> (Ident, Context) -> Err (Ident, Context)
+renameParam env (c,co) = do
+  co' <- renameContext env co
+  return (c,co')
+
+renameContext :: RenameEnv -> 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 :: RenameEnv -> [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-2.9/GF/Devel/Compile/SourceToGF.hs b/src-2.9/GF/Devel/Compile/SourceToGF.hs
new file mode 100644
index 000000000..a62179c18
--- /dev/null
+++ b/src-2.9/GF/Devel/Compile/SourceToGF.hs
@@ -0,0 +1,679 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : SourceToGF
+-- 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.Devel.Compile.SourceToGF ( 
+  transGrammar,
+  transModDef,
+  transExp,
+----  transOldGrammar,
+----  transInclude,
+  newReservedWords
+  ) where
+
+import qualified GF.Devel.Grammar.Grammar as G
+import GF.Devel.Grammar.Construct
+import qualified GF.Devel.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.Infra.Ident
+import GF.Devel.Compile.AbsGF
+import GF.Devel.Compile.PrintGF (printTree)
+----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 qualified Data.Map as Map
+import Data.List (genericReplicate)
+
+import Debug.Trace (trace) ----
+
+-- 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
+  PIdentName i -> transIdent i
+  ListName  i  -> transIdent (mkListId i)
+
+transGrammar :: Grammar -> Err G.GF
+transGrammar x = case x of
+  Gr moddefs  -> do
+    moddefs' <- mapM transModDef moddefs
+    let mos = Map.fromList moddefs'
+    return $ emptyGF {G.gfmodules = mos}
+
+transModDef :: ModDef -> Err (Ident, G.Module)
+transModDef x = case x of
+  MModule compl mtyp body -> do
+
+    let isCompl = transComplMod compl
+
+    (trDef, mtyp', id') <- case mtyp of
+      MAbstract id -> do
+        id' <- transIdent id
+        return (transAbsDef, G.MTAbstract, id')
+      MGrammar id -> mkModRes id G.MTGrammar body 
+      MResource id -> mkModRes id G.MTGrammar body 
+      MConcrete id open -> do
+        id'   <- transIdent id
+        open' <- transIdent open
+        return (transCncDef, G.MTConcrete open', id')
+      MInterface id -> mkModRes id G.MTInterface body
+      MInstance id open -> do
+        open' <- transIdent open
+        mkModRes id (G.MTInstance open') body
+
+    mkBody (isCompl, trDef, mtyp', id') body
+  where
+      mkBody xx@(isc, 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
+        let defs' = Map.fromListWith unifyJudgements 
+                       [(i,d) | Left ds <- defs0, (i,d) <- ds]
+        let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
+        return (id', G.Module mtyp' isc [] [] extends' opens' flags' defs')
+
+       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
+        let defs'  = Map.fromListWith unifyJudgements 
+                       [(i,d) | Left ds <- defs0, (i,d) <- ds]
+        let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
+        return (id', G.Module mtyp' isc [] [(m',insts')] extends' opens' flags' defs')
+       _ -> fail "deprecated module form"
+
+
+      mkModRes id mtyp body = do
+        id' <- transIdent id
+        return (transResDef, mtyp, id')
+
+
+getTopDefs :: [TopDef] -> [TopDef]
+getTopDefs x = x
+
+transComplMod :: ComplMod -> Bool
+transComplMod x = case x of
+  CMCompl   -> True
+  CMIncompl -> False
+
+transExtend :: Extend -> Err [(Ident,G.MInclude)]
+transExtend x = case x of
+  Ext ids  -> mapM transIncludedExt ids
+  NoExt -> return []
+
+transOpens :: Opens -> Err [(Ident,Ident)]
+transOpens x = case x of
+  NoOpens  -> return []
+  OpenIn opens  -> mapM transOpen opens
+
+transOpen :: Open -> Err (Ident,Ident)
+transOpen x = case x of
+  OName id   -> transIdent id >>= \y -> return (y,y)
+  OQual id m -> liftM2 (,) (transIdent id) (transIdent m)
+
+transIncludedExt :: Included -> Err (Ident, G.MInclude)
+transIncludedExt x = case x of
+  IAll i       -> liftM2 (,) (transIdent i) (return G.MIAll)
+  ISome  i ids -> liftM2 (,) (transIdent i) (liftM G.MIOnly   $ mapM transIdent ids)
+  IMinus i ids -> liftM2 (,) (transIdent i) (liftM G.MIExcept $ mapM transIdent ids)
+
+transAbsDef :: TopDef -> Err (Either [(Ident,G.Judgement)] [(Ident,String)])
+transAbsDef x = case x of
+  DefCat catdefs -> liftM (Left . concat) $ mapM transCatDef catdefs
+  DefFun fundefs -> do
+    fundefs' <- mapM transFunDef fundefs
+    returnl [(fun, absFun typ) | (funs,typ) <- fundefs', fun <- funs]
+{- ----
+  DefFunData fundefs -> do
+    fundefs' <- mapM transFunDef fundefs
+    returnl $
+      [(cat, G.AbsCat nope (yes [M.cn fun])) | (funs,typ) <- fundefs', 
+                                       fun <- funs, 
+                                       Ok (_,cat) <- [M.valCat typ]
+      ] ++
+      [(fun, G.AbsFun (yes typ) (yes G.EData)) | (funs,typ) <- fundefs', fun <- funs]
+  DefDef defs  -> do
+    defs' <- liftM concat $ mapM getDefsGen defs
+    returnl [(c, G.AbsFun nope pe) | (c,(_,pe)) <- defs']
+  DefData ds -> do
+    ds' <- mapM transDataDef ds
+    returnl $ 
+      [(c, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++
+      [(f, G.AbsFun nope (yes G.EData))  | (_,fs) <- ds', tf <- fs, f <- funs tf]
+-}
+  DefFlag defs -> liftM (Right . concat) $ mapM transFlagDef defs
+  _ -> return $ Left [] ----  
+----  _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x
+ where
+   -- to get data constructors as terms
+   funs t = case t of
+     G.Con f -> [f]
+     G.Q _ f -> [f]
+     G.QC _ f -> [f]
+     _ -> []
+
+returnl :: a -> Err (Either a b)
+returnl = return . Left
+
+transFlagDef :: Def -> Err [(Ident,String)]
+transFlagDef x = case x of
+  DDef f x -> do
+    fs <- mapM transName f
+    x' <- transExp x
+    v <- case x' of
+      G.K s -> return s
+      G.Vr (IC s) -> return s
+      G.EInt i -> return $ show i
+      _ -> fail $ "illegal flag value" +++ printTree x
+    return $ [(f',v) | f' <- fs]
+
+
+-- | Cat definitions can also return some fun defs
+--   if it is a list category definition
+transCatDef :: CatDef -> Err [(Ident, G.Judgement)]
+transCatDef x = case x of
+  SimpleCatDef id ddecls        -> liftM (:[]) $ cat id ddecls
+  ListCatDef id ddecls          -> listCat id ddecls 0
+  ListSizeCatDef id ddecls size -> listCat id ddecls size
+ where 
+   cat id ddecls = do
+		       i <- transIdent id
+		       cont <- liftM concat $ mapM transDDecl ddecls
+		       return (i, absCat cont)
+   listCat id ddecls size = do
+	 let li = mkListId id
+         li' <- transIdent $ li
+         baseId <- transIdent $ mkBaseId id
+         consId <- transIdent $ mkConsId id
+	 catd0@(c,ju) <- cat li ddecls
+         id' <- transIdent id
+	 let
+           cont0 = [] ---- cat context
+  	   catd = (c,ju) ----(Yes cont0) (Yes [M.cn baseId,M.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 = mkProd (cont ++ genericReplicate size cd) lc
+	   nilfund = (baseId, absFun niltyp) ---- (yes niltyp) (yes G.EData))
+	   constyp = mkProd (cont ++ [cd, M.mkDecl lc]) lc
+	   consfund = (consId, absFun constyp) ---- (yes constyp) (yes G.EData))
+	 return [catd,nilfund,consfund]
+   mkId x i = if isWildIdent x then (mkIdent "x" i) else x
+
+transFunDef :: FunDef -> Err ([Ident], G.Type)
+transFunDef x = case x of
+  FDecl ids typ  -> liftM2 (,) (mapM transName 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.Con $ transIdent id
+     DataQId id0 id  -> liftM2 G.QC (transIdent id0) (transIdent id)
+-}
+
+transResDef :: TopDef -> Err (Either [(Ident,G.Judgement)] [(Ident,String)])
+transResDef x = case x of
+  DefPar pardefs -> do
+    pardefs' <- mapM transParDef pardefs
+    returnl $ concatMap mkParamDefs pardefs'   
+
+  DefOper defs -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    returnl $ concatMap mkOverload [(f, resOper pt pe) | (f,(pt,pe)) <- defs']
+
+  DefLintype defs -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    returnl [(f, resOper pt pe) | (f,(pt,pe)) <- defs']
+
+  DefFlag defs -> liftM (Right . concat) $ mapM transFlagDef defs
+  _ -> return $ Left [] ----
+----  _ -> Bad $ "illegal definition form in resource" +++ printTree x
+ where
+
+   mkParamDefs (p,pars) =
+     if null pars 
+       then [(p,addJType M.meta0 (emptyJudgement G.JParam))]  -- in an interface
+       else (p,resParam p pars) : paramConstructors p pars
+
+   mkOverload (c,j) = case (G.jtype j, G.jdef j) of
+     (_,G.App keyw (G.R fs@(_:_:_))) | isOverloading keyw c fs -> 
+         [(c,resOverload [(ty,fu) | (_,(Just ty,fu)) <- fs])]
+
+     -- to enable separare type signature --- not type-checked
+     (G.App keyw (G.RecType fs@(_:_:_)),_) | isOverloading keyw c fs -> []
+     _ -> [(c,j)]
+   isOverloading (G.Vr keyw) c fs = 
+     prIdent keyw == "overload" &&       -- overload is a "soft keyword"
+     True ---- all (== GP.prt c) (map (GP.prt . fst) fs)
+
+transParDef :: ParDef -> Err (Ident, [(Ident,G.Context)])
+transParDef x = case x of
+  ParDefDir id params  -> liftM2 (,) (transIdent id) (mapM transParConstr params)
+  ParDefAbs id -> liftM2 (,) (transIdent id) (return [])
+
+transCncDef :: TopDef -> Err (Either [(Ident,G.Judgement)] [(Ident,String)])
+transCncDef x = case x of
+  DefLincat defs  -> do
+    defs' <- liftM concat $ mapM transPrintDef defs
+    returnl [(f, cncCat t) | (f,t) <- defs']
+----  DefLindef defs  -> do
+----    defs' <- liftM concat $ mapM getDefs defs
+----    returnl [(f, G.CncCat pt pe nope) | (f,(pt,pe)) <- defs']
+  DefLin defs  -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    returnl [(f, cncFun pe) | (f,(_,pe)) <- defs']
+{- ----
+  DefPrintCat defs -> do
+    defs' <- liftM concat $ mapM transPrintDef defs
+    returnl [(f, G.CncCat nope nope (yes e)) | (f,e) <- defs']    
+  DefPrintFun defs -> do
+    defs' <- liftM concat $ mapM transPrintDef defs
+    returnl [(f, 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, G.CncFun Nothing nope (yes e)) | (f,e) <- defs']    
+  DefFlag defs -> liftM Right $ mapM transFlagDef defs
+  DefPattern defs  -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    let defs2 = [(f, termInPattern t) | (f,(_,Yes t)) <- defs']
+    returnl [(f, G.CncFun Nothing (yes t) nope) | (f,t) <- defs2]
+-}
+  _ -> return $ Left [] ----
+----  _ -> errIn ("illegal definition in concrete syntax:") $ transResDef x
+
+transPrintDef :: Def -> Err [(Ident,G.Term)]
+transPrintDef x = case x of
+  DDef ids exp  -> do
+    (ids,e) <- liftM2 (,) (mapM transName ids) (transExp exp)
+    return $ [(i,e) | i <- ids]
+
+getDefsGen :: Def -> Err [(Ident, (G.Type, G.Term))]
+getDefsGen d = case d of
+  DDecl ids t -> do
+    ids' <- mapM transName ids
+    t'   <- transExp t
+    return [(i,(t', nope)) | i <- ids']
+  DDef ids e -> do
+    ids' <- mapM transName ids
+    e'   <- transExp e
+    return [(i,(nope, yes e')) | i <- ids']
+  DFull ids t e -> do
+    ids' <- mapM transName ids
+    t'   <- transExp t
+    e'   <- transExp e
+    return [(i,(yes t', yes e')) | i <- ids']
+  DPatt id patts e  -> do
+    id' <- transName id
+    ps' <- mapM transPatt patts
+    e'  <- transExp e
+    return [(id',(nope, yes (G.Eqs [(ps',e')])))]
+ where
+   yes = id
+   nope = G.Meta 0
+
+-- | sometimes you need this special case, e.g. in linearization rules
+getDefs :: Def -> Err [(Ident, (G.Type, G.Term))]
+getDefs d = case d of
+  DPatt id patts e  -> do
+    id' <- transName id
+    xs  <- mapM tryMakeVar patts
+    e'  <- transExp e
+    return [(id',(nope, (M.mkAbs xs e')))]
+  _ -> getDefsGen d
+ where
+   nope = G.Meta 0
+
+-- | 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" +++ show p'
+
+transExp :: Exp -> Err G.Term
+transExp x = case x of
+  EPIdent id    -> liftM G.Vr $ transIdent id
+  EConstr id    -> liftM G.Con $ transIdent id
+  ECons id      -> liftM G.Con $ 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    -> liftM G.Sort $ transSort sort
+  EInt n        -> return $ G.EInt n
+  EFloat n      -> return $ G.EFloat n
+  EMeta         -> return $ G.Meta 0
+  EEmpty        -> return G.Empty
+  -- [ C x_1 ... x_n ] becomes (ListC x_1 ... x_n)
+  EList i es    -> transExp $ foldl EApp (EPIdent (mkListId i)) (exps2list 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.FV $ 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 mkProd (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" +++ prIdent 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 str 
+----  ELin id -> liftM G.LiT $ transIdent id
+
+  EEqs eqs -> liftM G.Eqs $ mapM transEquation eqs
+  EData -> return G.EData
+
+  _ -> 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 (M.ident2label lab,ty)
+    _ -> Bad $ "illegal record type field" +++ show (fst f) --- manifest fields ?!
+  tryR f = case f of
+    (lab,(mty, Just t)) -> return (M.ident2label lab,(mty,t))
+    _ -> Bad $ "illegal record field" +++ show (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
+
+  -- this case is for bward compatibiity and should be removed
+  LPIdent (PIdent (_,'v':ds)) | all isDigit ds -> return $ G.LVar $ readIntArg ds 
+  
+  LPIdent (PIdent (_, s)) -> return $ G.LIdent s
+  LVar x   -> return $ G.LVar $ fromInteger x
+
+transSort :: Sort -> Err String
+transSort x = case x of
+  _ -> return $ printTree x
+
+transPatt :: Patt -> Err G.Patt
+transPatt x = case x of
+  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)
+  PW  -> return wildPatt
+  PV (PIdent (_,"_"))  -> return 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 LPIdent $ 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)
+
+
+
+transBind :: Bind -> Err Ident
+transBind x = case x of
+  BPIdent (PIdent (_,"_")) -> return identW
+  BPIdent 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 (Ident,G.Context)
+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 three 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,mkRes ops r,mkCnc ops c] ++ map mkPack ps
+     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)
+     _ -> (a,r,c,ps)
+   mkAbs a = MModule q (MTAbstract absName) (MBody ne (OpenIn [])  (topDefs a))
+   mkRes ps r = MModule q (MTResource resName) (MBody ne (OpenIn ops) (topDefs r))
+                  where ops = map OName ps
+   mkCnc ps r = MModule q (MTConcrete cncName absName) 
+                               (MBody ne (OpenIn (map OName (resName:ps))) (topDefs r))
+   mkPack (m, ds) = MModule q (MTResource m) (MBody ne  (OpenIn []) (topDefs ds))
+   topDefs t = t
+   ne = NoExt
+   q = CMCompl
+
+   name = maybe name0 (++ ".gf") $ getOptVal opts useName
+   absName = identC $ maybe topic id $ getOptVal opts useAbsName
+   resName = identC $ maybe ("Res" ++ lang) id $ getOptVal opts useResName
+   cncName = identC $ maybe lang id $ getOptVal opts useCncName
+
+   (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 = case x of
+  NoIncl -> return []
+  Incl filenames  -> return $ map trans filenames
+ where
+   trans f = case f of
+     FString s  -> s
+     FIdent (IC s) -> modif s
+     FSlash filename  -> '/' : trans filename
+     FDot filename  -> '.' : trans filename
+     FMinus filename  -> '-' : trans filename
+     FAddId (IC s) filename  -> modif s ++ trans filename
+   modif s = let s' = init s ++ [toLower (last s)] in 
+             if elem s' newReservedWords then s' else s 
+                      --- unsafe hack ; cf. GetGrammar.oldLexer
+-}
+
+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 "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  :: PIdent -> PIdent
+mkListId = prefixId "List"
+mkConsId = prefixId "Cons"
+mkBaseId = prefixId "Base"
+
+prefixId :: String -> PIdent -> PIdent
+prefixId pref (PIdent (p,id)) = PIdent (p, pref ++ id)
diff --git a/src-2.9/GF/Devel/Compute.hs b/src-2.9/GF/Devel/Compute.hs
new file mode 100644
index 000000000..a9081c28a
--- /dev/null
+++ b/src-2.9/GF/Devel/Compute.hs
@@ -0,0 +1,455 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.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.Macros
+import GF.Grammar.Lookup
+import GF.Grammar.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 (IC "Predef") _ -> return t
+     Q p c -> 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 (IC "Predef") f -> 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)
+--- - } ---
+
+         Alias _ _ r -> comp g (P r 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@(T ti cc) v -> do
+       v'     <- comp g v
+       case v' of
+         FV vs -> do
+           ts' <- mapM (comp g . S t) vs
+           return $ variants ts' 
+         _ -> case ti of
+{-
+           TComp _  -> do
+             case term2patt v' of
+               Ok p' -> case lookup p' cc of
+                 Just u -> comp g u
+                 _ -> do
+                   t' <- comp g t
+                   return $ S t' v' -- if v' is not canonical
+               _ -> do
+                  t' <- comp g t
+                  return $ S t' v'
+-}
+           _ -> case matchPattern cc v' of
+             Ok (c,g') -> comp (g' ++ g) c
+             _ | isCan v' -> prtBad ("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'     <- case t of
+--        T _ _ -> return t
+--        V _ _ -> return t
+        _ -> comp g t
+
+      v'     <- comp g 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
+-----             _ -> prtBad "selection" $ S t' v' -- debug
+             _ -> return $ S t' v' -- if v' is not canonical
+
+         T (TComp _) cs -> do
+           case term2patt v' of
+             Ok p' -> case lookup p' cs of
+               Just u -> comp g u
+               _ -> return $ S t' v' -- if v' is not canonical
+             _ -> return $ S t' v'
+
+         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
+
+         Alias _ _ d -> comp g (S d v')
+
+         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'
+
+     -- 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
+
+         (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
+         (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
+         (Alias _ _ d, _)  -> comp g $ ExtR d s'
+         (_, Alias _ _ d)  -> comp g $ Glue r' d
+
+         (R rs, R ss) -> plusRecord r' s'
+         (RecType rs, RecType ss) -> plusRecType r' s'
+         _ -> return $ ExtR r' s'
+
+     -- case-expand tables
+     -- if already expanded, don't expand again
+     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'
+     --- 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 <- 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
+
+     Alias c a d -> do
+       d' <- comp g d
+       return $ Alias c a d'  -- alias only disappears in certain redexes
+
+     -- 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'
+
+         (Alias _ _ d, _) -> comp g (App d 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
+
+{-
+     look p c = case lookupResDefKind gr p c of
+       Ok (t,_) | noExpand p || rec -> 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
+-}
+
+     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
+
+     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
+
+
+-- | 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."
diff --git a/src-2.9/GF/Devel/GF.hs b/src-2.9/GF/Devel/GF.hs
new file mode 100644
index 000000000..70fddcd67
--- /dev/null
+++ b/src-2.9/GF/Devel/GF.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import GF.Devel.GFC
+import GF.Devel.GFI
+
+import System (getArgs)
+
+main :: IO ()
+main = do
+  xx <- getArgs
+  case xx of
+    "--batch":args -> mainGFC args
+    _ -> mainGFI xx
+
diff --git a/src-2.9/GF/Devel/GFC.hs b/src-2.9/GF/Devel/GFC.hs
new file mode 100644
index 000000000..27e0e3ae2
--- /dev/null
+++ b/src-2.9/GF/Devel/GFC.hs
@@ -0,0 +1,67 @@
+module GF.Devel.GFC (mainGFC) where
+-- module Main where
+
+import GF.Compile.API
+import GF.Devel.PrintGFCC
+import GF.GFCC.CId
+import GF.GFCC.DataGFCC
+import GF.GFCC.Raw.ParGFCCRaw
+import GF.GFCC.Raw.ConvertGFCC
+import GF.Devel.UseIO
+import GF.Infra.Option
+import GF.GFCC.API
+import GF.Data.ErrM
+
+import System.FilePath
+
+mainGFC :: [String] -> IO ()
+mainGFC xx = do
+  let (opts,fs) = getOptions "-" xx
+  case opts of
+    _ | oElem (iOpt "help") opts -> putStrLn usageMsg
+    _ | oElem (iOpt "-make") opts -> do
+      gfcc <- appIOE (compileToGFCC opts fs) >>= err fail return
+      let gfccFile = targetNameGFCC opts (absname gfcc)
+      outputFile gfccFile (printGFCC gfcc)
+      mapM_ (alsoPrint opts gfcc) printOptions
+
+    -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
+    _ | all ((==".gfcc") . takeExtensions) fs -> do
+      gfccs <- mapM file2gfcc fs
+      let gfcc = foldl1 unionGFCC gfccs
+      let gfccFile = targetNameGFCC opts (absname gfcc)
+      outputFile gfccFile (printGFCC gfcc)
+      mapM_ (alsoPrint opts gfcc) printOptions
+      
+    _ -> do
+      appIOE (mapM_ (batchCompile opts) (map return fs)) >>= err fail return
+      putStrLn "Done."
+
+targetName :: Options -> CId -> String
+targetName opts abs = case getOptVal opts (aOpt "target") of
+  Just n -> n
+  _ -> prIdent abs
+
+targetNameGFCC :: Options -> CId -> FilePath
+targetNameGFCC opts abs = targetName opts abs ++ ".gfcc"
+
+---- TODO: nicer and richer print options
+
+alsoPrint opts gr (opt,name) = do
+  if oElem (iOpt opt) opts 
+    then outputFile name (prGFCC opt gr)
+    else return ()
+
+outputFile :: FilePath -> String -> IO ()
+outputFile outfile output = 
+      do writeFile outfile output
+         putStrLn $ "wrote file " ++ outfile
+
+printOptions = [
+  ("haskell","GSyntax.hs"),
+  ("haskell_gadt","GSyntax.hs"),
+  ("js","grammar.js")
+  ]
+
+usageMsg = 
+  "usage: gfc (-h | --make (-noopt) (-noparse) (-target=PREFIX) (-js | -haskell | -haskell_gadt)) (-src) FILES"
diff --git a/src-2.9/GF/Devel/GFC/Main.hs b/src-2.9/GF/Devel/GFC/Main.hs
new file mode 100644
index 000000000..d9ceb8e70
--- /dev/null
+++ b/src-2.9/GF/Devel/GFC/Main.hs
@@ -0,0 +1,28 @@
+module GF.Devel.GFC.Main where
+
+import GF.Devel.GFC.Options
+
+import System.Environment
+import System.Exit
+import System.IO
+
+
+version = "X.X"
+
+main :: IO ()
+main = 
+    do args <- getArgs
+       case parseOptions args of
+         Ok (opts, files) -> 
+             case optMode opts of
+               Version  -> putStrLn $ "GF, version " ++ version
+               Help     -> putStr helpMessage
+               Compiler -> gfcMain opts files
+         Errors errs -> 
+             do mapM_ (hPutStrLn stderr) errs
+                exitFailure
+
+gfcMain :: Options -> [FilePath] -> IO ()
+gfcMain opts files = return ()
+
+
diff --git a/src-2.9/GF/Devel/GFCCInterpreter.hs b/src-2.9/GF/Devel/GFCCInterpreter.hs
new file mode 100644
index 000000000..b2b17dba7
--- /dev/null
+++ b/src-2.9/GF/Devel/GFCCInterpreter.hs
@@ -0,0 +1,28 @@
+module Main where
+
+import GF.Command.Interpreter
+import GF.Command.Commands
+import GF.GFCC.API
+import System (getArgs)
+import Data.Char (isDigit)
+
+-- Simple translation application built on GFCC. AR 7/9/2006 -- 19/9/2007
+
+main :: IO ()
+main = do
+  file:_  <- getArgs
+  grammar <- file2grammar file
+  let env = CommandEnv grammar (allCommands grammar)
+  printHelp grammar
+  loop env
+
+loop :: CommandEnv -> IO ()
+loop env = do
+  s <- getLine
+  if s == "q" then return () else do
+    interpretCommandLine env s
+    loop env
+
+printHelp grammar = do
+  putStrLn $ "languages:  " ++ unwords (languages grammar)
+  putStrLn $ "categories: " ++ unwords (categories grammar)
diff --git a/src-2.9/GF/Devel/GFCCtoHaskell.hs b/src-2.9/GF/Devel/GFCCtoHaskell.hs
new file mode 100644
index 000000000..aa3eebe58
--- /dev/null
+++ b/src-2.9/GF/Devel/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.Devel.GFCCtoHaskell (grammar2haskell, grammar2haskellGADT) where
+
+import GF.GFCC.Macros
+import GF.GFCC.DataGFCC
+import GF.GFCC.CId
+
+import GF.Data.Operations
+import GF.Text.UTF8
+
+import Data.List --(isPrefixOf, find, intersperse)
+import qualified Data.Map as Map
+
+-- | the main function
+grammar2haskell :: GFCC -> String
+grammar2haskell gr = encodeUTF8 $ foldr (++++) [] $  
+  haskPreamble ++ [datatypes gr', gfinstances gr']
+    where gr' = hSkeleton gr
+
+grammar2haskellGADT :: GFCC -> String
+grammar2haskellGADT gr = encodeUTF8 $ foldr (++++) [] $  
+  ["{-# OPTIONS_GHC -fglasgow-exts #-}"] ++ 
+  haskPreamble ++ [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 =
+ [
+  "module GSyntax where",
+  "",
+  "import GF.GFCC.DataGFCC",
+  "import GF.GFCC.CId",
+  "----------------------------------------------------",
+  "-- automatic translation from GF to Haskell",
+  "----------------------------------------------------",
+  "", 
+  "class Gf a where",
+  "  gf :: a -> Exp",
+  "  fg :: Exp -> a",
+  "",
+  predefInst "GString" "String" "DTr [] (AS s) []",
+  "",
+  predefInst "GInt" "Integer" "DTr [] (AI s) []",
+  "",
+  predefInst "GFloat" "Double" "DTr [] (AF 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 = "DTr [] (AC (CId \"" ++ 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 =
+     "      DTr [] (AC (CId \"" ++ f ++ "\")) " ++
+     "[" ++ prTList "," xx' ++ "]" +++
+     "->" +++ 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 :: GFCC -> (String,HSkeleton)
+hSkeleton gr = 
+  (pr (absname gr), 
+   [(pr c, [(pr f, map pr 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
+   pr (CId c) = c
+   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-2.9/GF/Devel/GFCCtoJS.hs b/src-2.9/GF/Devel/GFCCtoJS.hs
new file mode 100644
index 000000000..c61ad08d5
--- /dev/null
+++ b/src-2.9/GF/Devel/GFCCtoJS.hs
@@ -0,0 +1,132 @@
+module GF.Devel.GFCCtoJS (gfcc2js) where
+
+import qualified GF.GFCC.Macros as M
+import qualified GF.GFCC.DataGFCC as D
+import GF.GFCC.CId
+import qualified GF.JavaScript.AbsJS as JS
+import qualified GF.JavaScript.PrintJS as JS
+
+import GF.Formalism.FCFG
+import GF.Parsing.FCFG.PInfo
+import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
+
+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
+
+gfcc2js :: D.GFCC -> String
+gfcc2js gfcc =
+  encodeUTF8 $ JS.printTree $ JS.Program [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident n) grammar]]
+ where
+   n  = D.printCId $ D.absname gfcc
+   as = D.abstract gfcc
+   cs = Map.assocs (D.concretes gfcc)
+   start = M.lookStartCat gfcc
+   grammar = new "GFGrammar" [abstract, concrete]
+   abstract = abstract2js start as
+   concrete = JS.EObj $ map (concrete2js start n) cs
+
+abstract2js :: String -> D.Abstr -> JS.Expr
+abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (D.funs ds))]
+
+absdef2js :: (CId,(D.Type,D.Exp)) -> JS.Property
+absdef2js (CId f,(typ,_)) =
+  let (args,CId cat) = M.catSkeleton typ in 
+    JS.Prop (JS.StringPropName f) (new "Type" [JS.EArray [JS.EStr x | CId x <- args], JS.EStr cat])
+
+concrete2js :: String -> String -> (CId,D.Concr) -> JS.Property
+concrete2js start n (CId c, cnc) =
+    JS.Prop l (new "GFConcrete" ([(JS.EObj $ ((map (cncdef2js n c) ds) ++ litslins))] ++
+                                 maybe [] (parser2js start) (D.parser cnc)))
+  where 
+   l  = JS.StringPropName c
+   ds = concatMap Map.assocs [D.lins cnc, D.opers cnc, D.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,D.Term) -> JS.Property
+cncdef2js n l (CId f, t) = JS.Prop (JS.StringPropName f) (JS.EFun [children] [JS.SReturn (term2js n l t)])
+
+term2js :: String -> String -> D.Term -> JS.Expr
+term2js n l t = f t
+  where 
+  f t = 
+    case t of
+      D.R xs           -> new "Arr" (map f xs)
+      D.P x y          -> JS.ECall (JS.EMember (f x) (JS.Ident "sel")) [f y]
+      D.S xs           -> mkSeq (map f xs)
+      D.K t            -> tokn2js t
+      D.V i            -> JS.EIndex (JS.EVar children) (JS.EInt i)
+      D.C i            -> new "Int" [JS.EInt i]
+      D.F (CId f)      -> JS.ECall (JS.EMember (JS.EIndex (JS.EMember (JS.EVar $ JS.Ident n) (JS.Ident "concretes")) (JS.EStr l)) (JS.Ident "rule")) [JS.EStr f, JS.EVar children]
+      D.FV xs          -> new "Variants" (map f xs)
+      D.W str x        -> new "Suffix" [JS.EStr str, f x]
+      D.RP x y         -> new "Rp" [f x, f y]
+      D.TM _           -> new "Meta" []
+
+tokn2js :: D.Tokn -> JS.Expr
+tokn2js (D.KS s) = mkStr s
+tokn2js (D.KP ss vs) = mkSeq (map mkStr ss) -- FIXME
+
+mkStr :: String -> JS.Expr
+mkStr s = new "Str" [JS.EStr s]
+
+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 -> FCFPInfo -> [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 (CId c,is) = JS.Prop (JS.StringPropName c) (JS.EArray (map JS.EInt is))
+
+frule2js :: FRule -> JS.Expr
+frule2js (FRule n args res lins) = new "Rule" [JS.EInt res, name2js n, JS.EArray (map JS.EInt args), lins2js lins]
+
+name2js :: FName -> JS.Expr
+name2js n = case n of
+              Name (CId "_") [p] -> fromProfile p
+              Name f ps          -> new "FunApp" $ [JS.EStr $ prCId f, JS.EArray (map fromProfile ps)]
+  where
+    fromProfile :: Profile (SyntaxForest CId) -> JS.Expr
+    fromProfile (Unify []) = new "MetaVar" []
+    fromProfile (Unify [x]) = daughter x
+    fromProfile (Unify args) = new "Unify" [JS.EArray (map daughter args)]
+    fromProfile (Constant forest) = fromSyntaxForest forest
+
+    daughter i = new "Arg" [JS.EInt i]
+
+    fromSyntaxForest :: SyntaxForest CId -> JS.Expr
+    fromSyntaxForest FMeta = new "MetaVar" []
+    -- FIXME: is there always just one element here?
+    fromSyntaxForest (FNode n [args]) = new "FunApp" $ [JS.EStr $ prCId n, JS.EArray (map fromSyntaxForest args)]
+    fromSyntaxForest (FString s) = new "Lit" $ [JS.EStr s]
+    fromSyntaxForest (FInt i) = new "Lit" $ [JS.EInt $ fromIntegral i]
+    fromSyntaxForest (FFloat f) = new "Lit" $ [JS.EDbl f]
+
+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-2.9/GF/Devel/GFI.hs b/src-2.9/GF/Devel/GFI.hs
new file mode 100644
index 000000000..f59bd15e6
--- /dev/null
+++ b/src-2.9/GF/Devel/GFI.hs
@@ -0,0 +1,77 @@
+module GF.Devel.GFI (mainGFI) where
+
+import GF.Command.Interpreter
+import GF.Command.Importing
+import GF.Command.Commands
+import GF.GFCC.API
+
+import GF.Devel.UseIO
+import GF.Devel.Arch
+import GF.Infra.Option ---- Haskell's option lib
+
+
+mainGFI :: [String] -> IO ()
+mainGFI xx = do
+  putStrLn welcome
+  env <- importInEnv emptyMultiGrammar xx
+  loop (GFEnv env [] 0)
+  return ()
+
+loop :: GFEnv -> IO GFEnv
+loop gfenv0 = do
+  let env = commandenv gfenv0
+  putStrFlush (prompt env)
+  s <- getLine
+  let gfenv = gfenv0 {history = s : history gfenv0}
+  case words s of
+
+  -- special commands, working on GFEnv
+    "i":args -> do
+      env1 <- importInEnv (multigrammar env) args
+      loopNewCPU $ gfenv {commandenv = env1}
+    "e":_ -> loopNewCPU $ gfenv {commandenv=env{multigrammar=emptyMultiGrammar}}
+    "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
+
+loopNewCPU gfenv = do
+  cpu <- prCPU $ cputime gfenv
+  loop $ gfenv {cputime = cpu}
+
+importInEnv mgr0 xx = do
+  let (opts,files) = getOptions "-" xx
+  mgr1 <- case files of
+    [] -> return mgr0
+    _  -> importGrammar mgr0 opts files
+  let env = CommandEnv mgr1 (allCommands mgr1)
+  putStrLn $ unwords $ "\nLanguages:" : languages mgr1
+  return env
+
+welcome = unlines [
+  "                              ",
+  "         *  *  *              ",
+  "      *           *           ",
+  "    *               *         ",
+  "   *                          ",
+  "   *                          ",
+  "   *        * * * * * *       ",
+  "   *        *         *       ",
+  "    *       * * * *  *        ",
+  "      *     *      *          ",
+  "         *  *  *              ",
+  "                              ",
+  "This is GF version 3.0 alpha. ",
+  "Some things may work.         "
+  ]
+
+prompt env = abstractName (multigrammar env) ++ "> "
+
+data GFEnv = GFEnv {
+  commandenv :: CommandEnv,
+  history    :: [String],
+  cputime    :: Integer
+  }
diff --git a/src-2.9/GF/Devel/GetGrammar.hs b/src-2.9/GF/Devel/GetGrammar.hs
new file mode 100644
index 000000000..cdd275ace
--- /dev/null
+++ b/src-2.9/GF/Devel/GetGrammar.hs
@@ -0,0 +1,54 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.GetGrammar where
+
+import GF.Data.Operations
+import qualified GF.Source.ErrM as E
+
+import GF.Devel.UseIO
+import GF.Grammar.Grammar
+import GF.Infra.Modules
+import GF.Devel.PrGrammar
+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.Devel.ReadFiles ----
+
+import Data.Char (toUpper)
+import Data.List (nub)
+import qualified Data.ByteString.Char8 as BS
+import Control.Monad (foldM)
+import System (system)
+
+getSourceModule :: Options -> FilePath -> IOE SourceModule
+getSourceModule opts file0 = do
+  file <- case getOptVal opts usePreprocessor of
+    Just p -> do
+      let tmp = "_gf_preproc.tmp"
+          cmd = p +++ file0 ++ ">" ++ tmp
+      ioeIO $ system cmd
+      -- ioeIO $ putStrLn $ "preproc" +++ cmd
+      return tmp
+    _ -> return file0
+  string    <- readFileIOE file
+  let tokens = myLexer string
+  mo1  <- ioeErr $ pModDef tokens
+  ioeErr $ transModDef mo1
diff --git a/src-2.9/GF/Devel/Grammar/AppPredefined.hs b/src-2.9/GF/Devel/Grammar/AppPredefined.hs
new file mode 100644
index 000000000..c8d2988fd
--- /dev/null
+++ b/src-2.9/GF/Devel/Grammar/AppPredefined.hs
@@ -0,0 +1,166 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.Grammar.AppPredefined (
+  isInPredefined, 
+  typPredefined, 
+  appPredefined
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.PrGF (prt,prt_,prtBad)
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+
+-- 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 c@(IC f) = case f of
+  "Int"    -> return typePType
+  "Float"  -> return typePType
+  "Error"  -> return typeType
+  "Ints"   -> return $ mkFunType [cnPredef "Int"] typePType
+  "PBool"  -> return typePType
+  "error"  -> return $ mkFunType [typeStr] (cnPredef "Error")  -- non-can. of empty set
+  "PFalse" -> return $ cnPredef "PBool"
+  "PTrue"  -> return $ cnPredef "PBool"
+  "dp"     -> return $ mkFunType [cnPredef "Int",typeStr] typeStr
+  "drop"   -> return $ mkFunType [cnPredef "Int",typeStr] typeStr
+  "eqInt"  -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
+  "lessInt"-> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
+  "eqStr"  -> return $ mkFunType [typeStr,typeStr] (cnPredef "PBool")
+  "length" -> return $ mkFunType [typeStr] (cnPredef "Int")
+  "occur"  -> return $ mkFunType [typeStr,typeStr] (cnPredef "PBool")
+  "occurs" -> return $ mkFunType [typeStr,typeStr] (cnPredef "PBool")
+  "plus"   -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "Int")
+----  "read"   -> (P : Type) -> Tok -> P
+  "show"   -> return $ mkProds -- (P : PType) -> P -> Tok
+    ([(identC "P",typePType),(wildIdent,Vr (identC "P"))],typeStr,[]) 
+  "toStr"  -> return $ mkProds -- (L : Type)  -> L -> Str
+    ([(identC "L",typeType),(wildIdent,Vr (identC "L"))],typeStr,[]) 
+  "mapStr" -> 
+    let ty = identC "L" in
+    return $ mkProds -- (L : Type)  -> (Str -> Str) -> L -> L
+    ([(ty,typeType),(wildIdent,mkFunType [typeStr] typeStr),(wildIdent,Vr ty)],Vr ty,[]) 
+  "take"   -> return $ mkFunType [cnPredef "Int",typeStr] typeStr
+  "tk"     -> return $ mkFunType [cnPredef "Int",typeStr] typeStr
+  _        -> prtBad "unknown in Predef:" c
+
+typPredefined c = prtBad "unknown in Predef:" c
+
+mkProds (cont,t,xx) = foldr (uncurry Prod) (mkApp t xx) cont
+
+appPredefined :: Term -> Err (Term,Bool)
+appPredefined t = case t of
+
+  App f x0 -> do
+   (x,_) <- appPredefined x0
+   case f of
+    -- one-place functions
+    Q (IC "Predef") (IC f) -> case (f, x) of
+      ("length", K s) -> retb $ EInt $ toInteger $ length s
+      _ -> retb t ---- prtBad "cannot compute predefined" t
+
+    -- two-place functions
+    App (Q (IC "Predef") (IC f)) z0 -> do
+     (z,_) <- appPredefined z0
+     case (f, norm z, norm x) of
+      ("drop", EInt i, K s) -> retb $ K (drop (fi i) s)
+      ("take", EInt i, K s) -> retb $ K (take (fi i) s)
+      ("tk",   EInt i, K s) -> retb $ K (take (max 0 (length s - fi i)) s)
+      ("dp",   EInt i, K s) -> retb $ K (drop (max 0 (length s - fi i)) s)
+      ("eqStr",K s,    K t) -> retb $ if s == t then predefTrue else predefFalse
+      ("occur",K s,    K t) -> retb $ if substring s t then predefTrue else predefFalse
+      ("occurs",K s,   K t) -> retb $ if any (flip elem t) s then predefTrue else predefFalse
+      ("eqInt",EInt i, EInt j) -> retb $ if i==j then predefTrue else predefFalse
+      ("lessInt",EInt i, EInt j) -> retb $ if i<j then predefTrue else predefFalse
+      ("plus", EInt i, EInt j) -> retb $ EInt $ i+j
+      ("show", _, t) -> retb $ foldr C Empty $ map K $ words $ prt t
+      ("read", _, K s) -> retb $ str2tag s --- because of K, only works for atomic tags
+      ("toStr", _, t) -> trm2str t >>= retb
+
+      _ -> retb t ---- prtBad "cannot compute predefined" t
+
+    -- three-place functions
+    App (App (Q (IC "Predef") (IC f)) z0) y0 -> do
+     (y,_) <- appPredefined y0
+     (z,_) <- appPredefined z0
+     case (f, z, y, x) of
+      ("mapStr",ty,op,t) -> 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 (t,True)  -- no further computing needed
+   retf t = return (t,False) -- must be computed further
+   norm t = case t of
+     Empty -> K []
+     _ -> t
+   fi = fromInteger
+
+-- read makes variables into constants
+
+str2tag :: String -> Term
+str2tag s = case s of
+----  '\'' : cs -> mkCn $ pTrm $ init cs
+  _ -> Con $ IC s ---
+ where
+   mkCn t = case t of
+     Vr i -> Con i
+     App c a -> App (mkCn c) (mkCn a)
+     _ -> t
+
+
+predefTrue = Q (IC "Predef") (IC "PTrue")
+predefFalse = Q (IC "Predef") (IC "PFalse")
+
+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
+  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,typeStr] -> 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-2.9/GF/Devel/Grammar/Compute.hs b/src-2.9/GF/Devel/Grammar/Compute.hs
new file mode 100644
index 000000000..5e465c160
--- /dev/null
+++ b/src-2.9/GF/Devel/Grammar/Compute.hs
@@ -0,0 +1,380 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.Grammar.Compute (
+  computeTerm,
+  computeTermCont,
+  computeTermRec
+  ) where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.Lookup
+import GF.Devel.Grammar.PrGF
+import GF.Devel.Grammar.PatternMatch
+import GF.Devel.Grammar.AppPredefined
+
+import GF.Infra.Ident
+import GF.Infra.Option
+
+--import GF.Grammar.Refresh
+--import GF.Grammar.Lockfield (isLockLabel) ----
+
+import GF.Data.Str ----
+import GF.Data.Operations
+
+import Data.List (nub,intersperse)
+import Control.Monad (liftM2, liftM)
+
+-- | computation of concrete syntax terms into normal form
+-- used mainly for partial evaluation
+computeTerm :: GF -> Term -> Err Term
+computeTerm g t = {- refreshTerm t >>= -} computeTermCont g [] t
+computeTermRec g t = {- refreshTerm t >>= -} computeTermOpt True g [] t
+
+computeTermCont :: GF -> Substitution -> Term -> Err Term
+computeTermCont = 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 -> GF -> Substitution -> Term -> Err Term
+computeTermOpt rec gr = comp where
+
+   comp g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging 
+              case t of
+
+     Q (IC "Predef") _ -> return t
+     Q p c -> look p c 
+
+     -- if computed do nothing
+     ---- Computed t' -> return $ unComputed t'
+
+     Vr x -> do
+       t' <- maybe (prtBad ("no value for 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'
+
+     -- beta-convert
+     App f a -> do
+       f' <- comp 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'
+
+     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@(T ti cc) v -> do
+       v'     <- comp g v
+       case v' of
+         FV vs -> do
+           ts' <- mapM (comp g . S t) vs
+           return $ variants ts' 
+         _ -> case ti of
+{-
+           TComp _  -> do
+             case term2patt v' of
+               Ok p' -> case lookup p' cc of
+                 Just u -> comp g u
+                 _ -> do
+                   t' <- comp g t
+                   return $ S t' v' -- if v' is not canonical
+               _ -> do
+                  t' <- comp g t
+                  return $ S t' v'
+-}
+           _ -> case matchPattern cc v' of
+             Ok (c,g') -> comp (g' ++ g) c
+             _ | isCan v' -> prtBad ("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'     <- case t of
+---- why not? ResFin.Agr "has no values"
+----        T (TComp _) _ -> return t
+----        V _ _ -> return t
+        _ -> comp g t
+
+      v'     <- comp g 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
+-----             _ -> prtBad "selection" $ S t' v' -- debug
+             _ -> return $ S t' v' -- if v' is not canonical
+
+         T (TComp _) cs -> do
+           case term2patt v' of
+             Ok p' -> case lookup p' cs of
+               Just u -> comp g u
+               _ -> return $ S t' v' -- if v' is not canonical
+             _ -> return $ S t' v'
+
+         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'
+
+     -- 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'
+
+     -- case-expand tables
+     -- if already expanded, don't expand again
+     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'
+
+     T i cs -> do
+       pty0 <- errIn (prt t) $ getTableType i
+       ptyp <- comp g pty0
+       case allParamValues gr ptyp of
+         Ok vs -> do
+
+           cs'  <- mapM (compBranchOpt g) cs  ---- why is this needed??
+           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 ---- why doesn't this work??
+           return $ 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
+
+    where
+
+     look p c
+       | rec       = lookupOperDef gr p c >>= comp []
+       | otherwise = lookupOperDef gr p c
+
+{-
+     look p c = case lookupResDefKind gr p c of
+       Ok (t,_) | noExpand p || rec -> 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
+-}
+
+     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
+       _ -> 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
+
+-- | 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."
diff --git a/src-2.9/GF/Devel/Grammar/Construct.hs b/src-2.9/GF/Devel/Grammar/Construct.hs
new file mode 100644
index 000000000..5b4215843
--- /dev/null
+++ b/src-2.9/GF/Devel/Grammar/Construct.hs
@@ -0,0 +1,221 @@
+module GF.Devel.Grammar.Construct where
+
+import GF.Devel.Grammar.Grammar
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Control.Monad
+import Data.Map
+import Debug.Trace (trace)
+
+------------------
+-- abstractions on Grammar, constructing objects
+------------------
+
+-- abstractions on GF
+
+emptyGF :: GF
+emptyGF = GF Nothing [] empty empty
+
+type SourceModule = (Ident,Module)
+
+listModules :: GF -> [SourceModule]
+listModules = assocs.gfmodules
+
+addModule :: Ident -> Module -> GF -> GF
+addModule c m gf = gf {gfmodules = insert c m (gfmodules gf)}
+
+gfModules :: [(Ident,Module)] -> GF
+gfModules ms = emptyGF {gfmodules = fromList ms}
+
+-- abstractions on Module
+
+emptyModule :: Module
+emptyModule = Module MTGrammar True [] [] [] [] empty empty
+
+isCompleteModule :: Module -> Bool
+isCompleteModule = miscomplete
+
+isInterface :: Module -> Bool
+isInterface m = case mtype m of
+  MTInterface -> True
+  MTAbstract -> True
+  _ -> False
+
+interfaceName :: Module -> Maybe Ident
+interfaceName mo = case mtype mo of
+  MTInstance i -> return i
+  MTConcrete i -> return i
+  _ -> Nothing
+
+listJudgements :: Module -> [(Ident,Judgement)]
+listJudgements = assocs . mjments
+
+isInherited :: MInclude -> Ident -> Bool
+isInherited mi i = case mi of
+  MIExcept is -> notElem i is
+  MIOnly is -> elem i is
+  _ -> True
+
+-- abstractions on Judgement
+
+isConstructor :: Judgement -> Bool
+isConstructor j = jdef j == EData
+
+isLink :: Judgement -> Bool
+isLink j = jform j == JLink
+
+-- constructing judgements from parse tree
+
+emptyJudgement :: JudgementForm -> Judgement
+emptyJudgement form = Judgement form meta meta meta (identC "#") 0 where
+  meta = Meta 0
+
+addJType :: Type -> Judgement -> Judgement
+addJType tr ju = ju {jtype = tr}
+
+addJDef :: Term -> Judgement -> Judgement
+addJDef tr ju = ju {jdef = tr}
+
+addJPrintname :: Term -> Judgement -> Judgement
+addJPrintname tr ju = ju {jprintname = tr}
+
+linkInherited :: Bool -> Ident -> Judgement
+linkInherited can mo = (emptyJudgement JLink){
+  jlink = mo,
+  jdef = if can then EData else Meta 0
+  }
+
+absCat :: Context -> Judgement
+absCat co = addJType (mkProd co typeType) (emptyJudgement JCat)
+
+absFun :: Type -> Judgement
+absFun ty = addJType ty (emptyJudgement JFun)
+
+cncCat :: Type -> Judgement
+cncCat ty = addJType ty (emptyJudgement JLincat)
+
+cncFun :: Term -> Judgement
+cncFun tr = addJDef tr (emptyJudgement JLin)
+
+resOperType :: Type -> Judgement
+resOperType ty = addJType ty (emptyJudgement JOper)
+
+resOperDef :: Term -> Judgement
+resOperDef tr = addJDef tr (emptyJudgement JOper)
+
+resOper :: Type -> Term -> Judgement
+resOper ty tr = addJDef tr (resOperType ty)
+
+resOverload :: [(Type,Term)] -> Judgement
+resOverload tts = resOperDef (Overload tts)
+
+-- param p = ci gi  is encoded as p : ((ci : gi) -> p) -> Type
+-- we use EData instead of p to make circularity check easier  
+resParam :: Ident -> [(Ident,Context)] -> Judgement
+resParam p cos = addJDef (EParam (Con p) cos) (addJType typePType (emptyJudgement JParam))
+
+-- to enable constructor type lookup:
+-- create an oper for each constructor p = c g, as c : g -> p = EData
+paramConstructors :: Ident -> [(Ident,Context)] -> [(Ident,Judgement)]
+paramConstructors p cs = [(c,resOper (mkProd co (Con p)) EData) | (c,co) <- cs]
+
+-- unifying contents of judgements
+
+---- used in SourceToGF; make error-free and informative
+unifyJudgements j k = case unifyJudgement j k of
+  Ok l -> l
+  Bad s -> error s
+
+unifyJudgement :: Judgement -> Judgement -> Err Judgement
+unifyJudgement old new = do
+  testErr (jform old == jform new) "different judment forms"
+  [jty,jde,jpri] <- mapM unifyField [jtype,jdef,jprintname]
+  return $ old{jtype = jty, jdef = jde, jprintname = jpri}
+ where
+   unifyField field = unifyTerm (field old) (field new)
+   unifyTerm oterm nterm = case (oterm,nterm) of
+     (Meta _,t) -> return t
+     (t,Meta _) -> return t
+     _ -> do
+       if (nterm /= oterm) 
+          then (trace (unwords ["illegal update of",show oterm,"to",show nterm]) 
+                (return ()))
+          else return () ---- to recover from spurious qualification conflicts
+----       testErr (nterm == oterm) 
+----               (unwords ["illegal update of",prt oterm,"to",prt nterm])
+       return nterm
+
+updateJudgement :: Ident -> Ident -> Judgement -> GF -> Err GF
+updateJudgement m c ju gf = do
+  mo  <- maybe (Bad (show m)) return $ Data.Map.lookup m $ gfmodules gf
+  let mo' = mo {mjments = insert c ju (mjments mo)}
+  return $ gf {gfmodules = insert m mo' (gfmodules gf)}
+
+-- abstractions on Term
+
+type Cat  = QIdent
+type Fun  = QIdent
+type QIdent = (Ident,Ident)
+
+-- | branches à la Alfa
+newtype Branch = Branch (Con,([Ident],Term)) deriving (Eq, Ord,Show,Read)
+type Con = Ident ---
+
+varLabel :: Int -> Label
+varLabel = LVar
+
+wildPatt :: Patt
+wildPatt = PW
+
+type Trm = Term
+
+mkProd :: Context -> Type -> Type
+mkProd = flip (foldr (uncurry Prod))
+
+-- type constants
+
+typeType :: Type
+typeType = Sort "Type"
+
+typePType :: Type
+typePType = Sort "PType"
+
+typeStr :: Type
+typeStr = Sort "Str"
+
+typeTok :: Type      ---- deprecated
+typeTok = Sort "Tok"  
+
+cPredef :: Ident
+cPredef = identC "Predef"
+
+cPredefAbs :: Ident
+cPredefAbs = identC "PredefAbs"
+
+typeString, typeFloat, typeInt :: Term
+typeInts :: Integer -> Term
+
+typeString = constPredefRes "String"
+typeInt = constPredefRes "Int"
+typeFloat = constPredefRes "Float"
+typeInts i = App (constPredefRes "Ints") (EInt i)
+
+isTypeInts :: Term -> Bool
+isTypeInts ty = case ty of
+  App c _ -> c == constPredefRes "Ints"
+  _ -> False
+
+cnPredef = constPredefRes
+
+constPredefRes :: String -> Term
+constPredefRes s = Q (IC "Predef") (identC s)
+
+isPredefConstant :: Term -> Bool
+isPredefConstant t = case t of
+  Q (IC "Predef") _ -> True
+  Q (IC "PredefAbs") _ -> True
+  _ -> False
+
+
diff --git a/src-2.9/GF/Devel/Grammar/GFtoSource.hs b/src-2.9/GF/Devel/Grammar/GFtoSource.hs
new file mode 100644
index 000000000..292f5b826
--- /dev/null
+++ b/src-2.9/GF/Devel/Grammar/GFtoSource.hs
@@ -0,0 +1,223 @@
+module GF.Devel.Grammar.GFtoSource ( 
+  trGrammar,
+  trModule,
+  trAnyDef,
+  trLabel,
+  trt, 
+  tri, 
+  trp
+  ) where
+
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros (contextOfType)
+import qualified GF.Devel.Compile.AbsGF as P
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import qualified Data.Map as Map
+
+-- From internal source syntax to BNFC-generated (used for printing).
+-- | AR 13\/5\/2003
+--
+-- translate internal to parsable and printable source
+
+trGrammar :: GF -> P.Grammar
+trGrammar = P.Gr . map trModule . listModules -- no includes
+
+trModule :: (Ident,Module) -> P.ModDef
+trModule (i,mo) = P.MModule compl typ body where
+    compl = case isCompleteModule mo of
+      False -> P.CMIncompl
+      _ -> P.CMCompl
+    i' = tri i
+    typ = case mtype mo of
+      MTGrammar -> P.MGrammar i'
+      MTAbstract -> P.MAbstract i'
+      MTConcrete a -> P.MConcrete i' (tri a)
+      MTInterface -> P.MInterface i'
+      MTInstance a -> P.MInstance i' (tri a)
+    body = P.MBody 
+             (trExtends (mextends mo)) 
+             (mkOpens (map trOpen (mopens mo)))
+             (concatMap trAnyDef [(c,j) | (c,j) <- listJudgements mo] ++ 
+                        map trFlag (Map.assocs (mflags mo)))
+
+trExtends :: [(Ident,MInclude)] -> 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)
+
+trOpen :: (Ident,Ident) -> P.Open
+trOpen (i,j) = P.OQual (tri i) (tri j)
+
+mkOpens ds = if null ds then P.NoOpens else P.OpenIn ds
+
+trAnyDef :: (Ident,Judgement) -> [P.TopDef]
+trAnyDef (i,ju) = let 
+   i' = mkName i
+   i0 = tri i 
+ in case jform ju of
+  JCat -> [P.DefCat [P.SimpleCatDef i0 []]] ---- (map trDecl co)]]
+  JFun -> [P.DefFun [P.FDecl [i'] (trt (jtype ju))]] 
+    ---- ++ case pt of
+    ---- Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]]
+    ---- _ -> []
+  ----  JFun ty EData -> [P.DefFunData [P.FunDef [i'] (trt ty)]]
+  JParam -> [P.DefPar [
+    P.ParDefDir i0 [
+      P.ParConstr (tri c) (map trDecl co) | let EParam _ cos = jdef ju, (c,co) <- cos]
+    ]] 
+  JOper -> case jdef ju of 
+    Overload tysts -> 
+      [P.DefOper [P.DDef [i'] (
+        P.EApp (P.EPIdent $ ppIdent "overload") 
+          (P.ERecord [P.LDFull [i0] (trt ty) (trt fu) | (ty,fu) <- tysts]))]]
+    tr -> [P.DefOper [trDef i (jtype ju) tr]]
+  JLincat -> [P.DefLincat [P.DDef [i'] (trt (jtype ju))]] 
+  ---- CncCat pty ptr ppr -> 
+  ----  [P.DefLindef [trDef i' pty ptr]] 
+    ---- ++ [P.DefPrintCat [P.DDef [mkName i] (trt pr)] | Yes pr <- [ppr]]
+  JLin -> 
+    [P.DefLin [trDef i (Meta 0) (jdef ju)]] 
+    ---- ++ [P.DefPrintFun [P.DDef [mkName i] (trt pr)] | Yes pr <- [ppr]]
+  JLink -> []
+
+trDef :: Ident -> Type -> Term -> P.Def
+trDef i pty ptr = case (pty,ptr) of
+  (Meta _, Meta _) -> P.DDef  [mkName i] (P.EMeta) ---
+  (_,      Meta _) -> P.DDecl [mkName i] (trPerh pty)
+  (Meta _,      _) -> P.DDef  [mkName i] (trPerh ptr)
+  (_,           _) -> P.DFull [mkName i] (trPerh pty) (trPerh ptr)
+
+trPerh p = case p of
+  Meta _ -> P.EMeta
+  _ -> trt p
+
+trFlag :: (Ident,String) -> P.TopDef
+trFlag (f,x) = P.DefFlag [P.DDef [mkName f] (P.EString x)]
+
+trt :: Term -> P.Exp 
+trt trm = case trm of
+    Vr s -> P.EPIdent $ tri s
+----    Cn s -> P.ECons $ tri s
+    Con s -> P.EConstr $ tri s
+    Sort s -> P.ESort $ case s of
+      "Type" -> P.Sort_Type
+      "PType" -> P.Sort_PType
+      "Tok" -> P.Sort_Tok
+      "Str" -> P.Sort_Str
+      "Strs" -> P.Sort_Strs
+      _ -> 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)
+    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)
+
+    Typed tr ty -> P.ETyped (trt tr) (trt ty)
+    Table x v -> P.ETType (trt x) (trt v)
+    S f x -> P.ESelect  (trt f) (trt x)
+    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
+    EData -> P.EData
+    EParam t _ -> trt t
+
+    _ -> error $ "not yet" +++ show trm ----
+
+trp :: Patt -> P.Patt
+trp p = case p of
+    PChar -> P.PChar
+    PChars s -> P.PChars s
+    PM m c -> P.PM (tri m) (tri c)
+    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 [trLabelIdent 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)
+
+
+trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty
+  where 
+    t' = trt t
+    x  = [trLabelIdent lab]
+
+trLabelling (lab,ty) = P.LDDecl [trLabelIdent 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 i = ppIdent (prIdent i)
+
+ppIdent i = P.PIdent ((0,0),i)
+  
+trb i = if isWildIdent i then P.BWild else P.BPIdent (tri i)
+
+trLabel :: Label -> P.Label
+trLabel i = case i of
+  LIdent s -> P.LPIdent $ ppIdent s
+  LVar i -> P.LVar $ toInteger i
+
+trLabelIdent i = ppIdent $ case i of
+  LIdent s -> s
+  LVar i -> "v" ++ show i --- should not happen
+
+mkName :: Ident -> P.Name
+mkName = P.PIdentName . tri
+
diff --git a/src-2.9/GF/Devel/Grammar/Grammar.hs b/src-2.9/GF/Devel/Grammar/Grammar.hs
new file mode 100644
index 000000000..df5a3907e
--- /dev/null
+++ b/src-2.9/GF/Devel/Grammar/Grammar.hs
@@ -0,0 +1,172 @@
+module GF.Devel.Grammar.Grammar where
+
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Data.Map
+
+
+------------------
+-- definitions  --
+------------------
+
+data GF = GF {
+  gfabsname   :: Maybe Ident ,
+  gfcncnames  :: [Ident] ,
+  gflags      :: Map Ident String ,   -- value of a global flag
+  gfmodules   :: Map Ident Module
+  }
+
+data Module = Module {
+  mtype       :: ModuleType,
+  miscomplete :: Bool,
+  minterfaces :: [(Ident,Ident)],           -- non-empty for functors 
+  minstances  :: [((Ident,MInclude),[(Ident,Ident)])], -- non-empty for inst'ions
+  mextends    :: [(Ident,MInclude)],
+  mopens      :: [(Ident,Ident)],           -- used name, original name
+  mflags      :: Map Ident String,
+  mjments     :: Map Ident Judgement
+  }
+
+data ModuleType =
+    MTAbstract
+  | MTConcrete Ident
+  | MTInterface
+  | MTInstance Ident
+  | MTGrammar 
+  deriving Eq
+
+data MInclude =
+    MIAll
+  | MIExcept [Ident]
+  | MIOnly [Ident]
+
+type Indirection = (Ident,Bool) -- module of origin, whether canonical
+
+data Judgement = Judgement {
+  jform :: JudgementForm,  -- cat      fun   lincat  lin     oper    param
+  jtype :: Type,           -- context  type  lincat  -       type    PType
+  jdef  :: Term,           -- lindef   def   lindef  lin     def     constrs
+  jprintname :: Term,      -- -        -     prname  prname  -       -
+  jlink :: Ident,   -- if inherited, the supermodule name, else #
+  jposition :: Int  -- line number where def begins
+  } 
+  deriving Show
+
+data JudgementForm =
+    JCat
+  | JFun
+  | JLincat
+  | JLin
+  | JOper
+  | JParam
+  | JLink
+  deriving (Eq,Show)
+
+type Type = Term
+
+data Term =
+   Vr Ident             -- ^ variable
+ | Con Ident            -- ^ constructor
+ | EData                -- ^ to mark in definition that a fun is a constructor
+ | Sort String          -- ^ predefined 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 ; ...}@
+ | V Type [Term]        -- ^ 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@
+
+ | Q  Ident Ident       -- ^ qualified constant from a module
+ | QC Ident Ident       -- ^ qualified constructor from a module
+
+ | C Term Term          -- ^ concatenation: @s ++ t@
+ | Glue Term Term       -- ^ agglutination: @s + t@
+
+ | EPatt Patt
+ | EPattType Term
+
+ | EParam Term [(Ident,Context)] -- to encode parameter constructor sets
+
+ | FV [Term]            -- ^ free variation: @variants { s ; ... }@
+
+ | Alts (Term, [(Term, Term)]) -- ^ prefix-dependent: @pre {t ; s\/c ; ...}@
+
+ | Overload [(Type,Term)]
+
+  deriving (Read, Show, Eq, Ord)
+
+data Patt =
+   PC Ident [Patt]        -- ^ constructor pattern: @C p1 ... pn@    @C@ 
+ | PP Ident Ident [Patt]  -- ^ qualified constr patt: @P.C p1 ... pn@    @P.C@ 
+ | PV Ident               -- ^ variable pattern: @x@
+ | PW                     -- ^ wild card pattern: @_@
+ | PR [(Label,Patt)]      -- ^ record pattern: @{r = p ; ...}@
+ | PString String         -- ^ string literal pattern: @\"foo\"@
+ | PInt    Integer        -- ^ integer literal pattern: @12@
+ | PFloat Double          -- ^ float literal pattern: @1.2@
+ | PT Type Patt           -- ^ type-annotated pattern
+ | 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 String          -- ^ list of characters: ["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 annotated, 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 String
+  | LVar Int
+   deriving (Read, Show, Eq, Ord)
+
+type MetaSymb = Int
+
+type Decl         = (Ident,Term)  -- (x:A)  (_:A)  A
+type Context      = [Decl]        -- (x:A)(y:B)   (x,y:A)   (_,_:A)
+type Substitution = [(Ident, Term)]
+type Equation     = ([Patt],Term) 
+
+type Labelling = (Label, Term) 
+type Assign    = (Label, (Maybe Type, Term)) 
+type Case      = (Patt, Term) 
+type LocalDef  = (Ident, (Maybe Type, Term))
+
diff --git a/src-2.9/GF/Devel/Grammar/Lookup.hs b/src-2.9/GF/Devel/Grammar/Lookup.hs
new file mode 100644
index 000000000..689996760
--- /dev/null
+++ b/src-2.9/GF/Devel/Grammar/Lookup.hs
@@ -0,0 +1,168 @@
+module GF.Devel.Grammar.Lookup where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.PrGF
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+import Control.Monad (liftM)
+import Data.Map
+import Data.List (sortBy) ----
+
+-- look up fields for a constant in a grammar
+
+lookupJField :: (Judgement -> a) -> GF -> Ident -> Ident -> Err a
+lookupJField field gf m c = do
+  j <- lookupJudgement gf m c
+  return $ field j
+
+lookupJForm :: GF -> Ident -> Ident -> Err JudgementForm
+lookupJForm = lookupJField jform
+
+-- the following don't (need to) check that the jment form is adequate
+ 
+lookupCatContext :: GF -> Ident -> Ident -> Err Context
+lookupCatContext gf m c = do
+  ty <- lookupJField jtype gf m c
+  return $ contextOfType ty
+
+lookupFunType :: GF -> Ident -> Ident -> Err Term
+lookupFunType = lookupJField jtype 
+
+lookupLin :: GF -> Ident -> Ident -> Err Term
+lookupLin = lookupJField jdef
+
+lookupLincat :: GF -> Ident -> Ident -> Err Term
+lookupLincat = lookupJField jtype
+
+lookupOperType :: GF -> Ident -> Ident -> Err Term
+lookupOperType gr m c = do
+  ju <- lookupJudgement gr m c
+  case jform ju of
+    JParam -> return typePType
+    _ -> case jtype ju of
+      Meta _ -> fail ("no type given to " ++ prIdent m ++ "." ++ prIdent c)
+      ty -> return ty
+---- can't be just lookupJField jtype 
+
+lookupOperDef :: GF -> Ident -> Ident -> Err Term
+lookupOperDef = lookupJField jdef
+
+lookupOverload :: GF -> Ident -> Ident -> Err [([Type],(Type,Term))]
+lookupOverload gr m c = do
+  tr <- lookupJField jdef gr m c
+  case tr of
+    Overload tysts -> return 
+      [(lmap snd args,(val,tr)) | (ty,tr) <- tysts, let (args,val) = prodForm ty]
+    _   -> Bad $ prt c +++ "is not an overloaded operation"
+
+lookupParams :: GF -> Ident -> Ident -> Err [(Ident,Context)]
+lookupParams gf m c = do
+  EParam _ ty <- lookupJField jdef gf m c
+  return ty
+
+lookupParamConstructor :: GF -> Ident -> Ident -> Err Type
+lookupParamConstructor = lookupJField jtype
+
+lookupParamValues :: GF -> Ident -> Ident -> Err [Term]
+lookupParamValues gf m c = do
+  ps <- lookupParams gf m c
+  liftM concat $ mapM mkPar ps
+ where
+   mkPar (f,co) = do
+     vs <- liftM combinations $ mapM (\ (_,ty) -> allParamValues gf ty) co
+     return $ lmap (mkApp (QC m f)) vs
+
+lookupFlags :: GF -> Ident -> [(Ident,String)]
+lookupFlags gf m = errVal [] $ do
+  mo <- lookupModule gf m
+  return $ toList $ mflags mo
+
+allParamValues :: GF -> Type -> Err [Term]
+allParamValues cnc ptyp = case ptyp of
+     App (Q (IC "Predef") (IC "Ints")) (EInt n) -> 
+       return [EInt i | i <- [0..n]]
+     QC p c -> lookupParamValues cnc p c
+     Q  p c -> lookupParamValues cnc p c ----
+
+     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))
+
+abstractOfConcrete :: GF -> Ident -> Err Ident
+abstractOfConcrete gf m = do
+  mo <- lookupModule gf m
+  case mtype mo of
+    MTConcrete a -> return a
+    MTInstance a -> return a
+    MTGrammar -> return m
+    _ -> prtBad "not concrete module" m
+
+allOrigJudgements :: GF -> Ident -> [(Ident,Judgement)]
+allOrigJudgements gf m = errVal [] $ do
+  mo <- lookupModule gf m
+  return [ju | ju@(_,j) <- listJudgements mo, jform j /= JLink]
+
+allConcretes :: GF -> Ident -> [Ident]
+allConcretes gf m = 
+  [c | (c,mo) <- toList (gfmodules gf), mtype mo == MTConcrete m]
+
+-- | select just those modules that a given one depends on, including itself
+partOfGrammar :: GF -> (Ident,Module) -> GF
+partOfGrammar gr (i,mo) = gr {
+  gfmodules = fromList [m | m@(j,_) <- mos, elem j modsFor]
+  } 
+  where
+    mos = toList $ gfmodules gr
+    modsFor = i : allDepsModule gr mo
+
+allDepsModule :: GF -> Module -> [Ident]
+allDepsModule gr m = iterFix add os0 where
+  os0 = depPathModule m
+  add os = [m | o <- os, Just n <- [llookup o mods], m <- depPathModule n]
+  mods = toList $ gfmodules gr
+
+-- | initial dependency list
+depPathModule :: Module -> [Ident]
+depPathModule mo = fors ++ lmap fst (mextends mo) ++ lmap snd (mopens mo) where
+  fors = case mtype mo of
+    MTConcrete i   -> [i]
+    MTInstance i   -> [i]
+    _              -> []
+
+-- infrastructure for lookup
+    
+lookupModule :: GF -> Ident -> Err Module
+lookupModule gf m = do
+  maybe (raiseIdent "module not found:" m) return $ mlookup m (gfmodules gf)
+
+-- this finds the immediate definition, which can be a link
+lookupIdent :: GF -> Ident -> Ident -> Err Judgement
+lookupIdent gf m c = do
+  mo <- lookupModule gf m
+  maybe (raiseIdent "constant not found:" c) return $ mlookup c (mjments mo)
+
+-- this follows the link
+lookupJudgement :: GF -> Ident -> Ident -> Err Judgement
+lookupJudgement gf m c = do
+  ju <- lookupIdent gf m c
+  case jform ju of
+    JLink -> lookupJudgement gf (jlink ju) c
+    _ -> return ju
+
+mlookup = Data.Map.lookup
+
+raiseIdent msg i = raise (msg +++ prIdent i)
+
+lmap = Prelude.map
+llookup = Prelude.lookup
+
diff --git a/src-2.9/GF/Devel/Grammar/Macros.hs b/src-2.9/GF/Devel/Grammar/Macros.hs
new file mode 100644
index 000000000..1a7a3582c
--- /dev/null
+++ b/src-2.9/GF/Devel/Grammar/Macros.hs
@@ -0,0 +1,434 @@
+module GF.Devel.Grammar.Macros where
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+import GF.Infra.Ident
+
+import GF.Data.Str
+import GF.Data.Operations
+
+import qualified Data.Map as Map
+import Control.Monad (liftM,liftM2)
+
+
+-- analyse types and terms
+
+contextOfType :: Type -> Context
+contextOfType ty = co where (co,_,_) = typeForm ty
+
+typeForm :: Type -> (Context,Term,[Term])
+typeForm t = (co,f,a) where
+  (co,t2) = prodForm t
+  (f,a) = appForm t2
+
+termForm :: Term -> ([Ident],Term,[Term])
+termForm t = (co,f,a) where
+  (co,t2) = absForm t
+  (f,a) = appForm t2
+
+prodForm :: Type -> (Context,Term)
+prodForm t = case t of
+  Prod x ty val -> ((x,ty):co,t2) where (co,t2) = prodForm val
+  _ -> ([],t)
+
+absForm :: Term -> ([Ident],Term)
+absForm t = case t of
+  Abs x val -> (x:co,t2) where (co,t2) = absForm val
+  _ -> ([],t)
+
+
+appForm :: Term -> (Term,[Term])
+appForm tr = (f,reverse xs) where 
+  (f,xs) = apps tr
+  apps t = case t of
+    App f a -> (f2,a:a2) where (f2,a2) = appForm f
+    _ -> (t,[])
+
+valCat :: Type -> Err (Ident,Ident)
+valCat typ = case typeForm typ of
+  (_,Q m c,_) -> return (m,c)
+
+typeRawSkeleton :: Type -> Err ([(Int,Type)],Type)
+typeRawSkeleton typ = do
+  let (cont,typ) = prodForm typ
+  args <- mapM (typeRawSkeleton . snd) cont
+  return ([(length c, v) | (c,v) <- args], typ)
+
+type MCat = (Ident,Ident)
+
+sortMCat :: String -> MCat
+sortMCat s = (identC "_", identC s)
+
+--- hack for Editing.actCat in empty state
+errorCat :: MCat
+errorCat = (identC "?", identC "?")
+
+getMCat :: Term -> Err MCat
+getMCat t = case t of
+  Q  m c -> return (m,c)
+  QC m c -> return (m,c)
+  Sort s -> return $ sortMCat s
+  App f _ -> getMCat f
+  _ -> error $ "no qualified constant" +++ show t
+
+typeSkeleton :: Type -> Err ([(Int,MCat)],MCat)
+typeSkeleton typ = do
+  (cont,val) <- typeRawSkeleton typ
+  cont' <- mapPairsM getMCat cont
+  val'  <- getMCat val
+  return (cont',val')
+
+-- construct types and terms
+
+mkFunType :: [Type] -> Type -> Type
+mkFunType tt t = mkProd ([(wildIdent, ty) | ty <- tt]) t -- nondep prod
+
+mkApp :: Term -> [Term] -> Term
+mkApp = foldl App
+
+mkAbs :: [Ident] -> Term -> Term
+mkAbs xs t = foldr Abs t xs
+
+mkCTable :: [Ident] -> Term -> Term
+mkCTable ids v = foldr ccase v ids where 
+  ccase x t = T TRaw [(PV x,t)]
+
+appCons :: Ident -> [Term] -> Term
+appCons = mkApp . Con
+
+appc :: String -> [Term] -> Term
+appc = appCons . identC
+
+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]
+
+tupleLabel :: Int -> Label
+tupleLabel i = LIdent $ "p" ++ show i
+
+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
+
+mkDecl :: Term -> Decl
+mkDecl typ = (wildIdent, typ)
+
+mkLet :: [LocalDef] -> Term -> Term
+mkLet defs t = foldr Let t defs
+
+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
+
+plusRecType :: Type -> Type -> Err Type
+plusRecType t1 t2 = case (t1, 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 show ls)
+  _ -> Bad ("cannot add record types" +++ show t1 +++ "and" +++ show 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" +++ show t1 +++ "and" +++ show t2)
+
+zipAssign :: [Label] -> [Term] -> [Assign]
+zipAssign ls ts = [assign l t | (l,t) <- zip ls ts]
+
+
+defLinType :: Type
+defLinType = RecType [(LIdent "s",  typeStr)]
+
+meta0 :: Term
+meta0 = Meta 0
+
+ident2label :: Ident -> Label
+ident2label c = LIdent (prIdent c)
+
+label2ident :: Label -> Ident
+label2ident (LIdent c) = identC c
+
+----label2ident :: Label -> Ident
+----label2ident = identC . prLabel
+
+-- to apply a term operation to every term in a judgement, module, grammar
+
+termOpGF :: Monad m => (Term -> m Term) -> GF -> m GF
+termOpGF f = moduleOpGF (termOpModule f) 
+
+moduleOpGF :: Monad m => (Module -> m Module) -> GF -> m GF
+moduleOpGF f g = do 
+  ms <- mapMapM f (gfmodules g)
+  return g {gfmodules = ms}
+
+termOpModule :: Monad m => (Term -> m Term) -> Module -> m Module
+termOpModule f = judgementOpModule fj where
+  fj = termOpJudgement f
+   
+judgementOpModule :: Monad m => (Judgement -> m Judgement) -> Module -> m Module
+judgementOpModule f m = do 
+  mjs <- mapMapM f (mjments m)
+  return m {mjments = mjs}
+
+entryOpModule :: Monad m => 
+                 (Ident -> Judgement -> m Judgement) -> Module -> m Module
+entryOpModule f m = do 
+  mjs <- liftM Map.fromAscList $ mapm $ Map.assocs $ mjments m
+  return $ m {mjments = mjs}
+ where
+  mapm = mapM (\ (i,j) -> liftM ((,) i) (f i j)) 
+   
+termOpJudgement :: Monad m => (Term -> m Term) -> Judgement -> m Judgement
+termOpJudgement f j = do 
+  jtyp <- f (jtype j)
+  jde <- f (jdef j)
+  jpri <- f (jprintname j)
+  return $ j {
+    jtype = jtyp,
+    jdef = jde,
+    jprintname = jpri
+    }
+
+-- | 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 monadic 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')
+   Eqs cc -> 
+     do cc' <- mapPairListM (co . snd) cc
+        return (Eqs cc')
+   EParam ty cos -> 
+     do ty' <- co ty
+        cos' <- mapPairListM (mapPairListM (co . snd) . snd) cos
+        return (EParam ty' cos')
+   V ty vs ->
+     do ty' <- co ty
+        vs' <- mapM co vs
+        return (V ty' vs')
+   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')
+   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
+   Overload tts -> do
+     tts' <- mapM (pairM co) tts
+     return $ Overload tts'
+
+   EPattType ty -> 
+     do ty' <- co ty
+        return (EPattType ty')
+
+   _ -> return trm -- covers K, Vr, Cn, Sort
+
+
+---- should redefine using composOp
+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
+  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
+  _ -> [] -- covers K, Vr, Cn, Sort, Ready
+
+--- just aux to composOp?
+
+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)
+
+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
+
+
+patt2term :: Patt -> Term
+patt2term pt = case pt of
+  PV x      -> Vr x
+  PW        -> Vr wildIdent             --- not parsable, should not occur
+  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   -> appc "@" [Vr x, patt2term p]            --- an encoding
+  PSeq a b  -> appc "+" [(patt2term a), (patt2term b)] --- an encoding
+  PAlt a b  -> appc "|" [(patt2term a), (patt2term b)] --- an encoding
+  PRep a    -> appc "*" [(patt2term a)]                --- an encoding
+  PNeg a    -> appc "-" [(patt2term a)]                --- an encoding
+
+
+term2patt :: Term -> Err Patt
+term2patt trm = case Ok (termForm trm) of
+  Ok ([], Vr x, []) -> return (PV x)
+  Ok ([], QC p c, aa) -> do
+    aa' <- mapM term2patt aa
+    return (PP p c aa')
+  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 ([], Con (IC "@"), [Vr a,b]) -> do
+    b' <- term2patt b
+    return (PAs a b')
+  Ok ([], Con (IC "-"), [a]) -> do
+    a' <- term2patt a
+    return (PNeg a')
+  Ok ([], Con (IC "*"), [a]) -> do
+    a' <- term2patt a
+    return (PRep a')
+  Ok ([], Con (IC "+"), [a,b]) -> do
+    a' <- term2patt a
+    b' <- term2patt b
+    return (PSeq a' b')
+  Ok ([], Con (IC "|"), [a,b]) -> do
+    a' <- term2patt a
+    b' <- term2patt b
+    return (PAlt a' b')
+
+  Ok ([], Con c, aa) -> do
+    aa' <- mapM term2patt aa
+    return (PC c aa')
+
+  _ -> Bad $ "no pattern corresponds to term" +++ show trm
+
+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"
+
+-- | to get a string from a term that represents a sequence of terminals
+strsFromTerm :: Term -> Err [Str]
+strsFromTerm t = case 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
+  _ -> Bad $ "cannot get Str from term" +++ show t
+
+
+
+---- given in lib?
+
+mapMapM :: (Monad m, Ord k) => (v -> m v) -> Map.Map k v -> m (Map.Map k v)
+mapMapM f = 
+  liftM Map.fromAscList . mapM (\ (x,y) -> liftM ((,) x) $ f y) . Map.assocs 
+
diff --git a/src-2.9/GF/Devel/Grammar/PatternMatch.hs b/src-2.9/GF/Devel/Grammar/PatternMatch.hs
new file mode 100644
index 000000000..ec64d7802
--- /dev/null
+++ b/src-2.9/GF/Devel/Grammar/PatternMatch.hs
@@ -0,0 +1,146 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.Grammar.PatternMatch (matchPattern,
+		     testOvershadow, 
+		     findMatch
+		    ) where
+
+
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Macros
+import GF.Devel.Grammar.PrGF
+import GF.Infra.Ident
+
+import GF.Data.Operations
+
+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 
+  let t' = termForm t
+  trym p t'
+ where
+  isInConstantFormt = True -- tested already
+  trym p t' =
+    case (p,t') of
+      (_,(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'
+
+--      (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
+
+eqStrIdent = (==) ----  
+
+isInConstantForm :: Term -> Bool
+isInConstantForm trm = case trm of
+    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
+    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
+  _ -> []
+
diff --git a/src-2.9/GF/Devel/Grammar/PrGF.hs b/src-2.9/GF/Devel/Grammar/PrGF.hs
new file mode 100644
index 000000000..221a0ac61
--- /dev/null
+++ b/src-2.9/GF/Devel/Grammar/PrGF.hs
@@ -0,0 +1,246 @@
+----------------------------------------------------------------------
+-- |
+-- 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 - 4/12/2007
+--
+-- printing and prettyprinting class for source grammar
+--
+-- 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.Devel.Grammar.PrGF where
+
+import qualified GF.Devel.Compile.PrintGF as P
+import GF.Devel.Grammar.GFtoSource
+import GF.Devel.Grammar.Grammar
+import GF.Devel.Grammar.Construct
+----import GF.Grammar.Values
+
+----import GF.Infra.Option
+import GF.Infra.Ident
+import GF.Infra.CompactPrint
+----import GF.Data.Str
+
+import GF.Data.Operations
+----import GF.Data.Zipper
+
+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.
+
+cprintTree :: P.Print a => a -> String
+cprintTree = compactPrint . P.printTree
+
+-- | to show terms etc in error messages
+prtBad :: Print a => String -> a -> Err b
+prtBad s a = Bad (s +++ prt a)
+
+prGF :: GF -> String
+prGF = cprintTree . trGrammar
+
+instance Print GF where
+  prt = cprintTree . trGrammar
+
+prModule :: SourceModule -> String
+prModule = cprintTree . trModule
+
+instance Print Judgement where
+  prt j = cprintTree $ trAnyDef (wildIdent, j)
+----  prt_ = prExp
+
+instance Print Term where
+  prt = cprintTree . trt
+----  prt_ = prExp
+
+instance Print Ident where
+  prt = cprintTree . tri
+
+instance Print Patt where
+  prt = P.printTree . trp
+
+instance Print Label where
+  prt = P.printTree . 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]
+
+
+-- printing values and trees in editing
+
+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 oElem nostripQualif 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
+
+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 f a -> Ident -> Err a
+lookupIdentInfo mo i = lookupIdent i (jments mo)
+-}
diff --git a/src-2.9/GF/Devel/GrammarToGFCC.hs b/src-2.9/GF/Devel/GrammarToGFCC.hs
new file mode 100644
index 000000000..2c1bbc169
--- /dev/null
+++ b/src-2.9/GF/Devel/GrammarToGFCC.hs
@@ -0,0 +1,545 @@
+module GF.Devel.GrammarToGFCC (prGrammar2gfcc,mkCanon2gfcc,addParsers) where
+
+import GF.Devel.OptimizeGF (unshareModule)
+
+import GF.Grammar.Grammar
+import qualified GF.Grammar.Lookup as Look
+
+import qualified GF.GFCC.Macros as CM
+import qualified GF.GFCC.DataGFCC as C
+import qualified GF.GFCC.DataGFCC as D
+import GF.GFCC.CId
+import qualified GF.Grammar.Abstract as A
+import qualified GF.Grammar.Macros as GM
+--import qualified GF.Grammar.Compute as Compute
+import qualified GF.Infra.Modules as M
+import qualified GF.Infra.Option as O
+
+import GF.Conversion.SimpleToFCFG (convertConcrete)
+import GF.Parsing.FCFG.PInfo (buildFCFPInfo)
+import GF.Devel.PrGrammar
+import GF.Devel.PrintGFCC
+import GF.Devel.ModDeps
+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 Debug.Trace ----
+
+-- when developing, swap commenting
+
+--traceD s t = trace s t 
+traceD s t = t 
+
+
+-- the main function: generate GFCC from GF.
+
+prGrammar2gfcc :: Options -> String -> SourceGrammar -> (String,String)
+prGrammar2gfcc opts cnc gr = (abs,printGFCC gc) where
+  (abs,gc) = mkCanon2gfcc opts cnc gr 
+
+mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.GFCC)
+mkCanon2gfcc opts cnc gr = 
+  (prIdent abs, (canon2gfcc opts pars . reorder abs . canon2canon abs) gr)
+  where
+    abs = err error id $ M.abstractOfConcrete gr (identC cnc)
+    pars = mkParamLincat gr
+
+-- Adds parsers for all concretes
+addParsers :: D.GFCC -> D.GFCC
+addParsers gfcc = gfcc { D.concretes = Map.map conv (D.concretes gfcc) }
+  where
+    conv cnc = cnc { D.parser = Just (buildFCFPInfo (convertConcrete (D.abstract gfcc) cnc)) }
+
+-- Generate GFCC from GFCM.
+-- this assumes a grammar translated by canon2canon
+
+canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> SourceGrammar -> D.GFCC
+canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = 
+  (if (oElem (iOpt "show_canon") opts) then trace (prGrammar cgr) else id) $
+     D.GFCC an cns gflags abs cncs 
+ where
+  -- abstract
+  an  = (i2i a)
+  cns = map (i2i . fst) cms
+  abs = D.Abstr aflags funs cats catfuns
+  gflags = Map.fromList [(CId fg,x) | Just x <- [getOptVal opts (aOpt fg)]] 
+                                          where fg = "firstlang"
+  aflags = Map.fromList [(CId f,x) | Opt (f,[x]) <- 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 [(CId f,x) | Opt (f,[x]) <- M.flags mo]
+      opers   = Map.fromAscList [] -- opers will be created as optimization
+      utf     = if elem (Opt ("coding",["utf8"])) (M.flags mo) 
+                  then D.convertStringsInTerm decodeUTF8 else id
+      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 . prIdent
+
+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.Exp
+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 (xx,c,args) -> C.DTr [i2i x | x <- xx] (mkAt c) (map mkExp args) 
+ where
+  mkAt c = case c of 
+    Q _ c  -> C.AC $ i2i c
+    QC _ c -> C.AC $ i2i c
+    Vr x   -> C.AV $ i2i x
+    EInt i -> C.AI i
+    EFloat f -> C.AF f
+    K s    -> C.AS s
+    Meta (MetaSymb i) -> C.AM $ toInteger i
+    _ -> C.AM 0
+  mkPatt p = uncurry CM.tree $ case p of
+    A.PP _ c ps -> (C.AC (i2i c), map mkPatt ps)
+    A.PV x      -> (C.AV (i2i x), [])
+    A.PW        -> (C.AV CM.wildCId, [])
+    A.PInt i    -> (C.AI 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 (last s) -> 
+    C.V (read (reverse (takeWhile (/='_') (reverse 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.Var (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 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 GFCC-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 "Str"        -> C.S [] --- Str only
+  App (Q (IC "Predef") (IC "Ints")) (EInt i) -> 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 "Str" -> 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):
+      [(c, M.ModMod $ 
+          M.Module (M.MTConcrete abs) M.MSComplete fs [] [] (sorted2tree js)) 
+            | (c,(fs,js)) <- cncs] 
+     where
+       mos = M.allModMod cg
+       adefs = sorted2tree $ sortIds $
+                 predefADefs ++ Look.allOrigInfos cg abs
+       predefADefs = 
+         [(IC c, AbsCat (Yes []) Nope) | c <- ["Float","Int","String"]]
+       aflags = nubFlags $ 
+         concat [M.flags mo | (_,mo) <- M.allModMod cg, M.isModAbs mo]
+
+       cncs = sortIds [(lang, concr lang) | lang <- M.allConcretes cg abs]
+       concr la = (nubFlags flags, 
+                   sortIds (predefCDefs ++ jments)) where 
+         jments = Look.allOrigInfos cg la
+         flags  = concat [M.flags mo | 
+                     (i,mo) <- mos, M.isModCnc mo, 
+                     Just r <- [lookup i (M.allExtendSpecs cg la)]]
+
+         predefCDefs = 
+           (IC "Int", CncCat (Yes Look.linTypeInt) Nope Nope) : 
+           [(IC c, CncCat (Yes GM.defLinType) Nope Nope) | 
+                                    ---- lindef,printname 
+                         c <- ["Float","String"]]
+
+       sortIds = sortBy (\ (f,_) (g,_) -> compare f g) 
+       nubFlags = nubBy (\ (Opt (f,_)) (Opt (g,_)) -> 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@(M.Module _ _ _ _ _ js) ->
+        (c, M.ModMod $ M.replaceJudgements mo $ mapTree f2 js)
+      _ -> (c,m)    
+  j2j cg (f,j) = case j of
+      CncFun x (Yes tr) z -> (f,CncFun x (Yes (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 (RecType ls)) _ _)) <- jments,
+              ty0 <- [ty | (_, ty) <- unlockTyp ls],
+              ty  <- typsFrom ty0
+-}
+            [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 = 
+    [(IC "Int",[f | let RecType fs = Look.linTypeInt, f <- fs])] ++
+    [(IC cat,[(LIdent "s",GM.typeStr)]) | cat <- ["Float", "String"]] ++
+    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]]
+----      [(cat,(unlockTyp ls)) | (_,(cat,CncCat (Yes (RecType ls)) _ _)) <- jments]
+  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..] (sort (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: errVal t $ Compute.computeConcreteRec cgr t
+   comp 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 (V typ ts) v0 -> err error id $ do
+       let v = comp v0 
+       return $ maybe t (comp . (ts !!) . fromInteger) $ Map.lookup v untyps
+     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 $ 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 = 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] -> 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 (("_" ++ 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 $ sort [(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
+
+
diff --git a/src-2.9/GF/Devel/Infra/ReadFiles.hs b/src-2.9/GF/Devel/Infra/ReadFiles.hs
new file mode 100644
index 000000000..dd8cbe5a9
--- /dev/null
+++ b/src-2.9/GF/Devel/Infra/ReadFiles.hs
@@ -0,0 +1,348 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.Infra.ReadFiles (-- * Heading 1
+		  getAllFiles,fixNewlines,ModName,getOptionsFromFile,
+		  -- * Heading 2
+		  gfoFile,gfFile,isGFO,resModName,isOldFile
+		 ) where
+
+import GF.Devel.Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime)
+
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Devel.UseIO
+
+import System
+import Data.Char
+import Control.Monad
+import Data.List
+import System.Directory
+
+type ModName = String
+type ModEnv  = [(ModName,ModTime)]
+
+getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
+getAllFiles opts ps env file = do
+
+  -- read module headers from all files recursively
+  ds0  <- getImports ps file
+  let ds = [((snd m,map fst ms),p) | ((m,ms),p) <- ds0]
+  if oElem beVerbose opts 
+    then ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds)
+    else return ()
+    -- get a topological sorting of files: returns file names --- deletes paths
+  ds1 <- ioeErr $ either 
+           return 
+           (\ms -> Bad $ "circular modules" +++ 
+                     unwords (map show (head ms))) $ topoTest $ map fst ds
+
+  -- associate each file name with its path --- more optimal: save paths in ds1
+  let paths = [(f,p) | ((f,_),p) <- ds]
+  let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]]
+  if oElem fromSource opts 
+    then return [gfFile (p </> f) | (p,f) <- pds1]
+    else do
+
+
+    ds2 <- ioeIO $ mapM (selectFormat opts env) pds1
+
+    let ds4 = needCompile opts (map fst ds0) ds2
+    return ds4
+
+-- to decide whether to read gf or gfo, or if in env; returns full file path
+
+data CompStatus =
+   CSComp -- compile: read gf
+ | CSRead -- read gfo
+ | CSEnv  -- gfo is in env
+ | CSEnvR -- also gfr is in env
+ | CSDont -- don't read at all
+ | CSRes  -- read gfr
+  deriving (Eq,Show)
+
+-- for gfo, we also return ModTime to cope with earlier compilation of libs
+
+selectFormat :: Options -> ModEnv -> (InitPath,ModName) -> 
+                IO (ModName,(InitPath,(CompStatus,Maybe ModTime)))
+
+selectFormat opts env (p,f) = do
+  let pf = p </> f
+  let mtenv = lookup f env   -- Nothing if f is not in env
+  let rtenv = lookup (resModName f) env
+  let fromComp = oElem isCompiled opts -- i -gfo
+  mtgfc <- getModTime $ gfoFile pf
+  mtgf  <- getModTime $ gfFile pf
+  let stat = case (rtenv,mtenv,mtgfc,mtgf) of
+        (_,Just tenv,_,_)        | fromComp -> (CSEnv, Just tenv)
+        (_,_,Just tgfc,_)        | fromComp -> (CSRead,Just tgfc)
+        (Just tenv,_,_,Just tgf) | laterModTime tenv tgf -> (CSEnvR,Just tenv)
+        (_,Just tenv,_,Just tgf) | laterModTime tenv tgf -> (CSEnv, Just tenv)
+        (_,_,Just tgfc,Just tgf) | laterModTime tgfc tgf -> (CSRead,Just tgfc)
+        (_,Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist
+        (_,_,_,        Nothing) -> (CSRead,Nothing)  -- source does not exist
+        _ -> (CSComp,Nothing)
+  return $ (f, (p,stat))
+
+needCompile :: Options -> 
+               [ModuleHeader] -> 
+               [(ModName,(InitPath,(CompStatus,Maybe ModTime)))] -> [FullPath]
+needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
+
+  deps = [(snd m,map fst ms) | (m,ms) <- headers]
+  typ m = maybe MTyOther id $ lookup m [(m,t) | ((t,m),_) <- headers]
+  uses m = [(n,u) | ((_,n),ms) <- headers, (k,u) <- ms, k==m]
+  stat0 m = maybe CSComp (fst . snd) $ lookup m sfiles0
+
+  allDeps = [(m,iterFix add ms) | (m,ms) <- deps] where
+    add os = [m | o <- os, Just n <- [lookup o deps],m <- n]
+
+  -- only treat reused, interface, or instantiation if needed
+  sfiles = sfiles0 ---- map relevant sfiles0
+  relevant fp@(f,(p,(st,_))) = 
+    let us = uses f
+        isUsed = not (null us)
+    in
+    if not (isUsed && all noComp us) then
+      fp else 
+    if (elem (typ f) [] ---- MTyIncomplete, MTyIncResource]
+        || 
+        (isUsed && all isAux us)) then
+      (f,(p,(CSDont,Nothing))) else
+      fp
+
+  isAux = flip elem [MUReuse,MUInstance,MUComplete] . snd
+  noComp = flip elem [CSRead,CSEnv,CSEnvR] . stat0 . fst
+
+  -- mark as to be compiled those whose gfo is earlier than a deeper gfo
+  sfiles1 = map compTimes sfiles
+  compTimes fp@(f,(p,(_, Just t))) =
+    if any (> t) [t' | Just fs <- [lookup f deps], 
+                       f0 <- fs,
+                       Just (_,(_,Just t')) <- [lookup f0 sfiles]]
+    then (f,(p,(CSComp, Nothing)))
+    else fp
+  compTimes fp = fp
+
+  -- start with the changed files themselves; returns [ModName]
+  changed = [f | (f,(_,(CSComp,_))) <- sfiles1] 
+
+  -- add other files that depend on some changed file; returns [ModName]
+  iter np = let new = [f | (f,fs) <- deps, 
+                           not (elem f np), any (flip elem np) fs]
+            in  if null new then np else (iter (new ++ np))
+
+  -- for each module in the full list, compile if depends on what needs compile
+  -- returns [FullPath]
+  mark cs = [(f,(path,st)) | 
+                (f,(path,(st0,_))) <- sfiles1, 
+                let st = if (elem f cs) then CSComp else st0]
+
+
+  -- Also read res if the option "retain" is present
+  -- Also, if a "with" file has to be compiled, read its mother file from source
+
+  res cs = map mkRes cs where
+    mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of
+      t | (not (null [m | (m,(_,CSComp)) <- cs,
+                                   Just ms <- [lookup m allDeps], elem f ms])
+                    || oElem retainOpers opts)
+        -> if elem t [MTyResource,MTyIncResource] 
+           then (f,(path,CSRes)) else
+              if t == MTyIncomplete
+              then (f,(path,CSComp)) else
+              x
+      _ -> x
+    mkRes x = x
+
+
+
+  -- construct list of paths to read
+  paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]]
+
+  mkName f p st = mk (p </> f) where
+    mk = case st of
+      CSComp -> gfFile
+      CSRead -> gfoFile
+      CSRes  -> gfoFile ---- gfr
+
+isGFO :: FilePath -> Bool
+isGFO = (== ".gfn") . takeExtensions
+
+gfoFile :: FilePath -> FilePath
+gfoFile f = addExtension f "gfn"
+
+gfFile :: FilePath -> FilePath
+gfFile f = addExtension f "gf"
+
+resModName :: ModName -> ModName
+resModName = ('#':)
+
+-- to get imports without parsing the whole files
+
+getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)]
+getImports ps = get [] where
+  get ds file0 = do
+    let name = dropExtension file0 ---- dropExtension file0
+    (p,s) <- tryRead name
+    let ((typ,mname),imps) = importsOfFile s
+    let namebody = takeFileName name
+    ioeErr $ testErr  (mname == namebody) $ 
+             "module name" +++ mname +++ "differs from file name" +++ namebody
+    case imps of
+      _ | elem name (map (snd . fst . fst) ds) -> return ds  --- file already read
+      [] -> return $ (((typ,name),[]),p):ds
+      _ -> do
+        let files = map (gfFile . fst) imps 
+        foldM get ((((typ,name),imps),p):ds) files
+  tryRead name = do
+    file <- do
+      let file_gf = gfFile name
+      b <- doesFileExistPath ps file_gf                 -- try gf file first
+      if b then return file_gf else do
+          return (gfoFile name)                         -- gfo next
+
+    readFileIfPath ps $ file
+
+
+
+-- internal module dep information
+
+data ModUse =
+   MUReuse
+ | MUInstance
+ | MUComplete
+ | MUOther
+  deriving (Eq,Show)
+
+data ModTyp =
+   MTyResource
+ | MTyIncomplete
+ | MTyIncResource -- interface, incomplete resource
+ | MTyOther
+  deriving (Eq,Show)
+
+type ModuleHeader = ((ModTyp,ModName),[(ModName,ModUse)])
+
+importsOfFile :: String -> ModuleHeader
+importsOfFile = 
+  getModuleHeader .          -- analyse into mod header
+  filter (not . spec) .      -- ignore keywords and special symbols
+  unqual .                   -- take away qualifiers
+  unrestr .                  -- take away union restrictions
+  takeWhile (not . term) .   -- read until curly or semic
+  lexs .                     -- analyse into lexical tokens
+  unComm                     -- ignore comments before the headed line
+ where
+    term = flip elem ["{",";"]
+    spec = flip elem ["of", "open","in",":", "->","=", "-","(", ")",",","**","union"]
+    unqual ws = case ws of
+      "(":q:ws' -> unqual ws'
+      w:ws' -> w:unqual ws'
+      _ -> ws
+    unrestr ws = case ws of
+      "[":ws' -> unrestr $ tail $ dropWhile (/="]") ws'
+      w:ws' -> w:unrestr ws'
+      _ -> ws
+
+getModuleHeader :: [String] -> ModuleHeader -- with, reuse
+getModuleHeader ws = case ws of
+  "incomplete":ws2 -> let ((ty,name),us) = getModuleHeader ws2 in
+    case ty of
+      MTyResource -> ((MTyIncResource,name),us)
+      _ -> ((MTyIncomplete,name),us)
+  "interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in
+    ((MTyIncResource,name),us)
+ 
+  "resource":name:ws2 -> case ws2 of
+    "reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)])
+    m:"with":ms -> ((MTyResource,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    ms -> ((MTyResource,name),[(n,MUOther) | n <- ms])
+
+  "instance":name:m:ws2 -> case ws2 of
+    "reuse":n:_ -> ((MTyResource,name),(m,MUInstance):[(n,MUReuse)])
+    n:"with":ms -> 
+      ((MTyResource,name),(m,MUInstance):(n,MUComplete):[(n,MUOther) | n <- ms])
+    ms -> ((MTyResource,name),(m,MUInstance):[(n,MUOther) | n <- ms])
+
+  "concrete":name:a:ws2 -> case span (/= "with") ws2 of
+
+    (es,_:ms) -> ((MTyOther,name),
+                  [(m,MUOther)    | m <- es] ++
+                  [(n,MUComplete) | n <- ms])
+    --- m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    (ms,[]) -> ((MTyOther,name),[(n,MUOther) | n <- a:ms])
+
+  _:name:ws2 -> case ws2 of
+    "reuse":m:_ -> ((MTyOther,name),[(m,MUReuse)])
+    ---- m:n:"with":ms -> 
+    ----  ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms])
+    m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    ms -> ((MTyOther,name),[(n,MUOther) | n <- ms])
+  _ -> error "the file is empty"
+
+unComm s = case s of
+      '-':'-':cs -> unComm $ dropWhile (/='\n') cs
+      '{':'-':cs -> dpComm cs
+      c:cs -> c : unComm cs
+      _ -> s
+    
+dpComm s = case s of
+      '-':'}':cs -> unComm cs
+      c:cs -> dpComm cs
+      _ -> s
+    
+lexs s = x:xs where 
+      (x,y) = head $ lex s
+      xs = if null y then [] else lexs y
+
+-- | options can be passed to the compiler by comments in @--#@, in the main file
+getOptionsFromFile ::  FilePath -> IO Options
+getOptionsFromFile file = do
+  s <- readFileIfStrict file
+  let ls = filter (isPrefixOf "--#") $ lines s
+  return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
+
+-- | check if old GF file
+isOldFile :: FilePath -> IO Bool
+isOldFile f = do
+  s <- readFileIfStrict f
+  let s' = unComm s
+  return $ not (null s') && old (head (words s'))
+ where
+   old = flip elem $ words 
+     "cat category data def flags fun include lin lincat lindef lintype oper param pattern printname rule"
+
+
+
+-- | old GF tolerated newlines in quotes. No more supported!
+fixNewlines :: String -> String
+fixNewlines s = case s of
+     '"':cs -> '"':mk cs
+     c  :cs -> c:fixNewlines cs
+     _ -> s
+ where
+   mk s = case s of
+     '\\':'"':cs -> '\\':'"': mk cs
+     '"'     :cs -> '"' :fixNewlines cs
+     '\n'    :cs -> '\\':'n': mk cs
+     c       :cs -> c : mk cs
+     _ -> s 
+
diff --git a/src-2.9/GF/Devel/ModDeps.hs b/src-2.9/GF/Devel/ModDeps.hs
new file mode 100644
index 000000000..ec5702910
--- /dev/null
+++ b/src-2.9/GF/Devel/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.Devel.ModDeps (mkSourceGrammar,
+		moduleDeps,
+		openInterfaces,
+		requiredCanModules
+	       ) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Devel.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 f 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-2.9/GF/Devel/Optimize.hs b/src-2.9/GF/Devel/Optimize.hs
new file mode 100644
index 000000000..b44f6a53d
--- /dev/null
+++ b/src-2.9/GF/Devel/Optimize.hs
@@ -0,0 +1,299 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.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.Devel.Compute
+import GF.Compile.BackOpt
+import GF.Devel.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
+
+import Debug.Trace
+
+
+-- conditional trace
+
+prtIf :: (Print a) => Bool -> a -> a
+prtIf b t = if b then trace (" " ++ prt t) t else t
+
+-- experimental evaluation, option to import
+oEval = iOpt "eval"
+
+-- | 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@(Module mt st fs me ops js) | 
+    st == MSComplete && isModRes m0 && not (oElem oEval oopts)-> do
+      (mo1,_) <- evalModule oopts mse mo
+      let 
+       mo2 = 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
+      return (mo2,eenv)
+  _ -> evalModule oopts mse mo
+ where
+   oopts = addOptions opts (iOpts (flagsModule mo))
+   optim = maybe "all" id $ getOptVal oopts useOptimizer
+
+evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> 
+               Err ((Ident,SourceModInfo),EEnv)
+evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
+
+  ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
+    _ | isModRes m0 && not (oElem oEval oopts) -> do
+      let deps = allOperDependencies name js
+      ids <- topoSortOpers deps
+      MGrammar (mod' : _) <- foldM evalOp gr ids
+      return $ (mod',eenv)
+
+    MTConcrete a -> do
+      js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
+      return $ ((name, ModMod (Module mt st fs me ops 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 = 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) = do
+
+ seq (prtIf (oElem beVerbose opts) 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 ([(strVar, typeStr)], typ) de
+      (Yes typ, Nope)   -> 
+        liftM yes $ mkLinDefault gr typ >>= partEval noOptions gr ([(strVar, 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 | notNewEval -> 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 +++ ":")
+   notNewEval = not (oElem oEval opts)
+
+-- | 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 subst trm1 >>= outCase subst
+             else etaExpand subst trm1
+  return $ mkAbs vars trm3
+
+ where 
+
+   globalTable = oElem showAll opts --- i -all
+
+   comp g t = {- refreshTerm t >>= -} computeTerm gr g t
+
+   etaExpand su t = do
+     t' <- comp su t 
+     case t' of
+       R _ | rightType t' -> comp su t' --- return t' wo noexpand...
+       _ -> recordExpand val t' >>= comp su
+   -- don't eta expand records of right length (correct by type checking)
+   rightType t = case (t,val) of
+     (R rs, RecType ts) -> length rs == length ts
+     _ -> False
+
+   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 strVar . R . mkAssign)
+    _ -> liftM (Abs strVar) $ 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 "Str" -> return $ Vr strVar
+     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-2.9/GF/Devel/OptimizeGF.hs b/src-2.9/GF/Devel/OptimizeGF.hs
new file mode 100644
index 000000000..99e33941f
--- /dev/null
+++ b/src-2.9/GF/Devel/OptimizeGF.hs
@@ -0,0 +1,271 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.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 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 (M.Module mt st fs me ops js) -> 
+    (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
+  _ -> (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 ("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 (mo,m) = errVal (mo,m) $ case m of
+  M.ModMod (M.Module mt st fs me ops js) -> do
+    (tree,_) <- appSTM (getSubtermsMod mo (tree2list js)) (Map.empty,0)
+    js2 <- liftM buildTree $ addSubexpConsts mo tree $ tree2list js
+    return (mo,M.ModMod (M.Module mt st fs me ops js2))
+  _ -> return (mo,m)
+
+unsubexpModule :: SourceModule -> SourceModule
+unsubexpModule mo@(i,m) = case m of
+    M.ModMod (M.Module mt st fs me ops js) | hasSub ljs ->
+      (i, M.ModMod (M.Module mt st fs me ops 
+                     (rebuild (map unparInfo ljs)))) 
+                        where ljs = tree2list js
+    _ -> (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@(IC ('A':'\'':'\'':_)) -> --- name convention of subexp opers
+        errVal t $ liftM unparTerm $ lookupResDef gr m c 
+      _ -> C.composSafeOp unparTerm t
+    gr = M.MGrammar [mo] 
+    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) | ident id /= f -> return $ Q mo (ident id)
+     _ -> C.composOp (recomp f) t
+
+   list = Map.toList tree
+
+   oper id trm = (ident 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
+
+ident :: Int -> Ident
+ident i = identC ("A''" ++ show i) ---
+
diff --git a/src-2.9/GF/Devel/Options.hs b/src-2.9/GF/Devel/Options.hs
new file mode 100644
index 000000000..9a4087096
--- /dev/null
+++ b/src-2.9/GF/Devel/Options.hs
@@ -0,0 +1,269 @@
+module GF.Devel.Options 
+    (
+     Err(..), -- FIXME: take from somewhere else
+
+     Options(..),
+     Mode(..), Phase(..), OutputFormat(..), Optimization(..),
+     parseOptions, helpMessage
+    ) where
+
+import Control.Monad
+import Data.Char (toLower)
+import Data.List
+import Data.Maybe
+import System.Console.GetOpt
+import System.FilePath
+
+
+
+
+
+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.",
+  ".gfc 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, .gfc or .gfe files.",
+  "For the other input formats, only one file can be given.",
+  "",
+  "Command-line options:"]
+
+
+helpMessage :: String
+helpMessage = usageInfo usageHeader optDescr
+
+-- Error monad
+
+type ErrorMsg = String
+
+data Err a = Ok a | Errors [ErrorMsg]
+  deriving (Read, Show, Eq)
+
+instance Monad Err where
+  return      = Ok
+  fail e      = Errors [e]
+  Ok a  >>= f = f a
+  Errors s >>= f = Errors s
+
+errors :: [ErrorMsg] -> Err a
+errors = Errors
+
+-- Types
+
+data Mode = Version | Help | Interactive | Compiler
+  deriving (Show,Eq,Ord)
+
+data Phase = Preproc | Convert | Compile | Link
+  deriving (Show,Eq,Ord)
+
+data Encoding = UTF_8 | ISO_8859_1
+  deriving (Show,Eq,Ord)
+
+data OutputFormat = FmtGFCC | FmtJS
+  deriving (Show,Eq,Ord)
+
+data Optimization = OptStem | OptCSE
+  deriving (Show,Eq,Ord)
+
+data Warning = WarnMissingLincat
+  deriving (Show,Eq,Ord)
+
+data Dump = DumpRebuild | DumpExtend | DumpRename | DumpTypecheck | DumpRefresh | DumpOptimize | DumpCanon
+  deriving (Show,Eq,Ord)
+
+data ModuleOptions = ModuleOptions {
+      optPreprocessors   :: [String],
+      optEncoding        :: Encoding,
+      optOptimizations   :: [Optimization],
+      optLibraryPath     :: [FilePath],
+      optSpeechLanguage  :: Maybe String,
+      optBuildParser     :: Bool,
+      optWarnings        :: [Warning],
+      optDump            :: [Dump]
+    }
+  deriving (Show)
+
+data Options = Options {
+      optMode            :: Mode,
+      optStopAfterPhase  :: Phase,
+      optVerbosity       :: Int,
+      optShowCPUTime     :: Bool,
+      optEmitGFO         :: Bool,
+      optGFODir          :: FilePath,
+      optOutputFormats   :: [OutputFormat],
+      optOutputName      :: Maybe String,
+      optOutputFile      :: Maybe FilePath,
+      optOutputDir       :: FilePath,
+      optForceRecomp     :: Bool,
+      optProb            :: Bool,
+      optStartCategory   :: Maybe String,
+      optModuleOptions   :: ModuleOptions
+    }
+  deriving (Show)
+
+-- Option parsing
+
+parseOptions :: [String] -> Err (Options, [FilePath])
+parseOptions args = case errs of
+                      [] -> do o <- foldM (\o f -> f o) defaultOptions opts
+                               return (o, files)
+                      _  -> errors errs
+    where (opts, files, errs) = getOpt RequireOrder optDescr args
+
+parseModuleFlags :: Options -> [(String,String)] -> Err ModuleOptions
+parseModuleFlags opts flags = foldr setOpt (optModuleOptions opts) moduleOptDescr
+  where
+    setOpt (Option _ ss arg _) d
+            | null values = d
+            | otherwise = case arg of
+                            NoArg a -> 
+                            ReqArg (String -> a) _ ->
+OptArg (Maybe String -> a) String
+last values
+        where values = [v | (k,v) <- flags, k `elem` ss ]
+
+-- Default options
+
+defaultModuleOptions :: ModuleOptions
+defaultModuleOptions = ModuleOptions {
+      optPreprocessors   = [],
+      optEncoding        = ISO_8859_1,
+      optOptimizations   = [OptStem,OptCSE],
+      optLibraryPath     = [],  
+      optSpeechLanguage  = Nothing,
+      optBuildParser     = True,
+      optWarnings        = [],
+      optDump            = []
+    }
+
+defaultOptions :: Options
+defaultOptions = Options {
+      optMode            = Interactive,
+      optStopAfterPhase  = Link,
+      optVerbosity       = 1,
+      optShowCPUTime     = False,
+      optEmitGFO         = True,
+      optGFODir          = ".",
+      optOutputFormats   = [FmtGFCC],
+      optOutputName      = Nothing,
+      optOutputFile      = Nothing,
+      optOutputDir       = ".",
+      optForceRecomp     = False,
+      optProb            = False,
+      optStartCategory   = Nothing,
+      optModuleOptions   = defaultModuleOptions
+    }
+
+-- Option descriptions
+
+moduleOptDescr :: [OptDescr (ModuleOptions -> Err ModuleOptions)]
+moduleOptDescr = 
+    [
+     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 [] ["stem"] (onOff (optimize OptStem) True) "Perform stem-suffix analysis (default on).",
+     Option [] ["cse"] (onOff (optimize OptCSE) True) "Perform common sub-expression elimination (default on).",
+     Option [] ["parser"] (onOff parser True) "Build parser (default on).",
+     Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar."
+    ]
+    where
+       addLibDir   x o = return $ o { optLibraryPath = x:optLibraryPath o }
+       setLibPath  x o = return $ o { optLibraryPath = splitInModuleSearchPath x }
+       preproc     x o = return $ o { optPreprocessors = optPreprocessors o ++ [x] }
+       optimize  x b o = return $ o { optOptimizations = (if b then (x:) else delete x) (optOptimizations o) }
+       parser      x o = return $ o { optBuildParser = x }
+       language    x o = return $ o { optSpeechLanguage = Just x }
+
+optDescr :: [OptDescr (Options -> Err Options)]
+optDescr = 
+    [
+     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.",
+     Option ['V'] ["version"] (NoArg (mode Version)) "Display GF version number.",
+     Option ['?','h'] ["help"] (NoArg (mode Help)) "Show help message.",
+     Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 3.",
+     Option ['q'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.",
+     Option [] ["batch"] (NoArg (mode Compiler)) "Run in batch compiler mode.",
+     Option [] ["interactive"] (NoArg (mode Interactive)) "Run in interactive mode (default).",
+     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: gfcc (default), gar, js, ...",
+                  "Single concrete only: cf, bnf, lbnf, gsl, srgs_xml, srgs_abnf, ...",
+                  "Abstract only: haskell, ..."]),
+     Option ['n'] ["output-name"] (ReqArg outName "NAME") 
+           ("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 ['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 (forceRecomp True)) 
+                 "Always recompile from source, i.e. disable recompilation checking.",
+     Option [] ["prob"] (NoArg (prob True)) "Read probabilities from '--# prob' pragmas.",
+     Option [] ["startcat"] (ReqArg startcat "CAT") "Use CAT as the start category in the generated grammar."
+    ] ++ map (fmap onModuleOptions) moduleOptDescr
+ where phase       x o = return $ o { optStopAfterPhase = x }
+       mode        x o = return $ o { optMode = x }
+       verbosity mv o  = case mv of
+                           Nothing -> return $ o { optVerbosity = 3 }
+                           Just v  -> case reads v of
+                                        [(i,"")] | i >= 0 -> return $ o { optVerbosity = i }
+                                        _        -> fail $ "Bad verbosity: " ++ show v
+       cpu         x o = return $ o { optShowCPUTime = x }
+       emitGFO     x o = return $ o { optEmitGFO = x }
+       gfoDir      x o = return $ o { optGFODir = x }
+       outFmt      x o = readOutputFormat x >>= \f ->
+                         return $ o { optOutputFormats = optOutputFormats o ++ [f] }
+       outName     x o = return $ o { optOutputName = Just x }
+       outFile     x o = return $ o { optOutputFile = Just x }
+       outDir      x o = return $ o { optOutputDir = x }
+       forceRecomp x o = return $ o { optForceRecomp = x }
+       prob        x o = return $ o { optProb = x }
+       startcat    x o = return $ o { optStartCategory = Just x }
+
+onModuleOptions :: Monad m => (ModuleOptions -> m ModuleOptions) -> Options -> m Options
+onModuleOptions f o = do mo' <- f (optModuleOptions o)
+                         return $ o { optModuleOptions = mo' }
+
+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
+
+outputFormats :: [(String,OutputFormat)]
+outputFormats = 
+    [("gfcc", FmtGFCC),
+     ("js",   FmtJS)]
+
+onOff :: Monad m => (Bool -> (a -> m a)) -> Bool -> ArgDescr (a -> m a)
+onOff f def = OptArg g "[on,off]"
+  where g ma x = do b <- maybe (return def) readOnOff ma
+                    f b x
+        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
diff --git a/src-2.9/GF/Devel/PrGrammar.hs b/src-2.9/GF/Devel/PrGrammar.hs
new file mode 100644
index 000000000..44d1c3200
--- /dev/null
+++ b/src-2.9/GF/Devel/PrGrammar.hs
@@ -0,0 +1,233 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.PrGrammar 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 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)
+
+prGrammar :: SourceGrammar -> String
+prGrammar = P.printTree . trGrammar
+
+prModule :: (Ident, SourceModInfo) -> String
+prModule  = P.printTree . trModule
+
+instance Print Term where
+  prt = P.printTree . trt
+  prt_ = prExp
+
+instance Print Ident where
+  prt = P.printTree . tri
+
+instance Print Patt where
+  prt = P.printTree . trp
+
+instance Print Label where
+  prt = P.printTree . 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]
+
+
+-- printing values and trees in editing
+
+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 oElem nostripQualif 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
+
+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 f a -> Ident -> Err a
+lookupIdentInfo mo i = lookupIdent i (jments mo)
diff --git a/src-2.9/GF/Devel/PrintGFCC.hs b/src-2.9/GF/Devel/PrintGFCC.hs
new file mode 100644
index 000000000..c7e668884
--- /dev/null
+++ b/src-2.9/GF/Devel/PrintGFCC.hs
@@ -0,0 +1,21 @@
+module GF.Devel.PrintGFCC where
+
+import GF.GFCC.DataGFCC (GFCC)
+import GF.GFCC.Raw.ConvertGFCC (fromGFCC)
+import GF.GFCC.Raw.PrintGFCCRaw (printTree)
+import GF.Devel.GFCCtoHaskell
+import GF.Devel.GFCCtoJS
+import GF.Text.UTF8
+
+-- top-level access to code generation
+
+prGFCC :: String -> GFCC -> String
+prGFCC printer gr = case printer of
+  "haskell" -> grammar2haskell gr
+  "haskell_gadt" -> grammar2haskellGADT gr
+  "js" -> gfcc2js gr
+  _ -> printGFCC gr
+
+printGFCC :: GFCC -> String
+printGFCC = encodeUTF8 . printTree . fromGFCC
+
diff --git a/src-2.9/GF/Devel/README-testgf3 b/src-2.9/GF/Devel/README-testgf3
new file mode 100644
index 000000000..0d1b6e80a
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Devel/ReadFiles.hs b/src-2.9/GF/Devel/ReadFiles.hs
new file mode 100644
index 000000000..a10ee1991
--- /dev/null
+++ b/src-2.9/GF/Devel/ReadFiles.hs
@@ -0,0 +1,196 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.ReadFiles 
+           ( getAllFiles,ModName,ModEnv,getOptionsFromFile,importsOfModule,
+             gfoFile,gfFile,isGFO ) where
+
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Devel.UseIO
+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
+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)
+  if oElem beVerbose opts
+    then ioeIO $ putStrLn $ "all modules:" +++ show [name | (name,_,_,_,_) <- ds]
+    else return ()
+  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 = oElem isCompiled opts -- i -gfo
+    fromSrc  = oElem fromSource opts
+
+
+-- 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)) = s
+
+
+-- | options can be passed to the compiler by comments in @--#@, in the main file
+getOptionsFromFile ::  FilePath -> IO Options
+getOptionsFromFile file = do
+  s <- readFileIfStrict file
+  let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
+  return $ fst $ getOptions "-" $ map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
diff --git a/src-2.9/GF/Devel/TC.hs b/src-2.9/GF/Devel/TC.hs
new file mode 100644
index 000000000..5c439f671
--- /dev/null
+++ b/src-2.9/GF/Devel/TC.hs
@@ -0,0 +1,299 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.TC (AExp(..),
+	   Theory,
+	   checkExp,
+	   inferExp,
+           checkEqs,
+	   eqVal,
+	   whnf
+	  ) where
+
+import GF.Data.Operations
+import GF.Grammar.Abstract
+import GF.Devel.AbsCompute
+
+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 && (elem c (map identC ["Int","String","Float"])) ->
+                                       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
+ where
+   predefAbs c s = case c of
+     IC "Int" -> return $ const $ Q cPredefAbs cInt
+     IC "Float" -> return $ const $ Q cPredefAbs cFloat
+     IC "String" -> return $ const $ Q cPredefAbs cString
+     _ -> Bad s
+
+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-2.9/GF/Devel/TestGF3.hs b/src-2.9/GF/Devel/TestGF3.hs
new file mode 100644
index 000000000..da4b5c8f6
--- /dev/null
+++ b/src-2.9/GF/Devel/TestGF3.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import GF.Devel.Compile.GFC
+
+import System (getArgs)
+
+main = do
+  xx <- getArgs
+  mainGFC xx
diff --git a/src-2.9/GF/Devel/TypeCheck.hs b/src-2.9/GF/Devel/TypeCheck.hs
new file mode 100644
index 000000000..818b48a10
--- /dev/null
+++ b/src-2.9/GF/Devel/TypeCheck.hs
@@ -0,0 +1,311 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Devel.TypeCheck (-- * top-level type checking functions; TC should not be called directly.
+		  annotate, annotateIn,
+		  justTypeCheck, checkIfValidExp,
+		  reduceConstraints, 
+		  splitConstraints,
+		  possibleConstraints,
+		  reduceConstraintsNode,
+		  performMetaSubstNode,
+		  -- * some top-level batch-mode checkers for the compiler
+		  justTypeCheckSrc,
+		  grammar2theorySrc,
+		  checkContext,
+		  checkTyp,
+		  checkEquation,
+		  checkConstrs,
+		  editAsTermCommand,
+		  exp2termCommand,
+		  exp2termlistCommand,
+		  tree2termlistCommand
+		 ) where
+
+import GF.Data.Operations
+import GF.Data.Zipper
+
+import GF.Grammar.Abstract
+import GF.Devel.AbsCompute
+import GF.Grammar.Refresh
+import GF.Grammar.LookAbs
+import qualified GF.Grammar.Lookup as Lookup ---
+
+import GF.Devel.TC
+
+import GF.Grammar.Unify ---
+
+import Control.Monad (foldM, liftM, liftM2)
+import Data.List (nub) ---
+
+-- top-level type checking functions; TC should not be called directly.
+
+annotate :: GFCGrammar -> Exp -> Err Tree
+annotate gr exp = annotateIn gr [] exp Nothing 
+
+-- | type check in empty context, return a list of constraints
+justTypeCheck :: GFCGrammar -> Exp -> Val -> Err Constraints
+justTypeCheck gr e v = do
+  (_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v
+  constrs1     <- reduceConstraints (lookupAbsDef gr) 0 constrs0
+  return $ fst $ splitConstraints gr constrs1
+
+-- | type check in empty context, return the expression itself if valid
+checkIfValidExp :: GFCGrammar -> Exp -> Err Exp
+checkIfValidExp gr e = do
+  (_,_,constrs0) <- inferExp (grammar2theory gr) (initTCEnv []) e
+  constrs1       <- reduceConstraints (lookupAbsDef gr) 0 constrs0
+  ifNull (return e) (Bad  . unwords . prConstrs) constrs1
+
+annotateIn :: GFCGrammar -> Binds -> Exp -> Maybe Val -> Err Tree
+annotateIn gr gamma exp = maybe (infer exp) (check exp) where
+  infer e = do 
+    (a,_,cs) <- inferExp theory env e
+    aexp2treeC (a,cs)
+  check e v = do
+    (a,cs) <- checkExp theory env e v
+    aexp2treeC (a,cs)
+  env = initTCEnv gamma
+  theory = grammar2theory gr 
+  aexp2treeC (a,c) = do
+    c' <- reduceConstraints (lookupAbsDef gr) (length gamma) c
+    aexp2tree (a,c')
+
+-- | invariant way of creating TCEnv from context
+initTCEnv gamma = 
+  (length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma) 
+
+-- | process constraints after eqVal by computing by defs
+reduceConstraints :: LookDef -> Int -> Constraints -> Err Constraints
+reduceConstraints look i = liftM concat . mapM redOne where
+  redOne (u,v) = do
+    u' <- computeVal look u
+    v' <- computeVal look v
+    eqVal i u' v' 
+
+computeVal :: LookDef -> Val -> Err Val
+computeVal look v = case v of
+  VClos g@(_:_) e -> do
+    e' <- compt (map fst g) e          --- bindings of g in e?
+    whnf $ VClos g e'
+{- ----
+  _ -> do            ---- how to compute a Val, really??
+    e  <- val2exp v
+    e' <- compt [] e
+    whnf $ vClos e'
+-}
+  VApp f c -> liftM2 VApp (compv f) (compv c) >>= whnf
+  _ -> whnf v
+ where
+   compt = computeAbsTermIn look
+   compv = computeVal look
+
+-- | take apart constraints that have the form (? <> t), usable as solutions
+splitConstraints :: GFCGrammar -> Constraints -> (Constraints,MetaSubst)
+splitConstraints gr = splitConstraintsGen (lookupAbsDef gr)
+
+splitConstraintsSrc :: Grammar -> Constraints -> (Constraints,MetaSubst)
+splitConstraintsSrc gr = splitConstraintsGen (Lookup.lookupAbsDef gr)
+
+splitConstraintsGen :: LookDef -> Constraints -> (Constraints,MetaSubst)
+splitConstraintsGen look cs = csmsu where
+
+  csmsu       = (nub [(a,b) | (a,b) <- csf1,a /= b],msf1)
+  (csf1,msf1) = unif (csf,msf)  -- alternative: filter first
+  (csf,msf)   = foldr mkOne ([],[]) cs
+
+  csmsf     = foldr mkOne ([],msu) csu
+  (csu,msu) = unif (cs1,[])    -- alternative: unify first
+
+  cs1 = errVal cs $ reduceConstraints look 0 cs
+
+  mkOne (u,v) = case (u,v) of
+    (VClos g (Meta m), v) | null g -> sub m v
+    (v, VClos g (Meta m)) | null g -> sub m v
+    -- do nothing if meta has nonempty closure; null g || isConstVal v WAS WRONG
+    c -> con c
+  con c (cs,ms) = (c:cs,ms)
+  sub m v (cs,ms) = (cs,(m,v):ms)
+
+  unifo = id -- alternative: don't use unification
+
+  unif cm@(cs,ms) = errVal cm $ do --- alternative: use unification  
+    (cs',ms') <- unifyVal cs
+    return (cs', ms' ++ ms)
+
+performMetaSubstNode :: MetaSubst -> TrNode -> TrNode
+performMetaSubstNode subst n@(N (b,a,v,(c,m),s)) = let
+  v' = metaSubstVal v
+  b' = [(x,metaSubstVal v) | (x,v) <- b]
+  c' = [(u',v') | (u,v) <- c, 
+                  let (u',v') = (metaSubstVal u, metaSubstVal v), u' /= v']
+  in N (b',a,v',(c',m),s)
+ where
+   metaSubstVal u = errVal u $ whnf $ case u of
+     VApp  f a -> VApp  (metaSubstVal f) (metaSubstVal a)
+     VClos g e -> VClos [(x,metaSubstVal v) | (x,v) <- g] (metaSubstExp e)
+     _ -> u
+   metaSubstExp e = case e of
+     Meta m -> errVal e $ maybe (return e) val2expSafe $ lookup m subst
+     _ -> composSafeOp metaSubstExp e
+
+reduceConstraintsNode :: GFCGrammar -> TrNode -> TrNode
+reduceConstraintsNode gr = changeConstrs red where
+  red cs = errVal cs $ reduceConstraints (lookupAbsDef gr) 0 cs
+
+-- | weak heuristic to narrow down menus; not used for TC. 15\/11\/2001.
+-- the age-old method from GF 0.9
+possibleConstraints :: GFCGrammar -> Constraints -> Bool
+possibleConstraints gr = and . map (possibleConstraint gr)
+
+possibleConstraint :: GFCGrammar -> (Val,Val) -> Bool
+possibleConstraint gr (u,v) = errVal True $ do
+    u' <- val2exp u >>= compute gr
+    v' <- val2exp v >>= compute gr
+    return $ cts u' v'
+ where
+  cts t u = isUnknown t || isUnknown u || case (t,u) of
+    (Q m c,      Q n d)      -> c == d || notCan (m,c) || notCan (n,d)
+    (QC m c,     QC n d)     -> c == d
+    (App f a,    App g b)    -> cts f g && cts a b
+    (Abs x b,    Abs y c)    -> cts b c
+    (Prod x a f, Prod y b g) -> cts a b && cts f g
+    (_         , _)          -> False
+
+  isUnknown t = case t of
+    Vr _ -> True
+    Meta _ -> True
+    _ -> False
+
+  notCan = not . isPrimitiveFun gr
+
+-- 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
+
+grammar2theory :: GFCGrammar -> 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
+
+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
+
+justTypeCheckSrc :: Grammar -> Exp -> Val -> Err Constraints
+justTypeCheckSrc gr e v = do
+  (_,constrs0) <- checkExp (grammar2theorySrc 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
+
+grammar2theorySrc :: Grammar -> Theory
+grammar2theorySrc gr (m,f) = case lookupFunTypeSrc gr m f of
+  Ok t -> return $ type2val t
+  Bad s -> case lookupCatContextSrc 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 $ justTypeCheckSrc gr typ vType
+
+checkEquation :: Grammar -> Fun -> Trm -> [String]
+checkEquation gr (m,fun) def = err singleton id $ do
+  typ  <- lookupFunTypeSrc gr m fun
+----  cs   <- checkEqs (grammar2theorySrc gr) (initTCEnv []) ((m,fun),def) (vClos typ)
+  cs   <- justTypeCheckSrc gr def (vClos typ)
+  let cs1 = filter notJustMeta cs ----- filter (not . possibleConstraint gr) cs ----
+  return $ ifNull [] (singleton . prConstraints) cs1
+
+checkConstrs :: Grammar -> Cat -> [Ident] -> [String]
+checkConstrs gr cat _ = [] ---- check constructors!
+
+
+
+
+
+ 
+{- ----
+err singleton concat . mapM checkOne where
+  checkOne con = do
+    typ   <- lookupFunType gr con
+    typ'  <- computeAbsTerm gr typ
+    vcat  <- valCat typ'
+    return $ if (cat == vcat) then [] else ["wrong type in constructor" +++ prt con]
+-}
+
+editAsTermCommand :: GFCGrammar -> (Loc TrNode -> Err (Loc TrNode)) -> Exp -> [Exp]
+editAsTermCommand gr c e = err (const []) singleton $ do
+  t  <- annotate gr $ refreshMetas [] e
+  t' <- c $ tree2loc t
+  return $ tree2exp $ loc2tree t'
+
+exp2termCommand :: GFCGrammar -> (Exp -> Err Exp) -> Tree -> Err Tree
+exp2termCommand gr f t = errIn ("modifying term" +++ prt t) $ do
+  let exp = tree2exp t
+  exp2 <- f exp
+  annotate gr exp2
+
+exp2termlistCommand :: GFCGrammar -> (Exp -> [Exp]) -> Tree -> [Tree]
+exp2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f . tree2exp
+
+tree2termlistCommand :: GFCGrammar -> (Tree -> [Exp]) -> Tree -> [Tree]
+tree2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f 
diff --git a/src-2.9/GF/Devel/UseIO.hs b/src-2.9/GF/Devel/UseIO.hs
new file mode 100644
index 000000000..afbf00efd
--- /dev/null
+++ b/src-2.9/GF/Devel/UseIO.hs
@@ -0,0 +1,298 @@
+{-# 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.Devel.UseIO where
+
+import GF.Data.Operations
+import GF.Infra.Option
+import GF.Today (libdir)
+
+import System.Directory
+import System.FilePath
+import System.IO
+import System.IO.Error
+import System.Environment
+import System.CPUTime
+import Control.Monad
+import Control.Exception(evaluate)
+import qualified Data.ByteString.Char8 as BS
+
+#ifdef mingw32_HOST_OS
+import System.Win32.DLL
+import Foreign.Ptr
+#endif
+
+putShow' :: Show a => (c -> a) -> c -> IO ()
+putShow' f = putStrLn . show . length . show . f
+
+putIfVerb :: Options -> String -> IO ()
+putIfVerb opts msg =
+      if oElem beVerbose opts
+         then putStrLn msg
+         else return ()
+
+putIfVerbW :: Options -> String -> IO ()
+putIfVerbW opts msg =
+      if oElem beVerbose opts
+         then putStr (' ' : msg)
+         else return ()
+
+-- | obsolete with IOE monad
+errIO :: a -> Err a -> IO a
+errIO = errOptIO noOptions
+
+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)
+#ifdef mingw32_HOST_OS
+    (\_ -> do exepath <- getModuleFileName nullPtr
+              let (path,_) = splitFileName exepath
+              canonicalizePath (combine path "../lib"))
+#else
+    (const (return libdir))
+#endif
+
+-- | 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)
+
+putStrLnE :: String -> IOE ()
+putStrLnE = ioeIO . putStrLnFlush 
+
+putStrE :: String -> IOE ()
+putStrE = ioeIO . putStrFlush 
+
+-- this is more verbose
+putPointE :: Options -> String -> IOE a -> IOE a
+putPointE = putPointEgen (oElem beSilent)
+
+-- this is less verbose
+putPointEsil :: Options -> String -> IOE a -> IOE a
+putPointEsil = putPointEgen (not . oElem beVerbose)
+
+putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a
+putPointEgen cond opts msg act = do
+  let ve x = if cond opts then return () else x
+  ve $ ioeIO $ putStrFlush msg
+
+  t1 <- ioeIO $ getCPUTime
+  a <- act >>= ioeIO . evaluate
+  t2 <- ioeIO $ getCPUTime
+
+  ve $ ioeIO $ putStrLnFlush (' ' : show ((t2 - t1) `div` 1000000000) ++ " msec")
+  return a
+
+
+-- | forces verbosity
+putPointEVerb :: Options -> String -> IOE a -> IOE a
+putPointEVerb opts = putPointE (addOption beVerbose opts)
+
+-- ((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-2.9/GF/Devel/gf-code.txt b/src-2.9/GF/Devel/gf-code.txt
new file mode 100644
index 000000000..e8954bedf
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Devel/gf3.txt b/src-2.9/GF/Devel/gf3.txt
new file mode 100644
index 000000000..56feeba2a
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Embed/EmbedAPI.hs b/src-2.9/GF/Embed/EmbedAPI.hs
new file mode 100644
index 000000000..43e4f2546
--- /dev/null
+++ b/src-2.9/GF/Embed/EmbedAPI.hs
@@ -0,0 +1,114 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : EmbedAPI
+-- Maintainer  : Aarne Ranta
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 
+-- > CVS $Author: 
+-- > CVS $Revision: 
+--
+-- Reduced Application Programmer's Interface to GF, meant for
+-- embedded GF systems. AR 10/5/2005
+-----------------------------------------------------------------------------
+
+module GF.Embed.EmbedAPI where
+
+import GF.Compile.ShellState (ShellState,grammar2shellState,canModules,stateGrammarOfLang,abstract,grammar,firstStateGrammar,allLanguages,allCategories,stateOptions,firstAbsCat)
+import GF.UseGrammar.Linear (linTree2string)
+import GF.UseGrammar.GetTree (string2tree)
+import GF.Embed.EmbedParsing (parseString)
+import GF.Canon.CMacros (noMark)
+import GF.Grammar.Grammar (Trm)
+import GF.Grammar.MMacros (exp2tree)
+import GF.Grammar.Macros (zIdent)
+import GF.Grammar.PrGrammar (prt_)
+import GF.Grammar.Values (tree2exp)
+import GF.Grammar.TypeCheck (annotate)
+import GF.Canon.GetGFC (getCanonGrammar)
+import GF.Infra.Modules (emptyMGrammar)
+import GF.CF.CFIdent (string2CFCat)
+import GF.Infra.UseIO
+import GF.Data.Operations
+import GF.Infra.Option (noOptions,useUntokenizer,options,iOpt)
+import GF.Infra.Ident (prIdent)
+import GF.Embed.EmbedCustom
+
+-- This API is meant to be used when embedding GF grammars in Haskell 
+-- programs. The embedded system is supposed to use the
+-- .gfcm grammar format, which is first produced by the gf program.
+
+---------------------------------------------------
+-- Interface
+---------------------------------------------------
+
+type MultiGrammar = ShellState
+type Language     = String
+type Category     = String
+type Tree         = Trm
+
+file2grammar :: FilePath -> IO MultiGrammar
+
+linearize    :: MultiGrammar -> Language -> Tree -> String
+parse        :: MultiGrammar -> Language -> Category -> String -> [Tree]
+
+linearizeAll     :: MultiGrammar -> Tree -> [String]
+linearizeAllLang :: MultiGrammar -> Tree -> [(Language,String)]
+
+parseAll     :: MultiGrammar -> Category -> String -> [[Tree]]
+parseAllLang :: MultiGrammar -> Category -> String -> [(Language,[Tree])]
+
+readTree     :: MultiGrammar -> String -> Tree
+showTree     ::                 Tree -> String
+
+languages    :: MultiGrammar -> [Language]
+categories   :: MultiGrammar -> [Category]
+
+startCat :: MultiGrammar -> Category
+
+---------------------------------------------------
+-- Implementation
+---------------------------------------------------
+
+file2grammar file = do
+  can <- useIOE (error "cannot parse grammar file") $ getCanonGrammar file
+  return $ errVal (error "cannot build multigrammar") $ 
+    grammar2shellState (options [iOpt "docf"]) (can,emptyMGrammar) 
+
+linearize mgr lang = 
+  untok .
+  linTree2string noMark (canModules mgr) (zIdent lang) . 
+  errVal (error "illegal tree") . 
+  annotate gr
+ where
+   gr    = grammar sgr
+   sgr   = stateGrammarOfLang mgr (zIdent lang)
+   untok = customOrDefault (stateOptions sgr) useUntokenizer customUntokenizer sgr
+
+parse mgr lang cat = 
+  map tree2exp . 
+  errVal [] . 
+  parseString (stateOptions sgr) sgr cfcat
+ where
+   sgr   = stateGrammarOfLang mgr (zIdent lang)
+   cfcat = string2CFCat abs cat
+   abs   = maybe (error "no abstract syntax") prIdent $ abstract mgr
+
+linearizeAll mgr = map snd . linearizeAllLang mgr
+linearizeAllLang mgr t = [(lang,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)]
+
+readTree mgr s = tree2exp $ string2tree (firstStateGrammar mgr) s
+
+showTree t  = prt_ t
+
+languages mgr = [prt_ l | l <- allLanguages mgr]
+
+categories mgr = [prt_ c | (_,c) <- allCategories mgr]
+
+startCat = prt_ . snd . firstAbsCat noOptions . firstStateGrammar
diff --git a/src-2.9/GF/Embed/EmbedCustom.hs b/src-2.9/GF/Embed/EmbedCustom.hs
new file mode 100644
index 000000000..f315441c5
--- /dev/null
+++ b/src-2.9/GF/Embed/EmbedCustom.hs
@@ -0,0 +1,113 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : EmbedCustom
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 
+-- > CVS $Author: 
+-- > CVS $Revision: 
+--
+-- A database for customizable lexers and unlexers. Reduced version of
+-- GF.API, intended for embedded GF grammars.
+
+-----------------------------------------------------------------------------
+
+module GF.Embed.EmbedCustom where
+
+import GF.Data.Operations
+import GF.Text.Text
+import GF.UseGrammar.Tokenize
+import GF.UseGrammar.Morphology
+import GF.Infra.Option
+import GF.CF.CFIdent
+import GF.Compile.ShellState
+import Data.Char
+
+-- | useTokenizer, \"-lexer=x\"
+customTokenizer      :: CustomData (StateGrammar -> String -> [CFTok])  
+
+-- | useUntokenizer, \"-unlexer=x\" --- should be from token list to string
+customUntokenizer    :: CustomData (StateGrammar -> String -> String)  
+
+-- | this is the way of selecting an item
+customOrDefault :: Options -> OptFun -> CustomData a -> a
+customOrDefault opts optfun db = maybe (defaultCustomVal db) id $ 
+                                   customAsOptVal opts optfun db
+
+-- | to produce menus of custom operations
+customInfo :: CustomData a -> (String, [String])
+customInfo c = (titleCustomData c, map (ciStr . fst) (dbCustomData c))
+
+type CommandId = String
+
+strCI :: String -> CommandId
+strCI = id
+
+ciStr :: CommandId -> String
+ciStr = id
+
+ciOpt :: CommandId -> Option
+ciOpt = iOpt
+
+newtype CustomData a = CustomData (String, [(CommandId,a)])
+
+customData :: String -> [(CommandId, a)] -> CustomData a
+customData title db = CustomData (title,db)
+
+dbCustomData :: CustomData a -> [(CommandId, a)]
+dbCustomData (CustomData (_,db)) = db
+
+titleCustomData :: CustomData a -> String
+titleCustomData (CustomData (t,_)) = t
+
+lookupCustom :: CustomData a -> CommandId -> Maybe a
+lookupCustom = flip lookup . dbCustomData
+
+customAsOptVal :: Options -> OptFun -> CustomData a -> Maybe a
+customAsOptVal opts optfun db = do
+  arg <- getOptVal opts optfun
+  lookupCustom db (strCI arg)
+
+-- | take the first entry from the database
+defaultCustomVal :: CustomData a -> a
+defaultCustomVal (CustomData (s,db)) = 
+  ifNull (error ("empty database:" +++ s)) (snd . head) db
+
+customTokenizer = 
+  customData "Tokenizers, selected by option -lexer=x" $
+  [
+   (strCI "words",     const $ tokWords)
+  ,(strCI "literals",  const $ tokLits)
+  ,(strCI "vars",      const $ tokVars)
+  ,(strCI "chars",     const $ map (tS . singleton))
+  ,(strCI "code",      const $ lexHaskell)
+  ,(strCI "codevars",  lexHaskellVar . stateIsWord)
+  ,(strCI "text",      const $ lexText)
+  ,(strCI "unglue",    \gr -> map tS . decomposeWords (stateMorpho gr))
+  ,(strCI "codelit",   lexHaskellLiteral . stateIsWord)
+  ,(strCI "textlit",   lexTextLiteral . stateIsWord)
+  ,(strCI "codeC",     const $ lexC2M)
+  ,(strCI "codeCHigh", const $ lexC2M' True)
+-- add your own tokenizers here
+  ]
+
+customUntokenizer = 
+  customData "Untokenizers, selected by option -unlexer=x" $
+  [
+   (strCI "unwords",   const $ id)   -- DEFAULT
+  ,(strCI "text",      const $ formatAsText)
+  ,(strCI "html",      const $ formatAsHTML)
+  ,(strCI "latex",     const $ formatAsLatex)
+  ,(strCI "code",      const $ formatAsCode)
+  ,(strCI "concat",    const $ filter (not . isSpace))
+  ,(strCI "textlit",   const $ formatAsTextLit)
+  ,(strCI "codelit",   const $ formatAsCodeLit)
+  ,(strCI "concat",    const $ concatRemSpace)
+  ,(strCI "glue",      const $ performBinds)
+  ,(strCI "reverse",   const $ reverse)
+  ,(strCI "bind",      const $ performBinds) -- backward compat
+-- add your own untokenizers here
+  ]
+
diff --git a/src-2.9/GF/Embed/EmbedParsing.hs b/src-2.9/GF/Embed/EmbedParsing.hs
new file mode 100644
index 000000000..43909f355
--- /dev/null
+++ b/src-2.9/GF/Embed/EmbedParsing.hs
@@ -0,0 +1,65 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : EmbedParsing
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 
+-- > CVS $Author: 
+-- > CVS $Revision: 
+--
+-- just one parse method, for use in embedded GF systems 
+-----------------------------------------------------------------------------
+
+module GF.Embed.EmbedParsing where
+
+import GF.Infra.CheckM
+import qualified GF.Canon.AbsGFC as C
+import GF.Canon.GFC
+import GF.Canon.MkGFC (trExp) ----
+import GF.Canon.CMacros
+import GF.Grammar.MMacros (refreshMetas)
+import GF.UseGrammar.Linear
+import GF.Data.Str
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.Infra.Ident
+import GF.Grammar.TypeCheck
+import GF.Grammar.Values
+import GF.UseGrammar.Tokenize
+import GF.CF.Profile
+import GF.Infra.Option
+import GF.Compile.ShellState
+import GF.Embed.EmbedCustom
+import GF.CF.PPrCF (prCFTree)
+import qualified GF.Parsing.GFC as New
+
+
+-- import qualified GF.Parsing.GFC as New
+
+import GF.Data.Operations
+
+import Data.List (nub)
+import Control.Monad (liftM)
+
+-- AR 26/1/2000 -- 8/4 -- 28/1/2001 -- 9/12/2002
+
+parseString :: Options -> StateGrammar -> CFCat -> String -> Err [Tree]
+parseString os sg cat = liftM fst . parseStringMsg os sg cat
+
+parseStringMsg :: Options -> StateGrammar -> CFCat -> String -> Err ([Tree],String)
+parseStringMsg os sg cat s = do
+  (ts,(_,ss)) <- checkStart $ parseStringC os sg cat s
+  return (ts,unlines ss)
+
+parseStringC :: Options -> StateGrammar -> CFCat -> String -> Check [Tree]
+parseStringC opts0 sg cat s = do
+  let opts      = unionOptions opts0 $ stateOptions sg
+      algorithm = "f" -- default algorithm: FCFG
+      strategy  = "bottomup" 
+      tokenizer = customOrDefault opts useTokenizer customTokenizer sg
+      toks = tokenizer s 
+  ts  <- checkErr $ New.parse algorithm strategy (pInfo sg) (absId sg) cat toks
+  checkErr $ allChecks $ map (annotate (stateGrammarST sg) . refreshMetas []) ts
+
diff --git a/src-2.9/GF/Embed/TemplateApp.hs b/src-2.9/GF/Embed/TemplateApp.hs
new file mode 100644
index 000000000..f8722691f
--- /dev/null
+++ b/src-2.9/GF/Embed/TemplateApp.hs
@@ -0,0 +1,44 @@
+module Main where
+
+import GF.Embed.EmbedAPI
+import System
+
+-- Simple translation application built on EmbedAPI. AR 7/10/2005
+
+main :: IO ()
+main = do
+  file:_  <- getArgs
+  grammar <- file2grammar file
+  translate grammar
+
+translate :: MultiGrammar -> IO ()
+translate grammar = do
+  s <- getLine
+  if s == "quit" then return () else do
+    treat grammar s
+    translate grammar
+
+treat :: MultiGrammar -> String -> IO ()
+treat grammar s = putStrLn $ case comm of
+  ["lin"]        -> unlines $ linearizeAll grammar $ readTree grammar rest 
+  ["lin",lang]   -> linearize grammar lang $ readTree grammar rest 
+  ["parse",cat]  -> unlines $ map showTree $ concat $ parseAll grammar cat rest
+  ["parse",lang,cat] -> unlines $ map showTree $ parse grammar lang cat rest
+  ["langs"]      -> unwords $ languages grammar
+  ["cats"]       -> unwords $ categories grammar
+  ["help"]       -> helpMsg
+  _ -> "command not interpreted: " ++ s
+ where
+   (comm,rest) = (words c,drop 1 r) where
+      (c,r) = span (/=':') s
+
+helpMsg = unlines [
+  "lin : <Tree>",
+  "lin <Lang> : <Tree>",
+  "parse <Cat> : <String>",
+  "parse <Lang> <Cat> : <String>",
+  "langs",
+  "cats",
+  "help",
+  "quit"
+  ]
diff --git a/src-2.9/GF/Formalism/CFG.hs b/src-2.9/GF/Formalism/CFG.hs
new file mode 100644
index 000000000..c38adb4e2
--- /dev/null
+++ b/src-2.9/GF/Formalism/CFG.hs
@@ -0,0 +1,50 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/11 13:52:49 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- CFG formalism
+-----------------------------------------------------------------------------
+
+module GF.Formalism.CFG where
+
+import GF.Formalism.Utilities
+import GF.Infra.Print
+import GF.Data.Assoc (accumAssoc)
+import GF.Data.SortedList (groupPairs)
+import GF.Data.Utilities (mapSnd)
+
+------------------------------------------------------------
+-- type definitions
+
+type CFGrammar  c n t = [CFRule c n t]
+data CFRule     c n t = CFRule c [Symbol c t] n
+			deriving (Eq, Ord, Show)
+
+type CFChart    c n t = CFGrammar (Edge c) n t
+
+
+------------------------------------------------------------
+-- building syntax charts from grammars
+
+grammar2chart :: (Ord n, Ord e) => CFGrammar e n t -> SyntaxChart n e
+grammar2chart cfchart = accumAssoc groupSyntaxNodes $
+			[ (lhs, SNode name (filterCats rhs)) |
+				     CFRule lhs rhs name <- cfchart ]
+
+
+----------------------------------------------------------------------
+-- pretty-printing
+
+instance (Print n, Print c, Print t) => Print (CFRule c n t) where
+    prt (CFRule cat rhs name) = prt name ++ " : " ++ prt cat ++ 
+				( if null rhs then "" 
+				  else " --> " ++ prtSep " " rhs )
+    prtList = prtSep "\n"
+
+
diff --git a/src-2.9/GF/Formalism/FCFG.hs b/src-2.9/GF/Formalism/FCFG.hs
new file mode 100644
index 000000000..5f9656658
--- /dev/null
+++ b/src-2.9/GF/Formalism/FCFG.hs
@@ -0,0 +1,106 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : Krasimir Angelov
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- Definitions of fast multiple context-free grammars
+-----------------------------------------------------------------------------
+
+module GF.Formalism.FCFG
+         ( 
+         -- * Token
+           FToken
+
+         -- * Category
+         , FPath
+         , FCat
+
+         , fcatString, fcatInt, fcatFloat, fcatVar
+
+         -- * Symbol
+         , FIndex
+         , FSymbol(..)
+
+         -- * Name
+         , FName
+         , isCoercionF
+
+         -- * Grammar
+         , FPointPos
+         , FGrammar
+         , FRule(..)
+         ) where
+
+import Control.Monad (liftM)
+import Data.List (groupBy)
+import Data.Array
+import qualified Data.Map as Map
+
+import GF.Formalism.Utilities
+import qualified GF.GFCC.CId as AbsGFCC
+import GF.Infra.PrintClass
+
+
+------------------------------------------------------------
+-- Token
+type FToken    = String
+
+
+------------------------------------------------------------
+-- Category
+type FPath     = [FIndex]
+type FCat      = Int
+
+fcatString, fcatInt, fcatFloat, fcatVar :: Int
+fcatString = (-1)
+fcatInt    = (-2)
+fcatFloat  = (-3)
+fcatVar    = (-4)
+
+
+------------------------------------------------------------
+-- Symbol
+type FIndex    = Int
+data FSymbol
+  = FSymCat {-# UNPACK #-} !FCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int 
+  | FSymTok FToken
+
+
+------------------------------------------------------------
+-- Name
+type FName     = NameProfile AbsGFCC.CId
+
+isCoercionF :: FName -> Bool
+isCoercionF (Name fun [Unify [0]]) = fun == AbsGFCC.CId "_"
+isCoercionF _ = False
+
+
+------------------------------------------------------------
+-- Grammar
+
+type FPointPos = Int
+type FGrammar  = ([FRule], Map.Map AbsGFCC.CId [FCat])
+data FRule     = FRule FName [FCat] FCat (Array FIndex (Array FPointPos FSymbol))
+
+------------------------------------------------------------
+-- pretty-printing
+
+instance Print AbsGFCC.CId where
+  prt (AbsGFCC.CId s) = s
+
+instance Print FSymbol where
+    prt (FSymCat c l n) = "($" ++ prt n ++ "!" ++ prt l ++ ")"
+    prt (FSymTok t)     = simpleShow (prt t)
+      where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
+            mkEsc '\\' = "\\\\"
+            mkEsc '\"' = "\\\""
+            mkEsc '\n' = "\\n"
+            mkEsc '\t' = "\\t"
+            mkEsc chr  = [chr]
+    prtList = prtSep " "
+
+instance Print FRule where
+    prt (FRule name args res lins) = prt name ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
+                                     " =\n   [" ++ prtSep "\n    " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
+    prtList = prtSep "\n"
diff --git a/src-2.9/GF/Formalism/GCFG.hs b/src-2.9/GF/Formalism/GCFG.hs
new file mode 100644
index 000000000..5242081c7
--- /dev/null
+++ b/src-2.9/GF/Formalism/GCFG.hs
@@ -0,0 +1,47 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.3 $
+--
+-- Basic GCFG formalism (derived from Pollard 1984)
+-----------------------------------------------------------------------------
+
+module GF.Formalism.GCFG where
+
+import GF.Formalism.Utilities (SyntaxChart)
+import GF.Data.Assoc (assocMap, accumAssoc)
+import GF.Data.SortedList (nubsort, groupPairs)
+import GF.Infra.PrintClass
+
+----------------------------------------------------------------------
+
+type Grammar c n l t  = [Rule c n l t]
+data Rule    c n l t  = Rule (Abstract c n) (Concrete l t)
+			deriving (Eq, Ord, Show)
+
+data Abstract cat name = Abs cat [cat] name 
+			 deriving (Eq, Ord, Show)
+data Concrete lin term = Cnc lin [lin] term 
+			 deriving (Eq, Ord, Show)
+
+----------------------------------------------------------------------
+
+instance (Print c, Print n, Print l, Print t) => Print (Rule n c l t) where
+    prt (Rule abs cnc) = prt abs ++ " := " ++ prt cnc 
+    prtList = prtSep "\n"
+
+instance (Print c, Print n) => Print (Abstract c n) where
+    prt (Abs cat args name) = prt name ++ ". " ++ prt cat ++ 
+			      ( if null args then ""
+				else " --> " ++ prtSep " " args )
+
+instance (Print l, Print t) => Print (Concrete l t) where
+    prt (Cnc lcat args term) = prt term 
+			       ++ " : " ++ prt lcat ++ 
+			       ( if null args then ""
+			         else " / " ++ prtSep " " args)
diff --git a/src-2.9/GF/Formalism/MCFG.hs b/src-2.9/GF/Formalism/MCFG.hs
new file mode 100644
index 000000000..e6aa965e7
--- /dev/null
+++ b/src-2.9/GF/Formalism/MCFG.hs
@@ -0,0 +1,58 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:45 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.2 $
+--
+-- Definitions of multiple context-free grammars
+-----------------------------------------------------------------------------
+
+module GF.Formalism.MCFG where
+
+import Control.Monad (liftM)
+import Data.List (groupBy)
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+
+import GF.Infra.PrintClass
+
+
+------------------------------------------------------------
+-- grammar types
+
+-- | the lables in the linearization record should be in the same
+-- order as specified by the linearization type @[lbl]@
+type MCFGrammar cat name lbl tok = Grammar cat name [lbl] [Lin cat lbl tok]
+type MCFRule    cat name lbl tok = Rule    cat name [lbl] [Lin cat lbl tok]
+
+-- | variants are encoded as several linearizations with the same label
+data Lin        cat      lbl tok = Lin lbl [Symbol (cat, lbl, Int) tok]
+				   deriving (Eq, Ord, Show)
+
+instantiateArgs :: [cat] -> Lin cat' lbl tok -> Lin cat lbl tok
+instantiateArgs args (Lin lbl lin) = Lin lbl (map instSym lin)
+    where instSym = mapSymbol instCat id
+	  instCat (_, lbl, nr) = (args !! nr, lbl, nr)
+
+expandVariants :: Eq lbl => MCFRule cat name lbl tok -> [MCFRule cat name lbl tok]
+expandVariants (Rule abs (Cnc typ typs lins)) = liftM (Rule abs . Cnc typ typs) $
+						expandLins lins
+    where expandLins = sequence . groupBy eqLbl 
+	  eqLbl (Lin l1 _) (Lin l2 _) = l1 == l2
+
+
+------------------------------------------------------------
+-- pretty-printing
+
+instance (Print c, Print l, Print t) => Print (Lin c l t) where
+    prt (Lin lbl lin) = prt lbl ++ " = " ++ prtSep " " (map (symbol prArg (show.prt)) lin)
+	where prArg (cat, lbl, nr) = prt cat ++ "@" ++ prt nr ++ prt lbl
+    prtList = prtBefore "\n\t"
+
+
+
diff --git a/src-2.9/GF/Formalism/SimpleGFC.hs b/src-2.9/GF/Formalism/SimpleGFC.hs
new file mode 100644
index 000000000..ea1f9dc12
--- /dev/null
+++ b/src-2.9/GF/Formalism/SimpleGFC.hs
@@ -0,0 +1,268 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/11 14:11:46 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.7 $
+--
+-- Simplistic GFC format
+-----------------------------------------------------------------------------
+
+module GF.Formalism.SimpleGFC where
+
+import Control.Monad (liftM)
+import qualified GF.Canon.AbsGFC as AbsGFC
+import qualified GF.Infra.Ident as Ident
+import GF.Formalism.GCFG
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+-- * basic (leaf) types
+
+type Constr = AbsGFC.CIdent
+type Var    = Ident.Ident
+type Label  = AbsGFC.Label
+
+anyVar :: Var
+anyVar = Ident.wildIdent
+
+----------------------------------------------------------------------
+-- * simple GFC
+
+type SimpleGrammar c n t = Grammar  (Decl c) n (LinType c t) (Maybe (Term c t))
+type SimpleRule    c n t = Rule     (Decl c) n (LinType c t) (Maybe (Term c t))
+
+-- ** dependent type declarations
+
+-- 'Decl x c ts' == x is of type (c applied to ts)
+-- data Decl c = Decl Var c [TTerm]
+--  	      deriving (Eq, Ord, Show)
+
+-- | 'Decl x t' == 'x' is of type 't'
+data Decl    c = Decl Var (AbsType c) deriving (Eq, Ord, Show)
+-- | '[t1..tn] ::--> t' == 't1 -> ... -> tn -> t'
+data AbsType c = [FOType c] ::--> FOType c deriving (Eq, Ord, Show)
+-- | 'c ::@ [t1..tn]' == '(c t1 ... tn)'
+data FOType  c = c ::@ [TTerm] deriving (Eq, Ord, Show)
+
+-- including second order functions:
+-- (A -> B)                ==>  Decl _ ([A ::@ []] ::--> (B ::@ []))
+-- (x : A -> B -> C)       ==>  Decl x ([A ::@ [], B ::@ []] ::--> (C ::@ []))
+-- (y : A t x -> B (t x))  ==>  Decl y ([A ::@ [t:@[],TVar x]] ::--> (B ::@ [t:@[TVar x]]))
+
+
+data TTerm  = Constr :@ [TTerm]
+	    | TVar Var
+	      deriving (Eq, Ord, Show)
+
+decl2cat :: Decl c -> c
+decl2cat (Decl _ (_ ::--> (cat ::@ _))) = cat
+
+varsInTTerm :: TTerm -> [Var]
+varsInTTerm tterm = vars tterm []
+    where vars (TVar x)  = (x:)
+	  vars (_ :@ ts) = foldr (.) id $ map vars ts
+
+tterm2term :: TTerm -> Term c t
+tterm2term (con :@ terms) = con :^ map tterm2term terms
+-- tterm2term (TVar x) = Var x
+tterm2term term = error $ "tterm2term: illegal term"
+
+term2tterm :: Term c t -> TTerm
+term2tterm (con :^ terms) = con :@ map term2tterm terms
+-- term2tterm (Var x) = TVar x
+term2tterm term = error $ "term2tterm: illegal term"
+
+-- ** linearization types and terms
+
+data LinType c t = RecT [(Label, LinType c t)]
+		 | TblT [Term c t] (LinType c t)
+		 | ConT [Term c t]
+		 | StrT
+		   deriving (Eq, Ord, Show)
+
+isBaseType :: LinType c t -> Bool
+isBaseType (ConT _) = True
+isBaseType (StrT)   = True
+isBaseType _        = False
+
+data Term c t
+    = Arg Int c (Path c t)       -- ^ argument variable, the 'Path' is a path 
+			         -- pointing into the term 
+    | Constr :^ [Term c t]       -- ^ constructor
+    | Rec [(Label, Term c t)]    -- ^ record
+    | Term c t :. Label          -- ^ record projection
+    | Tbl [(Term c t, Term c t)] -- ^ table of patterns\/terms
+    | Term c t :! Term c t       -- ^ table selection
+    | Variants [Term c t]        -- ^ variants
+    | Term c t :++ Term c t      -- ^ concatenation
+    | Token t   -- ^ single token
+    | Empty     -- ^ empty string
+    ---- | Wildcard  -- ^ wildcard pattern variable
+    ---- | Var Var   -- ^ bound pattern variable
+
+     -- Res CIdent        -- ^ resource identifier
+     -- Int Integer       -- ^ integer
+	    deriving (Eq, Ord, Show)
+
+-- ** calculations on terms
+
+(+.) :: Term c t -> Label -> Term c t
+Variants terms +. lbl = variants $ map (+. lbl) terms 
+Rec record +. lbl = maybe err id $ lookup lbl record
+    where err = error $ "(+.): label not in record"
+Arg arg cat path +. lbl = Arg arg cat (path ++. lbl)
+term +. lbl = term :. lbl
+
+(+!) :: (Eq c, Eq t) => Term c t -> Term c t -> Term c t
+Variants terms +! pat = variants $ map (+! pat) terms 
+term +! Variants pats = variants $ map (term +!) pats 
+term +! arg@(Arg _ _ _) = term :! arg
+Arg arg cat path +! pat = Arg arg cat (path ++! pat)
+-- cannot handle tables with pattern variales or wildcards (yet):
+term@(Tbl table) +! pat = maybe (term :! pat) id $ lookup pat table
+term +! pat = term :! pat
+
+{- does not work correctly:
+lookupTbl term [] _ = term
+lookupTbl _ ((Wildcard, term) : _) _ = term
+lookupTbl _ ((Var x, term) : _) pat = subst x pat term
+lookupTbl _ ((pat', term) : _) pat | pat == pat' = term
+lookupTbl term (_ : tbl) pat = lookupTbl term tbl pat
+
+subst x a (Arg n c (Path path)) = Arg n c (Path (map substP path))
+    where substP (Right (Var y)) | x==y = Right a
+	  substP p = p
+subst x a (con :^ ts) = con :^ map (subst x a) ts
+subst x a (Rec rec) = Rec [ (l, subst x a t) | (l, t) <- rec ]
+subst x a (t :. l) = subst x a t +. l
+subst x a (Tbl tbl) = Tbl [ (subst x a p, subst x a t) | (p, t) <- tbl ]
+subst x a (t :! s) = subst x a t +! subst x a s
+subst x a (Variants ts) = variants $ map (subst x a) ts
+subst x a (t1 :++ t2) = subst x a t1 ?++ subst x a t2
+subst x a (Var y) | x==y = a
+subst x a t = t
+-}
+
+(?++) :: Term c t -> Term c t -> Term c t
+Variants terms ?++ term  = variants $ map (?++ term) terms
+term  ?++ Variants terms = variants $ map (term ?++) terms
+Empty ?++ term  = term
+term  ?++ Empty = term
+term1 ?++ term2 = term1 :++ term2
+
+variants :: [Term c t] -> Term c t
+variants terms0 = case concatMap flatten terms0 of
+		    [term] -> term
+		    terms  -> Variants terms
+    where flatten (Variants ts) = ts
+	  flatten  t      = [t]
+
+-- ** enumerations
+
+enumerateTerms :: (Eq c, Eq t) => Maybe (Term c t) -> LinType c t -> [Term c t]
+enumerateTerms arg (StrT) = maybe err return arg
+    where err = error "enumeratePatterns: parameter type should not be string"
+enumerateTerms arg (ConT terms) = terms
+enumerateTerms arg (RecT rtype) 
+    = liftM Rec $ mapM enumAssign rtype
+    where enumAssign (lbl, ctype) = liftM ((,) lbl) $ enumerateTerms arg ctype
+enumerateTerms arg (TblT terms ctype)
+    = liftM Tbl $ mapM enumCase terms
+    where enumCase pat = liftM ((,) pat) $ enumerateTerms (fmap (+! pat) arg) ctype
+
+enumeratePatterns :: (Eq c, Eq t) => LinType c t -> [Term c t]
+enumeratePatterns t = enumerateTerms Nothing t
+
+----------------------------------------------------------------------
+-- * paths of record projections and table selections
+
+-- | Note that the list of labels/selection terms is /reversed/
+newtype Path c t = Path [Either Label (Term c t)] deriving (Eq, Ord, Show)
+
+emptyPath :: Path c t
+emptyPath = Path []
+
+-- ** calculations on paths
+
+(++.) :: Path c t -> Label -> Path c t 
+Path path ++. lbl = Path (Left lbl : path)
+
+(++!) :: Path c t -> Term c t -> Path c t 
+Path path ++! sel = Path (Right sel : path)
+
+lintypeFollowPath :: (Print c,Print t) => Path c t -> LinType c t -> LinType c t
+lintypeFollowPath (Path path0) ctype0 = follow (reverse path0) ctype0
+    where follow [] ctype = ctype
+	  follow (Right pat : path) (TblT _ ctype) = follow path ctype
+	  follow (Left  lbl : path) (RecT rec)
+	      = maybe err (follow path) $ lookup lbl rec
+	      where err = error $ "lintypeFollowPath: label not in record type"
+			    ++ "\nOriginal Path:  " ++ prt (Path path0)
+			    ++ "\nOriginal CType: " ++ prt ctype0
+                            ++ "\nCurrent Label:  " ++ prt lbl
+                            ++ "\nCurrent RType:  " ++ prt (RecT rec)
+                          --- by AR for debugging 23/11/2005
+
+termFollowPath :: (Eq c, Eq t) => Path c t -> Term c t -> Term c t
+termFollowPath (Path path0) = follow (reverse path0)
+    where follow [] term = term
+	  follow (Right pat : path) term = follow path (term +! pat)
+	  follow (Left  lbl : path) term = follow path (term +. lbl)
+
+lintype2paths :: (Eq c, Eq t) => Path c t -> LinType c t -> [Path c t]
+lintype2paths path (ConT _)     = []
+lintype2paths path (StrT)       = [ path ]
+lintype2paths path (RecT rec)   = concat [ lintype2paths (path ++. lbl) ctype |
+					   (lbl, ctype) <- rec ]
+lintype2paths path (TblT pts vt)= concat [ lintype2paths (path ++! pat) vt |
+					   pat <- pts ]
+
+----------------------------------------------------------------------
+-- * pretty-printing
+
+instance Print c => Print (Decl c) where
+    prt (Decl var typ) | var == anyVar = prt typ
+		       | otherwise     = "(?" ++ prt var ++ ":" ++ prt typ ++ ")"
+
+instance Print c => Print (AbsType c) where
+    prt ([]   ::--> typ) = prt typ
+    prt (args ::--> typ) = "(" ++ prtAfter "->" args ++ prt typ ++ ")"
+
+instance Print c => Print (FOType c) where
+    prt (cat ::@ args) = prt cat ++ prtBefore " " args
+
+instance Print TTerm where
+    prt (con :@ args)
+	| null args = prt con
+	| otherwise = "(" ++ prt con ++ prtBefore " " args ++ ")"
+    prt (TVar var)  = "?" ++ prt var
+
+instance (Print c, Print t) => Print (LinType c t) where
+    prt (RecT rec) = "{" ++ prtPairList ":" "; " rec ++ "}"
+    prt (TblT ts t2) = "([" ++ prtSep "|" ts ++ "] => " ++ prt t2 ++ ")"
+    prt (ConT ts) = "[" ++ prtSep "|" ts ++ "]"
+    prt (StrT) = "Str"
+
+instance (Print c, Print t) => Print (Term c t) where
+    prt (Arg n c p) = prt c ++ prt n ++ prt p
+    prt (c :^ [])  = prt c 
+    prt (c :^ ts)  = "(" ++ prt c ++ prtBefore " " ts ++ ")"
+    prt (Rec rec)   = "{" ++ prtPairList "=" "; " rec ++ "}"
+    prt (Tbl tbl)   = "[" ++ prtPairList "=>" "; " tbl ++ "]"
+    prt (Variants ts)  = "{| " ++ prtSep " | " ts ++ " |}"
+    prt (t1 :++ t2) = prt t1 ++ "++" ++ prt t2
+    prt (Token t)   = "'" ++ prt t ++ "'"
+    prt (Empty)     = "[]"
+    prt (term :. lbl) = prt term ++ "." ++ prt lbl
+    prt (term :! sel) = prt term ++ "!" ++ prt sel
+--    prt (Wildcard)  = "_"
+--    prt (Var var) = "?" ++ prt var
+
+instance (Print c, Print t) => Print (Path c t) where
+    prt (Path path) = concatMap prtEither (reverse path)
+	where prtEither (Left  lbl)  = "." ++ prt lbl
+	      prtEither (Right patt) = "!" ++ prt patt
diff --git a/src-2.9/GF/Formalism/Utilities.hs b/src-2.9/GF/Formalism/Utilities.hs
new file mode 100644
index 000000000..d1826d095
--- /dev/null
+++ b/src-2.9/GF/Formalism/Utilities.hs
@@ -0,0 +1,423 @@
+----------------------------------------------------------------------
+-- |
+-- 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 GF.Formalism.Utilities where
+
+import Control.Monad
+import Data.Array
+import Data.List (groupBy)
+
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.Data.Utilities (sameLength, foldMerge, splitBy)
+
+import GF.Infra.PrintClass
+
+------------------------------------------------------------
+-- * symbols
+
+data Symbol c t = Cat c | Tok t
+		  deriving (Eq, Ord, Show)
+
+symbol :: (c -> a) -> (t -> a) -> Symbol c t -> a
+symbol fc ft (Cat cat) = fc cat
+symbol fc ft (Tok tok) = ft tok
+
+mapSymbol :: (c -> d) -> (t -> u) -> Symbol c t -> Symbol d u
+mapSymbol fc ft = symbol (Cat . fc) (Tok . ft)
+
+filterCats :: [Symbol c t] -> [c]
+filterCats syms = [ cat | Cat cat <- syms ]
+
+filterToks :: [Symbol c t] -> [t]
+filterToks syms = [ tok | Tok tok <- syms ]
+
+------------------------------------------------------------
+-- * edges
+
+data Edge s = Edge Int Int s
+	      deriving (Eq, Ord, Show)
+
+instance Functor Edge where
+    fmap f (Edge i j s) = Edge i j (f s)
+
+
+------------------------------------------------------------
+-- * representaions of input tokens
+
+data Input t = MkInput { inputEdges  :: [Edge t],
+			 inputBounds :: (Int, Int),
+			 inputFrom   :: Array Int (Assoc t [Int]),
+			 inputTo     :: Array Int (Assoc t [Int]),
+			 inputToken  :: Assoc t [(Int, Int)]
+		       }
+
+makeInput :: Ord t => [Edge t] -> Input t
+input     :: Ord t =>  [t]     -> Input t
+inputMany :: Ord t => [[t]]    -> Input t
+
+instance Show t => Show (Input t) where
+    show input = "makeInput " ++ show (inputEdges input)
+
+----------
+
+makeInput inEdges  | null inEdges = input []
+		   | otherwise    = MkInput inEdges inBounds inFrom inTo inToken
+    where inBounds = foldr1 minmax [ (i, j) | Edge i j _ <- inEdges ]
+	      where minmax (a, b) (a', b') = (min a a', max b b')
+	  inFrom   = fmap (accumAssoc id) $ accumArray (<++>) [] inBounds $
+		     [ (i, [(tok, j)]) | Edge i j tok <- inEdges ]
+	  inTo     = fmap (accumAssoc id) $ accumArray (<++>) [] inBounds
+		     [ (j, [(tok, i)]) | Edge i j tok <- inEdges ]
+	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
+
+input toks         = MkInput inEdges inBounds inFrom inTo inToken
+    where inEdges  = zipWith3 Edge [0..] [1..] toks
+	  inBounds = (0, length toks)
+	  inFrom   = listArray inBounds $
+		     [ listAssoc [(tok, [j])] | (tok, j) <- zip toks [1..] ] ++ [ listAssoc [] ]
+	  inTo     = listArray inBounds $
+		     [ listAssoc [] ] ++ [ listAssoc [(tok, [i])] | (tok, i) <- zip toks [0..] ]
+	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
+
+inputMany toks     = MkInput inEdges inBounds inFrom inTo inToken
+    where inEdges  = [ Edge i j t | (i, j, ts) <- zip3 [0..] [1..] toks, t <- ts ]
+	  inBounds = (0, length toks)
+	  inFrom   = listArray inBounds $
+		     [ listAssoc [ (t, [j]) | t <- nubsort ts ] | (ts, j) <- zip toks [1..] ]
+		     ++ [ listAssoc [] ]
+	  inTo     = listArray inBounds $
+		     [ listAssoc [] ] ++ 
+		     [ listAssoc [ (t, [i]) | t <- nubsort ts ] | (ts, i) <- zip toks [0..] ]
+	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
+
+
+------------------------------------------------------------
+-- * 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
+
+-- better(?) representation of forests:
+-- data Forest n = F (SMap n (SList [Forest n])) Bool
+-- ==
+-- type Forest n = GeneralTrie n (SList [Forest n]) Bool
+-- (the Bool == isMeta)
+
+-- ** 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"
+
+{- måste tänka mer på detta:
+compactForests :: Ord n => [SyntaxForest n] -> SList (SyntaxForest n)
+compactForests = map joinForests . groupBy eqNames . sortForests
+    where eqNames f g    = forestName f == forestName g
+	  sortForests    = foldMerge mergeForests [] . map return 
+	  mergeForests [] gs = gs
+	  mergeForests fs [] = fs
+	  mergeForests fs@(f:fs') gs@(g:gs') 
+	      = case forestName f `compare` forestName g of
+		  LT ->     f : mergeForests fs' gs
+		  GT ->     g : mergeForests fs  gs'
+		  EQ -> f : g : mergeForests fs' gs'
+	  joinForests fs = case forestName (head fs) of
+			     Nothing   -> FMeta
+			     Just name -> FNode name $
+					  compactDaughters $
+					  concat [ fss | FNode _ fss <- fs ]
+	  compactDaughters fss = case head fss of
+				   []  -> [[]]
+				   [_] -> map return $ compactForests $ concat fss
+				   _   -> nubsort fss
+-}
+
+-- ** syntax trees
+
+data SyntaxTree n = TMeta
+                  | TNode n [SyntaxTree n]
+                  | TString  String
+                  | TInt     Integer
+                  | TFloat   Double
+		  deriving (Eq, Ord, Show)
+
+instance Functor SyntaxTree where
+    fmap f (TNode n trees) = TNode (f n) $ map (fmap f) trees
+    fmap _ (TString s)     = TString s
+    fmap _ (TInt    n)     = TInt    n
+    fmap _ (TFloat  f)     = TFloat  f
+    fmap _ (TMeta)         = TMeta 
+
+treeName :: SyntaxTree n -> Maybe n
+treeName (TNode n _) = Just n
+treeName (TMeta)     = Nothing
+
+unifyManyTrees :: (Monad m, Eq n) => [SyntaxTree n] -> m (SyntaxTree n)
+unifyManyTrees = foldM unifyTrees TMeta
+
+-- | two trees can be unified, if either is 'TMeta', 
+-- or both have the same parent, and their children can be unified
+unifyTrees :: (Monad m, Eq n) => SyntaxTree n -> SyntaxTree n -> m (SyntaxTree n)
+unifyTrees TMeta tree = return tree
+unifyTrees tree TMeta = return tree
+unifyTrees (TNode name1 children1) (TNode name2 children2)
+    | name1 == name2 && sameLength children1 children2 
+	= liftM (TNode name1) $ zipWithM unifyTrees children1 children2 
+unifyTrees (TString s1) (TString s2)
+    | s1 == s2 = return (TString s1)
+unifyTrees (TInt n1) (TInt n2)
+    | n1 == n2 = return (TInt n1)
+unifyTrees (TFloat f1) (TFloat f2)
+    | f1 == f2 = return (TFloat f1)
+unifyTrees _ _ = fail "tree 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
+	      -> SList (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
+
+-- simplest implementation
+
+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
+
+{- -before AR inserted peb's patch 8/7/2007, this was:
+
+chart2forests chart isMeta  = concatMap edge2forests
+    where edge2forests edge = if isMeta edge then [FMeta]
+			      else map item2forest $ chart ? edge
+	  item2forest (SMeta)               = FMeta
+	  item2forest (SNode name children) = FNode name $ children >>= mapM edge2forests
+	  item2forest (SString s)           = FString s
+	  item2forest (SInt    n)           = FInt    n
+	  item2forest (SFloat  f)           = FFloat  f
+	  
+-}
+
+{-
+-- more intelligent(?) implementation,
+-- requiring that charts and forests are sorted maps and sorted sets
+chart2forests chart isMeta = es2fs
+    where e2fs  e  = if isMeta e then [FMeta] else map i2f $ chart ? e
+	  es2fs es = if null metas then fs else FMeta : fs
+	      where (metas, nonMetas) = splitBy isMeta es
+		    fs = map i2f $ unionMap (<++>) $ map (chart ?) nonMetas
+	  i2f (name, children) = FNode name $ 
+				 case head children of
+				   []  -> [[]]
+				   [_] -> map return $ es2fs $ concat children
+				   _   -> children >>= mapM e2fs
+-}
+
+
+forest2trees :: SyntaxForest n -> SList (SyntaxTree n)
+forest2trees (FNode n forests) = map (TNode n) $ forests >>= mapM forest2trees
+forest2trees (FString s) = [TString s]
+forest2trees (FInt    n) = [TInt    n]
+forest2trees (FFloat  f) = [TFloat  f]
+forest2trees (FMeta)     = [TMeta]
+
+----------------------------------------------------------------------
+-- * profiles
+
+-- | Pairing a rule name with a profile
+data NameProfile a = Name a [Profile (SyntaxForest a)]
+		     deriving (Eq, Ord, Show)
+
+name2fun :: NameProfile a -> a
+name2fun (Name fun _) = fun
+
+-- | A profile is a simple representation of a function on a number of arguments.
+-- We only use lists of profiles
+data Profile a = Unify [Int] -- ^ The Int's are the argument positions.
+			     -- 'Unify []' will become a metavariable,
+			     -- 'Unify [a,b]' means that the arguments are equal,
+	       | Constant a
+		 deriving (Eq, Ord, Show)
+
+instance Functor Profile where
+    fmap f (Constant a) = Constant (f a)
+    fmap f (Unify xs)   = Unify xs
+
+-- | a function name where the profile does not contain arguments 
+-- (i.e. denoting a constant, not a function)
+constantNameToForest :: NameProfile a -> SyntaxForest a
+constantNameToForest name@(Name fun profile) = FNode fun [map unConstant profile] 
+    where unConstant (Constant a) = a
+	  unConstant (Unify [])   = FMeta
+	  unConstant _ = error $ "constantNameToForest: the profile should not contain arguments"
+
+-- | profile application; we need some way of unifying a list of arguments
+applyProfile :: ([b] -> a) -> [Profile a] -> [b] -> [a]
+applyProfile unify profile args = map apply profile
+    where apply (Unify xs)  = unify $ map (args !!) xs
+	  apply (Constant a) = a
+
+-- | monadic profile application
+applyProfileM :: Monad m => ([b] -> m a) -> [Profile a] -> [b] -> m [a]
+applyProfileM unify profile args = mapM apply profile
+    where apply (Unify xs)  = unify $ map (args !!) xs
+	  apply (Constant a) = return a
+
+-- | profile composition: 
+-- 
+-- >   applyProfile u z (ps `composeProfiles` qs) args
+-- >      ==
+-- >   applyProfile u z ps (applyProfile u z qs args)
+--
+-- compare with function composition
+--
+-- >   (p . q) arg
+-- >      ==
+-- >   p (q arg)
+--
+-- Note that composing an 'Constant' with two or more arguments returns an error
+-- (since 'Unify' can only take arguments) -- this might change in the future, if there is a need.
+composeProfiles :: [Profile a] -> [Profile a] -> [Profile a]
+composeProfiles ps qs = map compose ps
+    where compose (Unify [x]) = qs !! x
+	  compose (Unify xs)  = Unify [ y | x <- xs, let Unify ys = qs !! x, y <- ys ]
+	  compose constant    = constant
+
+
+
+------------------------------------------------------------
+-- pretty-printing
+
+instance (Print c, Print t) => Print (Symbol c t) where
+    prt = symbol prt (simpleShow . prt)
+	where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
+	      mkEsc '\\' = "\\\\"
+	      mkEsc '\"' = "\\\""
+	      mkEsc '\n' = "\\n"
+	      mkEsc '\t' = "\\t"
+	      mkEsc chr  = [chr]
+    prtList = prtSep " "
+
+instance Print t => Print (Input t) where
+    prt input = "input " ++ prt (inputEdges input)
+
+instance (Print s) => Print (Edge s) where
+    prt (Edge i j s) = "[" ++ show i ++ "-" ++ show j ++ ": " ++ prt s ++ "]"
+    prtList = prtSep ""
+
+instance (Print s) => Print (SyntaxTree s) where
+    prt (TNode s trees)
+	| null trees = prt s
+	| otherwise  = "(" ++ prt s ++ prtBefore " " trees ++ ")"
+    prt (TString  s) = show s
+    prt (TInt     n) = show n
+    prt (TFloat   f) = show f
+    prt (TMeta)      = "?"
+    prtList = prtAfter "\n"
+
+instance (Print s) => Print (SyntaxForest s) where
+    prt (FNode s []) = "(" ++ prt s ++ " - ERROR: null forests)"
+    prt (FNode s [[]]) = prt s
+    prt (FNode s [forests]) = "(" ++ prt s ++ prtBefore " " forests ++ ")"
+    prt (FNode s children) = "{" ++ prtSep " | " [ prt s ++ prtBefore " " forests | 
+						   forests <- children ] ++ "}"
+    prt (FString s) = show s
+    prt (FInt    n) = show n
+    prt (FFloat  f) = show f
+    prt (FMeta)     = "?"
+    prtList = prtAfter "\n"
+
+instance Print a => Print (Profile a) where
+    prt (Unify [])   = "?"
+    prt (Unify args) = prtSep "=" args
+    prt (Constant a) = prt a
+
+instance Print a => Print (NameProfile a) where
+    prt (Name fun profile) = prt fun ++ prt profile
+
+
diff --git a/src-2.9/GF/Fudgets/ArchEdit.hs b/src-2.9/GF/Fudgets/ArchEdit.hs
new file mode 100644
index 000000000..5bc0dc84b
--- /dev/null
+++ b/src-2.9/GF/Fudgets/ArchEdit.hs
@@ -0,0 +1,30 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : (Module)
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:46:05 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Fudgets.ArchEdit (
+  fudlogueEdit, fudlogueWrite, fudlogueWriteUni
+ ) where
+
+import GF.Fudgets.CommandF
+import GF.Fudgets.UnicodeF
+
+-- architecture/compiler dependent definitions for unix/ghc, if Fudgets works.
+-- If not, use the modules in for-ghci
+
+fudlogueEdit font = fudlogueEditF ----
+fudlogueWrite = fudlogueWriteU
+fudlogueWriteUni _ _ = do
+  putStrLn "sorry no unicode available in ghc"
+
+
diff --git a/src-2.9/GF/Fudgets/CommandF.hs b/src-2.9/GF/Fudgets/CommandF.hs
new file mode 100644
index 000000000..15af12215
--- /dev/null
+++ b/src-2.9/GF/Fudgets/CommandF.hs
@@ -0,0 +1,134 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CommandF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:15 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- a graphical shell for any kind of GF with Zipper editing. AR 20\/8\/2001
+-----------------------------------------------------------------------------
+
+module GF.Fudgets.CommandF where
+
+import GF.Data.Operations
+
+import GF.UseGrammar.Session
+import GF.Shell.Commands
+
+import Fudgets
+import GF.Fudgets.FudgetOps
+
+import GF.Fudgets.EventF
+
+-- a graphical shell for any kind of GF with Zipper editing. AR 20/8/2001
+
+fudlogueEditF :: CEnv -> IO ()
+fudlogueEditF env = 
+  fudlogue $ gfSizeP $ shellF ("GF 2.0- Fudget Editor") (gfF env)
+
+gfF env = nameLayoutF gfLayout $ (gfOutputF env >==< gfCommandF env) >+< quitButF
+
+( quitN : menusN : newN : transformN : filterN : displayN :
+  navigateN : viewN : outputN : saveN : _) = map show [1..]
+
+gfLayout = placeNL verticalP [generics,output,navigate,menus,transform]
+  where
+    generics  = placeNL horizontalP (map leafNL 
+                           [newN,saveN,viewN,displayN,filterN,quitN])
+    output    = leafNL outputN
+    navigate  = leafNL navigateN
+    menus     = leafNL menusN
+    transform = leafNL transformN
+ 
+gfSizeP = spacerF (sizeS (Point 720 640))
+
+gfOutputF env = 
+  ((nameF outputN $ (writeFileF >+< textWindowF)) 
+     >==< 
+   (absF (saveSP "EMPTY") 
+                        >==< 
+    (nameF saveN (popupStringInputF "Save" "foo.tmp" "Save to file:")
+         >+<  
+      mapF (displayJustStateIn env))))
+   >==< 
+  mapF Right 
+
+gfCommandF :: CEnv -> F () SState
+gfCommandF env = loopCommandsF env >==< getCommandsF env >==< mapF (\_ -> Click)
+
+loopCommandsF :: CEnv -> F Command SState
+loopCommandsF env = loopThroughRightF (mapGfStateF env) (mkMenusF env)
+
+mapGfStateF :: CEnv -> F (Either Command Command) (Either SState SState)
+mapGfStateF env = mapstateF execFC (initSState) where
+  execFC e0 (Left  c) = (e,[Right e,Left e]) where e = execECommand env c e0
+  execFC e0 (Right c) = (e,[Left e,Right e]) where e = execECommand env c e0
+
+mkMenusF :: CEnv -> F SState Command
+mkMenusF env = 
+  nameF menusN $
+  labAboveF "Select Action on Subterm" 
+            (mapF fst >==< smallPickListF snd >==< mapF (mkRefineMenu env))
+
+getCommandsF env = 
+    newF env     >*<
+    viewF        >*<
+    menuDisplayF env >*<
+    filterF      >*<
+    navigateF    >*<
+    transformF
+
+key2command ((key,_),_) = case key of
+     "Up"    -> CBack 1
+     "Down"  -> CAhead 1
+     "Left"  -> CPrevMeta
+     "Right" -> CNextMeta
+     "space" -> CTop
+
+     "d"     -> CDelete
+     "u"     -> CUndo
+     "v"     -> CView
+
+     _ -> CVoid
+
+transformF =
+  nameF transformN $
+  mapF (either key2command id) >==< (keyboardF $
+  placerF horizontalP $
+  cPopupStringInputF CRefineParse    "Parse" "" "Parse in concrete syntax" >*< 
+  --- to enable Unicode: ("Refine by parsing" `labLeftOfF` writeInputF)
+  cPopupStringInputF CRefineWithTree "Term" "" "Parse term"                >*<
+  cMenuF "Modify" termCommandMenu                                 	   >*<
+  cPopupStringInputF CAlphaConvert "Alpha" "x_0 x" "Alpha convert"         >*<  
+  cButtonF CRefineRandom "Random"                                          >*<
+  cButtonF CUndo "Undo"
+  )
+
+quitButF = nameF quitN $ quitF >==< buttonF "Quit"
+
+newF env = nameF newN     $ cMenuF "New"    (newCatMenu env)
+menuDisplayF env = nameF displayN $ cMenuF "Menus" $ displayCommandMenu env
+filterF  = nameF filterN  $ cMenuF "Filter" stringCommandMenu
+
+viewF = nameF viewN $ cButtonF CView "View"
+
+navigateF =
+  nameF navigateN $
+  placerF horizontalP $
+  cButtonF CPrevMeta  "?<"    >*<
+  cButtonF (CBack 1)  "<"     >*<
+  cButtonF CTop       "Top"   >*<
+  cButtonF CLast      "Last"  >*<
+  cButtonF (CAhead 1) ">"     >*<
+  cButtonF CNextMeta  ">?"
+
+cButtonF c s = mapF (const c) >==< buttonF s
+cMenuF s css = menuF s css >==< mapF (\_ -> CVoid)
+
+cPopupStringInputF comm lab def msg = 
+  mapF comm >==< popupStringInputF lab def msg >==< mapF (const [])
+
diff --git a/src-2.9/GF/Fudgets/EventF.hs b/src-2.9/GF/Fudgets/EventF.hs
new file mode 100644
index 000000000..7ea058dfa
--- /dev/null
+++ b/src-2.9/GF/Fudgets/EventF.hs
@@ -0,0 +1,51 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : EventF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:16 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Fudgets.EventF where
+import AllFudgets
+
+-- | The first string is the name of the key (e.g., "Down" for the down arrow key)
+--
+-- The modifiers list shift, control and alt keys that were active while the
+-- key was pressed.
+--
+-- The last string is the text produced by the key (for keys that produce
+-- printable characters, empty for control keys).
+type KeyPress = ((String,[Modifiers]),String)
+
+keyboardF :: F i o -> F i (Either KeyPress o)
+keyboardF fud = idRightSP (concatMapSP post) >^^=< oeventF mask fud
+  where
+    post (KeyEvent {type'=Pressed,keySym=sym,state=mods,keyLookup=s}) =
+       [((sym,mods),s)]
+    post _ = []
+
+    mask = [KeyPressMask,
+            EnterWindowMask, LeaveWindowMask -- because of CTT implementation
+	   ]
+
+-- | Output events:
+oeventF em fud =  eventF em (idLeftF fud)
+
+-- | Feed events to argument fudget:
+eventF eventmask = serCompLeftToRightF . groupF startcmds eventK
+  where
+    startcmds = [XCmd $ ChangeWindowAttributes [CWEventMask eventmask],
+	         XCmd $ ConfigureWindow [CWBorderWidth 0]]
+    eventK = K $ mapFilterSP route
+      where route = message low high
+            low (XEvt event) = Just (High (Left event))
+	    low _ = Nothing
+	    high h = Just (High (Right h))
+
diff --git a/src-2.9/GF/Fudgets/FudgetOps.hs b/src-2.9/GF/Fudgets/FudgetOps.hs
new file mode 100644
index 000000000..4aba5eec5
--- /dev/null
+++ b/src-2.9/GF/Fudgets/FudgetOps.hs
@@ -0,0 +1,59 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : FudgetOps
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:17 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- auxiliary Fudgets for GF syntax editor
+-----------------------------------------------------------------------------
+
+module GF.Fudgets.FudgetOps where
+
+import Fudgets
+
+-- save and display
+
+showAndSaveF fud = (writeFileF >+< textWindowF) >==< saveF fud
+
+saveF :: F a String -> F (Either String a) (Either (String,String) String)
+saveF fud = 
+  absF (saveSP "EMPTY") 
+    >==< 
+  (popupStringInputF "Save" "foo.tmp" "Save to file:" >+< fud)
+
+saveSP :: String -> SP (Either String String) (Either (String,String) String)
+saveSP contents = getSP $ \msg -> case msg of
+  Left  file   -> putSP (Left (file,contents)) (saveSP contents)
+  Right string -> putSP (Right string)         (saveSP string)
+
+textWindowF = writeOutputF
+
+-- | to replace stringInputF by a pop-up slot behind a button
+popupStringInputF :: String -> String -> String -> F String String
+popupStringInputF label deflt msg =
+  mapF snd 
+      >==<
+  (popupSizeP $ stringPopupF deflt)
+      >==<
+  mapF (\_ -> (Just msg,Nothing)) 
+      >==<
+  decentButtonF label
+      >==<
+  mapF (\_ -> Click)
+
+decentButtonF = spacerF (sizeS (Point 80 20)) . buttonF
+
+popupSizeP = spacerF (sizeS (Point 240 100))
+
+--- the Unicode stuff should be inserted here
+
+writeOutputF = moreF >==< mapF lines
+
+writeInputF = stringInputF
+
+
diff --git a/src-2.9/GF/Fudgets/UnicodeF.hs b/src-2.9/GF/Fudgets/UnicodeF.hs
new file mode 100644
index 000000000..024205698
--- /dev/null
+++ b/src-2.9/GF/Fudgets/UnicodeF.hs
@@ -0,0 +1,37 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : UnicodeF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:17 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Fudgets.UnicodeF (fudlogueWriteU) where
+import Fudgets
+
+import GF.Data.Operations
+import GF.Text.Unicode
+
+-- AR 12/4/2000, 18/9/2001 (added font parameter)
+
+fudlogueWriteU :: String -> (String -> String) -> IO ()
+fudlogueWriteU fn trans = 
+  fudlogue $
+  shellF "GF Unicode Output" (writeF fn trans >+< quitButtonF)
+
+writeF fn trans = writeOutputF fn >==< mapF trans >==< writeInputF fn
+
+displaySizeP = placerF (spacerP (sizeS (Point 440 500)) verticalP)
+
+writeOutputF fn = moreF' (setFont fn) >==< justWriteOutputF
+
+justWriteOutputF = mapF (map (wrapLines 0) . filter (/=[]) . map mkUnicode . lines)
+
+writeInputF fn = stringInputF' (setShowString mkUnicode . setFont fn)
+
diff --git a/src-2.9/GF/GFCC/API.hs b/src-2.9/GF/GFCC/API.hs
new file mode 100644
index 000000000..c266a5553
--- /dev/null
+++ b/src-2.9/GF/GFCC/API.hs
@@ -0,0 +1,140 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GFCCAPI
+-- Maintainer  : Aarne Ranta
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 
+-- > CVS $Author: 
+-- > CVS $Revision: 
+--
+-- Reduced Application Programmer's Interface to GF, meant for
+-- embedded GF systems. AR 19/9/2007
+-----------------------------------------------------------------------------
+
+module  GF.GFCC.API where
+
+import GF.GFCC.Linearize
+import GF.GFCC.Generate
+import GF.GFCC.Macros
+import GF.GFCC.DataGFCC
+import GF.GFCC.CId
+import GF.GFCC.Raw.ConvertGFCC
+import GF.GFCC.Raw.ParGFCCRaw
+import GF.Command.PPrTree
+
+import GF.Data.ErrM
+
+import GF.Parsing.FCFG
+
+--import GF.Data.Operations
+--import GF.Infra.UseIO
+import qualified Data.Map as Map
+import System.Random (newStdGen)
+import System.Directory (doesFileExist)
+
+
+-- This API is meant to be used when embedding GF grammars in Haskell 
+-- programs. The embedded system is supposed to use the
+-- .gfcc grammar format, which is first produced by the gf program.
+
+---------------------------------------------------
+-- Interface
+---------------------------------------------------
+
+data MultiGrammar = MultiGrammar {gfcc :: GFCC}
+type Language     = String
+type Category     = String
+type Tree         = Exp
+
+file2grammar :: FilePath -> IO MultiGrammar
+
+linearize    :: MultiGrammar -> Language -> Tree -> String
+parse        :: MultiGrammar -> Language -> Category -> String -> [Tree]
+
+linearizeAll     :: MultiGrammar -> Tree -> [String]
+linearizeAllLang :: MultiGrammar -> Tree -> [(Language,String)]
+
+parseAll     :: MultiGrammar -> Category -> String -> [[Tree]]
+parseAllLang :: MultiGrammar -> Category -> String -> [(Language,[Tree])]
+
+generateAll      :: MultiGrammar -> Category -> [Tree]
+generateRandom   :: MultiGrammar -> Category -> IO [Tree]
+generateAllDepth :: MultiGrammar -> Category -> Maybe Int -> [Tree]
+
+readTree   :: MultiGrammar -> String -> Tree
+showTree   ::                 Tree -> String
+
+languages  :: MultiGrammar -> [Language]
+categories :: MultiGrammar -> [Category]
+
+startCat   :: MultiGrammar -> Category
+
+---------------------------------------------------
+-- Implementation
+---------------------------------------------------
+
+file2grammar f = do
+  gfcc <- file2gfcc f
+  return (MultiGrammar gfcc)
+
+file2gfcc f = do
+  s <- readFileIf f
+  g <- parseGrammar s
+  return $ toGFCC g
+
+linearize mgr lang = GF.GFCC.Linearize.linearize (gfcc mgr) (CId lang)
+
+parse mgr lang cat s = 
+  case lookParser (gfcc mgr) (CId lang) of
+    Nothing    -> error "no parser"
+    Just pinfo -> case parseFCF "bottomup" pinfo (CId cat) (words s) of
+                    Ok x -> x
+                    Bad s -> error s
+
+linearizeAll mgr = map snd . linearizeAllLang mgr
+linearizeAllLang mgr t = 
+  [(lang,linearThis 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)]
+
+generateRandom mgr cat = do
+  gen <- newStdGen
+  return $ genRandom gen (gfcc mgr) (CId cat)
+
+generateAll mgr cat = generate (gfcc mgr) (CId cat) Nothing
+generateAllDepth mgr cat = generate (gfcc mgr) (CId cat)
+
+readTree _ = pTree
+
+showTree = prExp
+
+prIdent :: CId -> String
+prIdent (CId s) = s
+
+abstractName mgr = prIdent (absname (gfcc mgr))
+
+languages mgr = [l | CId l <- cncnames (gfcc mgr)]
+
+categories mgr = [c | CId c <- Map.keys (cats (abstract (gfcc mgr)))]
+
+startCat mgr = lookStartCat (gfcc mgr)
+
+emptyMultiGrammar = MultiGrammar emptyGFCC
+
+------------ for internal use only
+
+linearThis = GF.GFCC.API.linearize
+
+err f g ex = case ex of
+  Ok x -> g x
+  Bad s -> f s
+
+readFileIf f = do
+  b <- doesFileExist f
+  if b then readFile f 
+       else putStrLn ("file " ++ f ++ " not found") >> return ""
diff --git a/src-2.9/GF/GFCC/CId.hs b/src-2.9/GF/GFCC/CId.hs
new file mode 100644
index 000000000..e4efa98ba
--- /dev/null
+++ b/src-2.9/GF/GFCC/CId.hs
@@ -0,0 +1,14 @@
+module GF.GFCC.CId (
+  module GF.GFCC.Raw.AbsGFCCRaw,
+  prCId,
+  cId
+  ) where
+
+import GF.GFCC.Raw.AbsGFCCRaw (CId(CId))
+
+prCId :: CId -> String
+prCId (CId s) = s
+
+cId :: String -> CId
+cId = CId
+
diff --git a/src-2.9/GF/GFCC/CheckGFCC.hs b/src-2.9/GF/GFCC/CheckGFCC.hs
new file mode 100644
index 000000000..d59dba1a9
--- /dev/null
+++ b/src-2.9/GF/GFCC/CheckGFCC.hs
@@ -0,0 +1,186 @@
+module GF.GFCC.CheckGFCC (checkGFCC, checkGFCCio, checkGFCCmaybe) where
+
+import GF.GFCC.CId
+import GF.GFCC.Macros
+import GF.GFCC.DataGFCC
+import GF.Data.ErrM
+
+import qualified Data.Map as Map
+import Control.Monad
+import Debug.Trace
+
+checkGFCCio :: GFCC -> IO GFCC
+checkGFCCio gfcc = case checkGFCC gfcc of
+  Ok (gc,b) -> do 
+    putStrLn $ if b then "OK" else "Corrupted GFCC"
+    return gc
+  Bad s -> do
+    putStrLn s
+    error "building GFCC failed"
+
+---- needed in old Custom
+checkGFCCmaybe :: GFCC -> Maybe GFCC
+checkGFCCmaybe gfcc = case checkGFCC gfcc of
+  Ok (gc,b) -> return gc 
+  Bad s -> Nothing
+
+checkGFCC :: GFCC -> Err (GFCC,Bool)
+checkGFCC gfcc = do
+  (cs,bs) <- mapM (checkConcrete gfcc) 
+               (Map.assocs (concretes gfcc)) >>= return . unzip
+  return (gfcc {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 :: GFCC -> (CId,Concr) -> Err ((CId,Concr),Bool)
+checkConcrete gfcc (lang,cnc) = 
+  labelBoolErr ("happened in language " ++ printCId lang) $ do
+    (rs,bs) <- mapM checkl (Map.assocs (lins cnc)) >>= return . unzip
+    return ((lang,cnc{lins = Map.fromAscList rs}),and bs)
+ where
+   checkl = checkLin gfcc lang
+
+checkLin :: GFCC -> CId -> (CId,Term) -> Err ((CId,Term),Bool)
+checkLin gfcc lang (f,t) = 
+  labelBoolErr ("happened in function " ++ printCId f) $ do
+    (t',b) <- checkTerm (lintype gfcc lang f) t --- $ inline gfcc 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 :: GFCC -> CId -> CId -> LinType
+lintype gfcc lang fun = case typeSkeleton (lookType gfcc fun) of
+  (cs,c) -> (map vlinc cs, linc c) ---- HOAS
+ where 
+   linc = lookLincat gfcc lang
+   vlinc (0,c) = linc c
+   vlinc (i,c) = case linc c of
+     R ts -> R (ts ++ replicate i str)
+
+inline :: GFCC -> CId -> Term -> Term
+inline gfcc lang t = case t of
+  F c -> inl $ look c
+  _ -> composSafeOp inl t
+ where
+  inl  = inline gfcc lang
+  look = lookLin gfcc 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-2.9/GF/GFCC/ComposOp.hs b/src-2.9/GF/GFCC/ComposOp.hs
new file mode 100644
index 000000000..de2522bc7
--- /dev/null
+++ b/src-2.9/GF/GFCC/ComposOp.hs
@@ -0,0 +1,30 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+module GF.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-2.9/GF/GFCC/DataGFCC.hs b/src-2.9/GF/GFCC/DataGFCC.hs
new file mode 100644
index 000000000..077d62b19
--- /dev/null
+++ b/src-2.9/GF/GFCC/DataGFCC.hs
@@ -0,0 +1,152 @@
+module GF.GFCC.DataGFCC where
+
+import GF.GFCC.CId
+import GF.Infra.CompactPrint
+import GF.Text.UTF8
+import GF.Formalism.FCFG
+import GF.Parsing.FCFG.PInfo
+
+import Data.Map
+import Data.List
+
+-- internal datatypes for GFCC
+
+data GFCC = GFCC {
+  absname   :: CId ,
+  cncnames  :: [CId] ,
+  gflags    :: Map CId String,   -- value of a global flag
+  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 to a cat (redundant, for fast lookup)
+  }
+
+data Concr = Concr {
+  cflags  :: 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
+  paramlincats :: Map CId Term, -- lin type of cat, with printable param names
+  parser  :: Maybe FCFPInfo     -- parser
+  }
+
+data Type =
+   DTyp [Hypo] CId [Exp]
+  deriving (Eq,Ord,Show)
+
+data Exp =
+   DTr [CId] Atom [Exp]
+ | EEq [Equation]
+  deriving (Eq,Ord,Show)
+
+data Atom =
+   AC CId
+ | AS String
+ | AI Integer
+ | AF Double
+ | AM Integer
+ | AV CId
+  deriving (Eq,Ord,Show)
+
+data Term =
+   R [Term]
+ | P Term Term
+ | S [Term]
+ | K Tokn
+ | V Int
+ | C Int
+ | F CId
+ | FV [Term]
+ | W String Term
+ | TM String
+ | RP Term Term
+  deriving (Eq,Ord,Show)
+
+data Tokn =
+   KS String
+ | KP [String] [Variant]
+  deriving (Eq,Ord,Show)
+
+data Variant =
+   Var [String] [String]
+  deriving (Eq,Ord,Show)
+
+data Hypo =
+   Hyp CId Type
+  deriving (Eq,Ord,Show)
+
+data Equation =
+   Equ [Exp] Exp
+  deriving (Eq,Ord,Show)
+
+-- print statistics
+
+statGFCC :: GFCC -> String
+statGFCC gfcc = unlines [
+  "Abstract\t" ++ pr (absname gfcc), 
+  "Concretes\t" ++ unwords (lmap pr (cncnames gfcc)), 
+  "Categories\t" ++ unwords (lmap pr (keys (cats (abstract gfcc)))) 
+  ]
+ where pr (CId s) = s
+
+printCId :: CId -> String
+printCId (CId s) = s
+
+-- merge two GFCCs; fails is differens absnames; priority to second arg
+
+unionGFCC :: GFCC -> GFCC -> GFCC
+unionGFCC one two = case absname one of
+  CId "" -> two                  -- extending empty grammar
+  n | n == absname two -> one {  -- extending grammar with same abstract
+      concretes = Data.Map.union (concretes two) (concretes one),
+      cncnames  = Data.List.union (cncnames two) (cncnames one)
+    }
+  _ -> one   -- abstracts don't match ---- print error msg
+
+emptyGFCC :: GFCC
+emptyGFCC = GFCC {
+  absname   = CId "",
+  cncnames  = [] ,
+  gflags    = empty,
+  abstract  = error "empty grammar, no abstract",
+  concretes = empty
+  }
+
+-- default map and filter are for Map here
+lmap = Prelude.map
+lfilter = Prelude.filter
+mmap = Data.Map.map
+
+-- encode idenfifiers and strings in UTF8
+
+utf8GFCC :: GFCC -> GFCC
+utf8GFCC gfcc = gfcc {
+  concretes = mmap u8concr (concretes gfcc)
+  }
+ where 
+   u8concr cnc = cnc {
+     lins = mmap u8term (lins cnc),
+     opers = mmap 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 $ lmap convs ts
+  S ts     -> S $ lmap convs ts
+  FV ts    -> FV $ lmap convs ts
+  P u v    -> P (convs u) (convs v)
+  _        -> t
+ where
+  convs = convertStringsInTerm conv
+
diff --git a/src-2.9/GF/GFCC/GFCC.cf b/src-2.9/GF/GFCC/GFCC.cf
new file mode 100644
index 000000000..96d68649b
--- /dev/null
+++ b/src-2.9/GF/GFCC/GFCC.cf
@@ -0,0 +1,81 @@
+Grm. Grammar  ::= 
+  "grammar" CId "(" [CId] ")" "(" [Flag] ")" ";" 
+  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]
+     "param"  [LinDef]     -- lincats with param value names
+  "}" ;
+
+Flg. Flag     ::= CId "=" String ;
+Cat. CatDef   ::= CId "[" [Hypo] "]" ;
+
+Fun. FunDef   ::= CId ":" Type "=" Exp ;
+Lin. LinDef   ::= CId "=" Term ;
+
+DTyp. Type    ::= "[" [Hypo] "]" CId [Exp] ;         -- dependent type
+DTr.  Exp     ::= "[" "(" [CId] ")" Atom [Exp] "]" ; -- term with bindings
+
+AC.   Atom     ::= CId ;
+AS.   Atom     ::= String ;
+AI.   Atom     ::= Integer ;
+AF.   Atom     ::= Double ;
+AM.   Atom     ::= "?" Integer ;
+
+R.   Term     ::= "[" [Term] "]" ;          -- record/table
+P.   Term     ::= "(" Term "!" Term ")" ;   -- projection/selection
+S.   Term     ::= "(" [Term] ")" ;          -- concatenated sequence
+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
+TM.  Term     ::= "?" ;                     -- lin of metavariable
+
+KS.  Tokn     ::= String ;
+KP.  Tokn     ::= "[" "pre" [String] "[" [Variant] "]" "]" ;
+Var. Variant  ::= [String] "/" [String] ;
+
+
+RP.  Term     ::= "(" Term "@" Term ")";    -- DEPRECATED: record parameter alias
+
+terminator Concrete ";" ;
+terminator Flag ";" ;
+terminator CatDef ";" ;
+terminator FunDef ";" ;
+terminator LinDef ";" ;
+separator  CId "," ;
+separator  Term "," ;
+terminator Exp "" ;
+terminator String "" ;
+separator  Variant "," ;
+
+token CId (('_' | letter) (letter | digit | '\'' | '_')*) ;
+
+
+-- the following are needed if dependent types or HOAS or defs are present
+
+Hyp. Hypo     ::= CId ":" Type ;
+AV.  Atom     ::= "$" CId ;
+
+EEq. Exp      ::= "{" [Equation] "}" ;  -- list of pattern eqs; primitive: []
+Equ. Equation ::= [Exp] "->" Exp ;      -- patterns are encoded as exps
+
+separator  Hypo "," ;
+terminator Equation ";" ;
+
diff --git a/src-2.9/GF/GFCC/Generate.hs b/src-2.9/GF/GFCC/Generate.hs
new file mode 100644
index 000000000..63bdb3b9a
--- /dev/null
+++ b/src-2.9/GF/GFCC/Generate.hs
@@ -0,0 +1,70 @@
+module GF.GFCC.Generate where
+
+import GF.GFCC.Macros
+import GF.GFCC.DataGFCC
+import GF.GFCC.CId
+
+import qualified Data.Map as M
+import System.Random
+
+-- generate an infinite list of trees exhaustively
+generate :: GFCC -> CId -> Maybe Int -> [Exp]
+generate gfcc cat dp = concatMap (\i -> gener i cat) depths
+ where
+  gener 0 c = [tree (AC f) [] | (f, ([],_)) <- fns c]
+  gener i c = [
+    tr | 
+      (f, (cs,_)) <- fns c,
+      let alts = map (gener (i-1)) cs,
+      ts <- combinations alts,
+      let tr = tree (AC f) ts,
+      depth tr >= i
+    ]
+  fns c = [(f,catSkeleton ty) | (f,ty) <- functionsToCat gfcc c]
+  depths = maybe [0 ..] (\d -> [0..d]) dp
+
+-- generate an infinite list of trees randomly
+genRandom :: StdGen -> GFCC -> CId -> [Exp]
+genRandom gen gfcc 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 "String") = (tree (AS "foo") [], 1)
+    gett ds (CId "Int")    = (tree (AI 12345) [], 1)
+    gett [] _ = (tree (AS "TIMEOUT") [], 1) ----
+    gett ds cat = case fns cat of
+      [] -> (tree (AM 0) [],1)
+      fs -> let 
+          d:ds2    = ds
+          (f,args) = getf d fs
+          (ts,k)   = getts ds2 args
+        in (tree (AC 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 gfcc 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 -> GFCC -> CId -> [String] -> [Exp]
+searchParse i gfcc cat ws = [t | t <- gen, s <- lins t, words s == ws] where 
+  gen    = take i $ generate gfcc cat
+  lins t = [linearize gfcc lang t | lang <- cncnames gfcc]
+-}
diff --git a/src-2.9/GF/GFCC/LexGFCC.hs b/src-2.9/GF/GFCC/LexGFCC.hs
new file mode 100644
index 000000000..c86195e3d
--- /dev/null
+++ b/src-2.9/GF/GFCC/LexGFCC.hs
@@ -0,0 +1,349 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LINE 3 "GF/GFCC/LexGFCC.x" #-}
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.GFCC.LexGFCC 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\xeb\xff\xff\xff\x0b\x00\x00\x00\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\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x03\x00\x03\x00\xff\xff\x03\x00\x03\x00\x06\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\x05\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\x5d\x00\x3e\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 "GF/GFCC/LexGFCC.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 "lin" (b "flags" (b "cat" (b "abstract" N N) (b "concrete" N N)) (b "grammar" (b "fun" N N) N)) (b "param" (b "lindef" (b "lincat" N N) (b "oper" N N)) (b "printname" (b "pre" N 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" #-}
+
+
+
+
+
+
+
+
+
+
+
+
+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-2.9/GF/GFCC/Linearize.hs b/src-2.9/GF/GFCC/Linearize.hs
new file mode 100644
index 000000000..c66ff93c1
--- /dev/null
+++ b/src-2.9/GF/GFCC/Linearize.hs
@@ -0,0 +1,91 @@
+module GF.GFCC.Linearize where
+
+import GF.GFCC.Macros
+import GF.GFCC.DataGFCC
+import GF.GFCC.CId
+import Data.Map
+import Data.List
+
+import Debug.Trace
+
+-- linearization and computation of concrete GFCC Terms
+
+linearize :: GFCC -> CId -> Exp -> String
+linearize mcfg lang = realize . linExp mcfg lang
+
+realize :: Term -> String
+realize trm = case trm of
+  R ts     -> realize (ts !! 0)
+  S ss     -> unwords $ lmap realize ss
+  K t -> case t of
+    KS s -> s
+    KP s _ -> unwords s ---- prefix choice TODO
+  W s t    -> s ++ realize t
+  FV ts    -> realize (ts !! 0)  ---- other variants TODO
+  RP _ r   -> realize r ---- DEPREC
+  TM s     -> s
+  _ -> "ERROR " ++ show trm ---- debug
+
+linExp :: GFCC -> CId -> Exp -> Term
+linExp mcfg lang tree@(DTr xs at trees) =
+  addB $ case at of
+    AC fun -> comp (lmap lin trees) $ look fun
+    AS s   -> R [kks (show s)] -- quoted
+    AI i   -> R [kks (show i)] 
+                --- [C lst, kks (show i), C size] where 
+                --- lst = mod (fromInteger i) 10 ; size = if i < 10 then 0 else 1
+    AF d   -> R [kks (show d)]
+    AV x   -> TM (prCId x)
+    AM i   -> TM (show i)
+ where
+   lin  = linExp mcfg lang
+   comp = compute mcfg lang
+   look = lookLin mcfg lang
+   addB t 
+     | Data.List.null xs = t
+     | otherwise = case t of
+         R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs)
+         TM s -> R $ t : (Data.List.map (kks . prCId) xs)
+
+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)  ---- DEPREC
+    W s t  -> W s (comp t)
+    R ts   -> R $ lmap comp ts
+    V i    -> idx args i          -- already computed
+    F c    -> comp $ look c       -- not computed (if contains argvar)
+    FV ts  -> FV $ lmap comp ts
+    S ts   -> S $ lfilter (/= S []) $ lmap comp ts
+    _ -> trm
+
+  look = lookOper mcfg lang
+
+  idx xs i = if i > length xs - 1 
+    then trace 
+         ("too large " ++ show i ++ " for\n" ++ unlines (lmap show xs) ++ "\n") tm0 
+    else xs !! i 
+
+  proj r p = case (r,p) of
+    (_,     FV ts) -> FV $ lmap (proj r) ts
+    (FV ts, _    ) -> FV $ lmap (\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
+    RP p _ -> getIndex p ---- DEPREC
+    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
+    RP _ r -> getField r i ---- DEPREC
+    TM s   -> TM s
+    _ -> error ("ERROR in grammar compiler: field from " ++ show t) t
+
diff --git a/src-2.9/GF/GFCC/Macros.hs b/src-2.9/GF/GFCC/Macros.hs
new file mode 100644
index 000000000..4897aa667
--- /dev/null
+++ b/src-2.9/GF/GFCC/Macros.hs
@@ -0,0 +1,121 @@
+module GF.GFCC.Macros where
+
+import GF.GFCC.CId
+import GF.GFCC.DataGFCC
+import GF.Formalism.FCFG (FGrammar)
+import GF.Parsing.FCFG.PInfo (FCFPInfo, fcfPInfoToFGrammar)
+----import GF.GFCC.PrintGFCC
+import Control.Monad
+import Data.Map
+import Data.Maybe
+import Data.List
+
+-- operations for manipulating GFCC grammars and objects
+
+lookLin :: GFCC -> CId -> CId -> Term
+lookLin gfcc lang fun = 
+  lookMap tm0 fun $ lins $ lookMap (error "no lang") lang $ concretes gfcc
+
+lookOper :: GFCC -> CId -> CId -> Term
+lookOper gfcc lang fun = 
+  lookMap tm0 fun $ opers $ lookMap (error "no lang") lang $ concretes gfcc
+
+lookLincat :: GFCC -> CId -> CId -> Term
+lookLincat gfcc lang fun = 
+  lookMap tm0 fun $ lincats $ lookMap (error "no lang") lang $ concretes gfcc
+
+lookParamLincat :: GFCC -> CId -> CId -> Term
+lookParamLincat gfcc lang fun = 
+  lookMap tm0 fun $ paramlincats $ lookMap (error "no lang") lang $ concretes gfcc
+
+lookType :: GFCC -> CId -> Type
+lookType gfcc f = 
+  fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract gfcc))
+
+lookParser :: GFCC -> CId -> Maybe FCFPInfo
+lookParser gfcc lang = parser $ lookMap (error "no lang") lang $ concretes gfcc
+
+lookFCFG :: GFCC -> CId -> Maybe FGrammar
+lookFCFG gfcc lang = fmap fcfPInfoToFGrammar $ lookParser gfcc lang
+
+lookStartCat :: GFCC -> String
+lookStartCat gfcc = fromMaybe "S" $ msum $ Data.List.map (Data.Map.lookup (CId "startcat"))
+                                              [gflags gfcc, aflags (abstract gfcc)]
+
+lookGlobalFlag :: GFCC -> CId -> String
+lookGlobalFlag gfcc f = 
+  lookMap "?" f (gflags gfcc)
+
+lookAbsFlag :: GFCC -> CId -> String
+lookAbsFlag gfcc f = 
+  lookMap "?" f (aflags (abstract gfcc))
+
+lookCncFlag :: GFCC -> CId -> CId -> String
+lookCncFlag gfcc lang f = 
+  lookMap "?" f $ cflags $ lookMap (error "no lang") lang $ concretes gfcc
+
+functionsToCat :: GFCC -> CId -> [(CId,Type)]
+functionsToCat gfcc cat =
+  [(f,ty) | f <- fs, Just (ty,_) <- [Data.Map.lookup f $ funs $ abstract gfcc]]
+ where 
+   fs = lookMap [] cat $ catfuns $ abstract gfcc
+
+depth :: Exp -> Int
+depth tr = case tr of
+  DTr _ _ [] -> 1
+  DTr _ _ ts -> maximum (lmap depth ts) + 1
+
+tree :: Atom -> [Exp] -> Exp
+tree = DTr []
+
+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
+
+cid :: String -> CId
+cid = CId
+
+wildCId :: CId
+wildCId = cid "_"
+
+exp0 :: Exp
+exp0 = tree (AM 0) []
+
+primNotion :: Exp
+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 i a -> a 
+lookMap d c m = maybe d id $ Data.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-2.9/GF/GFCC/OptimizeGFCC.hs b/src-2.9/GF/GFCC/OptimizeGFCC.hs
new file mode 100644
index 000000000..394458041
--- /dev/null
+++ b/src-2.9/GF/GFCC/OptimizeGFCC.hs
@@ -0,0 +1,116 @@
+module GF.GFCC.OptimizeGFCC where
+
+import GF.GFCC.CId
+import GF.GFCC.DataGFCC
+
+import GF.Data.Operations
+
+import Data.List
+import qualified Data.Map as Map
+
+
+-- back-end optimization: 
+-- suffix analysis followed by common subexpression elimination
+
+optGFCC :: GFCC -> GFCC
+optGFCC gfcc = gfcc {
+  concretes = Map.map opt (concretes gfcc)
+  }
+ where 
+  opt cnc = subex $ cnc {
+    lins = Map.map optTerm (lins cnc),
+    lindefs = Map.map optTerm (lindefs cnc),
+    printnames = Map.map optTerm (printnames cnc)
+  }
+
+-- 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 = errVal cnc $ 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 = CId $ "_" ++ 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-2.9/GF/GFCC/Raw/AbsGFCCRaw.hs b/src-2.9/GF/GFCC/Raw/AbsGFCCRaw.hs
new file mode 100644
index 000000000..ab5f184a8
--- /dev/null
+++ b/src-2.9/GF/GFCC/Raw/AbsGFCCRaw.hs
@@ -0,0 +1,17 @@
+module GF.GFCC.Raw.AbsGFCCRaw where
+
+-- Haskell module generated by the BNF converter
+
+newtype CId = CId String deriving (Eq,Ord,Show)
+data Grammar =
+   Grm [RExp]
+  deriving (Eq,Ord,Show)
+
+data RExp =
+   App CId [RExp]
+ | AInt Integer
+ | AStr String
+ | AFlt Double
+ | AMet
+  deriving (Eq,Ord,Show)
+
diff --git a/src-2.9/GF/GFCC/Raw/ConvertGFCC.hs b/src-2.9/GF/GFCC/Raw/ConvertGFCC.hs
new file mode 100644
index 000000000..0b010d604
--- /dev/null
+++ b/src-2.9/GF/GFCC/Raw/ConvertGFCC.hs
@@ -0,0 +1,277 @@
+module GF.GFCC.Raw.ConvertGFCC (toGFCC,fromGFCC) where
+
+import GF.GFCC.DataGFCC
+import GF.GFCC.Raw.AbsGFCCRaw
+
+import GF.Data.Assoc
+import GF.Formalism.FCFG
+import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
+import GF.Parsing.FCFG.PInfo (FCFPInfo(..), buildFCFPInfo)
+
+import qualified Data.Array as Array
+import Data.Map
+
+pgfMajorVersion, pgfMinorVersion :: Integer
+(pgfMajorVersion, pgfMinorVersion) = (1,0)
+
+-- convert parsed grammar to internal GFCC
+
+toGFCC :: Grammar -> GFCC
+toGFCC (Grm [
+  App (CId "pgf") (AInt v1 : AInt v2 : App a []:cs),
+  App (CId "flags")     gfs, 
+  ab@(
+    App (CId "abstract") [
+      App (CId "fun")   fs,
+      App (CId "cat")   cts
+      ]), 
+  App (CId "concrete") ccs
+  ]) = GFCC {
+    absname = a,
+    cncnames = [c | App c [] <- cs],
+    gflags = fromAscList [(f,v) | App f [AStr v] <- gfs],
+    abstract = 
+     let
+      aflags  = fromAscList [(f,v) | App f [AStr v] <- gfs]
+      lfuns   = [(f,(toType typ,toExp def)) | App f [typ, def] <- fs]
+      funs    = fromAscList lfuns
+      lcats   = [(c, Prelude.map toHypo hyps) | App c hyps <- cts]
+      cats    = fromAscList lcats
+      catfuns = fromAscList 
+        [(cat,[f | (f, (DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
+     in Abstr aflags funs cats catfuns,
+    concretes = fromAscList [(lang, toConcr ts) | App lang ts <- ccs]
+    }
+ where
+
+toConcr :: [RExp] -> Concr
+toConcr = foldl add (Concr {
+               cflags       = empty,
+               lins         = empty,
+               opers        = empty,
+               lincats      = empty,
+               lindefs      = empty,
+               printnames   = empty,
+               paramlincats = empty,
+               parser       = Nothing
+             })
+  where
+    add :: Concr -> RExp -> Concr
+    add cnc (App (CId "flags") ts)     = cnc { cflags = fromAscList [(f,v) | App f [AStr v] <- ts] }
+    add cnc (App (CId "lin") ts)       = cnc { lins = mkTermMap ts }
+    add cnc (App (CId "oper") ts)      = cnc { opers = mkTermMap ts }
+    add cnc (App (CId "lincat") ts)    = cnc { lincats = mkTermMap ts }
+    add cnc (App (CId "lindef") ts)    = cnc { lindefs = mkTermMap ts }
+    add cnc (App (CId "printname") ts) = cnc { printnames = mkTermMap ts }
+    add cnc (App (CId "param") ts)     = cnc { paramlincats = mkTermMap ts }
+    add cnc (App (CId "parser") ts)    = cnc { parser = Just (toPInfo ts) }
+
+toPInfo :: [RExp] -> FCFPInfo
+toPInfo [App (CId "rules") rs, App (CId "startupcats") cs] = buildFCFPInfo (rules, cats)
+  where 
+    rules = lmap toFRule rs
+    cats = fromList [(c, lmap expToInt fs) | App c fs <- cs]
+
+    toFRule :: RExp -> FRule
+    toFRule (App (CId "rule") 
+              [n,                      
+               App (CId "cats") (rt:at),
+               App (CId "R") ls]) = FRule name args res lins
+      where 
+        name = toFName n
+        args = lmap expToInt at
+        res  = expToInt rt
+        lins = mkArray [mkArray [toSymbol s | s <- l] | App (CId "S") l <- ls]
+
+toFName :: RExp -> FName
+toFName (App (CId "_A") [x]) = Name (CId "_") [Unify [expToInt x]]
+toFName (App f ts) = Name f (lmap toProfile ts)
+    where
+      toProfile :: RExp -> Profile (SyntaxForest CId)
+      toProfile AMet = Unify []
+      toProfile (App (CId "_A") [t]) = Unify [expToInt t]
+      toProfile (App (CId "_U") ts) = Unify [expToInt t | App (CId "_A") [t] <- ts]
+      toProfile t = Constant (toSyntaxForest t)
+
+      toSyntaxForest :: RExp -> SyntaxForest CId
+      toSyntaxForest AMet = FMeta
+      toSyntaxForest (App n ts) = FNode n [lmap toSyntaxForest ts]
+      toSyntaxForest (AStr s) = FString s
+      toSyntaxForest (AInt i) = FInt i
+      toSyntaxForest (AFlt f) = FFloat f
+
+toSymbol :: RExp -> FSymbol
+toSymbol (App (CId "P") [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n)
+toSymbol (AStr t) = FSymTok t
+
+toType :: RExp -> Type
+toType e = case e of
+  App cat [App (CId "H") hypos, App (CId "X") exps] -> 
+    DTyp (lmap toHypo hypos) cat (lmap toExp exps) 
+  _ -> error $ "type " ++ show e
+
+toHypo :: RExp -> Hypo
+toHypo e = case e of
+  App x [typ] -> Hyp x (toType typ)
+  _ -> error $ "hypo " ++ show e
+
+toExp :: RExp -> Exp
+toExp e = case e of
+  App (CId "App") [App fun [], App (CId "B") xs, App (CId "X") exps] ->
+    DTr [x | App x [] <- xs] (AC fun) (lmap toExp exps)
+  App (CId "Eq") eqs -> 
+    EEq [Equ (lmap toExp ps) (toExp v) | App (CId "E") (v:ps) <- eqs]
+  App (CId "Var") [App i []] -> DTr [] (AV i) []
+  AMet -> DTr [] (AM 0) []
+  AInt i -> DTr [] (AI i) []
+  AFlt i -> DTr [] (AF i) []
+  AStr i -> DTr [] (AS i) []
+  _ -> error $ "exp " ++ show e
+
+toTerm :: RExp -> Term
+toTerm e = case e of
+  App (CId "R") es    -> R  (lmap toTerm es)
+  App (CId "S") es    -> S  (lmap toTerm es)
+  App (CId "FV") es   -> FV (lmap toTerm es)
+  App (CId "P") [e,v] -> P  (toTerm e) (toTerm v)
+  App (CId "RP") [e,v] -> RP  (toTerm e) (toTerm v) ----
+  App (CId "W") [AStr s,v] -> W s (toTerm v)
+  App (CId "A") [AInt i] -> V (fromInteger i)
+  App f []  -> F f
+  AInt i -> C (fromInteger i)
+  AMet   -> TM "?"
+  AStr s -> K (KS s) ----
+  _ -> error $ "term " ++ show e
+
+------------------------------
+--- from internal to parser --
+------------------------------
+
+fromGFCC :: GFCC -> Grammar
+fromGFCC gfcc0 = Grm [
+  app "pgf" (AInt pgfMajorVersion:AInt pgfMinorVersion
+             : App (absname gfcc) [] : lmap (flip App []) (cncnames gfcc)), 
+  app "flags" [App f [AStr v] | (f,v) <- toList (gflags gfcc `union` aflags agfcc)],
+  app "abstract" [
+    app "fun"   [App f [fromType t,fromExp d] | (f,(t,d)) <- toList (funs agfcc)],
+    app "cat"   [App f (lmap fromHypo hs) | (f,hs) <- toList (cats agfcc)]
+    ],
+  app "concrete" [App lang (fromConcrete c) | (lang,c) <- toList (concretes gfcc)]
+  ]
+ where
+  gfcc = utf8GFCC gfcc0
+  app s = App (CId s)
+  agfcc = abstract gfcc
+  fromConcrete cnc = [
+      app "flags"     [App f [AStr v]     | (f,v) <- toList (cflags cnc)],
+      app "lin"       [App f [fromTerm v] | (f,v) <- toList (lins cnc)],
+      app "oper"      [App f [fromTerm v] | (f,v) <- toList (opers cnc)],
+      app "lincat"    [App f [fromTerm v] | (f,v) <- toList (lincats cnc)],
+      app "lindef"    [App f [fromTerm v] | (f,v) <- toList (lindefs cnc)],
+      app "printname" [App f [fromTerm v] | (f,v) <- toList (printnames cnc)],
+      app "param"     [App f [fromTerm v] | (f,v) <- toList (paramlincats cnc)]
+     ] ++ maybe [] (\p -> [fromPInfo p]) (parser cnc)
+
+fromType :: Type -> RExp
+fromType e = case e of
+  DTyp hypos cat exps -> 
+    App cat [
+      App (CId "H") (lmap fromHypo hypos), 
+      App (CId "X") (lmap fromExp exps)] 
+
+fromHypo :: Hypo -> RExp
+fromHypo e = case e of
+  Hyp x typ -> App x [fromType typ]
+
+fromExp :: Exp -> RExp
+fromExp e = case e of
+  DTr xs (AC fun) exps ->
+    App (CId "App") [App fun [], App (CId "B") (lmap (flip App []) xs), App (CId "X") (lmap fromExp exps)]
+  DTr [] (AV x) [] -> App (CId "Var") [App x []]
+  DTr [] (AS s) [] -> AStr s
+  DTr [] (AF d) [] -> AFlt d
+  DTr [] (AI i) [] -> AInt (toInteger i)
+  DTr [] (AM _) [] -> AMet ----
+  EEq eqs -> 
+    App (CId "Eq") [App (CId "E") (lmap fromExp (v:ps)) | Equ ps v <- eqs]
+  _ -> error $ "exp " ++ show e
+
+fromTerm :: Term -> RExp
+fromTerm e = case e of
+  R es    -> app "R" (lmap fromTerm es)
+  S es    -> app "S" (lmap fromTerm es)
+  FV es   -> app "FV" (lmap fromTerm es)
+  P e v   -> app "P"  [fromTerm e, fromTerm v]
+  RP e v  -> app "RP" [fromTerm e, fromTerm v] ----
+  W s v   -> app "W" [AStr s, fromTerm v]
+  C i     -> AInt (toInteger i)
+  TM _    -> AMet
+  F f     -> App f []
+  V i     -> App (CId "A") [AInt (toInteger i)]
+  K (KS s) -> AStr s ----
+  K (KP d vs) -> app "FV" (str d : [str v | Var v _ <- vs]) ----
+ where
+   app = App . CId
+   str v = app "S" (lmap AStr v)
+
+-- ** Parsing info
+
+fromPInfo :: FCFPInfo -> RExp
+fromPInfo p = app "parser" [
+          app "rules"         [fromFRule rule | rule <- Array.elems (allRules p)],
+          app "startupcats"   [App f (lmap intToExp cs) | (f,cs) <- toList (startupCats p)]
+        ]
+
+fromFRule :: FRule -> RExp
+fromFRule (FRule n args res lins) = 
+    app "rule" [fromFName n,
+                app "cats" (intToExp res:lmap intToExp args),
+                app "R" [app "S" [fromSymbol s | s <- Array.elems l] | l <- Array.elems lins]
+               ]
+
+fromFName :: FName -> RExp
+fromFName n = case n of
+                Name (CId "_") [p] -> fromProfile p
+                Name f ps          -> App f (lmap fromProfile ps)
+  where
+    fromProfile :: Profile (SyntaxForest CId) -> RExp
+    fromProfile (Unify []) = AMet
+    fromProfile (Unify [x]) = daughter x
+    fromProfile (Unify args) = app "_U" (lmap daughter args)
+    fromProfile (Constant forest) = fromSyntaxForest forest
+
+    daughter n = app "_A" [intToExp n]
+
+    fromSyntaxForest :: SyntaxForest CId -> RExp
+    fromSyntaxForest FMeta = AMet
+    -- FIXME: is there always just one element here?
+    fromSyntaxForest (FNode n [args]) = App n (lmap fromSyntaxForest args)
+    fromSyntaxForest (FString s) = AStr s
+    fromSyntaxForest (FInt i) = AInt i
+    fromSyntaxForest (FFloat f) = AFlt f
+
+fromSymbol :: FSymbol -> RExp
+fromSymbol (FSymCat c l n) = app "P" [intToExp c, intToExp n, intToExp l]
+fromSymbol (FSymTok t) = AStr t
+
+-- ** Utilities
+
+mkTermMap :: [RExp] -> Map CId Term
+mkTermMap ts = fromAscList [(f,toTerm v) | App f [v] <- ts]
+
+app :: String -> [RExp] -> RExp
+app = App . CId
+
+mkArray :: [a] -> Array.Array Int a
+mkArray xs = Array.listArray (0, length xs - 1) xs
+
+expToInt :: Integral a => RExp -> a
+expToInt (App (CId "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 (CId "neg") [AInt (fromIntegral (negate x))]
+           | otherwise =  AInt (fromIntegral x)
diff --git a/src-2.9/GF/GFCC/Raw/GFCCRaw.cf b/src-2.9/GF/GFCC/Raw/GFCCRaw.cf
new file mode 100644
index 000000000..bedaef685
--- /dev/null
+++ b/src-2.9/GF/GFCC/Raw/GFCCRaw.cf
@@ -0,0 +1,12 @@
+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 | '\'' | '_')*) ;
diff --git a/src-2.9/GF/GFCC/Raw/ParGFCCRaw.hs b/src-2.9/GF/GFCC/Raw/ParGFCCRaw.hs
new file mode 100644
index 000000000..b71904948
--- /dev/null
+++ b/src-2.9/GF/GFCC/Raw/ParGFCCRaw.hs
@@ -0,0 +1,99 @@
+module GF.GFCC.Raw.ParGFCCRaw (parseGrammar) where
+
+import GF.GFCC.Raw.AbsGFCCRaw
+
+import Control.Monad
+import Data.Char
+
+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 = liftM CId $ 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-2.9/GF/GFCC/Raw/PrintGFCCRaw.hs b/src-2.9/GF/GFCC/Raw/PrintGFCCRaw.hs
new file mode 100644
index 000000000..d46d8096f
--- /dev/null
+++ b/src-2.9/GF/GFCC/Raw/PrintGFCCRaw.hs
@@ -0,0 +1,36 @@
+module GF.GFCC.Raw.PrintGFCCRaw (printTree) where
+
+import GF.GFCC.Raw.AbsGFCCRaw
+
+import Data.List (intersperse)
+import Numeric (showFFloat)
+
+printTree :: Grammar -> String
+printTree g = prGrammar g ""
+
+prGrammar :: Grammar -> ShowS
+prGrammar (Grm xs) = prRExpList xs
+
+prRExp :: Int -> RExp -> ShowS
+prRExp _ (App x []) = prCId x
+prRExp n (App x xs) = p (prCId 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)
+
+prCId :: CId -> ShowS
+prCId (CId x) = showString x
+
+concatS :: [ShowS] -> ShowS
+concatS = foldr (.) id
diff --git a/src-2.9/GF/GFCC/ShowLinearize.hs b/src-2.9/GF/GFCC/ShowLinearize.hs
new file mode 100644
index 000000000..f627dfd28
--- /dev/null
+++ b/src-2.9/GF/GFCC/ShowLinearize.hs
@@ -0,0 +1,87 @@
+module GF.GFCC.ShowLinearize (
+  tableLinearize,
+  recordLinearize,
+  termLinearize,
+  allLinearize
+  ) where
+
+import GF.GFCC.Linearize
+import GF.GFCC.Macros
+import GF.GFCC.DataGFCC
+import GF.GFCC.CId
+--import GF.GFCC.PrintGFCC ----
+
+import GF.Data.Operations
+import Data.List
+
+-- 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 GFCC.paramlincat
+mkRecord :: Term -> Term -> Record
+mkRecord typ trm = case (typ,trm) of
+  (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 $ realize trm
+  _                   -> RS $ show trm ---- printTree trm
+ where
+   str = realize
+
+-- show all branches, without labels and params
+allLinearize :: GFCC -> CId -> Exp -> String
+allLinearize gfcc lang = concat . map pr . tabularLinearize gfcc lang where
+  pr (p,vs) = unlines vs
+
+-- show all branches, with labels and params
+tableLinearize :: GFCC -> CId -> Exp -> String
+tableLinearize gfcc lang = unlines . map pr . tabularLinearize gfcc lang where
+  pr (p,vs) = p +++ ":" +++ unwords (intersperse "|" vs)
+
+-- create a table from labels+params to variants
+tabularLinearize :: GFCC -> CId -> Exp -> [(String,[String])]
+tabularLinearize gfcc lang = branches . recLinearize gfcc lang where
+  branches r = case r of
+    RR  fs -> [(lab +++ 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 :: GFCC -> CId -> Exp -> String
+recordLinearize gfcc lang = prRecord . recLinearize gfcc lang
+
+-- create a GF-like record, forming the basis of all functions above
+recLinearize :: GFCC -> CId -> Exp -> Record
+recLinearize gfcc lang exp = mkRecord typ $ linExp gfcc lang exp where
+  typ = case exp of
+    DTr _ (AC f) _ -> lookParamLincat gfcc lang $ valCat $ lookType gfcc f
+
+-- show GFCC term
+termLinearize :: GFCC -> CId -> Exp -> String
+termLinearize gfcc lang = show . linExp gfcc lang
+
+
diff --git a/src-2.9/GF/GFCC/SkelGFCC.hs b/src-2.9/GF/GFCC/SkelGFCC.hs
new file mode 100644
index 000000000..6972fd3c3
--- /dev/null
+++ b/src-2.9/GF/GFCC/SkelGFCC.hs
@@ -0,0 +1,109 @@
+module GF.GFCC.SkelGFCC where
+
+-- Haskell module generated by the BNF converter
+
+import GF.GFCC.AbsGFCC
+import GF.Data.ErrM
+type Result = Err String
+
+failure :: Show a => a -> Result
+failure x = Bad $ "Undefined case: " ++ show x
+
+transCId :: CId -> Result
+transCId x = case x of
+  CId str  -> failure x
+
+
+transGrammar :: Grammar -> Result
+transGrammar x = case x of
+  Grm cid cids abstract concretes  -> failure x
+
+
+transAbstract :: Abstract -> Result
+transAbstract x = case x of
+  Abs flags fundefs catdefs  -> failure x
+
+
+transConcrete :: Concrete -> Result
+transConcrete x = case x of
+  Cnc cid flags lindefs0 lindefs1 lindefs2 lindefs3 lindefs  -> failure x
+
+
+transFlag :: Flag -> Result
+transFlag x = case x of
+  Flg cid str  -> failure x
+
+
+transCatDef :: CatDef -> Result
+transCatDef x = case x of
+  Cat cid hypos  -> failure x
+
+
+transFunDef :: FunDef -> Result
+transFunDef x = case x of
+  Fun cid type' exp  -> failure x
+
+
+transLinDef :: LinDef -> Result
+transLinDef x = case x of
+  Lin cid term  -> failure x
+
+
+transType :: Type -> Result
+transType x = case x of
+  DTyp hypos cid exps  -> failure x
+
+
+transExp :: Exp -> Result
+transExp x = case x of
+  DTr cids atom exps  -> failure x
+  EEq equations  -> failure x
+
+
+transAtom :: Atom -> Result
+transAtom x = case x of
+  AC cid  -> failure x
+  AS str  -> failure x
+  AI n  -> failure x
+  AF d  -> failure x
+  AM n  -> failure x
+  AV cid  -> failure x
+
+
+transTerm :: Term -> Result
+transTerm x = case x of
+  R terms  -> failure x
+  P term0 term  -> failure x
+  S terms  -> failure x
+  K tokn  -> failure x
+  V n  -> failure x
+  C n  -> failure x
+  F cid  -> failure x
+  FV terms  -> failure x
+  W str term  -> failure x
+  TM  -> failure x
+  RP term0 term  -> failure x
+
+
+transTokn :: Tokn -> Result
+transTokn x = case x of
+  KS str  -> failure x
+  KP strs variants  -> failure x
+
+
+transVariant :: Variant -> Result
+transVariant x = case x of
+  Var strs0 strs  -> failure x
+
+
+transHypo :: Hypo -> Result
+transHypo x = case x of
+  Hyp cid type'  -> failure x
+
+
+transEquation :: Equation -> Result
+transEquation x = case x of
+  Equ exps exp  -> failure x
+
+
+
diff --git a/src-2.9/GF/GFCC/TestGFCC.hs b/src-2.9/GF/GFCC/TestGFCC.hs
new file mode 100644
index 000000000..c379a687a
--- /dev/null
+++ b/src-2.9/GF/GFCC/TestGFCC.hs
@@ -0,0 +1,58 @@
+-- automatically generated by BNF Converter
+module Main where
+
+
+import IO ( stdin, hGetContents )
+import System ( getArgs, getProgName )
+
+import GF.GFCC.LexGFCC
+import GF.GFCC.ParGFCC
+import GF.GFCC.SkelGFCC
+import GF.GFCC.PrintGFCC
+import GF.GFCC.AbsGFCC
+
+
+
+
+import GF.Data.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-2.9/GF/GFCC/doc/Eng.gf b/src-2.9/GF/GFCC/doc/Eng.gf
new file mode 100644
index 000000000..c64f46313
--- /dev/null
+++ b/src-2.9/GF/GFCC/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-2.9/GF/GFCC/doc/Ex.gf b/src-2.9/GF/GFCC/doc/Ex.gf
new file mode 100644
index 000000000..bd0b03483
--- /dev/null
+++ b/src-2.9/GF/GFCC/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-2.9/GF/GFCC/doc/Swe.gf b/src-2.9/GF/GFCC/doc/Swe.gf
new file mode 100644
index 000000000..1d6672371
--- /dev/null
+++ b/src-2.9/GF/GFCC/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-2.9/GF/GFCC/doc/Test.gf b/src-2.9/GF/GFCC/doc/Test.gf
new file mode 100644
index 000000000..5cd4c5474
--- /dev/null
+++ b/src-2.9/GF/GFCC/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-2.9/GF/GFCC/doc/gfcc.html b/src-2.9/GF/GFCC/doc/gfcc.html
new file mode 100644
index 000000000..8f8c478c0
--- /dev/null
+++ b/src-2.9/GF/GFCC/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 -&gt; VP -&gt; 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 =&gt; 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 =&gt; "sleeps" ; 
+        Pl =&gt; "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] "-&gt;" CId
+    Typ args val = DTyp [Hyp (CId "_") arg | arg &lt;- 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] "-&gt;" 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 -&gt; CId -&gt; Exp -&gt; Term
+    linExp gfcc lang tree@(DTr _ at trees) = case at of
+      AC fun -&gt; comp (Prelude.map lin trees) $ look fun
+      AS s   -&gt; R [kks (show s)] -- quoted
+      AI i   -&gt; R [kks (show i)]
+      AF d   -&gt; R [kks (show d)]
+      AM     -&gt; 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 -&gt; String
+    realize trm = case trm of
+      R (t:_)  -&gt; realize t
+      S ss     -&gt; unwords $ Prelude.map realize ss
+      K (KS s) -&gt; s
+      K (KP s _) -&gt; unwords s ---- prefix choice TODO
+      W s t    -&gt; s ++ realize t
+      FV (t:_) -&gt; realize t
+      TM       -&gt; "?"
+</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 -&gt; CId -&gt; [Term] -&gt; Term -&gt; Term
+  compute gfcc lang args = comp where
+    comp trm = case trm of
+      P r p  -&gt; proj (comp r) (comp p)
+      W s t  -&gt; W s (comp t)
+      R ts   -&gt; R $ Prelude.map comp ts
+      V i    -&gt; idx args (fromInteger i)  -- already computed
+      F c    -&gt; comp $ look c             -- not computed (if contains V)
+      FV ts  -&gt; FV $ Prelude.map comp ts
+      S ts   -&gt; S $ Prelude.filter (/= S []) $ Prelude.map comp ts
+      _ -&gt; trm
+  
+    look = lookOper gfcc lang
+  
+    idx xs i = xs !! i
+  
+    proj r p = case (r,p) of
+      (_,     FV ts) -&gt; FV $ Prelude.map (proj r) ts
+      (W s t, _)     -&gt; kks (s ++ getString (proj t p))
+      _              -&gt; comp $ getField r (getIndex p)
+  
+    getString t = case t of
+      K (KS s) -&gt; s
+      _ -&gt; trace ("ERROR in grammar compiler: string from "++ show t) "ERR"
+  
+    getIndex t =  case t of
+      C i    -&gt; fromInteger i
+      RP p _ -&gt; getIndex p
+      TM     -&gt; 0  -- default value for parameter
+      _ -&gt; trace ("ERROR in grammar compiler: index from " ++ show t) 0
+  
+    getField t i = case t of
+      R rs   -&gt; idx rs i
+      RP _ r -&gt; getField r i
+      TM     -&gt; TM
+      _ -&gt; 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 = &lt;&gt;</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 =&gt; 2 ;
+      1 =&gt; 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  ===&gt; 
+    case rnp of {
+      0 =&gt; 0 ;
+      1 =&gt; 0 ;
+      2 =&gt; 0 ;
+      3 =&gt; 1 ;
+      4 =&gt; 1 ;
+      5 =&gt; 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} {... ...}
+     ===&gt;
+    table Number {Sg =&gt; 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   ===&gt; 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 =&gt; 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} =&gt; 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 &lt;GFCC-file&gt;
+</PRE>
+<P>
+The available commands are
+</P>
+<UL>
+<LI><CODE>gr &lt;Cat&gt; &lt;Int&gt;</CODE>:  generate a number of random trees in category.
+  and show their linearizations in all languages
+<LI><CODE>grt &lt;Cat&gt; &lt;Int&gt;</CODE>:  generate a number of random trees in category.
+  and show the trees and their linearizations in all languages
+<LI><CODE>gt &lt;Cat&gt; &lt;Int&gt;</CODE>:  generate a number of trees in category from smallest,
+  and show their linearizations in all languages
+<LI><CODE>gtt &lt;Cat&gt; &lt;Int&gt;</CODE>:  generate a number of trees in category from smallest,
+  and show the trees and their linearizations in all languages
+<LI><CODE>p &lt;Lang&gt; &lt;Cat&gt; &lt;String&gt;</CODE>: parse a string into a set of trees
+<LI><CODE>lin &lt;Tree&gt;</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-2.9/GF/GFCC/doc/gfcc.txt b/src-2.9/GF/GFCC/doc/gfcc.txt
new file mode 100644
index 000000000..5dcf2fbdc
--- /dev/null
+++ b/src-2.9/GF/GFCC/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-2.9/GF/GFCC/doc/old-GFCC.cf b/src-2.9/GF/GFCC/doc/old-GFCC.cf
new file mode 100644
index 000000000..65657a259
--- /dev/null
+++ b/src-2.9/GF/GFCC/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-2.9/GF/GFCC/doc/old-gfcc.txt b/src-2.9/GF/GFCC/doc/old-gfcc.txt
new file mode 100644
index 000000000..6ffd9bd64
--- /dev/null
+++ b/src-2.9/GF/GFCC/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-2.9/GF/GFCC/doc/syntax.txt b/src-2.9/GF/GFCC/doc/syntax.txt
new file mode 100644
index 000000000..db8f7c149
--- /dev/null
+++ b/src-2.9/GF/GFCC/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-2.9/GF/GFModes.hs b/src-2.9/GF/GFModes.hs
new file mode 100644
index 000000000..faab3cede
--- /dev/null
+++ b/src-2.9/GF/GFModes.hs
@@ -0,0 +1,112 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : Aarne Ranta
+-- Stability   : (stability)
+-- Portability : (portability)
+--
+-- > CVS $Date: 2005/10/06 10:02:33 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.8 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.GFModes (gfInteract, gfBatch, batchCompile) where
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.Infra.Option
+import GF.Compile.ShellState
+import GF.Shell.ShellCommands
+import GF.Shell
+import GF.Shell.CommandL (execCommandHistory)
+import GF.Shell.SubShell
+import GF.Shell.PShell
+import GF.Shell.JGF
+import Data.Char (isSpace)
+
+-- separated from GF Main 24/6/2003
+
+gfInteract :: HState -> IO HState
+gfInteract st@(env,hist@(his,_,_,_)) = do
+  -- putStrFlush "> " M.F 25/01-02 prompt moved to Arch.
+  (s,cs) <- getCommandLines st
+  case ifImpure cs of
+
+    -- these are the three impure commands
+    Just (ICQuit,_) -> do
+      ifNotSilent "See you."
+      return st
+    Just (ICExecuteHistory file,_) -> do
+      ss  <- readFileIf file
+      let co = pCommandLines st ss
+      st' <- execLinesH s co st      
+      gfInteract st'      
+    Just (ICEarlierCommand i,_) -> do
+      let line = earlierCommandH st i
+          co   = pCommandLine st $ words line
+      st' <- execLinesH line [co] st       -- s would not work in execLinesH
+      gfInteract st'
+
+    Just (ICReload,_) -> case dropWhile (not . isImport) his of
+      line:_ -> do
+        let co = pCommandLine st $ words line
+        st' <- execLinesH line [co] st
+        gfInteract st'
+      _ -> do
+        putStrLn "No previous import"
+        gfInteract st
+
+    Just (ICEditSession,os) -> case getOptVal os useFile of
+      Just file -> do
+        s <- readFileIf file
+        (env',tree) <- execCommandHistory env s
+        gfInteract st
+      _ -> 
+        editSession (addOptions os opts) env >> gfInteract st
+    Just (ICTranslateSession,os) -> 
+      translateSession (addOptions os opts) env >> gfInteract st
+
+    -- this is a normal command sequence
+    _ -> do
+      st' <- execLinesH s cs st
+      gfInteract st'
+   where
+     opts = globalOptions env
+     ifNotSilent c = 
+       if oElem beSilent opts then return () else putStrLnFlush c
+     isImport l = case words l of
+       "i":_ -> True
+       "import":_ -> True
+       _ -> False
+
+gfBatch :: HState -> IO HState
+gfBatch st@(sh,_) = do
+  (s,cs) <- getCommandLinesBatch st
+  if s == "q" then return st else do
+    st' <- if all isSpace s then return st else do
+        putVe "<gfcommand>"
+        putVe s
+        putVe "</gfcommand>"
+        putVe "<gfreply>"
+        (_,st') <- execLines True cs st
+        putVe "</gfreply>"
+        return st'
+    gfBatch st'
+ where
+   putVe = putVerb st
+
+putVerb st@(sh,_) s = if (oElem beSilent (globalOptions sh))
+                          then return ()
+                          else putStrLnFlush s 
+
+batchCompile :: Options -> FilePath -> IO ()
+batchCompile os file = do
+  let file' = mkGFC file
+  let st    = initHState $ addGlobalOptions (options [iOpt "make"]) emptyShellState
+  let s     = "i -o" +++ (unwords $ map ('-':) $ words $ prOpts os) +++ file
+  let cs    = pCommandLines st s
+  execLines True cs st
+  return ()
+
+mkGFC = reverse . ("cfg" ++) . dropWhile (/='.') . reverse
diff --git a/src-2.9/GF/Grammar/AbsCompute.hs b/src-2.9/GF/Grammar/AbsCompute.hs
new file mode 100644
index 000000000..57e21f1dd
--- /dev/null
+++ b/src-2.9/GF/Grammar/AbsCompute.hs
@@ -0,0 +1,145 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : AbsCompute
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/02 20:50:19 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.8 $
+--
+-- computation in abstract syntax w.r.t. explicit definitions.
+--
+-- old GF computation; to be updated
+-----------------------------------------------------------------------------
+
+module GF.Grammar.AbsCompute (LookDef,
+		   compute, 
+		   computeAbsTerm, 
+		   computeAbsTermIn, 
+		   beta
+		  ) where
+
+import GF.Data.Operations
+
+import GF.Grammar.Abstract
+import GF.Grammar.PrGrammar
+import GF.Grammar.LookAbs
+import GF.Grammar.Compute
+
+import Debug.Trace
+import Data.List(intersperse)
+import Control.Monad (liftM, liftM2)
+
+-- for debugging
+tracd m t = t 
+-- tracd = trace
+
+compute :: GFCGrammar -> Exp -> Err Exp
+compute = computeAbsTerm
+
+computeAbsTerm :: GFCGrammar -> Exp -> Err Exp
+computeAbsTerm gr = computeAbsTermIn (lookupAbsDef gr) []
+
+-- | a hack to make compute work on source grammar as well
+type LookDef = Ident -> Ident -> Err (Maybe Term)
+
+computeAbsTermIn :: LookDef -> [Ident] -> Exp -> Err Exp
+computeAbsTermIn lookd xs e = errIn ("computing" +++ prt e) $ compt xs e where
+  compt vv t = case t of
+--    Prod x a b  -> liftM2 (Prod x) (compt vv a) (compt (x:vv) b)
+--    Abs x b     -> liftM  (Abs  x)              (compt (x:vv) b)
+    _ -> do
+      let t' = beta vv t
+      (yy,f,aa) <- termForm t'
+      let vv' = yy ++ vv
+      aa'    <- mapM (compt vv') aa
+      case look f of
+        Just (Eqs eqs) -> tracd ("\nmatching" +++ prt f) $ 
+                          case findMatch eqs aa' of
+          Ok (d,g) -> do
+            --- let (xs,ts) = unzip g
+            --- ts' <- alphaFreshAll vv' ts
+            let g' = g --- zip xs ts'
+            d' <- compt vv' $ substTerm vv' g' d
+            tracd ("by Egs:" +++ prt d') $ return $ mkAbs yy $ d'
+          _ -> tracd ("no match" +++ prt t') $ 
+               do
+            let v = mkApp f aa'
+            return $ mkAbs yy $ v
+        Just d -> tracd ("define" +++ prt t') $ do
+          da <- compt vv' $ mkApp d aa' 
+          return $ mkAbs yy $ da
+        _ -> do
+          let t2 = mkAbs yy $ mkApp f aa'
+          tracd ("not defined" +++ prt_ t2) $ return t2
+
+  look t = case t of
+     (Q m f) -> case lookd m f of
+       Ok (Just EData) -> Nothing  -- canonical --- should always be QC
+       Ok md -> md
+       _ -> Nothing
+     Eqs _ -> return t ---- for nested fn
+     _ -> Nothing
+
+beta :: [Ident] -> Exp -> Exp
+beta vv c = case c of
+  Let (x,(_,a)) b -> beta vv $ substTerm vv [(x,beta vv a)] (beta (x:vv) b) 
+  App f         a -> 
+    let (a',f') = (beta vv a, beta vv f) in 
+    case f' of
+      Abs x b -> beta vv $ substTerm vv [(x,a')] (beta (x:vv) b) 
+      _ ->               (if a'==a && f'==f then id else beta vv) $ App f' a'
+  Prod x a b      -> Prod x (beta vv a) (beta (x:vv) b)
+  Abs x b         -> Abs x (beta (x:vv) b)
+  _               -> c
+
+-- special version of pattern matching, to deal with comp under lambda
+
+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 (tracd ("value" +++ prt_ val) val, concat substs)
+     _         -> findMatch cc terms
+
+tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
+tryMatch (p,t) = do 
+  t' <- termForm t
+  trym p t'
+ where
+
+  trym p t' = err (\s -> tracd s (Bad s)) (\t -> tracd (prtm p t) (return t)) $ ---- 
+              case (p,t') of
+    (PV IW, _) | notMeta t -> return [] -- optimization with wildcard
+    (PV x,  _) | notMeta t -> 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?
+    (PP q p pp, ([], QC r f, tt)) | 
+       p `eqStrIdent` f && length pp == length tt -> do
+         matches <- mapM tryMatch (zip pp tt)
+         return (concat matches)
+    (PP q p pp, ([], Q r f, tt)) | 
+       p `eqStrIdent` f && length pp == length tt -> do
+         matches <- mapM tryMatch (zip pp tt)
+         return (concat matches)
+    (PT _ p',_) -> trym p' t'
+    (_, ([],Alias _ _ d,[])) -> tryMatch (p,d)
+    (PAs x p',_) -> do
+       subst <- trym p' t'
+       return $ (x,t) : subst
+    _ -> Bad ("no match in pattern" +++ prt p +++ "for" +++ prt t)
+
+  notMeta e = case e of
+    Meta _  -> False
+    App f a -> notMeta f &&  notMeta a  
+    Abs _ b -> notMeta b
+    _ -> True
+
+  prtm p g = 
+    prt p +++ ":" ++++ unwords ["  " ++ prt_ x +++ "=" +++ prt_ y +++ ";" | (x,y) <- g]
diff --git a/src-2.9/GF/Grammar/Abstract.hs b/src-2.9/GF/Grammar/Abstract.hs
new file mode 100644
index 000000000..c03783a52
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Grammar/AppPredefined.hs b/src-2.9/GF/Grammar/AppPredefined.hs
new file mode 100644
index 000000000..fa0048c80
--- /dev/null
+++ b/src-2.9/GF/Grammar/AppPredefined.hs
@@ -0,0 +1,159 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Data.Operations
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Grammar.Macros
+import GF.Grammar.PrGrammar (prt,prt_,prtBad)
+---- import PGrammar (pTrm)
+
+-- 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 c@(IC f) = case f of
+  "Int"    -> return typePType
+  "Float"  -> return typePType
+  "Error"  -> return typeType
+  "Ints"   -> return $ mkFunType [cnPredef "Int"] typePType
+  "PBool"  -> return typePType
+  "error"  -> return $ mkFunType [typeStr] (cnPredef "Error")  -- non-can. of empty set
+  "PFalse" -> return $ cnPredef "PBool"
+  "PTrue"  -> return $ cnPredef "PBool"
+  "dp"     -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
+  "drop"   -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
+  "eqInt"  -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
+  "lessInt"-> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
+  "eqStr"  -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
+  "length" -> return $ mkFunType [typeTok] (cnPredef "Int")
+  "occur"  -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
+  "occurs" -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
+  "plus"   -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "Int")
+----  "read"   -> (P : Type) -> Tok -> P
+  "show"   -> return $ mkProd -- (P : PType) -> P -> Tok
+    ([(zIdent "P",typePType),(wildIdent,Vr (zIdent "P"))],typeStr,[]) 
+  "toStr"  -> return $ mkProd -- (L : Type)  -> L -> Str
+    ([(zIdent "L",typeType),(wildIdent,Vr (zIdent "L"))],typeStr,[]) 
+  "mapStr" -> 
+    let ty = zIdent "L" in
+    return $ mkProd -- (L : Type)  -> (Str -> Str) -> L -> L
+    ([(ty,typeType),(wildIdent,mkFunType [typeStr] typeStr),(wildIdent,Vr ty)],Vr ty,[]) 
+  "take"   -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
+  "tk"     -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
+  _        -> prtBad "unknown in Predef:" c
+typPredefined c = prtBad "unknown in Predef:" c
+
+appPredefined :: Term -> Err (Term,Bool)
+appPredefined t = case t of
+
+  App f x0 -> do
+   (x,_) <- appPredefined x0
+   case f of
+    -- one-place functions
+    Q (IC "Predef") (IC f) -> case (f, x) of
+      ("length", K s) -> retb $ EInt $ toInteger $ length s
+      _ -> retb t ---- prtBad "cannot compute predefined" t
+
+    -- two-place functions
+    App (Q (IC "Predef") (IC f)) z0 -> do
+     (z,_) <- appPredefined z0
+     case (f, norm z, norm x) of
+      ("drop", EInt i, K s) -> retb $ K (drop (fi i) s)
+      ("take", EInt i, K s) -> retb $ K (take (fi i) s)
+      ("tk",   EInt i, K s) -> retb $ K (take (max 0 (length s - fi i)) s)
+      ("dp",   EInt i, K s) -> retb $ K (drop (max 0 (length s - fi i)) s)
+      ("eqStr",K s,    K t) -> retb $ if s == t then predefTrue else predefFalse
+      ("occur",K s,    K t) -> retb $ if substring s t then predefTrue else predefFalse
+      ("occurs",K s,   K t) -> retb $ if any (flip elem t) s then predefTrue else predefFalse
+      ("eqInt",EInt i, EInt j) -> retb $ if i==j then predefTrue else predefFalse
+      ("lessInt",EInt i, EInt j) -> retb $ if i<j then predefTrue else predefFalse
+      ("plus", EInt i, EInt j) -> retb $ EInt $ i+j
+      ("show", _, t) -> retb $ foldr C Empty $ map K $ words $ prt t
+      ("read", _, K s) -> retb $ str2tag s --- because of K, only works for atomic tags
+      ("toStr", _, t) -> trm2str t >>= retb
+
+      _ -> retb t ---- prtBad "cannot compute predefined" t
+
+    -- three-place functions
+    App (App (Q (IC "Predef") (IC f)) z0) y0 -> do
+     (y,_) <- appPredefined y0
+     (z,_) <- appPredefined z0
+     case (f, z, y, x) of
+      ("mapStr",ty,op,t) -> 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 (t,True)  -- no further computing needed
+   retf t = return (t,False) -- must be computed further
+   norm t = case t of
+     Empty -> K []
+     _ -> t
+   fi = fromInteger
+
+-- read makes variables into constants
+
+str2tag :: String -> Term
+str2tag s = case s of
+----  '\'' : cs -> mkCn $ pTrm $ init cs
+  _ -> Cn $ IC s ---
+ where
+   mkCn t = case t of
+     Vr i -> Cn i
+     App c a -> App (mkCn c) (mkCn a)
+     _ -> t
+
+
+predefTrue = Q (IC "Predef") (IC "PTrue")
+predefFalse = Q (IC "Predef") (IC "PFalse")
+
+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-2.9/GF/Grammar/Compute.hs b/src-2.9/GF/Grammar/Compute.hs
new file mode 100644
index 000000000..c76058cc2
--- /dev/null
+++ b/src-2.9/GF/Grammar/Compute.hs
@@ -0,0 +1,426 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Grammar.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.Macros
+import GF.Grammar.Lookup
+import GF.Grammar.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 (IC "Predef") _ -> return t
+     Q p c -> 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 (IC "Predef") f -> 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)
+--- - } ---
+
+         Alias _ _ r -> comp g (P r 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@(T ti cc) v -> do
+       v'     <- comp g v
+       case v' of
+         FV vs -> do
+           ts' <- mapM (comp g . S t) vs
+           return $ variants ts' 
+         _ -> case ti of
+{-
+           TComp _  -> do
+             case term2patt v' of
+               Ok p' -> case lookup p' cc of
+                 Just u -> comp g u
+                 _ -> do
+                   t' <- comp g t
+                   return $ S t' v' -- if v' is not canonical
+               _ -> do
+                  t' <- comp g t
+                  return $ S t' v'
+-}
+           _ -> case matchPattern cc v' of
+             Ok (c,g') -> comp (g' ++ g) c
+             _ | isCan v' -> prtBad ("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'     <- case t of
+--        T _ _ -> return t
+--        V _ _ -> return t
+        _ -> comp g t
+
+      v'     <- comp g 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
+-----             _ -> prtBad "selection" $ S t' v' -- debug
+             _ -> return $ S t' v' -- if v' is not canonical
+
+         T (TComp _) cs -> do
+           case term2patt v' of
+             Ok p' -> case lookup p' cs of
+               Just u -> comp g u
+               _ -> return $ S t' v' -- if v' is not canonical
+             _ -> return $ S t' v'
+
+         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
+
+         Alias _ _ d -> comp g (S d v')
+
+         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'
+
+     -- 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
+
+         (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
+         (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
+         (Alias _ _ d, _)  -> comp g $ ExtR d s'
+         (_, Alias _ _ d)  -> comp g $ Glue r' d
+
+         (R rs, R ss) -> plusRecord r' s'
+         (RecType rs, RecType ss) -> plusRecType r' s'
+         _ -> return $ ExtR r' s'
+
+     -- case-expand tables
+     -- if already expanded, don't expand again
+     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'
+     --- 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 <- getTableType i
+       ptyp <- comp g pty0
+       case allParamValues gr ptyp of
+         Ok vs -> do
+
+           cs'  <- mapM (compBranchOpt g) 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
+
+     Alias c a d -> do
+       d' <- comp g d
+       return $ Alias c a d'  -- alias only disappears in certain redexes
+
+     -- 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'
+
+         (Alias _ _ d, _) -> comp g (App d 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
+
+{-
+     look p c = case lookupResDefKind gr p c of
+       Ok (t,_) | noExpand p || rec -> 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
+-}
+
+     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
+       _ -> 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
+
+-- | 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."
diff --git a/src-2.9/GF/Grammar/Grammar.hs b/src-2.9/GF/Grammar/Grammar.hs
new file mode 100644
index 000000000..95fdce611
--- /dev/null
+++ b/src-2.9/GF/Grammar/Grammar.hs
@@ -0,0 +1,244 @@
+----------------------------------------------------------------------
+-- |
+-- 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,
+		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
+	       ) where
+
+import GF.Data.Str
+import GF.Infra.Ident
+import GF.Infra.Option ---
+import GF.Infra.Modules
+
+import GF.Data.Operations
+
+-- | grammar as presented to the compiler
+type SourceGrammar = MGrammar Ident Option Info
+
+type SourceModInfo = ModInfo Ident Option Info
+
+type SourceModule = (Ident, SourceModInfo)
+
+type SourceAbs = Module Ident Option Info
+type SourceRes = Module Ident Option Info
+type SourceCnc = Module Ident Option 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 [(Type,Term)]               -- ^ (/RES/)
+
+-- 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 String          -- ^ 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 String
+  | 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
+
+wildPatt :: Patt
+wildPatt = PV wildIdent
+
+type Trm = Term
diff --git a/src-2.9/GF/Grammar/Lockfield.hs b/src-2.9/GF/Grammar/Lockfield.hs
new file mode 100644
index 000000000..960b12983
--- /dev/null
+++ b/src-2.9/GF/Grammar/Lockfield.hs
@@ -0,0 +1,46 @@
+----------------------------------------------------------------------
+-- |
+-- 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 GF.Grammar.Grammar
+import GF.Infra.Ident
+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 $ "lock_" ++ prt c ----
+
+isLockLabel :: Label -> Bool
+isLockLabel l = case l of
+  LIdent c -> take 5 c == "lock_"
+  _ -> False
diff --git a/src-2.9/GF/Grammar/LookAbs.hs b/src-2.9/GF/Grammar/LookAbs.hs
new file mode 100644
index 000000000..5bd4c1e41
--- /dev/null
+++ b/src-2.9/GF/Grammar/LookAbs.hs
@@ -0,0 +1,196 @@
+----------------------------------------------------------------------
+-- |
+-- 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 (GFCGrammar,
+		lookupAbsDef,
+		lookupFunType,
+		lookupCatContext,
+		lookupTransfer,
+		isPrimitiveFun,
+		lookupRef,
+		refsForType,
+		funRulesOf,
+		hasHOAS,
+		allCatsOf,
+		allBindCatsOf,
+		funsForType,
+		funsOnType,
+		funsOnTypeFs,
+		allDefs,
+		lookupFunTypeSrc,
+		lookupCatContextSrc
+	       ) where
+
+import GF.Data.Operations
+import qualified GF.Canon.GFC as C
+import GF.Grammar.Abstract
+import GF.Infra.Ident
+
+import GF.Infra.Modules
+
+import Data.List (nub)
+import Control.Monad
+
+type GFCGrammar = C.CanonGrammar
+
+lookupAbsDef :: GFCGrammar -> 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
+        C.AbsFun _ t  -> return $ return t
+        C.AnyInd _ n  -> lookupAbsDef gr n c
+        _ -> return Nothing
+    _ -> Bad $ prt m +++ "is not an abstract module"
+
+lookupFunType :: GFCGrammar -> Ident -> Ident -> Err Type
+lookupFunType gr m c = errIn ("looking up funtype of" +++ prt c +++ "in module" +++ prt m) $ do
+  mi   <- lookupModule gr m
+  case mi of
+    ModMod mo -> do
+      info <- lookupIdentInfo mo c
+      case info of
+        C.AbsFun t _  -> return t
+        C.AnyInd _ n  -> lookupFunType gr n c
+        _ -> prtBad "cannot find type of" c
+    _ -> Bad $ prt m +++ "is not an abstract module"
+
+lookupCatContext :: GFCGrammar -> Ident -> Ident -> Err Context
+lookupCatContext gr m c = errIn ("looking up context of cat" +++ prt c) $ do
+  mi   <- lookupModule gr m
+  case mi of
+    ModMod mo -> do
+      info <- lookupIdentInfo mo c
+      case info of
+        C.AbsCat co _ -> return co
+        C.AnyInd _ n  -> lookupCatContext gr n c
+        _ -> prtBad "unknown category" c
+    _ -> Bad $ prt m +++ "is not an abstract module"
+
+-- | lookup for transfer function: transfer-module-name, category name
+lookupTransfer :: GFCGrammar -> Ident -> Ident -> Err Term
+lookupTransfer gr m c = errIn ("looking up transfer of cat" +++ prt c) $ do
+  mi   <- lookupModule gr m
+  case mi of
+    ModMod mo -> do
+      info <- lookupIdentInfo mo c
+      case info of
+        C.AbsTrans t -> return t
+        C.AnyInd _ n  -> lookupTransfer gr n c
+        _ -> prtBad "cannot transfer function for" c
+    _ -> Bad $ prt m +++ "is not a transfer module"
+
+
+-- | should be revised (20\/9\/2003)
+isPrimitiveFun :: GFCGrammar -> Fun -> Bool
+isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of
+  Ok (Just (Eqs [])) -> True  -- is canonical
+  Ok (Just _)        -> False -- has defining clauses
+  _                  -> True  -- has no definition
+
+
+-- | looking up refinement terms
+lookupRef :: GFCGrammar -> Binds -> Term -> Err Val
+lookupRef gr binds at = case at of
+  Q m f  -> lookupFunType gr m f >>= return . vClos
+  Vr i   -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
+  EInt _ -> return valAbsInt
+  EFloat _ -> return valAbsFloat
+  K _    -> return valAbsString
+  _      -> prtBad "cannot refine with complex term" at ---
+
+refsForType :: (Val -> Type -> Bool) -> GFCGrammar -> Binds -> Val -> [(Term,(Val,Bool))]
+refsForType compat gr binds val =     
+    -- bound variables --- never recursive?
+    [(vr i, (t,False)) | (i,t) <- binds, Ok ty <- [val2exp t], compat val ty] ++
+    -- integer and string literals
+    [(EInt i, (val,False)) | val == valAbsInt, i <- [0,1,2,5,11,1978]] ++
+    [(EFloat i, (val,False)) | val == valAbsFloat, i <- [3.1415926]] ++
+    [(K s, (val,False)) | val == valAbsString, s <- ["foo", "NN", "x"]] ++
+    -- functions defined in the current abstract syntax
+    [(qq f, (vClos t,isRecursiveType t)) | (f,t) <- funsForType compat gr val]
+
+
+funRulesOf :: GFCGrammar -> [(Fun,Type)]
+funRulesOf gr = 
+----  funRulesForLiterals ++
+  [((i,f),typ) | (i, ModMod m) <- modules gr,
+                 mtype m == MTAbstract,
+                 (f, C.AbsFun typ _) <- tree2list (jments m)]
+
+-- testing for higher-order abstract syntax
+hasHOAS :: GFCGrammar -> Bool
+hasHOAS gr = any isHigherOrderType [t | (_,t) <- funRulesOf gr] where
+
+allCatsOf :: GFCGrammar -> [(Cat,Context)]
+allCatsOf gr = 
+  [((i,c),cont) | (i, ModMod m) <- modules gr,
+                    isModAbs m,
+                    (c, C.AbsCat cont _) <- tree2list (jments m)]
+
+allBindCatsOf :: GFCGrammar -> [Cat]
+allBindCatsOf gr = 
+  nub [c | (i, ModMod m) <- modules gr,
+                    isModAbs m,
+                    (c, C.AbsFun typ _) <- tree2list (jments m),
+                    Ok (cont,_) <- [firstTypeForm typ],
+                    c <- concatMap fst $ errVal [] $ mapM (catSkeleton . snd) cont
+                    ]
+
+funsForType :: (Val -> Type -> Bool) -> GFCGrammar -> Val -> [(Fun,Type)]
+funsForType compat gr val = [(fun,typ) | (fun,typ) <- funRulesOf gr, 
+                                         compat val typ]
+
+funsOnType :: (Val -> Type -> Bool) -> GFCGrammar -> Val -> [((Fun,Int),Type)]
+funsOnType compat gr = funsOnTypeFs compat (funRulesOf gr)
+
+funsOnTypeFs :: (Val -> Type -> Bool) -> [(Fun,Type)] -> Val -> [((Fun,Int),Type)]
+funsOnTypeFs compat fs val = [((fun,i),typ) | 
+                                       (fun,typ) <- fs,
+                                        Ok (args,_,_) <- [typeForm typ],
+                                        (i,arg) <- zip [0..] (map snd args),
+                                        compat val arg]
+
+allDefs :: GFCGrammar -> [(Fun,Term)]
+allDefs gr = [((i,c),d) | (i, ModMod m) <- modules gr,
+                    isModAbs m,
+                    (c, C.AbsFun _ d) <- tree2list (jments m)]
+
+-- | this is needed at compile time
+lookupFunTypeSrc :: Grammar -> Ident -> Ident -> Err Type
+lookupFunTypeSrc 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  -> lookupFunTypeSrc gr n c
+        _ -> prtBad "cannot find type of" c
+    _ -> Bad $ prt m +++ "is not an abstract module"
+
+-- | this is needed at compile time
+lookupCatContextSrc :: Grammar -> Ident -> Ident -> Err Context
+lookupCatContextSrc 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  -> lookupCatContextSrc gr n c
+        _ -> prtBad "unknown category" c
+    _ -> Bad $ prt m +++ "is not an abstract module"
diff --git a/src-2.9/GF/Grammar/Lookup.hs b/src-2.9/GF/Grammar/Lookup.hs
new file mode 100644
index 000000000..81a62decf
--- /dev/null
+++ b/src-2.9/GF/Grammar/Lookup.hs
@@ -0,0 +1,275 @@
+----------------------------------------------------------------------
+-- |
+-- 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,
+               linTypeInt
+	      ) where
+
+import GF.Data.Operations
+import GF.Grammar.Abstract
+import GF.Infra.Modules
+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 = look True m c where 
+  look isTop 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, 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) $ 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 tysts -> 
+            return [(map snd args,(val,tr)) | 
+                      (ty,tr) <- tysts, Ok (args,val) <- [typeFormCnc ty]]
+
+          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
+     App (Q (IC "Predef") (IC "Ints")) (EInt n) -> 
+       return [EInt i | i <- [0..n]]
+     QC p c -> lookupParamValues cnc p c
+     Q  p c -> lookupParamValues cnc p c ----
+     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"
+
+linTypeInt :: Type
+linTypeInt = defLinType
+---      let ints k = App (Q (IC "Predef") (IC "Ints")) (EInt k) in
+---      RecType [
+---        (LIdent "last",ints 9),(LIdent "s", typeStr), (LIdent "size",ints 1)]
+
+lookupLincat :: SourceGrammar -> Ident -> Ident -> Err Type
+lookupLincat gr m c | elem c [zIdent "Int"] = return linTypeInt
+lookupLincat gr m c | elem c [zIdent "String", zIdent "Float"] = 
+  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 zIdent 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-2.9/GF/Grammar/MMacros.hs b/src-2.9/GF/Grammar/MMacros.hs
new file mode 100644
index 000000000..dd7331685
--- /dev/null
+++ b/src-2.9/GF/Grammar/MMacros.hs
@@ -0,0 +1,341 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Grammar.Refresh
+import GF.Grammar.Values
+----import GrammarST
+import GF.Grammar.Macros
+
+import Control.Monad
+
+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
+
+uBoundVar :: Ident
+uBoundVar = zIdent "#h" -- used for suppressed bindings
+
+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 = zIdent . ('$':) . 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 $ prIdent x
+    
+string2var :: String -> Ident
+string2var s = case s of
+  c:'_':i -> identV (readIntArg i,[c]) ---
+  _ -> zIdent 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 $ prIdent x ++ "_" ++ 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-2.9/GF/Grammar/Macros.hs b/src-2.9/GF/Grammar/Macros.hs
new file mode 100644
index 000000000..7a48e7c3a
--- /dev/null
+++ b/src-2.9/GF/Grammar/Macros.hs
@@ -0,0 +1,814 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Grammar.PrGrammar
+
+import Control.Monad (liftM, liftM2)
+import Data.Char (isDigit)
+
+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
+
+cPredef :: Ident
+cPredef = identC "Predef"
+
+cnPredef :: String -> Term
+cnPredef f = Q cPredef (identC f)
+
+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)
+
+sortMCat :: String -> MCat
+sortMCat s = (zIdent "_", zIdent s)
+
+--- hack for Editing.actCat in empty state
+errorCat :: MCat
+errorCat = (zIdent "?", zIdent "?")
+
+getMCat :: Term -> Err MCat
+getMCat t = case t of
+  Q  m c -> return (m,c)
+  QC m c -> return (m,c)
+  Sort s -> return $ sortMCat s
+  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
+
+appc :: String -> [Term] -> Term
+appc = appCons . zIdent
+
+appqc :: String -> String -> [Term] -> Term
+appqc q c = mkApp (Q (zIdent q) (zIdent c))
+
+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 = (==)
+
+zIdent :: String -> Ident
+zIdent s = identC s
+
+uType :: Type
+uType = Cn (zIdent "UndefinedType")
+
+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]
+
+ident2label :: Ident -> Label
+ident2label c = LIdent (prIdent c)
+
+label2ident :: Label -> Ident
+label2ident = identC . prLabel
+
+prLabel :: Label -> String
+prLabel = prt
+
+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 [(zIdent x, t) | (LIdent x,(_,t)) <- fs]
+  _ -> prtBad "record expected, found" t
+
+typeType, typePType, typeStr, typeTok, typeStrs :: Term
+
+typeType  = srt "Type"
+typePType = srt "PType"
+typeStr   = srt "Str"
+typeTok   = srt "Tok"
+typeStrs  = srt "Strs"
+
+typeString, typeFloat, typeInt :: Term
+typeInts :: Integer -> Term
+
+typeString = constPredefRes "String"
+typeInt = constPredefRes "Int"
+typeFloat = constPredefRes "Float"
+typeInts i = App (constPredefRes "Ints") (EInt i)
+
+isTypeInts :: Term -> Bool
+isTypeInts ty = case ty of
+  App c _ -> c == constPredefRes "Ints"
+  _ -> False
+
+constPredefRes :: String -> Term
+constPredefRes s = Q (IC "Predef") (zIdent s)
+
+isPredefConstant :: Term -> Bool
+isPredefConstant t = case t of
+  Q (IC "Predef") _ -> True
+  Q (IC "PredefAbs") _ -> True
+  _ -> False
+
+isPredefAbsType :: Ident -> Bool
+isPredefAbsType c = elem c [zIdent "Int", zIdent "String"]
+
+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 = (wildIdent, typ)
+
+eqStrIdent :: Ident -> Ident -> Bool
+eqStrIdent = (==)
+
+tupleLabel, linLabel :: Int -> Label
+tupleLabel i = LIdent $ "p" ++ show i
+linLabel i = LIdent $ "s" ++ show i
+
+theLinLabel :: Label
+theLinLabel = LIdent "s"
+
+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 wildIdent
+
+mkFunType :: [Type] -> Type -> Type
+mkFunType tt t = mkProd ([(wildIdent, 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 [(LIdent "s",  typeStr)]
+
+-- | refreshing variables
+varX :: Int -> Ident
+varX i = identV (i,"x")
+
+-- | 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
+
+-- | create a constant
+string2CnTrm :: String -> Term
+string2CnTrm = Cn . zIdent
+
+symbolOfIdent :: Ident -> String
+symbolOfIdent = prIdent
+
+symid :: Ident -> String
+symid = symbolOfIdent
+
+vr :: Ident -> Term
+cn :: Ident -> Term
+srt :: String -> Term
+meta :: MetaSymb -> Term
+cnIC :: String -> Term
+
+vr = Vr
+cn = Cn
+srt = Sort
+meta = Meta
+cnIC = cn . IC
+
+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}
+
+linDefStr :: Term
+linDefStr = Abs s (R [assign (linLabel 0) (Vr s)]) where s = zIdent "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 (IC "@"), [Vr a,b]) -> do
+    b' <- term2patt b
+    return (PAs a b')
+  Ok ([], Cn (IC "-"), [a]) -> do
+    a' <- term2patt a
+    return (PNeg a')
+  Ok ([], Cn (IC "*"), [a]) -> do
+    a' <- term2patt a
+    return (PRep a')
+  Ok ([], Cn (IC "?"), []) -> do
+    return PChar
+  Ok ([], Cn (IC "[]"),[K s]) -> do
+    return $ PChars s
+  Ok ([], Cn (IC "+"), [a,b]) -> do
+    a' <- term2patt a
+    b' <- term2patt b
+    return (PSeq a' b')
+  Ok ([], Cn (IC "|"), [a,b]) -> 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 wildIdent             --- 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   -> appc "@" [Vr x, patt2term p]            --- an encoding
+  PChar     -> appc "?" []                             --- an encoding
+  PChars s  -> appc "[]" [K s]                         --- an encoding
+  PSeq a b  -> appc "+" [(patt2term a), (patt2term b)] --- an encoding
+  PAlt a b  -> appc "|" [(patt2term a), (patt2term b)] --- an encoding
+  PRep a    -> appc "*" [(patt2term a)]                --- an encoding
+  PNeg a    -> appc "-" [(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 s-fields; assumes term in normal form, preserves label
+allLinFields :: Term -> Err [[(Label,Term)]]
+allLinFields trm = case unComputed trm of
+----  R rs  -> return [[(l,t) | (l,(Just ty,t)) <- rs, isStrType ty]] -- good
+  R rs  -> return [[(l,t) | (l,(_,t)) <- rs, isLinLabel l]] ---- bad
+  FV ts -> do
+    lts <- mapM allLinFields ts
+    return $ concat lts
+  _ -> prtBad "fields can only be sought in a record not in" trm
+
+-- | deprecated
+isLinLabel :: Label -> Bool
+isLinLabel l = case l of
+     LIdent ('s':cs) | all isDigit cs -> True
+     _ -> False
+
+-- | 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 gather all linearizations; assumes normal form, preserves label and args
+allLinValues :: Term -> Err [[(Label,[([Patt],Term)])]]
+allLinValues trm = do
+  lts <- allLinFields trm
+  mapM (mapPairsM (return . allCaseValues)) lts
+
+-- | to mark str parts of fields in a record f by a function f
+markLinFields :: (Term -> Term) -> Term -> Term
+markLinFields f t = case t of
+    R r -> R $ map mkField r
+    _ -> t
+ where
+  mkField (l,(_,t)) = if (isLinLabel l) then (assign l (mkTbl t)) else (assign l t)
+  mkTbl t = case t of
+    T i cs -> T i [(p, mkTbl v) | (p,v) <- cs]
+    _ -> f t
+
+-- | 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
+
diff --git a/src-2.9/GF/Grammar/PatternMatch.hs b/src-2.9/GF/Grammar/PatternMatch.hs
new file mode 100644
index 000000000..b96d35b93
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Grammar/PrGrammar.hs b/src-2.9/GF/Grammar/PrGrammar.hs
new file mode 100644
index 000000000..c3a21d1d6
--- /dev/null
+++ b/src-2.9/GF/Grammar/PrGrammar.hs
@@ -0,0 +1,286 @@
+----------------------------------------------------------------------
+-- |
+-- 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, prPatt, prOperSignature,
+                  lookupIdent, lookupIdentInfo
+		 ) 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 qualified GF.Canon.PrintGFC as C
+import qualified GF.Canon.AbsGFC as A
+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
+
+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.Exp where prt = C.printTree
+instance Print A.Term where prt = C.printTree
+instance Print A.Case where prt = C.printTree
+instance Print A.CType where prt = C.printTree
+instance Print A.Label where prt = C.printTree
+instance Print A.Module where prt = C.printTree
+instance Print A.Def where prt = C.printTree
+instance Print A.Canon where prt = C.printTree
+instance Print A.Sort where prt = C.printTree
+
+instance Print A.Atom where 
+  prt = C.printTree
+  prt_ (A.AC c) = prt_ c
+  prt_ (A.AD c) = prt_ c
+  prt_ a = prt a
+
+instance Print A.Patt where 
+  prt = C.printTree
+  prt_ = prPatt
+
+instance Print A.CIdent where 
+  prt = C.printTree
+  prt_ (A.CIQ _ c) = prt c
+
+-- printing values and trees in editing
+
+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
+
+prPatt :: A.Patt -> String
+prPatt p = case p of
+  A.PC c ps -> prt_ c +++ unwords (map pr1 ps)
+  _ -> prt p --- PR
+ where
+   pr1 p = case p of
+     A.PC _ (_:_) -> prParenth $ prPatt p
+     _ -> prPatt p
+
+-- | option @-strip@ strips qualifications
+prTermOpt :: Options -> Term -> String
+prTermOpt opts = if oElem nostripQualif 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
+
+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 f a -> Ident -> Err a
+lookupIdentInfo mo i = lookupIdent i (jments mo)
diff --git a/src-2.9/GF/Grammar/Refresh.hs b/src-2.9/GF/Grammar/Refresh.hs
new file mode 100644
index 000000000..bc77c1837
--- /dev/null
+++ b/src-2.9/GF/Grammar/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.Grammar.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@(Module mt fs st me ops js) | (isModCnc mo || isModRes mo) -> do
+      (k',js') <- foldM refreshRes (k,[]) $ tree2list js
+      return (k', (i, ModMod(Module mt fs st me ops (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 tyts -> do
+      (k',tyts') <- liftM (\ (t,(_,i)) -> (i,t)) $ 
+                    appSTM (mapPairsM refresh tyts) (initIdStateN k)
+      return $ (k', (c, ResOverload 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-2.9/GF/Grammar/ReservedWords.hs b/src-2.9/GF/Grammar/ReservedWords.hs
new file mode 100644
index 000000000..b440141d6
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Grammar/SGrammar.hs b/src-2.9/GF/Grammar/SGrammar.hs
new file mode 100644
index 000000000..e0c001b6b
--- /dev/null
+++ b/src-2.9/GF/Grammar/SGrammar.hs
@@ -0,0 +1,169 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : SGrammar
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+--
+-- A simple format for context-free abstract syntax used e.g. in
+-- generation. AR 31\/3\/2006
+--
+-- (c) Aarne Ranta 2004 under GNU GPL
+--
+-- Purpose: to generate corpora. We use simple types and don't
+-- guarantee the correctness of bindings\/dependences.
+-----------------------------------------------------------------------------
+
+module GF.Grammar.SGrammar where
+
+import GF.Canon.GFC
+import GF.Grammar.LookAbs
+import GF.Grammar.PrGrammar
+import GF.Grammar.Macros
+import GF.Grammar.Values
+import GF.Grammar.Grammar
+import GF.Infra.Ident (Ident)
+
+import GF.Data.Operations
+import GF.Data.Zipper
+import GF.Infra.Option
+
+import Data.List
+
+-- (c) Aarne Ranta 2006 under GNU GPL
+
+
+type SGrammar = BinTree SCat [SRule]
+type SIdent = String
+type SRule = (SFun,SType)
+type SType = ([SCat],SCat)
+type SCat = SIdent
+type SFun = (Double,SIdent)
+
+allRules gr = concat [rs  | (c,rs) <- tree2list gr]
+
+data STree = 
+    SApp (SFun,[STree]) 
+  | SMeta SCat
+  | SString String
+  | SInt Integer
+  | SFloat Double
+   deriving (Show,Eq)
+
+depth :: STree -> Int
+depth t = case t of
+  SApp (_,ts@(_:_)) -> maximum (map depth ts) + 1
+  _ -> 1
+
+type Probs = BinTree Ident Double
+
+emptyProbs :: Probs
+emptyProbs = emptyBinTree
+
+prProbs :: Probs -> String
+prProbs = unlines . map pr . tree2list where
+  pr (f,p) = prt f ++ "\t" ++ show p
+
+------------------------------------------
+-- translate grammar to simpler form and generated trees back
+
+gr2sgr :: Options -> Probs -> GFCGrammar -> SGrammar
+gr2sgr opts probs gr = buildTree [(c,norm (noexp c rs)) | rs@((_,(_,c)):_) <- rules] where
+  noe = maybe [] (chunks ',') $ getOptVal opts (aOpt "noexpand")
+  only = maybe [] (chunks ',') $ getOptVal opts (aOpt "doexpand")
+  un  = getOptInt opts (aOpt "atoms")
+  rules =
+     prune $
+       groupBy (\x y -> scat x == scat y) $
+        sortBy (\x y -> compare (scat x) (scat y)) $
+          [(trId f, ty') | (f,ty) <- funRulesOf gr, ty' <- trTy ty]
+  trId (_,f) = let f' = prt f in case lookupTree prt f probs of
+    Ok p -> (p,f')
+    _ -> (2.0, f')
+  trTy ty = case catSkeleton ty of
+    Ok (mcs,mc) -> [(map trCat mcs, trCat mc)]
+    _ -> []
+  trCat (m,c) = prt c ---
+  scat (_,(_,c)) = c
+
+  prune rs = maybe rs (\n -> map (onlyAtoms n) rs) $ un
+
+  norm = fillProb
+
+  onlyAtoms n rs = 
+    let (rs1,rs2) = partition atom rs 
+    in take n rs1 ++ rs2
+  atom = null . fst . snd
+
+  noexp c rs 
+    | null only = if elem c noe then [((2.0,'?':c),([],c))] else rs
+    | otherwise = if elem c only then rs else [((2.0,'?':c),([],c))]
+
+-- for cases where explicit probability is not given (encoded as
+-- p > 1) divide the remaining mass by the number of such cases
+
+fillProb :: [SRule] -> [SRule]
+fillProb rs = [((defa p,f),ty) | ((p,f),ty) <- rs] where
+  defa p = if p > 1.0 then def else p
+  def = (1 - sum given) / genericLength nope 
+  (nope,given) = partition (> 1.0) [p | ((p,_),_) <- rs]
+
+-- str2tr :: STree -> Exp
+str2tr t = case t of
+  SApp ((_,'?':c),[]) -> mkMeta 0 -- from noexpand=c
+  SApp ((_,f),ts) -> mkApp (trId f) (map str2tr ts) 
+  SMeta _     -> mkMeta 0
+  SString s   -> K s
+  SInt i      -> EInt i
+  SFloat i    -> EFloat i
+ where
+   trId = cn . zIdent
+
+-- tr2str :: Tree -> STree
+tr2str (Tr (N (_,at,val,_,_),ts)) = case (at,val) of
+  (AtC (_,f), _)         -> SApp ((2.0,prt_ f),map tr2str ts)
+  (AtM _,     v)         -> SMeta (catOf v)
+  (AtL s,     _)         -> SString s
+  (AtI i,     _)         -> SInt i
+  (AtF i,     _)         -> SFloat i
+  _ -> SMeta "FAILED_TO_GENERATE" ---- err monad!
+ where
+   catOf v = case v of
+     VApp w _  -> catOf w
+     VCn (_,c) -> prt_ c
+     _ -> "FAILED_TO_GENERATE_FROM_META"
+
+
+------------------------------------------
+-- to test
+
+prSTree t = case t of
+  SApp ((_,f),ts) -> f ++ concat (map pr1 ts)
+  SMeta c -> '?':c
+  SString s -> prQuotedString s
+  SInt i -> show i 
+  SFloat i -> show i 
+ where
+  pr1 t@(SApp (_,ts)) = ' ' : (if null ts then id else prParenth) (prSTree t)
+  pr1 t = prSTree t
+
+pSRule :: String -> SRule
+pSRule s = case words s of
+  f : _ : cs -> ((2.0,f),(init cs', last cs')) 
+    where cs' = [cs !! i | i <- [0,2..length cs - 1]]
+  _ -> error $ "not a rule" +++ s
+
+exSgr = map pSRule [
+   "Pred   : NP -> VP -> S"
+  ,"Compl  : TV -> NP -> VP" 
+  ,"PredVV : VV -> VP -> VP"
+  ,"DefCN  : CN -> NP"
+  ,"ModCN  : AP -> CN -> CN" 
+  ,"john   : NP"
+  ,"walk   : VP"
+  ,"love   : TV"
+  ,"try    : VV"
+  ,"girl   : CN"
+  ,"big    : AP"
+  ]
diff --git a/src-2.9/GF/Grammar/TC.hs b/src-2.9/GF/Grammar/TC.hs
new file mode 100644
index 000000000..be52d1889
--- /dev/null
+++ b/src-2.9/GF/Grammar/TC.hs
@@ -0,0 +1,299 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Grammar.TC (AExp(..),
+	   Theory,
+	   checkExp,
+	   inferExp,
+           checkEqs,
+	   eqVal,
+	   whnf
+	  ) where
+
+import GF.Data.Operations
+import GF.Grammar.Abstract
+import GF.Grammar.AbsCompute
+
+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 && (elem c (map identC ["Int","String","Float"])) ->
+                                       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
+ where
+   predefAbs c s = case c of
+     IC "Int" -> return $ const $ Q cPredefAbs cInt
+     IC "Float" -> return $ const $ Q cPredefAbs cFloat
+     IC "String" -> return $ const $ Q cPredefAbs cString
+     _ -> Bad s
+
+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-2.9/GF/Grammar/TypeCheck.hs b/src-2.9/GF/Grammar/TypeCheck.hs
new file mode 100644
index 000000000..97b7ff243
--- /dev/null
+++ b/src-2.9/GF/Grammar/TypeCheck.hs
@@ -0,0 +1,311 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Grammar.TypeCheck (-- * top-level type checking functions; TC should not be called directly.
+		  annotate, annotateIn,
+		  justTypeCheck, checkIfValidExp,
+		  reduceConstraints, 
+		  splitConstraints,
+		  possibleConstraints,
+		  reduceConstraintsNode,
+		  performMetaSubstNode,
+		  -- * some top-level batch-mode checkers for the compiler
+		  justTypeCheckSrc,
+		  grammar2theorySrc,
+		  checkContext,
+		  checkTyp,
+		  checkEquation,
+		  checkConstrs,
+		  editAsTermCommand,
+		  exp2termCommand,
+		  exp2termlistCommand,
+		  tree2termlistCommand
+		 ) where
+
+import GF.Data.Operations
+import GF.Data.Zipper
+
+import GF.Grammar.Abstract
+import GF.Grammar.AbsCompute
+import GF.Grammar.Refresh
+import GF.Grammar.LookAbs
+import qualified GF.Grammar.Lookup as Lookup ---
+
+import GF.Grammar.TC
+
+import GF.Grammar.Unify ---
+
+import Control.Monad (foldM, liftM, liftM2)
+import Data.List (nub) ---
+
+-- top-level type checking functions; TC should not be called directly.
+
+annotate :: GFCGrammar -> Exp -> Err Tree
+annotate gr exp = annotateIn gr [] exp Nothing 
+
+-- | type check in empty context, return a list of constraints
+justTypeCheck :: GFCGrammar -> Exp -> Val -> Err Constraints
+justTypeCheck gr e v = do
+  (_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v
+  constrs1     <- reduceConstraints (lookupAbsDef gr) 0 constrs0
+  return $ fst $ splitConstraints gr constrs1
+
+-- | type check in empty context, return the expression itself if valid
+checkIfValidExp :: GFCGrammar -> Exp -> Err Exp
+checkIfValidExp gr e = do
+  (_,_,constrs0) <- inferExp (grammar2theory gr) (initTCEnv []) e
+  constrs1       <- reduceConstraints (lookupAbsDef gr) 0 constrs0
+  ifNull (return e) (Bad  . unwords . prConstrs) constrs1
+
+annotateIn :: GFCGrammar -> Binds -> Exp -> Maybe Val -> Err Tree
+annotateIn gr gamma exp = maybe (infer exp) (check exp) where
+  infer e = do 
+    (a,_,cs) <- inferExp theory env e
+    aexp2treeC (a,cs)
+  check e v = do
+    (a,cs) <- checkExp theory env e v
+    aexp2treeC (a,cs)
+  env = initTCEnv gamma
+  theory = grammar2theory gr 
+  aexp2treeC (a,c) = do
+    c' <- reduceConstraints (lookupAbsDef gr) (length gamma) c
+    aexp2tree (a,c')
+
+-- | invariant way of creating TCEnv from context
+initTCEnv gamma = 
+  (length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma) 
+
+-- | process constraints after eqVal by computing by defs
+reduceConstraints :: LookDef -> Int -> Constraints -> Err Constraints
+reduceConstraints look i = liftM concat . mapM redOne where
+  redOne (u,v) = do
+    u' <- computeVal look u
+    v' <- computeVal look v
+    eqVal i u' v' 
+
+computeVal :: LookDef -> Val -> Err Val
+computeVal look v = case v of
+  VClos g@(_:_) e -> do
+    e' <- compt (map fst g) e          --- bindings of g in e?
+    whnf $ VClos g e'
+{- ----
+  _ -> do            ---- how to compute a Val, really??
+    e  <- val2exp v
+    e' <- compt [] e
+    whnf $ vClos e'
+-}
+  VApp f c -> liftM2 VApp (compv f) (compv c) >>= whnf
+  _ -> whnf v
+ where
+   compt = computeAbsTermIn look
+   compv = computeVal look
+
+-- | take apart constraints that have the form (? <> t), usable as solutions
+splitConstraints :: GFCGrammar -> Constraints -> (Constraints,MetaSubst)
+splitConstraints gr = splitConstraintsGen (lookupAbsDef gr)
+
+splitConstraintsSrc :: Grammar -> Constraints -> (Constraints,MetaSubst)
+splitConstraintsSrc gr = splitConstraintsGen (Lookup.lookupAbsDef gr)
+
+splitConstraintsGen :: LookDef -> Constraints -> (Constraints,MetaSubst)
+splitConstraintsGen look cs = csmsu where
+
+  csmsu       = (nub [(a,b) | (a,b) <- csf1,a /= b],msf1)
+  (csf1,msf1) = unif (csf,msf)  -- alternative: filter first
+  (csf,msf)   = foldr mkOne ([],[]) cs
+
+  csmsf     = foldr mkOne ([],msu) csu
+  (csu,msu) = unif (cs1,[])    -- alternative: unify first
+
+  cs1 = errVal cs $ reduceConstraints look 0 cs
+
+  mkOne (u,v) = case (u,v) of
+    (VClos g (Meta m), v) | null g -> sub m v
+    (v, VClos g (Meta m)) | null g -> sub m v
+    -- do nothing if meta has nonempty closure; null g || isConstVal v WAS WRONG
+    c -> con c
+  con c (cs,ms) = (c:cs,ms)
+  sub m v (cs,ms) = (cs,(m,v):ms)
+
+  unifo = id -- alternative: don't use unification
+
+  unif cm@(cs,ms) = errVal cm $ do --- alternative: use unification  
+    (cs',ms') <- unifyVal cs
+    return (cs', ms' ++ ms)
+
+performMetaSubstNode :: MetaSubst -> TrNode -> TrNode
+performMetaSubstNode subst n@(N (b,a,v,(c,m),s)) = let
+  v' = metaSubstVal v
+  b' = [(x,metaSubstVal v) | (x,v) <- b]
+  c' = [(u',v') | (u,v) <- c, 
+                  let (u',v') = (metaSubstVal u, metaSubstVal v), u' /= v']
+  in N (b',a,v',(c',m),s)
+ where
+   metaSubstVal u = errVal u $ whnf $ case u of
+     VApp  f a -> VApp  (metaSubstVal f) (metaSubstVal a)
+     VClos g e -> VClos [(x,metaSubstVal v) | (x,v) <- g] (metaSubstExp e)
+     _ -> u
+   metaSubstExp e = case e of
+     Meta m -> errVal e $ maybe (return e) val2expSafe $ lookup m subst
+     _ -> composSafeOp metaSubstExp e
+
+reduceConstraintsNode :: GFCGrammar -> TrNode -> TrNode
+reduceConstraintsNode gr = changeConstrs red where
+  red cs = errVal cs $ reduceConstraints (lookupAbsDef gr) 0 cs
+
+-- | weak heuristic to narrow down menus; not used for TC. 15\/11\/2001.
+-- the age-old method from GF 0.9
+possibleConstraints :: GFCGrammar -> Constraints -> Bool
+possibleConstraints gr = and . map (possibleConstraint gr)
+
+possibleConstraint :: GFCGrammar -> (Val,Val) -> Bool
+possibleConstraint gr (u,v) = errVal True $ do
+    u' <- val2exp u >>= compute gr
+    v' <- val2exp v >>= compute gr
+    return $ cts u' v'
+ where
+  cts t u = isUnknown t || isUnknown u || case (t,u) of
+    (Q m c,      Q n d)      -> c == d || notCan (m,c) || notCan (n,d)
+    (QC m c,     QC n d)     -> c == d
+    (App f a,    App g b)    -> cts f g && cts a b
+    (Abs x b,    Abs y c)    -> cts b c
+    (Prod x a f, Prod y b g) -> cts a b && cts f g
+    (_         , _)          -> False
+
+  isUnknown t = case t of
+    Vr _ -> True
+    Meta _ -> True
+    _ -> False
+
+  notCan = not . isPrimitiveFun gr
+
+-- 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
+
+grammar2theory :: GFCGrammar -> 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
+
+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
+
+justTypeCheckSrc :: Grammar -> Exp -> Val -> Err Constraints
+justTypeCheckSrc gr e v = do
+  (_,constrs0) <- checkExp (grammar2theorySrc 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
+
+grammar2theorySrc :: Grammar -> Theory
+grammar2theorySrc gr (m,f) = case lookupFunTypeSrc gr m f of
+  Ok t -> return $ type2val t
+  Bad s -> case lookupCatContextSrc 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 $ justTypeCheckSrc gr typ vType
+
+checkEquation :: Grammar -> Fun -> Trm -> [String]
+checkEquation gr (m,fun) def = err singleton id $ do
+  typ  <- lookupFunTypeSrc gr m fun
+----  cs   <- checkEqs (grammar2theorySrc gr) (initTCEnv []) ((m,fun),def) (vClos typ)
+  cs   <- justTypeCheckSrc gr def (vClos typ)
+  let cs1 = filter notJustMeta cs ----- filter (not . possibleConstraint gr) cs ----
+  return $ ifNull [] (singleton . prConstraints) cs1
+
+checkConstrs :: Grammar -> Cat -> [Ident] -> [String]
+checkConstrs gr cat _ = [] ---- check constructors!
+
+
+
+
+
+ 
+{- ----
+err singleton concat . mapM checkOne where
+  checkOne con = do
+    typ   <- lookupFunType gr con
+    typ'  <- computeAbsTerm gr typ
+    vcat  <- valCat typ'
+    return $ if (cat == vcat) then [] else ["wrong type in constructor" +++ prt con]
+-}
+
+editAsTermCommand :: GFCGrammar -> (Loc TrNode -> Err (Loc TrNode)) -> Exp -> [Exp]
+editAsTermCommand gr c e = err (const []) singleton $ do
+  t  <- annotate gr $ refreshMetas [] e
+  t' <- c $ tree2loc t
+  return $ tree2exp $ loc2tree t'
+
+exp2termCommand :: GFCGrammar -> (Exp -> Err Exp) -> Tree -> Err Tree
+exp2termCommand gr f t = errIn ("modifying term" +++ prt t) $ do
+  let exp = tree2exp t
+  exp2 <- f exp
+  annotate gr exp2
+
+exp2termlistCommand :: GFCGrammar -> (Exp -> [Exp]) -> Tree -> [Tree]
+exp2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f . tree2exp
+
+tree2termlistCommand :: GFCGrammar -> (Tree -> [Exp]) -> Tree -> [Tree]
+tree2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f 
diff --git a/src-2.9/GF/Grammar/Unify.hs b/src-2.9/GF/Grammar/Unify.hs
new file mode 100644
index 000000000..588c1b306
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Grammar/Values.hs b/src-2.9/GF/Grammar/Values.hs
new file mode 100644
index 000000000..6e029d98b
--- /dev/null
+++ b/src-2.9/GF/Grammar/Values.hs
@@ -0,0 +1,109 @@
+----------------------------------------------------------------------
+-- |
+-- 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,
+	       cType, cPredefAbs, cInt, cFloat, cString,
+	       eType, tree2exp, loc2treeFocus
+	      ) where
+
+import GF.Data.Operations
+import GF.Data.Zipper
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+
+-- 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
+
+cType :: Ident
+cType = identC "Type" --- #0
+
+cPredefAbs :: Ident
+cPredefAbs = identC "PredefAbs"
+
+cInt :: Ident
+cInt = identC "Int"
+
+cFloat :: Ident
+cFloat = identC "Float"
+
+cString :: Ident
+cString = identC "String"
+
+isPredefCat :: Ident -> Bool
+isPredefCat c = elem c [cInt,cString,cFloat]
+
+eType :: Exp
+eType = Sort "Type"
+
+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-2.9/GF/IDE/IDECommands.hs b/src-2.9/GF/IDE/IDECommands.hs
new file mode 100644
index 000000000..56d392a71
--- /dev/null
+++ b/src-2.9/GF/IDE/IDECommands.hs
@@ -0,0 +1,95 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : IDECommands
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.2 $
+--
+-- Commands usable in grammar-writing IDE.
+-----------------------------------------------------------------------------
+
+module GF.IDE.IDECommands where
+
+import GF.Infra.Ident (Ident, identC)
+import GF.Compile.ShellState
+import qualified GF.Shell.ShellCommands as S
+import qualified GF.Shell.Commands as E
+import qualified GF.Shell.CommandL as PE
+import GF.UseGrammar.Session
+import GF.UseGrammar.Custom
+import GF.Grammar.PrGrammar
+
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Infra.Modules
+import GF.Infra.UseIO
+
+data IDEState = IDE {
+  ideShellState :: ShellState, 
+  ideAbstract   :: Maybe Ident,
+  ideConcretes  :: [Ident],
+  ideCurrentCnc :: Maybe Ident,
+  ideCurrentLin :: Maybe Ident, -- lin or lincat
+  ideSState     :: Maybe SState
+  }
+
+emptyIDEState :: ShellState -> IDEState
+emptyIDEState shst = IDE shst Nothing [] Nothing Nothing Nothing
+
+data IDECommand =
+    IDEInit
+  | IDEAbstract Ident
+  | IDEConcrete Ident
+  | IDELin      Ident
+  | IDEShell    String -- S.Command
+  | IDEEdit     String -- E.Command
+  | IDEQuit
+  | IDEVoid     String -- the given command itself maybe
+
+
+execIDECommand :: IDECommand -> IDEState -> IOE IDEState
+execIDECommand c state = case c of
+  IDEInit -> 
+    return $ emptyIDEState env
+  IDEAbstract a -> 
+    return $ state {ideAbstract = Just a} ---- check a exists or import it
+  IDEConcrete a -> 
+    return $ state {ideCurrentCnc = Just a} ---- check a exists or import it
+  IDELin a -> 
+    return $ state {ideCurrentLin = Just a} ---- check a exists
+  IDEEdit s ->
+    execEdit s
+  IDEShell s ->
+    execShell s
+  IDEVoid s  -> ioeErr $ fail s
+  _ -> ioeErr $ fail "command not implemented"
+
+ where
+   env = ideShellState state
+   sstate = maybe initSState id $ ideSState state
+
+   execShell s = execEdit $ "gf" +++ s
+
+   execEdit s = ioeIO $ do
+     (env',sstate') <- E.execCommand env (PE.pCommand s) sstate
+     return $ state {ideShellState = env', ideSState = Just sstate'}
+
+   putMsg = putStrLn ---- XML
+
+pCommands :: String -> [IDECommand]
+pCommands = map pCommand . concatMap (chunks ";;" . words) . lines
+
+pCommand :: [String] -> IDECommand
+pCommand ws = case ws of
+  "gf"       : s     -> IDEShell $ unwords s
+  "edit"     : s     -> IDEEdit  $ unwords s
+  "abstract" : a : _ -> IDEAbstract $ identC a
+  "concrete" : a : _ -> IDEConcrete $ identC a
+  "lin"      : a : _ -> IDELin      $ identC a
+  "empty"    : _     -> IDEInit
+  "quit"     : _     -> IDEQuit
+  _                  -> IDEVoid $ unwords ws
diff --git a/src-2.9/GF/Infra/CheckM.hs b/src-2.9/GF/Infra/CheckM.hs
new file mode 100644
index 000000000..251ed2b8b
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Infra/Comments.hs b/src-2.9/GF/Infra/Comments.hs
new file mode 100644
index 000000000..0126db468
--- /dev/null
+++ b/src-2.9/GF/Infra/Comments.hs
@@ -0,0 +1,43 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Comments
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:34 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- comment removal
+-----------------------------------------------------------------------------
+
+module GF.Infra.Comments ( remComments
+		) where
+
+-- | comment removal : line tails prefixed by -- as well as chunks in @{- ... -}@
+remComments :: String -> String
+remComments s = 
+  case s of
+    '"':s2 -> '"':pass remComments s2 -- comment marks in quotes not removed!
+    '{':'-':cs -> readNested cs
+    '-':'-':cs -> readTail cs
+    c:cs -> c : remComments cs
+    [] -> []
+   where
+     readNested t = 
+       case t of
+         '"':s2 -> '"':pass readNested s2
+         '-':'}':cs -> remComments cs
+         _:cs -> readNested cs
+         [] -> []
+     readTail t = 
+       case t of
+         '\n':cs -> '\n':remComments cs
+         _:cs -> readTail cs
+         [] -> []
+     pass f t = 
+       case t of
+         '"':s2 -> '"': f s2
+         c:s2 -> c:pass f s2
+         _ -> t
diff --git a/src-2.9/GF/Infra/CompactPrint.hs b/src-2.9/GF/Infra/CompactPrint.hs
new file mode 100644
index 000000000..486c9e183
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Infra/Ident.hs b/src-2.9/GF/Infra/Ident.hs
new file mode 100644
index 000000000..5ed860990
--- /dev/null
+++ b/src-2.9/GF/Infra/Ident.hs
@@ -0,0 +1,155 @@
+----------------------------------------------------------------------
+-- |
+-- 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(..), prIdent,
+	      identC, identV, identA, identAV, identW,
+	      argIdent, strVar, wildIdent, isWildIdent,
+	      newIdent, mkIdent, varIndex,
+	      -- * refreshing identifiers
+	      IdState, initIdStateN, initIdState,
+	      lookVar, refVar, refVarPlus
+	     ) where
+
+import GF.Data.Operations
+-- import Monad
+
+
+-- | the constructors labelled /INTERNAL/ are
+-- internal representation never returned by the parser
+data Ident = 
+   IC String            -- ^ raw identifier after parsing, resolved in Rename
+ | IW                   -- ^ wildcard
+--
+-- below this constructor: internal representation never returned by the parser
+ | IV (Int,String)      -- ^ /INTERNAL/ variable
+ | IA (String,Int)      -- ^ /INTERNAL/ argument of cat at position
+ | IAV (String,Int,Int) -- ^ /INTERNAL/ argument of cat with bindings at position
+-- 
+
+  deriving (Eq, Ord, Show, Read)
+
+prIdent :: Ident -> String
+prIdent i = case i of
+  IC s -> s
+  IV (n,s) -> s ++ "_" ++ show n
+  IA (s,j) -> s ++ "_" ++ show j
+  IAV (s,b,j) -> s ++ "_" ++ show b ++ "_" ++ show j
+  IW -> "_"
+
+identC :: String -> Ident
+identV :: (Int, String) -> Ident
+identA :: (String, Int) -> Ident
+identAV:: (String, 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
+strVar :: Ident
+strVar = identA ("str",0)
+
+-- | wild card
+wildIdent :: Ident
+wildIdent = identW
+
+isWildIdent :: Ident -> Bool
+isWildIdent x = case x of
+  IW -> True
+  IC "_" -> True
+  _ -> False
+
+newIdent :: Ident
+newIdent = identC "#h"
+
+mkIdent :: String -> Int -> Ident
+mkIdent s i = identV (i,s)
+
+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 (m, prIdent x)
+  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-2.9/GF/Infra/Modules.hs b/src-2.9/GF/Infra/Modules.hs
new file mode 100644
index 000000000..4d50608c6
--- /dev/null
+++ b/src-2.9/GF/Infra/Modules.hs
@@ -0,0 +1,416 @@
+----------------------------------------------------------------------
+-- |
+-- 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,
+		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 f a = MGrammar {modules :: [(i,ModInfo i f a)]}
+  deriving Show
+
+data ModInfo i f a =
+    ModMainGrammar (MainGrammar i)
+  | ModMod  (Module i f a)
+  | ModWith (Module i f a) (i,MInclude i) [OpenSpec i]
+  deriving Show
+
+data Module i f a = Module {
+    mtype   :: ModuleType i ,
+    mstatus :: ModuleStatus ,
+    flags   :: [f] ,
+    extend  :: [(i,MInclude i)],
+    opens   :: [OpenSpec i] ,
+    jments  :: BinTree i a
+  }
+---  deriving Show
+instance Show (Module i f 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 f 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 f a -> MGrammar i f a -> MGrammar i f 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 f t -> i -> t -> Module i f t
+updateModule (Module  mt ms fs me ops js) i t = 
+  Module mt ms fs me ops (updateTree (i,t) js)
+
+replaceJudgements :: Module i f t -> BinTree i t -> Module i f t
+replaceJudgements (Module mt ms fs me ops _) js = Module mt ms fs me ops js
+
+addOpenQualif :: i -> i -> Module i f t -> Module i f t
+addOpenQualif i j (Module mt ms fs me ops js) = 
+  Module mt ms fs me (oQualif i j : ops) js
+
+addFlag :: f -> Module i f t -> Module i f t
+addFlag f mo = mo {flags = f : flags mo} 
+
+flagsModule :: (i,ModInfo i f a) -> [f]
+flagsModule (_,mi) = case mi of
+  ModMod m -> flags m
+  _ -> []
+
+allFlags :: MGrammar i f a -> [f]
+allFlags gr = concat $ map flags $ [m | (_, ModMod m) <- modules gr]
+
+mapModules :: (Module i f a -> Module i f a) 
+	   -> MGrammar i f a -> MGrammar i f 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 f 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 f 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 f a -> Module i f 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 f a -> (i,ModInfo i f a) -> MGrammar i f 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 f 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 f 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 f 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 f 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 f 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 f a -> i -> ModInfo i f a -> MGrammar i f a
+addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
+
+emptyMGrammar :: MGrammar i f a
+emptyMGrammar = MGrammar []
+
+emptyModInfo :: ModInfo i f a
+emptyModInfo = ModMod emptyModule
+
+emptyModule :: Module i f a
+emptyModule = Module MTResource MSComplete [] [] [] emptyBinTree
+
+-- | we store the module type with the identifier
+data IdentM i = IdentM {
+  identM :: i ,
+  typeM  :: ModuleType i
+  }
+  deriving (Eq,Show)
+
+typeOfModule :: ModInfo i f a -> ModuleType i
+typeOfModule mi = case mi of
+  ModMod m -> mtype m
+
+abstractOfConcrete :: (Show i, Eq i) => MGrammar i f 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 f a -> i -> Err (Module i f 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 f a -> i -> Err (ModInfo i f 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 f a -> i -> Err (ModuleType i)
+lookupModuleType gr m = do
+  mi <- lookupModule gr m
+  return $ typeOfModule mi
+
+lookupModMod :: (Show i,Eq i) => MGrammar i f a -> i -> Err (Module i f 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 f a -> i -> Err a
+lookupInfo mo i = lookupTree show i (jments mo)
+
+allModMod :: (Show i,Eq i) => MGrammar i f a -> [(i,Module i f a)]
+allModMod gr = [(i,m) | (i, ModMod m) <- modules gr]
+
+isModAbs :: Module i f a -> Bool
+isModAbs m = case mtype m of
+  MTAbstract -> True
+----  MTUnion t -> isModAbs t
+  _ -> False
+
+isModRes :: Module i f 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 f a -> Bool
+isModCnc m = case mtype m of
+  MTConcrete _ -> True
+----  MTUnion t -> isModCnc t
+  _ -> False
+
+isModTrans :: Module i f 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 f 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 f a -> Bool
+isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
+
+
+-- | all abstract modules sorted from least to most dependent
+allAbstracts :: Eq i => MGrammar i f 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 f a -> Maybe i
+greatestAbstract gr = case allAbstracts gr of
+  [] -> Nothing
+  as -> return $ last as
+
+-- | all resource modules
+allResources :: MGrammar i f a -> [i]
+allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m]
+
+-- | the greatest resource in dependency order
+greatestResource :: MGrammar i f a -> Maybe i
+greatestResource gr = case allResources gr of
+  [] -> Nothing
+  a -> return $ head a
+
+-- | all concretes for a given abstract
+allConcretes :: Eq i => MGrammar i f 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 f a -> [i]
+allConcreteModules gr = 
+  [i | (i, ModMod m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]
diff --git a/src-2.9/GF/Infra/Option.hs b/src-2.9/GF/Infra/Option.hs
new file mode 100644
index 000000000..a44cd9db8
--- /dev/null
+++ b/src-2.9/GF/Infra/Option.hs
@@ -0,0 +1,375 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Option
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.34 $
+--
+-- Options and flags used in GF shell commands and files.
+--
+-- The types 'Option' and 'Options' should be kept abstract, but:
+--
+--   - The constructor 'Opt' is used in "ShellCommands" and "GrammarToSource"
+--
+--   - The constructor 'Opts' us udes in "API", "Shell" and "ShellCommands"
+-----------------------------------------------------------------------------
+
+module GF.Infra.Option where
+
+import Data.List (partition)
+import Data.Char (isDigit)
+
+-- * all kinds of options, to be kept abstract
+
+newtype Option = Opt (String,[String]) deriving (Eq,Show,Read)
+newtype Options = Opts [Option] deriving (Eq,Show,Read)
+
+noOptions :: Options
+noOptions = Opts []
+
+-- | simple option -o
+iOpt :: String -> Option
+iOpt o = Opt (o,[])   
+
+-- | option with argument -o=a
+aOpt :: String -> String -> Option
+aOpt o a = Opt (o,[a])  
+
+iOpts :: [Option] -> Options
+iOpts = Opts
+
+-- | value of option argument
+oArg :: String -> String
+oArg s = s 
+
+oElem :: Option -> Options -> Bool
+oElem o (Opts os) = elem o os
+
+eqOpt :: String -> Option -> Bool
+eqOpt s (Opt (o, [])) = s == o
+eqOpt s _ = False
+
+type OptFun = String -> Option
+type OptFunId = String
+
+getOptVal :: Options -> OptFun -> Maybe String
+getOptVal (Opts os) fopt = 
+  case [a | opt@(Opt (o,[a])) <- os, opt == fopt a] of
+    a:_ -> Just a
+    _ -> Nothing
+
+isSetFlag :: Options -> OptFun -> Bool
+isSetFlag (Opts os) fopt = 
+  case [a | opt@(Opt (o,[a])) <- os, opt == fopt a] of
+    a:_ -> True
+    _ -> False
+
+getOptInt :: Options -> OptFun -> Maybe Int
+getOptInt opts f = do
+  s <- getOptVal opts f
+  if (not (null s) && all isDigit s) then return (read s) else Nothing 
+
+optIntOrAll :: Options -> OptFun -> [a] -> [a]
+optIntOrAll opts f = case getOptInt opts f of
+  Just i -> take i
+  _ -> id
+
+optIntOrN :: Options -> OptFun -> Int -> Int
+optIntOrN opts f n = case getOptInt opts f of
+  Just i -> i
+  _ -> n
+
+optIntOrOne :: Options -> OptFun -> Int
+optIntOrOne opts f = optIntOrN opts f 1
+
+changeOptVal :: Options -> OptFun -> String -> Options
+changeOptVal os f x = 
+  addOption (f x) $ maybe os (\y -> removeOption (f y) os) $ getOptVal os f
+
+addOption :: Option -> Options -> Options
+addOption o (Opts os) = iOpts (o:os)
+
+addOptions :: Options -> Options -> Options
+addOptions (Opts os) os0 = foldr addOption os0 os
+
+concatOptions :: [Options] -> Options
+concatOptions = foldr addOptions noOptions
+
+removeOption :: Option -> Options -> Options
+removeOption o (Opts os) = iOpts (filter (/=o) os)
+
+removeOptions :: Options -> Options -> Options
+removeOptions (Opts os) os0 = foldr removeOption os0 os
+
+options :: [Option] -> Options
+options = foldr addOption noOptions
+
+unionOptions :: Options -> Options -> Options
+unionOptions (Opts os) (Opts os') = Opts (os ++ os')
+
+-- * parsing options, with prefix pre (e.g. \"-\")
+
+getOptions :: String -> [String] -> (Options, [String])
+getOptions pre inp = let
+  (os,rest) = span (isOption pre) inp -- options before args
+  in
+  (Opts (map (pOption pre) os), rest)
+
+pOption :: String -> String -> Option
+pOption pre s = case span (/= '=') (drop (length pre) s) of
+  (f,_:a) -> aOpt f a
+  (o,[])  -> iOpt o
+
+isOption :: String -> String -> Bool
+isOption pre = (==pre) . take (length pre)
+
+-- * printing options, without prefix
+
+prOpt :: Option -> String
+prOpt (Opt (s,[])) = s
+prOpt (Opt (s,xs)) = s ++ "=" ++ concat xs
+
+prOpts :: Options -> String
+prOpts (Opts os) = unwords $ map prOpt os
+
+-- * a suggestion for option names
+
+-- ** parsing
+
+strictParse, forgiveParse, ignoreParse, literalParse, rawParse, firstParse :: Option
+-- | parse as term instead of string
+dontParse :: Option
+
+strictParse  = iOpt "strict"
+forgiveParse = iOpt "n"
+ignoreParse  = iOpt "ign"
+literalParse = iOpt "lit"
+rawParse     = iOpt "raw"
+firstParse   = iOpt "1"
+dontParse    = iOpt "read" 
+
+newParser, newerParser, newCParser, newMParser :: Option
+newParser   = iOpt "new"
+newerParser = iOpt "newer"
+newCParser  = iOpt "cfg"
+newMParser  = iOpt "mcfg"
+newFParser  = iOpt "fcfg"
+
+{-
+useParserMCFG, useParserMCFGviaCFG, useParserCFG, useParserCF :: Option
+
+useParserMCFG = iOpt "mcfg"
+useParserMCFGviaCFG = iOpt "mcfg-via-cfg"
+useParserCFG = iOpt "cfg"
+useParserCF = iOpt "cf"
+-}
+
+-- ** grammar formats
+
+showAbstr, showXML, showOld, showLatex, showFullForm,
+  showEBNF, showCF, showWords, showOpts,
+  isCompiled, isHaskell, noCompOpers, retainOpers,
+  noCF, checkCirc, noCheckCirc, lexerByNeed, useUTF8id :: Option
+defaultGrOpts :: [Option]
+
+showAbstr   = iOpt "abs"
+showXML     = iOpt "xml"
+showOld     = iOpt "old"
+showLatex   = iOpt "latex"
+showFullForm = iOpt "fullform" 
+showEBNF    = iOpt "ebnf"
+showCF      = iOpt "cf"
+showWords   = iOpt "ws"
+showOpts    = iOpt "opts"
+-- showOptim   = iOpt "opt"
+isCompiled  = iOpt "gfc"
+isHaskell   = iOpt "gfhs"
+noCompOpers = iOpt "nocomp"
+retainOpers = iOpt "retain"
+defaultGrOpts = []
+noCF        = iOpt "nocf"
+checkCirc   = iOpt "nocirc"
+noCheckCirc = iOpt "nocheckcirc"
+lexerByNeed = iOpt "cflexer"
+useUTF8id   = iOpt "utf8id"
+elimSubs    = iOpt "subs"
+
+-- ** linearization
+
+allLin, firstLin, distinctLin, dontLin,
+  showRecord, showStruct, xmlLin, latexLin,
+  tableLin, useUTF8, showLang, withMetas :: Option
+defaultLinOpts :: [Option]
+
+allLin      = iOpt "all"
+firstLin    = iOpt "one"
+distinctLin = iOpt "nub"
+dontLin     = iOpt "show"
+showRecord  = iOpt "record"
+showStruct  = iOpt "structured"
+xmlLin      = showXML
+latexLin    = showLatex
+tableLin    = iOpt "table"
+defaultLinOpts = [firstLin]
+useUTF8     = iOpt "utf8"
+showLang    = iOpt "lang"
+showDefs    = iOpt "defs"
+withMetas   = iOpt "metas"
+
+-- ** other
+
+beVerbose, showInfo, beSilent, emitCode, getHelp,
+  doMake, doBatch, notEmitCode, makeMulti, beShort,
+  wholeGrammar, makeFudget, byLines, byWords, analMorpho,
+  doTrace, noCPU, doCompute, optimizeCanon, optimizeValues,
+  stripQualif, nostripQualif, showAll, fromSource :: Option
+
+beVerbose    = iOpt "v"
+invertGrep   = iOpt "v" --- same letter in unix
+showInfo     = iOpt "i"
+beSilent     = iOpt "s"
+emitCode     = iOpt "o"
+getHelp      = iOpt "help"
+doMake       = iOpt "make"
+doBatch      = iOpt "batch"
+notEmitCode  = iOpt "noemit"
+makeMulti    = iOpt "multi"
+beShort      = iOpt "short"
+wholeGrammar = iOpt "w"
+makeFudget   = iOpt "f"
+byLines      = iOpt "lines"
+byWords      = iOpt "words"
+analMorpho   = iOpt "morpho"
+doTrace      = iOpt "tr"
+noCPU        = iOpt "nocpu"
+doCompute    = iOpt "c"
+optimizeCanon = iOpt "opt"
+optimizeValues = iOpt "val"
+stripQualif   = iOpt "strip"
+nostripQualif = iOpt "nostrip"
+showAll      = iOpt "all"
+showFields   = iOpt "fields"
+showMulti    = iOpt "multi"
+fromSource   = iOpt "src"
+makeConcrete = iOpt "examples"
+fromExamples = iOpt "ex"
+openEditor   = iOpt "edit"
+getTrees     = iOpt "trees"
+
+-- ** mainly for stand-alone
+
+useUnicode, optCompute, optCheck, optParaphrase, forJava :: Option
+
+useUnicode    = iOpt "unicode"
+optCompute    = iOpt "compute"
+optCheck      = iOpt "typecheck"
+optParaphrase = iOpt "paraphrase"
+forJava       = iOpt "java"
+
+-- ** for edit session
+
+allLangs, absView :: Option
+
+allLangs  = iOpt "All"
+absView   = iOpt "Abs"
+
+-- ** options that take arguments
+
+useTokenizer, useUntokenizer, useParser, withFun, 
+  useLanguage, useResource, speechLanguage, useFont,
+  grammarFormat, grammarPrinter, filterString, termCommand,
+  transferFun, forForms, menuDisplay, sizeDisplay, typeDisplay,
+  noDepTypes, extractGr, pathList, uniCoding :: String -> Option
+-- | used on command line
+firstCat :: String -> Option
+-- | used in grammar, to avoid clash w res word
+gStartCat :: String -> Option
+
+useTokenizer   = aOpt "lexer"
+useUntokenizer = aOpt "unlexer"
+useParser      = aOpt "parser"
+-- useStrategy    = aOpt "strategy" -- parsing strategy
+withFun        = aOpt "fun"
+firstCat       = aOpt "cat"      
+gStartCat      = aOpt "startcat" 
+useLanguage    = aOpt "lang"
+useResource    = aOpt "res"
+speechLanguage = aOpt "language"
+useFont        = aOpt "font"
+grammarFormat  = aOpt "format"
+grammarPrinter = aOpt "printer"
+filterString   = aOpt "filter"
+termCommand    = aOpt "transform"
+transferFun    = aOpt "transfer"
+forForms       = aOpt "forms"
+menuDisplay    = aOpt "menu"
+sizeDisplay    = aOpt "size"
+typeDisplay    = aOpt "types"
+noDepTypes     = aOpt "nodeptypes"
+extractGr      = aOpt "extract"
+pathList       = aOpt "path"
+uniCoding      = aOpt "coding"
+probFile       = aOpt "probs"
+noparseFile    = aOpt "noparse"
+usePreprocessor = aOpt "preproc"
+
+-- peb 16/3-05:
+gfcConversion :: String -> Option
+gfcConversion  = aOpt "conversion"
+
+useName, useAbsName, useCncName, useResName, 
+  useFile, useOptimizer :: String -> Option
+
+useName        = aOpt "name"
+useAbsName     = aOpt "abs"
+useCncName     = aOpt "cnc"
+useResName     = aOpt "res"
+useFile        = aOpt "file"
+useOptimizer   = aOpt "optimize"
+
+markLin :: String -> Option
+markOptXML, markOptJava, markOptStruct, markOptFocus :: String
+
+markLin        = aOpt "mark"
+markOptXML     = oArg "xml"
+markOptJava    = oArg "java"
+markOptStruct  = oArg "struct"
+markOptFocus   = oArg "focus"
+
+
+-- ** refinement order
+
+nextRefine :: String -> Option
+firstRefine, lastRefine :: String
+
+nextRefine  = aOpt "nextrefine"
+firstRefine = oArg "first"
+lastRefine  = oArg "last"
+
+-- ** Boolean flags
+
+flagYes, flagNo :: String
+
+flagYes = oArg "yes"
+flagNo  = oArg "no"
+
+-- ** integer flags
+
+flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees :: String -> Option
+
+flagDepth  = aOpt "depth"
+flagAlts   = aOpt "alts"
+flagLength = aOpt "length"
+flagNumber = aOpt "number"
+flagRawtrees = aOpt "rawtrees"
+
+caseYesNo :: Options -> OptFun -> Maybe Bool
+caseYesNo opts f = do
+  v <- getOptVal opts f
+  if v == flagYes   then return True
+     else if v == flagNo then return False
+     else Nothing
diff --git a/src-2.9/GF/Infra/Print.hs b/src-2.9/GF/Infra/Print.hs
new file mode 100644
index 000000000..17f2c2188
--- /dev/null
+++ b/src-2.9/GF/Infra/Print.hs
@@ -0,0 +1,127 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 14:15:18 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- Pretty-printing
+-----------------------------------------------------------------------------
+
+module GF.Infra.Print
+    (module GF.Infra.PrintClass
+    ) where
+
+-- haskell modules:
+import Data.Char (toUpper)
+-- gf modules:
+
+import GF.Infra.PrintClass
+import GF.Data.Operations (Err(..))
+import GF.Infra.Ident (Ident(..))
+import GF.Canon.AbsGFC
+import GF.CF.CF
+import GF.CF.CFIdent
+import qualified GF.Canon.PrintGFC as P
+
+------------------------------------------------------------
+
+----------------------------------------------------------------------
+
+instance Print Ident where
+    prt = P.printTree 
+
+instance Print Term where
+    prt (Arg arg)         = prt arg
+    prt (con `Par` [])    = prt con
+    prt (con `Par` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
+    prt (LI ident)        = "$" ++ prt ident
+    prt (R record)        = "{" ++ prtSep "; " record ++ "}"
+    prt (term `P` lbl)    = prt term ++ "." ++ prt lbl
+    prt (T _ table)       = "table{" ++ prtSep "; " table ++ "}"
+    prt (V _ terms)       = "values{" ++ prtSep "; " terms ++ "}"
+    prt (term `S` sel)    = "(" ++ prt term ++ " ! " ++ prt sel ++ ")"
+    prt (FV terms)        = "variants{" ++ prtSep " | " terms ++ "}"
+    prt (term `C` term')  = prt term ++ "  " ++ prt term'
+    prt (EInt n)          = prt n
+    prt (K tokn)          = show (prt tokn)
+    prt (E)               = show ""
+
+instance Print Patt where
+    prt (con `PC` [])     = prt con
+    prt (con `PC` pats)   = prt con ++ "(" ++ prtSep "," pats ++ ")"
+    prt (PV ident)        = "$" ++ prt ident
+    prt (PW)              = "_"
+    prt (PR record)       = "{" ++ prtSep ";" record ++ "}"
+
+instance Print Label where
+    prt (L ident)          = prt ident
+    prt (LV nr)            = "$" ++ show nr
+
+instance Print Tokn where
+    prt (KS str)          = str
+    prt tokn@(KP _ _)     = show tokn
+
+instance Print ArgVar where
+    prt (A cat argNr)     = prt cat ++ "#" ++ show argNr
+
+instance Print CIdent where
+    prt (CIQ _ ident)     = prt ident
+
+instance Print Case where
+    prt (pats `Cas` term) = prtSep "|" pats ++ "=>" ++ prt term
+
+instance Print Assign where
+    prt (lbl `Ass` term)  = prt lbl ++ "=" ++ prt term
+
+instance Print PattAssign where
+    prt (lbl `PAss` pat)  = prt lbl ++ "=" ++ prt pat
+
+instance Print Atom where
+    prt (AC c) = prt c
+    prt (AD c) = "<" ++ prt c ++ ">"
+    prt (AV i) = "$" ++ prt i
+    prt (AM n) = "?" ++ show n
+    prt atom   = show atom
+
+instance Print CType where
+    prt (RecType rtype) = "{" ++ prtSep "; " rtype ++ "}"
+    prt (Table ptype vtype) = "(" ++ prt ptype ++ " => " ++ prt vtype ++ ")"
+    prt (Cn cn) = prt cn
+    prt (TStr) = "Str"
+
+instance Print Labelling where
+    prt (lbl `Lbg` ctype) = prt lbl ++ ":" ++ prt ctype
+
+instance Print CFItem where
+    prt (CFTerm regexp) = prt regexp
+    prt (CFNonterm cat) = prt cat
+
+instance Print RegExp where
+    prt (RegAlts words) = "("++prtSep "|" words ++ ")"
+    prt (RegSpec tok) = prt tok
+
+instance Print CFTok where
+    prt (TS str) = str
+    prt (TC (c:str)) = '(' : toUpper c : ')' : str
+    prt (TL str) = show str
+    prt (TI n) = "#" ++ show n
+    prt (TV x) = "$" ++ prt x
+    prt (TM n s) = "?" ++ show n ++ s
+
+instance Print CFCat where
+    prt (CFCat (cid,lbl)) = prt cid ++ "-" ++ prt lbl
+
+instance Print CFFun where 
+    prt (CFFun fun) = prt (fst fun)
+
+instance Print Exp where
+    prt = P.printTree
+
+instance Print a => Print (Err a) where
+    prt (Ok a) = prt a
+    prt (Bad str) = str
+
diff --git a/src-2.9/GF/Infra/PrintClass.hs b/src-2.9/GF/Infra/PrintClass.hs
new file mode 100644
index 000000000..5e94984a6
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Infra/ReadFiles.hs b/src-2.9/GF/Infra/ReadFiles.hs
new file mode 100644
index 000000000..ce33ec23f
--- /dev/null
+++ b/src-2.9/GF/Infra/ReadFiles.hs
@@ -0,0 +1,362 @@
+----------------------------------------------------------------------
+-- |
+-- 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.gfc@ or @file.gfr@ otherwise.
+-----------------------------------------------------------------------------
+
+module GF.Infra.ReadFiles (-- * Heading 1
+		  getAllFiles,fixNewlines,ModName,getOptionsFromFile,
+		  -- * Heading 2
+		  gfcFile,gfFile,gfrFile,isGFC,resModName,isOldFile
+		 ) where
+
+import GF.System.Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime)
+
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Infra.UseIO
+
+import System
+import Data.Char
+import Control.Monad
+import Data.List
+import System.Directory
+import System.FilePath
+
+type ModName = String
+type ModEnv  = [(ModName,ModTime)]
+
+getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
+getAllFiles opts ps env file = do
+
+  -- read module headers from all files recursively
+  ds0  <- getImports ps file
+  let ds = [((snd m,map fst ms),p) | ((m,ms),p) <- ds0]
+  if oElem beVerbose opts 
+    then ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds)
+    else return ()
+    -- get a topological sorting of files: returns file names --- deletes paths
+  ds1 <- ioeErr $ either 
+           return 
+           (\ms -> Bad $ "circular modules" +++ 
+                     unwords (map show (head ms))) $ topoTest $ map fst ds
+
+  -- associate each file name with its path --- more optimal: save paths in ds1
+  let paths = [(f,p) | ((f,_),p) <- ds]
+  let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]]
+  if oElem fromSource opts 
+    then return [gfFile (p </> f) | (p,f) <- pds1]
+    else do
+
+
+    ds2 <- ioeIO $ mapM (selectFormat opts env) pds1
+
+    let ds4 = needCompile opts (map fst ds0) ds2
+    return ds4
+
+-- to decide whether to read gf or gfc, or if in env; returns full file path
+
+data CompStatus =
+   CSComp -- compile: read gf
+ | CSRead -- read gfc
+ | CSEnv  -- gfc is in env
+ | CSEnvR -- also gfr is in env
+ | CSDont -- don't read at all
+ | CSRes  -- read gfr
+  deriving (Eq,Show)
+
+-- for gfc, we also return ModTime to cope with earlier compilation of libs
+
+selectFormat :: Options -> ModEnv -> (InitPath,ModName) -> 
+                IO (ModName,(InitPath,(CompStatus,Maybe ModTime)))
+
+selectFormat opts env (p,f) = do
+  let pf = p </> f
+  let mtenv = lookup f env   -- Nothing if f is not in env
+  let rtenv = lookup (resModName f) env
+  let fromComp = oElem isCompiled opts -- i -gfc
+  mtgfc <- getModTime $ gfcFile pf
+  mtgf  <- getModTime $ gfFile pf
+  let stat = case (rtenv,mtenv,mtgfc,mtgf) of
+--        (_,Just tenv,_,_)        | fromComp -> (CSEnv, Just tenv)
+        (_,_,Just tgfc,_)        | fromComp -> (CSRead,Just tgfc)
+--        (Just tenv,_,_,Just tgf) | laterModTime tenv tgf -> (CSEnvR,Just tenv)
+--        (_,Just tenv,_,Just tgf) | laterModTime tenv tgf -> (CSEnv, Just tenv)
+        (_,_,Just tgfc,Just tgf) | laterModTime tgfc tgf -> 
+          case mtenv of 
+--            Just tenv | laterModTime tenv tgfc -> (CSEnv,Just tenv)
+            _ -> (CSRead,Just tgfc)
+
+
+--        (_,Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist
+        (_,_,_,        Nothing) -> (CSRead,Nothing)  -- source does not exist
+        _ -> (CSComp,Nothing)
+  return $ (f, (p,stat))
+
+needCompile :: Options -> 
+               [ModuleHeader] -> 
+               [(ModName,(InitPath,(CompStatus,Maybe ModTime)))] -> [FullPath]
+needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
+
+  deps = [(snd m,map fst ms) | (m,ms) <- headers]
+  typ m = maybe MTyOther id $ lookup m [(m,t) | ((t,m),_) <- headers]
+  uses m = [(n,u) | ((_,n),ms) <- headers, (k,u) <- ms, k==m]
+  stat0 m = maybe CSComp (fst . snd) $ lookup m sfiles0
+
+  allDeps = [(m,iterFix add ms) | (m,ms) <- deps] where
+    add os = [m | o <- os, Just n <- [lookup o deps],m <- n]
+
+  -- only treat reused, interface, or instantiation if needed
+  sfiles = sfiles0 ---- map relevant sfiles0
+  relevant fp@(f,(p,(st,_))) = 
+    let us = uses f
+        isUsed = not (null us)
+    in
+    if not (isUsed && all noComp us) then
+      fp else 
+    if (elem (typ f) [] ---- MTyIncomplete, MTyIncResource]
+        || 
+        (isUsed && all isAux us)) then
+      (f,(p,(CSDont,Nothing))) else
+      fp
+
+  isAux = flip elem [MUReuse,MUInstance,MUComplete] . snd
+  noComp = flip elem [CSRead,CSEnv,CSEnvR] . stat0 . fst
+
+  -- mark as to be compiled those whose gfc is earlier than a deeper gfc
+  sfiles1 = map compTimes sfiles
+  compTimes fp@(f,(p,(_, Just t))) =
+    if any (> t) [t' | Just fs <- [lookup f deps], 
+                       f0 <- fs,
+                       Just (_,(_,Just t')) <- [lookup f0 sfiles]]
+    then (f,(p,(CSComp, Nothing)))
+    else fp
+  compTimes fp = fp
+
+  -- start with the changed files themselves; returns [ModName]
+  changed = [f | (f,(_,(CSComp,_))) <- sfiles1] 
+
+  -- add other files that depend on some changed file; returns [ModName]
+  iter np = let new = [f | (f,fs) <- deps, 
+                           not (elem f np), any (flip elem np) fs]
+            in  if null new then np else (iter (new ++ np))
+
+  -- for each module in the full list, compile if depends on what needs compile
+  -- returns [FullPath]
+  mark cs = [(f,(path,st)) | 
+                (f,(path,(st0,_))) <- sfiles1, 
+                let st = if (elem f cs) then CSComp else st0]
+
+
+  -- if a compilable file depends on a resource, read gfr instead of gfc/env
+  -- but don't read gfr if already in env (by CSEnvR)
+  -- Also read res if the option "retain" is present
+  -- Also, if a "with" file has to be compiled, read its mother file from source
+
+  res cs = map mkRes cs where
+    mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of
+      t | (not (null [m | (m,(_,CSComp)) <- cs,
+                                   Just ms <- [lookup m allDeps], elem f ms])
+                    || oElem retainOpers opts)
+        -> if elem t [MTyResource,MTyIncResource] 
+           then (f,(path,CSRes)) else
+              if t == MTyIncomplete
+              then (f,(path,CSComp)) else
+              x
+      _ -> x
+    mkRes x = x
+
+
+
+  -- construct list of paths to read
+  paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]]
+
+  mkName f p st = mk (p </> f) where
+    mk = case st of
+      CSComp -> gfFile
+      CSRead -> gfcFile
+      CSRes  -> gfrFile
+
+isGFC :: FilePath -> Bool
+isGFC = (== ".gfc") . takeExtensions
+
+gfcFile :: FilePath -> FilePath
+gfcFile f = addExtension f "gfc"
+
+gfrFile :: FilePath -> FilePath
+gfrFile f = addExtension f "gfr"
+
+gfFile :: FilePath -> FilePath
+gfFile f = addExtension f "gf"
+
+resModName :: ModName -> ModName
+resModName = ('#':)
+
+-- to get imports without parsing the whole files
+
+getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)]
+getImports ps = get [] where
+  get ds file0 = do
+    let name = dropExtension file0 ---- dropExtension file0
+    (p,s) <- tryRead name
+    let ((typ,mname),imps) = importsOfFile s
+    let namebody = takeFileName name
+    ioeErr $ testErr  (mname == namebody) $ 
+             "module name" +++ mname +++ "differs from file name" +++ namebody
+    case imps of
+      _ | elem name (map (snd . fst . fst) ds) -> return ds  --- file already read
+      [] -> return $ (((typ,name),[]),p):ds
+      _ -> do
+        let files = map (gfFile . fst) imps 
+        foldM get ((((typ,name),imps),p):ds) files
+  tryRead name = do
+    file <- do
+      let file_gf = gfFile name
+      b <- doesFileExistPath ps file_gf                 -- try gf file first
+      if b then return file_gf else do
+        let file_gfr = gfrFile name
+        bb <- doesFileExistPath ps file_gfr             -- gfr file next
+        if bb then return file_gfr else do
+          return (gfcFile name)                         -- gfc next
+
+    readFileIfPath ps $ file
+
+
+
+-- internal module dep information
+
+data ModUse =
+   MUReuse
+ | MUInstance
+ | MUComplete
+ | MUOther
+  deriving (Eq,Show)
+
+data ModTyp =
+   MTyResource
+ | MTyIncomplete
+ | MTyIncResource -- interface, incomplete resource
+ | MTyOther
+  deriving (Eq,Show)
+
+type ModuleHeader = ((ModTyp,ModName),[(ModName,ModUse)])
+
+importsOfFile :: String -> ModuleHeader
+importsOfFile = 
+  getModuleHeader .          -- analyse into mod header
+  filter (not . spec) .      -- ignore keywords and special symbols
+  unqual .                   -- take away qualifiers
+  unrestr .                  -- take away union restrictions
+  takeWhile (not . term) .   -- read until curly or semic
+  lexs .                     -- analyse into lexical tokens
+  unComm                     -- ignore comments before the headed line
+ where
+    term = flip elem ["{",";"]
+    spec = flip elem ["of", "open","in",":", "->","=", "-","(", ")",",","**","union"]
+    unqual ws = case ws of
+      "(":q:ws' -> unqual ws'
+      w:ws' -> w:unqual ws'
+      _ -> ws
+    unrestr ws = case ws of
+      "[":ws' -> unrestr $ tail $ dropWhile (/="]") ws'
+      w:ws' -> w:unrestr ws'
+      _ -> ws
+
+getModuleHeader :: [String] -> ModuleHeader -- with, reuse
+getModuleHeader ws = case ws of
+  "incomplete":ws2 -> let ((ty,name),us) = getModuleHeader ws2 in
+    case ty of
+      MTyResource -> ((MTyIncResource,name),us)
+      _ -> ((MTyIncomplete,name),us)
+  "interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in
+    ((MTyIncResource,name),us)
+ 
+  "resource":name:ws2 -> case ws2 of
+    "reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)])
+    m:"with":ms -> ((MTyResource,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    ms -> ((MTyResource,name),[(n,MUOther) | n <- ms])
+
+  "instance":name:m:ws2 -> case ws2 of
+    "reuse":n:_ -> ((MTyResource,name),(m,MUInstance):[(n,MUReuse)])
+    n:"with":ms -> 
+      ((MTyResource,name),(m,MUInstance):(n,MUComplete):[(n,MUOther) | n <- ms])
+    ms -> ((MTyResource,name),(m,MUInstance):[(n,MUOther) | n <- ms])
+
+  "concrete":name:a:ws2 -> case span (/= "with") ws2 of
+
+    (es,_:ms) -> ((MTyOther,name),
+                  [(m,MUOther)    | m <- es] ++
+                  [(n,MUComplete) | n <- ms])
+    --- m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    (ms,[]) -> ((MTyOther,name),[(n,MUOther) | n <- a:ms])
+
+  _:name:ws2 -> case ws2 of
+    "reuse":m:_ -> ((MTyOther,name),[(m,MUReuse)])
+    ---- m:n:"with":ms -> 
+    ----  ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms])
+    m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
+    ms -> ((MTyOther,name),[(n,MUOther) | n <- ms])
+  _ -> error "the file is empty"
+
+unComm s = case s of
+      '-':'-':cs -> unComm $ dropWhile (/='\n') cs
+      '{':'-':cs -> dpComm cs
+      c:cs -> c : unComm cs
+      _ -> s
+    
+dpComm s = case s of
+      '-':'}':cs -> unComm cs
+      c:cs -> dpComm cs
+      _ -> s
+    
+lexs s = x:xs where 
+      (x,y) = head $ lex s
+      xs = if null y then [] else lexs y
+
+-- | options can be passed to the compiler by comments in @--#@, in the main file
+getOptionsFromFile ::  FilePath -> IO Options
+getOptionsFromFile file = do
+  s <- readFileIfStrict file
+  let ls = filter (isPrefixOf "--#") $ lines s
+  return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
+
+-- | check if old GF file
+isOldFile :: FilePath -> IO Bool
+isOldFile f = do
+  s <- readFileIfStrict f
+  let s' = unComm s
+  return $ not (null s') && old (head (words s'))
+ where
+   old = flip elem $ words 
+     "cat category data def flags fun include lin lincat lindef lintype oper param pattern printname rule"
+
+
+
+-- | old GF tolerated newlines in quotes. No more supported!
+fixNewlines :: String -> String
+fixNewlines s = case s of
+     '"':cs -> '"':mk cs
+     c  :cs -> c:fixNewlines cs
+     _ -> s
+ where
+   mk s = case s of
+     '\\':'"':cs -> '\\':'"': mk cs
+     '"'     :cs -> '"' :fixNewlines cs
+     '\n'    :cs -> '\\':'n': mk cs
+     c       :cs -> c : mk cs
+     _ -> s 
+
diff --git a/src-2.9/GF/Infra/UseIO.hs b/src-2.9/GF/Infra/UseIO.hs
new file mode 100644
index 000000000..4125a0417
--- /dev/null
+++ b/src-2.9/GF/Infra/UseIO.hs
@@ -0,0 +1,330 @@
+{-# 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.System.Arch (prCPU)
+import GF.Infra.Option
+import GF.Today (libdir)
+
+import System.Directory
+import System.IO
+import System.IO.Error
+import System.Environment
+import System.FilePath
+import Control.Monad
+
+#ifdef mingw32_HOST_OS
+import System.Win32.DLL
+import Foreign.Ptr
+#endif
+
+
+putShow' :: Show a => (c -> a) -> c -> IO ()
+putShow' f = putStrLn . show . length . show . f
+
+putIfVerb :: Options -> String -> IO ()
+putIfVerb opts msg =
+      if oElem beVerbose opts
+         then putStrLn msg
+         else return ()
+
+putIfVerbW :: Options -> String -> IO ()
+putIfVerbW opts msg =
+      if oElem beVerbose opts
+         then putStr (' ' : msg)
+         else return ()
+
+-- | obsolete with IOE monad
+errIO :: a -> Err a -> IO a
+errIO = errOptIO noOptions
+
+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
+
+prOptCPU :: Options -> Integer -> IO Integer
+prOptCPU opts = if (oElem noCPU opts) then (const (return 0)) else prCPU
+
+putCPU :: IO ()
+putCPU = do 
+  prCPU 0 
+  return ()
+
+putPoint :: Show a => Options -> String -> IO a -> IO a
+putPoint = putPoint' id
+
+putPoint' :: Show a => (c -> a) -> Options -> String -> IO c -> IO c
+putPoint' f opts msg act = do
+  let sil x = if oElem beSilent opts then return () else x
+      ve  x = if oElem beVerbose opts then x else return ()
+  ve $ putStrLn msg
+  a <- act
+  ve $ putShow' f a
+  ve $ putCPU
+  return a
+
+readFileStrict :: String -> IO String
+readFileStrict f = do
+  s <- readFile f
+  return $ seq (length s) ()
+  return s
+
+readFileIf = readFileIfs readFile
+readFileIfStrict  = readFileIfs readFileStrict
+
+readFileIfs rf f = catch (rf f) (\_ -> reportOn f) where
+ reportOn f = do
+   putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string")
+   return ""
+
+type FileName = String
+type InitPath = String
+type FullPath = String
+
+getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
+getFilePath ps file = do
+  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 exist then return (Just pfile) else get ps
+---               catch (readFileStrict pfile >> return (Just pfile)) (\_ -> get ps)
+
+readFileIfPath :: [FilePath] -> String -> IOE (FilePath,String)
+readFileIfPath paths file = do
+  mpfile <- ioeIO $ getFilePath paths file
+  case mpfile of
+    Just pfile -> do
+      s <- ioeIO $ readFileStrict 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"
+
+-- | environment variable for grammar search path
+gfGrammarPathVar = "GF_GRAMMAR_PATH"
+
+getLibraryPath :: IO FilePath
+getLibraryPath =
+  catch
+    (getEnv gfLibraryPath)
+#ifdef mingw32_HOST_OS
+    (\_ -> do exepath <- getModuleFileName nullPtr
+              let (path,_) = splitFileName exepath
+              canonicalizePath (combine path "../lib"))
+#else
+    (const (return libdir))
+#endif
+
+-- | 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)
+
+putStrLnE :: String -> IOE ()
+putStrLnE = ioeIO . putStrLnFlush 
+
+putStrE :: String -> IOE ()
+putStrE = ioeIO . putStrFlush 
+
+-- this is more verbose
+putPointE :: Options -> String -> IOE a -> IOE a
+putPointE = putPointEgen (oElem beSilent)
+
+-- this is less verbose
+putPointEsil :: Options -> String -> IOE a -> IOE a
+putPointEsil = putPointEgen (not . oElem beVerbose)
+
+putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a
+putPointEgen cond opts msg act = do
+  let ve x = if cond opts then return () else x
+  ve $ ioeIO $ putStrFlush msg
+  a <- act
+---  ve $ ioeIO $ putShow' id a --- replace by a statistics command
+  ve $ ioeIO $ putStrFlush " "
+  ve $ ioeIO $ putCPU
+  return a
+{-
+putPointE :: Options -> String -> IOE a -> IOE a
+putPointE opts msg act = do
+  let ve x = if oElem beVerbose opts then x else return ()
+  ve $ putStrE msg
+  a <- act
+---  ve $ ioeIO $ putShow' id a --- replace by a statistics command
+  ve $ ioeIO $ putCPU
+  return a
+-}
+
+-- | forces verbosity
+putPointEVerb :: Options -> String -> IOE a -> IOE a
+putPointEVerb opts = putPointE (addOption beVerbose opts)
+
+-- ((do {s <- readFile f; return (return s)}) ) 
+readFileIOE :: FilePath -> IOE (String)
+readFileIOE f = ioe $ catch (readFileStrict 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, String)
+readFileLibraryIOE ini f = ioe $ do
+  lp <- getLibraryPath
+  tryRead ini $ \_ ->
+    tryRead lp  $ \e ->
+      return (Bad (show e))
+  where
+    tryRead path onError =
+      catch (readFileStrict 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-2.9/GF/JavaScript/AbsJS.hs b/src-2.9/GF/JavaScript/AbsJS.hs
new file mode 100644
index 000000000..2632ade48
--- /dev/null
+++ b/src-2.9/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-2.9/GF/JavaScript/JS.cf b/src-2.9/GF/JavaScript/JS.cf
new file mode 100644
index 000000000..fe31a2074
--- /dev/null
+++ b/src-2.9/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-2.9/GF/JavaScript/LexJS.hs b/src-2.9/GF/JavaScript/LexJS.hs
new file mode 100644
index 000000000..242831195
--- /dev/null
+++ b/src-2.9/GF/JavaScript/LexJS.hs
@@ -0,0 +1,337 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LINE 3 "LexJS.x" #-}
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.JavaScript.LexJS 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\x9a\x00\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\x6d\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\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x00\x03\x00\xff\xff\xff\xff\x03\x00\xff\xff\x03\x00\xff\xff\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x03\x00\x03\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\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\x03\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x02\x00\x0b\x00\x00\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x08\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x03\x00\xff\xff\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\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x06\x00\x00\x00\x00\x00\xff\xff\x04\x00\x06\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\xff\xff\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x0d\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x07\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x0c\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\xff\xff\xff\xff\xff\xff\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\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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# "\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_accept = listArray (0::Int,13) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))],[],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[],[],[]]
+{-# LINE 32 "LexJS.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 "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
+
+alex_action_1 = tok (\p s -> PT p (TS $ share s)) 
+alex_action_2 = tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
+alex_action_3 = tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) 
+alex_action_4 = tok (\p s -> PT p (TI $ share s))    
+alex_action_5 = 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-2.9/GF/JavaScript/LexJS.x b/src-2.9/GF/JavaScript/LexJS.x
new file mode 100644
index 000000000..10ba66d69
--- /dev/null
+++ b/src-2.9/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-2.9/GF/JavaScript/Makefile b/src-2.9/GF/JavaScript/Makefile
new file mode 100644
index 000000000..10f867b06
--- /dev/null
+++ b/src-2.9/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-2.9/GF/JavaScript/ParJS.hs b/src-2.9/GF/JavaScript/ParJS.hs
new file mode 100644
index 000000000..f57c44a22
--- /dev/null
+++ b/src-2.9/GF/JavaScript/ParJS.hs
@@ -0,0 +1,1175 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# 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
+#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 (() -> ())
+happyIn4 :: (Ident) -> (HappyAbsSyn )
+happyIn4 x = unsafeCoerce# x
+{-# INLINE happyIn4 #-}
+happyOut4 :: (HappyAbsSyn ) -> (Ident)
+happyOut4 x = unsafeCoerce# x
+{-# INLINE happyOut4 #-}
+happyIn5 :: (Integer) -> (HappyAbsSyn )
+happyIn5 x = unsafeCoerce# x
+{-# INLINE happyIn5 #-}
+happyOut5 :: (HappyAbsSyn ) -> (Integer)
+happyOut5 x = unsafeCoerce# x
+{-# INLINE happyOut5 #-}
+happyIn6 :: (Double) -> (HappyAbsSyn )
+happyIn6 x = unsafeCoerce# x
+{-# INLINE happyIn6 #-}
+happyOut6 :: (HappyAbsSyn ) -> (Double)
+happyOut6 x = unsafeCoerce# x
+{-# INLINE happyOut6 #-}
+happyIn7 :: (String) -> (HappyAbsSyn )
+happyIn7 x = unsafeCoerce# x
+{-# INLINE happyIn7 #-}
+happyOut7 :: (HappyAbsSyn ) -> (String)
+happyOut7 x = unsafeCoerce# x
+{-# INLINE happyOut7 #-}
+happyIn8 :: (Program) -> (HappyAbsSyn )
+happyIn8 x = unsafeCoerce# x
+{-# INLINE happyIn8 #-}
+happyOut8 :: (HappyAbsSyn ) -> (Program)
+happyOut8 x = unsafeCoerce# x
+{-# INLINE happyOut8 #-}
+happyIn9 :: (Element) -> (HappyAbsSyn )
+happyIn9 x = unsafeCoerce# x
+{-# INLINE happyIn9 #-}
+happyOut9 :: (HappyAbsSyn ) -> (Element)
+happyOut9 x = unsafeCoerce# x
+{-# INLINE happyOut9 #-}
+happyIn10 :: ([Element]) -> (HappyAbsSyn )
+happyIn10 x = unsafeCoerce# x
+{-# INLINE happyIn10 #-}
+happyOut10 :: (HappyAbsSyn ) -> ([Element])
+happyOut10 x = unsafeCoerce# x
+{-# INLINE happyOut10 #-}
+happyIn11 :: ([Ident]) -> (HappyAbsSyn )
+happyIn11 x = unsafeCoerce# x
+{-# INLINE happyIn11 #-}
+happyOut11 :: (HappyAbsSyn ) -> ([Ident])
+happyOut11 x = unsafeCoerce# x
+{-# INLINE happyOut11 #-}
+happyIn12 :: (Stmt) -> (HappyAbsSyn )
+happyIn12 x = unsafeCoerce# x
+{-# INLINE happyIn12 #-}
+happyOut12 :: (HappyAbsSyn ) -> (Stmt)
+happyOut12 x = unsafeCoerce# x
+{-# INLINE happyOut12 #-}
+happyIn13 :: ([Stmt]) -> (HappyAbsSyn )
+happyIn13 x = unsafeCoerce# x
+{-# INLINE happyIn13 #-}
+happyOut13 :: (HappyAbsSyn ) -> ([Stmt])
+happyOut13 x = unsafeCoerce# x
+{-# INLINE happyOut13 #-}
+happyIn14 :: (DeclOrExpr) -> (HappyAbsSyn )
+happyIn14 x = unsafeCoerce# x
+{-# INLINE happyIn14 #-}
+happyOut14 :: (HappyAbsSyn ) -> (DeclOrExpr)
+happyOut14 x = unsafeCoerce# x
+{-# INLINE happyOut14 #-}
+happyIn15 :: (DeclVar) -> (HappyAbsSyn )
+happyIn15 x = unsafeCoerce# x
+{-# INLINE happyIn15 #-}
+happyOut15 :: (HappyAbsSyn ) -> (DeclVar)
+happyOut15 x = unsafeCoerce# x
+{-# INLINE happyOut15 #-}
+happyIn16 :: ([DeclVar]) -> (HappyAbsSyn )
+happyIn16 x = unsafeCoerce# x
+{-# INLINE happyIn16 #-}
+happyOut16 :: (HappyAbsSyn ) -> ([DeclVar])
+happyOut16 x = unsafeCoerce# x
+{-# INLINE happyOut16 #-}
+happyIn17 :: (Expr) -> (HappyAbsSyn )
+happyIn17 x = unsafeCoerce# x
+{-# INLINE happyIn17 #-}
+happyOut17 :: (HappyAbsSyn ) -> (Expr)
+happyOut17 x = unsafeCoerce# x
+{-# INLINE happyOut17 #-}
+happyIn18 :: (Expr) -> (HappyAbsSyn )
+happyIn18 x = unsafeCoerce# x
+{-# INLINE happyIn18 #-}
+happyOut18 :: (HappyAbsSyn ) -> (Expr)
+happyOut18 x = unsafeCoerce# x
+{-# INLINE happyOut18 #-}
+happyIn19 :: (Expr) -> (HappyAbsSyn )
+happyIn19 x = unsafeCoerce# x
+{-# INLINE happyIn19 #-}
+happyOut19 :: (HappyAbsSyn ) -> (Expr)
+happyOut19 x = unsafeCoerce# x
+{-# INLINE happyOut19 #-}
+happyIn20 :: (Expr) -> (HappyAbsSyn )
+happyIn20 x = unsafeCoerce# x
+{-# INLINE happyIn20 #-}
+happyOut20 :: (HappyAbsSyn ) -> (Expr)
+happyOut20 x = unsafeCoerce# x
+{-# INLINE happyOut20 #-}
+happyIn21 :: ([Expr]) -> (HappyAbsSyn )
+happyIn21 x = unsafeCoerce# x
+{-# INLINE happyIn21 #-}
+happyOut21 :: (HappyAbsSyn ) -> ([Expr])
+happyOut21 x = unsafeCoerce# x
+{-# INLINE happyOut21 #-}
+happyIn22 :: (Expr) -> (HappyAbsSyn )
+happyIn22 x = unsafeCoerce# x
+{-# INLINE happyIn22 #-}
+happyOut22 :: (HappyAbsSyn ) -> (Expr)
+happyOut22 x = unsafeCoerce# x
+{-# INLINE happyOut22 #-}
+happyIn23 :: (Expr) -> (HappyAbsSyn )
+happyIn23 x = unsafeCoerce# x
+{-# INLINE happyIn23 #-}
+happyOut23 :: (HappyAbsSyn ) -> (Expr)
+happyOut23 x = unsafeCoerce# x
+{-# INLINE happyOut23 #-}
+happyIn24 :: (Expr) -> (HappyAbsSyn )
+happyIn24 x = unsafeCoerce# x
+{-# INLINE happyIn24 #-}
+happyOut24 :: (HappyAbsSyn ) -> (Expr)
+happyOut24 x = unsafeCoerce# x
+{-# INLINE happyOut24 #-}
+happyIn25 :: (Expr) -> (HappyAbsSyn )
+happyIn25 x = unsafeCoerce# x
+{-# INLINE happyIn25 #-}
+happyOut25 :: (HappyAbsSyn ) -> (Expr)
+happyOut25 x = unsafeCoerce# x
+{-# INLINE happyOut25 #-}
+happyIn26 :: (Expr) -> (HappyAbsSyn )
+happyIn26 x = unsafeCoerce# x
+{-# INLINE happyIn26 #-}
+happyOut26 :: (HappyAbsSyn ) -> (Expr)
+happyOut26 x = unsafeCoerce# x
+{-# INLINE happyOut26 #-}
+happyIn27 :: (Expr) -> (HappyAbsSyn )
+happyIn27 x = unsafeCoerce# x
+{-# INLINE happyIn27 #-}
+happyOut27 :: (HappyAbsSyn ) -> (Expr)
+happyOut27 x = unsafeCoerce# x
+{-# INLINE happyOut27 #-}
+happyIn28 :: (Expr) -> (HappyAbsSyn )
+happyIn28 x = unsafeCoerce# x
+{-# INLINE happyIn28 #-}
+happyOut28 :: (HappyAbsSyn ) -> (Expr)
+happyOut28 x = unsafeCoerce# x
+{-# INLINE happyOut28 #-}
+happyIn29 :: (Expr) -> (HappyAbsSyn )
+happyIn29 x = unsafeCoerce# x
+{-# INLINE happyIn29 #-}
+happyOut29 :: (HappyAbsSyn ) -> (Expr)
+happyOut29 x = unsafeCoerce# x
+{-# INLINE happyOut29 #-}
+happyIn30 :: (Expr) -> (HappyAbsSyn )
+happyIn30 x = unsafeCoerce# x
+{-# INLINE happyIn30 #-}
+happyOut30 :: (HappyAbsSyn ) -> (Expr)
+happyOut30 x = unsafeCoerce# x
+{-# INLINE happyOut30 #-}
+happyIn31 :: (Expr) -> (HappyAbsSyn )
+happyIn31 x = unsafeCoerce# x
+{-# INLINE happyIn31 #-}
+happyOut31 :: (HappyAbsSyn ) -> (Expr)
+happyOut31 x = unsafeCoerce# x
+{-# INLINE happyOut31 #-}
+happyIn32 :: (Expr) -> (HappyAbsSyn )
+happyIn32 x = unsafeCoerce# x
+{-# INLINE happyIn32 #-}
+happyOut32 :: (HappyAbsSyn ) -> (Expr)
+happyOut32 x = unsafeCoerce# x
+{-# INLINE happyOut32 #-}
+happyIn33 :: (Expr) -> (HappyAbsSyn )
+happyIn33 x = unsafeCoerce# x
+{-# INLINE happyIn33 #-}
+happyOut33 :: (HappyAbsSyn ) -> (Expr)
+happyOut33 x = unsafeCoerce# x
+{-# INLINE happyOut33 #-}
+happyIn34 :: (Expr) -> (HappyAbsSyn )
+happyIn34 x = unsafeCoerce# x
+{-# INLINE happyIn34 #-}
+happyOut34 :: (HappyAbsSyn ) -> (Expr)
+happyOut34 x = unsafeCoerce# x
+{-# INLINE happyOut34 #-}
+happyIn35 :: (Property) -> (HappyAbsSyn )
+happyIn35 x = unsafeCoerce# x
+{-# INLINE happyIn35 #-}
+happyOut35 :: (HappyAbsSyn ) -> (Property)
+happyOut35 x = unsafeCoerce# x
+{-# INLINE happyOut35 #-}
+happyIn36 :: ([Property]) -> (HappyAbsSyn )
+happyIn36 x = unsafeCoerce# x
+{-# INLINE happyIn36 #-}
+happyOut36 :: (HappyAbsSyn ) -> ([Property])
+happyOut36 x = unsafeCoerce# x
+{-# INLINE happyOut36 #-}
+happyIn37 :: (PropertyName) -> (HappyAbsSyn )
+happyIn37 x = unsafeCoerce# x
+{-# INLINE happyIn37 #-}
+happyOut37 :: (HappyAbsSyn ) -> (PropertyName)
+happyOut37 x = unsafeCoerce# x
+{-# INLINE happyOut37 #-}
+happyInTok :: Token -> (HappyAbsSyn )
+happyInTok x = unsafeCoerce# x
+{-# INLINE happyInTok #-}
+happyOutTok :: (HappyAbsSyn ) -> Token
+happyOutTok x = unsafeCoerce# x
+{-# INLINE happyOutTok #-}
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\x00\x00\x9d\x00\x00\x00\x96\x00\x02\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\xab\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x02\xfe\xff\x30\x02\x00\x00\x02\x00\x9a\x00\x00\x00\x19\x02\x00\x00\x00\x00\x9a\x00\x00\x00\x00\x00\x00\x00\xa9\x00\xa8\x00\x00\x00\xa6\x00\x00\x00\x3c\x00\x00\x00\xaa\x00\x93\x00\x92\x00\x7e\x00\x87\x00\x8b\x00\x00\x00\x00\x00\xeb\x01\x8a\x00\x89\x00\x83\x00\x12\x00\x30\x02\x61\x00\x30\x02\x30\x02\x00\x00\x00\x00\x82\x00\x00\x00\x72\x00\x00\x00\x30\x02\x30\x02\x00\x00\x20\x00\x00\x00\x00\x00\x30\x02\x00\x00\x6e\x00\x70\x00\x5d\x00\x30\x02\x00\x00\x5d\x00\x30\x02\x00\x00\x00\x00\x6d\x00\x6b\x00\x59\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\xd4\x01\x00\x00\xbd\x01\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\x6a\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x01\x01\x00\x04\x01\x00\x00\x27\x00\x0b\x00\x00\x00\x80\x01\x00\x00\x00\x00\x31\x00\x00\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\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc6\x00\x07\x00\x61\x01\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x00\x42\x01\x00\x00\x05\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x4e\x00\x69\x00\x00\x00\x13\x00\x23\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\xfd\xff\x4a\x00\x00\x00\x4a\x00\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\xf7\xff\x00\x00\xfe\xff\x00\x00\xfa\xff\xdd\xff\xdc\xff\xdb\xff\xda\xff\xf6\xff\xf8\xff\x00\x00\xc1\xff\xe4\xff\xe2\xff\xde\xff\xeb\xff\xcc\xff\xcb\xff\xca\xff\xc9\xff\xc8\xff\xc7\xff\xc6\xff\xc5\xff\xc4\xff\xc3\xff\xc2\xff\x00\x00\xee\xff\xd0\xff\xd8\xff\x00\x00\x00\x00\xd7\xff\x00\x00\xd6\xff\xd9\xff\xe8\xff\xfd\xff\xfc\xff\xfb\xff\xea\xff\xe7\xff\xec\xff\x00\x00\xcd\xff\xbf\xff\xf1\xff\x00\x00\x00\x00\x00\x00\xf5\xff\x00\x00\xcf\xff\xbc\xff\xbb\xff\x00\x00\xbe\xff\x00\x00\x00\x00\x00\x00\xd0\xff\x00\x00\x00\x00\x00\x00\xef\xff\xe5\xff\x00\x00\xe1\xff\x00\x00\xd1\xff\xd0\xff\x00\x00\xd3\xff\xbf\xff\xed\xff\xf2\xff\xd0\xff\xd4\xff\xf4\xff\x00\x00\xf5\xff\xd0\xff\xf0\xff\xe8\xff\x00\x00\xe9\xff\xe6\xff\x00\x00\x00\x00\x00\x00\xf5\xff\xce\xff\xbd\xff\xc0\xff\x00\x00\xdf\xff\xe0\xff\xd2\xff\xf3\xff\xee\xff\x00\x00\xe3\xff\xee\xff\x00\x00\xd5\xff\x00\x00\xf9\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\x00\x00\x04\x00\x01\x00\x03\x00\x00\x00\x09\x00\x00\x00\x03\x00\x00\x00\x09\x00\x00\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x01\x00\x14\x00\x00\x00\x02\x00\x17\x00\x14\x00\x05\x00\x08\x00\x09\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x0b\x00\x0c\x00\x1f\x00\x20\x00\x21\x00\x09\x00\x1f\x00\x20\x00\x21\x00\x00\x00\x1f\x00\x20\x00\x21\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x05\x00\x00\x00\x02\x00\x08\x00\x14\x00\x0a\x00\x07\x00\x17\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x0b\x00\x0c\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\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x00\x00\x14\x00\x14\x00\x08\x00\x17\x00\x0a\x00\x07\x00\x07\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x03\x00\x03\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\x00\x00\x01\x00\x02\x00\x03\x00\x02\x00\x04\x00\x02\x00\x06\x00\x14\x00\x02\x00\x05\x00\x02\x00\x14\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\x00\x00\x01\x00\x02\x00\x03\x00\x0a\x00\x04\x00\x0b\x00\x05\x00\x05\x00\x0a\x00\x14\x00\x01\x00\x01\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\x00\x00\x01\x00\x02\x00\x03\x00\x01\x00\x06\x00\x05\x00\x14\x00\x19\x00\x07\x00\x14\x00\x07\x00\x06\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\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\xff\xff\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\xff\xff\xff\xff\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\xff\xff\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\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\xff\xff\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\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\xff\xff\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\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\xff\xff\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\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\xff\xff\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\x01\x00\xff\xff\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x01\x00\xff\xff\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x01\x00\xff\xff\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x01\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x01\x00\xff\xff\x03\x00\xff\xff\xff\xff\x06\x00\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\x15\x00\x16\x00\x17\x00\x01\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x0c\x00\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\x12\x00\xff\xff\x14\x00\x15\x00\x16\x00\x17\x00\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\x37\x00\xbf\xff\x35\x00\x38\x00\x37\x00\x6b\x00\x45\x00\x38\x00\x37\x00\x39\x00\x32\x00\x38\x00\x05\x00\x06\x00\x07\x00\x08\x00\x3f\x00\x03\x00\x2a\x00\x48\x00\x2a\x00\x03\x00\x49\x00\x40\x00\x41\x00\x43\x00\x0d\x00\x0e\x00\x0f\x00\x2b\x00\x58\x00\x3a\x00\x3b\x00\x3c\x00\x69\x00\x3a\x00\x5e\x00\x3c\x00\x33\x00\x3a\x00\x3b\x00\x3c\x00\x05\x00\x06\x00\x07\x00\x08\x00\x50\x00\x09\x00\x2a\x00\x64\x00\x0a\x00\x03\x00\x0b\x00\x64\x00\x2a\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x2b\x00\x2c\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\x05\x00\x06\x00\x07\x00\x08\x00\x50\x00\x50\x00\x03\x00\x03\x00\x4c\x00\x2a\x00\x0b\x00\x5a\x00\x51\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x69\x00\x66\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\x05\x00\x06\x00\x07\x00\x08\x00\x67\x00\x03\x00\x68\x00\x04\x00\x03\x00\x5c\x00\x5d\x00\x62\x00\x03\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x59\x00\x36\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x63\x00\x4b\x00\x4a\x00\x4c\x00\x4f\x00\x50\x00\x03\x00\x53\x00\x54\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x5d\x00\x36\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x35\x00\x55\x00\x56\x00\x03\x00\xff\xff\x57\x00\x03\x00\x42\x00\x43\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x60\x00\x36\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x46\x00\x36\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x00\x00\x00\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\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x35\x00\x36\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x00\x00\x57\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x00\x00\x5f\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x00\x00\x44\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x00\x00\x2d\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x00\x00\x3d\x00\x2e\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1d\x00\x00\x00\x1e\x00\x6d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x32\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x03\x00\x28\x00\x29\x00\x2a\x00\x1d\x00\x00\x00\x1e\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x32\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x03\x00\x28\x00\x29\x00\x2a\x00\x1d\x00\x00\x00\x1e\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x32\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x03\x00\x28\x00\x29\x00\x2a\x00\x1d\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x03\x00\x28\x00\x29\x00\x2a\x00\x1d\x00\x00\x00\x30\x00\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x32\x00\x22\x00\x23\x00\x00\x00\x25\x00\x26\x00\x00\x00\x03\x00\x28\x00\x29\x00\x2a\x00\x1d\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x32\x00\x22\x00\x23\x00\x00\x00\x25\x00\x26\x00\x00\x00\x03\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyReduceArr = array (1, 68) [
+	(1 , happyReduce_1),
+	(2 , happyReduce_2),
+	(3 , happyReduce_3),
+	(4 , happyReduce_4),
+	(5 , happyReduce_5),
+	(6 , happyReduce_6),
+	(7 , happyReduce_7),
+	(8 , happyReduce_8),
+	(9 , happyReduce_9),
+	(10 , happyReduce_10),
+	(11 , happyReduce_11),
+	(12 , happyReduce_12),
+	(13 , happyReduce_13),
+	(14 , happyReduce_14),
+	(15 , happyReduce_15),
+	(16 , happyReduce_16),
+	(17 , happyReduce_17),
+	(18 , happyReduce_18),
+	(19 , happyReduce_19),
+	(20 , happyReduce_20),
+	(21 , happyReduce_21),
+	(22 , happyReduce_22),
+	(23 , happyReduce_23),
+	(24 , happyReduce_24),
+	(25 , happyReduce_25),
+	(26 , happyReduce_26),
+	(27 , happyReduce_27),
+	(28 , happyReduce_28),
+	(29 , happyReduce_29),
+	(30 , happyReduce_30),
+	(31 , happyReduce_31),
+	(32 , happyReduce_32),
+	(33 , happyReduce_33),
+	(34 , happyReduce_34),
+	(35 , happyReduce_35),
+	(36 , happyReduce_36),
+	(37 , happyReduce_37),
+	(38 , happyReduce_38),
+	(39 , happyReduce_39),
+	(40 , happyReduce_40),
+	(41 , happyReduce_41),
+	(42 , happyReduce_42),
+	(43 , happyReduce_43),
+	(44 , happyReduce_44),
+	(45 , happyReduce_45),
+	(46 , happyReduce_46),
+	(47 , happyReduce_47),
+	(48 , happyReduce_48),
+	(49 , happyReduce_49),
+	(50 , happyReduce_50),
+	(51 , happyReduce_51),
+	(52 , happyReduce_52),
+	(53 , happyReduce_53),
+	(54 , happyReduce_54),
+	(55 , happyReduce_55),
+	(56 , happyReduce_56),
+	(57 , happyReduce_57),
+	(58 , happyReduce_58),
+	(59 , happyReduce_59),
+	(60 , happyReduce_60),
+	(61 , happyReduce_61),
+	(62 , happyReduce_62),
+	(63 , happyReduce_63),
+	(64 , happyReduce_64),
+	(65 , happyReduce_65),
+	(66 , happyReduce_66),
+	(67 , happyReduce_67),
+	(68 , happyReduce_68)
+	]
+
+happy_n_terms = 26 :: Int
+happy_n_nonterms = 34 :: Int
+
+happyReduce_1 = happySpecReduce_1 0# happyReduction_1
+happyReduction_1 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TV happy_var_1)) -> 
+	happyIn4
+		 (Ident happy_var_1
+	)}
+
+happyReduce_2 = happySpecReduce_1 1# happyReduction_2
+happyReduction_2 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> 
+	happyIn5
+		 ((read happy_var_1) :: Integer
+	)}
+
+happyReduce_3 = happySpecReduce_1 2# happyReduction_3
+happyReduction_3 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TD happy_var_1)) -> 
+	happyIn6
+		 ((read happy_var_1) :: Double
+	)}
+
+happyReduce_4 = happySpecReduce_1 3# happyReduction_4
+happyReduction_4 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TL happy_var_1)) -> 
+	happyIn7
+		 (happy_var_1
+	)}
+
+happyReduce_5 = happySpecReduce_1 4# happyReduction_5
+happyReduction_5 happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	happyIn8
+		 (Program (reverse happy_var_1)
+	)}
+
+happyReduce_6 = happyReduce 8# 5# happyReduction_6
+happyReduction_6 (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 happyOut4 happy_x_2 of { happy_var_2 -> 
+	case happyOut11 happy_x_4 of { happy_var_4 -> 
+	case happyOut13 happy_x_7 of { happy_var_7 -> 
+	happyIn9
+		 (FunDef happy_var_2 happy_var_4 (reverse happy_var_7)
+	) `HappyStk` happyRest}}}
+
+happyReduce_7 = happySpecReduce_1 5# happyReduction_7
+happyReduction_7 happy_x_1
+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> 
+	happyIn9
+		 (ElStmt happy_var_1
+	)}
+
+happyReduce_8 = happySpecReduce_0 6# happyReduction_8
+happyReduction_8  =  happyIn10
+		 ([]
+	)
+
+happyReduce_9 = happySpecReduce_2 6# happyReduction_9
+happyReduction_9 happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut9 happy_x_2 of { happy_var_2 -> 
+	happyIn10
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_10 = happySpecReduce_0 7# happyReduction_10
+happyReduction_10  =  happyIn11
+		 ([]
+	)
+
+happyReduce_11 = happySpecReduce_1 7# happyReduction_11
+happyReduction_11 happy_x_1
+	 =  case happyOut4 happy_x_1 of { happy_var_1 -> 
+	happyIn11
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_12 = happySpecReduce_3 7# happyReduction_12
+happyReduction_12 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut4 happy_x_1 of { happy_var_1 -> 
+	case happyOut11 happy_x_3 of { happy_var_3 -> 
+	happyIn11
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_13 = happySpecReduce_3 8# happyReduction_13
+happyReduction_13 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut13 happy_x_2 of { happy_var_2 -> 
+	happyIn12
+		 (SCompound (reverse happy_var_2)
+	)}
+
+happyReduce_14 = happySpecReduce_2 8# happyReduction_14
+happyReduction_14 happy_x_2
+	happy_x_1
+	 =  happyIn12
+		 (SReturnVoid
+	)
+
+happyReduce_15 = happySpecReduce_3 8# happyReduction_15
+happyReduction_15 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut22 happy_x_2 of { happy_var_2 -> 
+	happyIn12
+		 (SReturn happy_var_2
+	)}
+
+happyReduce_16 = happySpecReduce_2 8# happyReduction_16
+happyReduction_16 happy_x_2
+	happy_x_1
+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> 
+	happyIn12
+		 (SDeclOrExpr happy_var_1
+	)}
+
+happyReduce_17 = happySpecReduce_0 9# happyReduction_17
+happyReduction_17  =  happyIn13
+		 ([]
+	)
+
+happyReduce_18 = happySpecReduce_2 9# happyReduction_18
+happyReduction_18 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_19 = happySpecReduce_2 10# happyReduction_19
+happyReduction_19 happy_x_2
+	happy_x_1
+	 =  case happyOut16 happy_x_2 of { happy_var_2 -> 
+	happyIn14
+		 (Decl happy_var_2
+	)}
+
+happyReduce_20 = happySpecReduce_1 10# happyReduction_20
+happyReduction_20 happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	happyIn14
+		 (DExpr happy_var_1
+	)}
+
+happyReduce_21 = happySpecReduce_1 11# happyReduction_21
+happyReduction_21 happy_x_1
+	 =  case happyOut4 happy_x_1 of { happy_var_1 -> 
+	happyIn15
+		 (DVar happy_var_1
+	)}
+
+happyReduce_22 = happySpecReduce_3 11# happyReduction_22
+happyReduction_22 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut4 happy_x_1 of { happy_var_1 -> 
+	case happyOut22 happy_x_3 of { happy_var_3 -> 
+	happyIn15
+		 (DInit happy_var_1 happy_var_3
+	)}}
+
+happyReduce_23 = happySpecReduce_0 12# happyReduction_23
+happyReduction_23  =  happyIn16
+		 ([]
+	)
+
+happyReduce_24 = happySpecReduce_1 12# happyReduction_24
+happyReduction_24 happy_x_1
+	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
+	happyIn16
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_25 = happySpecReduce_3 12# happyReduction_25
+happyReduction_25 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
+	case happyOut16 happy_x_3 of { happy_var_3 -> 
+	happyIn16
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_26 = happySpecReduce_3 13# happyReduction_26
+happyReduction_26 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
+		 (EAssign happy_var_1 happy_var_3
+	)}}
+
+happyReduce_27 = happySpecReduce_1 13# happyReduction_27
+happyReduction_27 happy_x_1
+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
+	happyIn17
+		 (happy_var_1
+	)}
+
+happyReduce_28 = happyReduce 5# 14# 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 happyOut4 happy_x_2 of { happy_var_2 -> 
+	case happyOut21 happy_x_4 of { happy_var_4 -> 
+	happyIn18
+		 (ENew happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_29 = happySpecReduce_1 14# happyReduction_29
+happyReduction_29 happy_x_1
+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> 
+	happyIn18
+		 (happy_var_1
+	)}
+
+happyReduce_30 = happySpecReduce_3 15# happyReduction_30
+happyReduction_30 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> 
+	case happyOut4 happy_x_3 of { happy_var_3 -> 
+	happyIn19
+		 (EMember happy_var_1 happy_var_3
+	)}}
+
+happyReduce_31 = happyReduce 4# 15# happyReduction_31
+happyReduction_31 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut19 happy_x_1 of { happy_var_1 -> 
+	case happyOut22 happy_x_3 of { happy_var_3 -> 
+	happyIn19
+		 (EIndex happy_var_1 happy_var_3
+	) `HappyStk` happyRest}}
+
+happyReduce_32 = happyReduce 4# 15# happyReduction_32
+happyReduction_32 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut19 happy_x_1 of { happy_var_1 -> 
+	case happyOut21 happy_x_3 of { happy_var_3 -> 
+	happyIn19
+		 (ECall happy_var_1 happy_var_3
+	) `HappyStk` happyRest}}
+
+happyReduce_33 = happySpecReduce_1 15# happyReduction_33
+happyReduction_33 happy_x_1
+	 =  case happyOut20 happy_x_1 of { happy_var_1 -> 
+	happyIn19
+		 (happy_var_1
+	)}
+
+happyReduce_34 = happySpecReduce_1 16# happyReduction_34
+happyReduction_34 happy_x_1
+	 =  case happyOut4 happy_x_1 of { happy_var_1 -> 
+	happyIn20
+		 (EVar happy_var_1
+	)}
+
+happyReduce_35 = happySpecReduce_1 16# happyReduction_35
+happyReduction_35 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn20
+		 (EInt happy_var_1
+	)}
+
+happyReduce_36 = happySpecReduce_1 16# happyReduction_36
+happyReduction_36 happy_x_1
+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> 
+	happyIn20
+		 (EDbl happy_var_1
+	)}
+
+happyReduce_37 = happySpecReduce_1 16# happyReduction_37
+happyReduction_37 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn20
+		 (EStr happy_var_1
+	)}
+
+happyReduce_38 = happySpecReduce_1 16# happyReduction_38
+happyReduction_38 happy_x_1
+	 =  happyIn20
+		 (ETrue
+	)
+
+happyReduce_39 = happySpecReduce_1 16# happyReduction_39
+happyReduction_39 happy_x_1
+	 =  happyIn20
+		 (EFalse
+	)
+
+happyReduce_40 = happySpecReduce_1 16# happyReduction_40
+happyReduction_40 happy_x_1
+	 =  happyIn20
+		 (ENull
+	)
+
+happyReduce_41 = happySpecReduce_1 16# happyReduction_41
+happyReduction_41 happy_x_1
+	 =  happyIn20
+		 (EThis
+	)
+
+happyReduce_42 = happyReduce 7# 16# happyReduction_42
+happyReduction_42 (happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut11 happy_x_3 of { happy_var_3 -> 
+	case happyOut13 happy_x_6 of { happy_var_6 -> 
+	happyIn20
+		 (EFun happy_var_3 (reverse happy_var_6)
+	) `HappyStk` happyRest}}
+
+happyReduce_43 = happySpecReduce_3 16# happyReduction_43
+happyReduction_43 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut21 happy_x_2 of { happy_var_2 -> 
+	happyIn20
+		 (EArray happy_var_2
+	)}
+
+happyReduce_44 = happySpecReduce_3 16# happyReduction_44
+happyReduction_44 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut36 happy_x_2 of { happy_var_2 -> 
+	happyIn20
+		 (EObj happy_var_2
+	)}
+
+happyReduce_45 = happyReduce 5# 16# happyReduction_45
+happyReduction_45 (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_2 of { happy_var_2 -> 
+	case happyOut21 happy_x_4 of { happy_var_4 -> 
+	happyIn20
+		 (eseq1_ happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_46 = happySpecReduce_3 16# happyReduction_46
+happyReduction_46 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut22 happy_x_2 of { happy_var_2 -> 
+	happyIn20
+		 (happy_var_2
+	)}
+
+happyReduce_47 = happySpecReduce_0 17# happyReduction_47
+happyReduction_47  =  happyIn21
+		 ([]
+	)
+
+happyReduce_48 = happySpecReduce_1 17# happyReduction_48
+happyReduction_48 happy_x_1
+	 =  case happyOut22 happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_49 = happySpecReduce_3 17# happyReduction_49
+happyReduction_49 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut22 happy_x_1 of { happy_var_1 -> 
+	case happyOut21 happy_x_3 of { happy_var_3 -> 
+	happyIn21
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_50 = happySpecReduce_1 18# happyReduction_50
+happyReduction_50 happy_x_1
+	 =  case happyOut23 happy_x_1 of { happy_var_1 -> 
+	happyIn22
+		 (happy_var_1
+	)}
+
+happyReduce_51 = happySpecReduce_1 19# happyReduction_51
+happyReduction_51 happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 (happy_var_1
+	)}
+
+happyReduce_52 = happySpecReduce_1 20# happyReduction_52
+happyReduction_52 happy_x_1
+	 =  case happyOut25 happy_x_1 of { happy_var_1 -> 
+	happyIn24
+		 (happy_var_1
+	)}
+
+happyReduce_53 = happySpecReduce_1 21# happyReduction_53
+happyReduction_53 happy_x_1
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
+	happyIn25
+		 (happy_var_1
+	)}
+
+happyReduce_54 = happySpecReduce_1 22# happyReduction_54
+happyReduction_54 happy_x_1
+	 =  case happyOut27 happy_x_1 of { happy_var_1 -> 
+	happyIn26
+		 (happy_var_1
+	)}
+
+happyReduce_55 = happySpecReduce_1 23# happyReduction_55
+happyReduction_55 happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	happyIn27
+		 (happy_var_1
+	)}
+
+happyReduce_56 = happySpecReduce_1 24# happyReduction_56
+happyReduction_56 happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	happyIn28
+		 (happy_var_1
+	)}
+
+happyReduce_57 = happySpecReduce_1 25# happyReduction_57
+happyReduction_57 happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	happyIn29
+		 (happy_var_1
+	)}
+
+happyReduce_58 = happySpecReduce_1 26# happyReduction_58
+happyReduction_58 happy_x_1
+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 (happy_var_1
+	)}
+
+happyReduce_59 = happySpecReduce_1 27# happyReduction_59
+happyReduction_59 happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	happyIn31
+		 (happy_var_1
+	)}
+
+happyReduce_60 = happySpecReduce_1 28# happyReduction_60
+happyReduction_60 happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	happyIn32
+		 (happy_var_1
+	)}
+
+happyReduce_61 = happySpecReduce_1 29# happyReduction_61
+happyReduction_61 happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	happyIn33
+		 (happy_var_1
+	)}
+
+happyReduce_62 = happySpecReduce_1 30# happyReduction_62
+happyReduction_62 happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 (happy_var_1
+	)}
+
+happyReduce_63 = happySpecReduce_3 31# happyReduction_63
+happyReduction_63 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> 
+	case happyOut22 happy_x_3 of { happy_var_3 -> 
+	happyIn35
+		 (Prop happy_var_1 happy_var_3
+	)}}
+
+happyReduce_64 = happySpecReduce_0 32# happyReduction_64
+happyReduction_64  =  happyIn36
+		 ([]
+	)
+
+happyReduce_65 = happySpecReduce_1 32# happyReduction_65
+happyReduction_65 happy_x_1
+	 =  case happyOut35 happy_x_1 of { happy_var_1 -> 
+	happyIn36
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_66 = happySpecReduce_3 32# happyReduction_66
+happyReduction_66 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 -> 
+	happyIn36
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_67 = happySpecReduce_1 33# happyReduction_67
+happyReduction_67 happy_x_1
+	 =  case happyOut4 happy_x_1 of { happy_var_1 -> 
+	happyIn37
+		 (IdentPropName happy_var_1
+	)}
+
+happyReduce_68 = happySpecReduce_1 33# happyReduction_68
+happyReduction_68 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn37
+		 (StringPropName happy_var_1
+	)}
+
+happyNewToken action sts stk [] =
+	happyDoAction 25# (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 "false") -> cont 12#;
+	PT _ (TS "function") -> cont 13#;
+	PT _ (TS "new") -> cont 14#;
+	PT _ (TS "null") -> cont 15#;
+	PT _ (TS "return") -> cont 16#;
+	PT _ (TS "this") -> cont 17#;
+	PT _ (TS "true") -> cont 18#;
+	PT _ (TS "var") -> cont 19#;
+	PT _ (TV happy_dollar_dollar) -> cont 20#;
+	PT _ (TI happy_dollar_dollar) -> cont 21#;
+	PT _ (TD happy_dollar_dollar) -> cont 22#;
+	PT _ (TL happy_dollar_dollar) -> cont 23#;
+	_ -> cont 24#;
+	_ -> 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
+
+pProgram tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut8 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
+eseq1_ x_ xs_ = ESeq (x_ : xs_)
+{-# 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-2.9/GF/JavaScript/ParJS.y b/src-2.9/GF/JavaScript/ParJS.y
new file mode 100644
index 000000000..bf0614757
--- /dev/null
+++ b/src-2.9/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-2.9/GF/JavaScript/PrintJS.hs b/src-2.9/GF/JavaScript/PrintJS.hs
new file mode 100644
index 000000000..66e78346e
--- /dev/null
+++ b/src-2.9/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 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-2.9/GF/JavaScript/SkelJS.hs b/src-2.9/GF/JavaScript/SkelJS.hs
new file mode 100644
index 000000000..f8cd588a7
--- /dev/null
+++ b/src-2.9/GF/JavaScript/SkelJS.hs
@@ -0,0 +1,80 @@
+module GF.JavaScript.SkelJS where
+
+-- Haskell module generated by the BNF converter
+
+import GF.JavaScript.AbsJS
+import GF.Data.ErrM
+type Result = Err String
+
+failure :: Show a => a -> Result
+failure x = Bad $ "Undefined case: " ++ show x
+
+transIdent :: Ident -> Result
+transIdent x = case x of
+  Ident str  -> failure x
+
+
+transProgram :: Program -> Result
+transProgram x = case x of
+  Program elements  -> failure x
+
+
+transElement :: Element -> Result
+transElement x = case x of
+  FunDef id ids stmts  -> failure x
+  ElStmt stmt  -> failure x
+
+
+transStmt :: Stmt -> Result
+transStmt x = case x of
+  SCompound stmts  -> failure x
+  SReturnVoid  -> failure x
+  SReturn expr  -> failure x
+  SDeclOrExpr declorexpr  -> failure x
+
+
+transDeclOrExpr :: DeclOrExpr -> Result
+transDeclOrExpr x = case x of
+  Decl declvars  -> failure x
+  DExpr expr  -> failure x
+
+
+transDeclVar :: DeclVar -> Result
+transDeclVar x = case x of
+  DVar id  -> failure x
+  DInit id expr  -> failure x
+
+
+transExpr :: Expr -> Result
+transExpr x = case x of
+  EAssign expr0 expr  -> failure x
+  ENew id exprs  -> failure x
+  EMember expr id  -> failure x
+  EIndex expr0 expr  -> failure x
+  ECall expr exprs  -> failure x
+  EVar id  -> failure x
+  EInt n  -> failure x
+  EDbl d  -> failure x
+  EStr str  -> failure x
+  ETrue  -> failure x
+  EFalse  -> failure x
+  ENull  -> failure x
+  EThis  -> failure x
+  EFun ids stmts  -> failure x
+  EArray exprs  -> failure x
+  EObj propertys  -> failure x
+  ESeq exprs  -> failure x
+
+
+transProperty :: Property -> Result
+transProperty x = case x of
+  Prop propertyname expr  -> failure x
+
+
+transPropertyName :: PropertyName -> Result
+transPropertyName x = case x of
+  IdentPropName id  -> failure x
+  StringPropName str  -> failure x
+
+
+
diff --git a/src-2.9/GF/JavaScript/TestJS.hs b/src-2.9/GF/JavaScript/TestJS.hs
new file mode 100644
index 000000000..3ddb52074
--- /dev/null
+++ b/src-2.9/GF/JavaScript/TestJS.hs
@@ -0,0 +1,58 @@
+-- automatically generated by BNF Converter
+module Main where
+
+
+import IO ( stdin, hGetContents )
+import System ( getArgs, getProgName )
+
+import GF.JavaScript.LexJS
+import GF.JavaScript.ParJS
+import GF.JavaScript.SkelJS
+import GF.JavaScript.PrintJS
+import GF.JavaScript.AbsJS
+
+
+
+
+import GF.Data.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 pProgram
+            "-s":fs -> mapM_ (runFile 0 pProgram) fs
+            fs -> mapM_ (runFile 2 pProgram) fs
+
+
+
+
+
diff --git a/src-2.9/GF/OldParsing/CFGrammar.hs b/src-2.9/GF/OldParsing/CFGrammar.hs
new file mode 100644
index 000000000..5a71fe0ab
--- /dev/null
+++ b/src-2.9/GF/OldParsing/CFGrammar.hs
@@ -0,0 +1,153 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CFGrammar
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:41 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Definitions of context-free grammars,
+-- parser information and chart conversion
+----------------------------------------------------------------------
+
+module GF.OldParsing.CFGrammar
+    (-- * Type definitions
+     Grammar,
+     Rule(..),
+     CFParser,
+     -- * Parser information
+     pInfo,
+     PInfo(..),
+     -- * Building parse charts
+     edges2chart,
+     -- * Grammar checking
+     checkGrammar
+    ) where
+
+import GF.System.Tracing 
+
+-- haskell modules:
+import Data.Array
+-- gf modules:
+import GF.Data.SortedList
+import GF.Data.Assoc
+import qualified GF.CF.CF as CF
+-- parser modules:
+import GF.OldParsing.Utilities
+import GF.Printing.PrintParser
+
+
+------------------------------------------------------------
+-- type definitions
+
+type Grammar n c t = [Rule n c t]
+data Rule    n c t = Rule c [Symbol c t] n
+		     deriving (Eq, Ord, Show)
+
+
+type CFParser n c t = PInfo n c t -> [c] -> Input t -> [Edge (Rule n c t)]
+-- - - - - - - - - - - - - - - - - - ^^^ possible starting categories
+
+
+------------------------------------------------------------
+-- parser information
+
+pInfo :: (Ord n, Ord c, Ord t) => Grammar n c t -> PInfo n c t
+
+data PInfo n c t
+    = PInfo { grammarTokens        :: SList t,
+	      nameRules            :: Assoc n            (SList (Rule n c t)),
+	      topdownRules         :: Assoc c            (SList (Rule n c t)),
+	      bottomupRules        :: Assoc (Symbol c t) (SList (Rule n c t)),
+	      emptyLeftcornerRules :: Assoc c            (SList (Rule n c t)),
+	      emptyCategories      :: Set c,
+	      cyclicCategories     :: SList c,
+	      -- ^^ONLY FOR DIRECT CYCLIC RULES!!!
+	      leftcornerTokens     :: Assoc c (SList t)
+	      -- ^^DOES NOT WORK WITH EMPTY RULES!!!
+	    }
+
+-- this is not permanent...
+pInfo grammar = pInfo' (filter (not.isCyclic) grammar)
+
+pInfo' grammar = tracePrt "#parserInfo" prt $
+		 PInfo grToks nmRules tdRules buRules elcRules emptyCats cyclicCats leftToks 
+    where grToks    = union [ nubsort [ tok | Tok tok <- rhs ] | Rule _ rhs _ <- grammar ]
+	  nmRules   = accumAssoc id [ (name, rule) | rule@(Rule _ _ name) <- grammar ]
+	  tdRules   = accumAssoc id [ (cat,  rule) | rule@(Rule cat _ _) <- grammar ]
+	  buRules   = accumAssoc id [ (next, rule) | rule@(Rule _ (next:_) _) <- grammar ]
+	  elcRules  = accumAssoc id $ limit lc emptyRules
+	  leftToks  = accumAssoc id $ limit lc $ 
+		            nubsort [ (cat, token) | Rule cat (Tok token:_) _ <- grammar ]
+	  lc (left, res)  = nubsort [ (cat, res)   | Rule cat _ _ <- buRules ? Cat left ]
+	  emptyRules      = nubsort [ (cat, rule)  | rule@(Rule cat [] _) <- grammar ]
+	  emptyCats       = listSet $ limitEmpties $ map fst emptyRules
+	  limitEmpties es = if es==es' then es else limitEmpties es'
+	      where es'   = nubsort [ cat | Rule cat rhs _ <- grammar, 
+				      all (symbol (`elem` es) (const False)) rhs ]
+	  cyclicCats = nubsort [ cat | Rule cat [Cat cat'] _ <- grammar, cat == cat' ]
+
+isCyclic (Rule cat [Cat cat'] _) = cat==cat'
+isCyclic _ = False
+
+------------------------------------------------------------
+-- building parse charts
+
+edges2chart :: (Ord n, Ord c, Ord t) => Input t -> 
+	       [Edge (Rule n c t)] -> ParseChart n (Edge c)
+
+----------
+
+edges2chart input edges 
+    = accumAssoc id [ (Edge i k cat, (name, children i k rhs)) |
+		      Edge i k (Rule cat rhs name) <- edges ]
+    where children i k []            = [ [] | i == k ]
+	  children i k (Tok tok:rhs) = [ rest | i <= k,
+					 j <- (inputFrom input ! i) ? tok,
+					 rest <- children j k rhs ]
+	  children i k (Cat cat:rhs) = [ Edge i j cat : rest | i <= k,
+					 j <- echart ? (i, cat),
+					 rest <- children j k rhs ]
+	  echart = accumAssoc id [ ((i, cat), j) | Edge i j (Rule cat _ _) <- edges ]
+
+
+------------------------------------------------------------
+-- grammar checking
+
+checkGrammar :: (Ord n, Ord c, Ord t, Print n, Print c, Print t) => 
+		Grammar n c t -> [String]
+
+----------
+
+checkGrammar rules = [ "rhs category does not exist: " ++ prt cat ++ "\n" ++
+		       "  in rule: " ++ prt rule |
+		       rule@(Rule _ rhs _) <- rules,
+		       Cat cat <- rhs, cat `notElem` cats ]
+    where cats = nubsort [ cat | Rule cat _ _ <- rules ]
+
+
+------------------------------------------------------------
+-- pretty-printing
+
+instance (Print n, Print c, Print t) => Print (Rule n c t) where
+    prt (Rule cat rhs name) = prt name ++ ". " ++ prt cat ++ " -> " ++ prt rhs ++ 
+			      (if null rhs then ".\n" else "\n")
+    prtList = concatMap prt
+
+
+instance (Ord n, Ord c, Ord t) => Print (PInfo n c t) where
+    prt pI = "[ tokens=" ++ show (length (grammarTokens pI)) ++
+	     "; names=" ++ sla nameRules ++ 
+	     "; tdCats=" ++ sla topdownRules ++
+	     "; buCats=" ++ sla bottomupRules ++ 
+	     "; elcCats=" ++ sla emptyLeftcornerRules ++
+	     "; eCats=" ++ sla emptyCategories ++
+	     "; cCats=" ++ show (length (cyclicCategories pI)) ++
+	     -- "; lctokCats=" ++ sla leftcornerTokens ++ 
+	     " ]"
+	where sla f = show $ length $ aElems $ f pI
+
+
diff --git a/src-2.9/GF/OldParsing/ConvertFiniteGFC.hs b/src-2.9/GF/OldParsing/ConvertFiniteGFC.hs
new file mode 100644
index 000000000..25ed3fdb3
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertFiniteGFC.hs
@@ -0,0 +1,283 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:42 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Calculating the finiteness of each type in a grammar
+-----------------------------------------------------------------------------
+
+module GF.OldParsing.ConvertFiniteGFC where
+
+import GF.Data.Operations
+import GF.Canon.GFC
+import GF.Canon.MkGFC
+import GF.Canon.AbsGFC
+import GF.Infra.Ident (Ident(..))
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.Data.BacktrackM
+
+type Cat = Ident
+type Name = Ident
+
+type CnvMonad a = BacktrackM () a
+
+convertGrammar :: CanonGrammar -> CanonGrammar
+convertGrammar = canon2grammar . convertCanon . grammar2canon
+
+convertCanon :: Canon -> Canon
+convertCanon (Gr modules) = Gr (map (convertModule split) modules)
+    where split = calcSplitable modules
+
+convertModule :: Splitable -> Module -> Module
+convertModule split (Mod mtyp ext op fl defs) 
+    = Mod mtyp ext op fl newDefs
+    where newDefs  = solutions defMonad () 
+	  defMonad = member defs >>= convertDef split
+
+----------------------------------------------------------------------
+-- the main conversion function
+convertDef :: Splitable -> Def -> CnvMonad Def
+
+-- converting abstract "cat" definitions
+convertDef split (AbsDCat cat decls cidents)
+    = case splitableCat split cat of
+        Just newCats -> do newCat <- member newCats
+			   return $ AbsDCat newCat decls cidents
+	Nothing -> do (newCat, newDecls) <- expandDecls cat decls
+		      return $ AbsDCat newCat newDecls cidents
+    where expandDecls cat [] = return (cat, [])
+	  expandDecls cat (decl@(Decl var typ) : decls)
+	      = do (newCat, newDecls) <- expandDecls cat decls
+		   let argCat = resultCat typ
+		   case splitableCat split argCat of
+		     Nothing -> return (newCat, decl : newDecls) 
+		     Just newArgs -> do newArg <- member newArgs
+					return (mergeArg newCat newArg, newDecls)
+
+-- converting abstract "fun" definitions
+convertDef split (AbsDFun fun typ@(EAtom (AC (CIQ mod cat))) def)
+    = case splitableFun split fun of
+        Just newCat -> return (AbsDFun fun (EAtom (AC (CIQ mod newCat))) def)
+	Nothing -> do newTyp <- expandType split [] typ
+		      return (AbsDFun fun newTyp def)
+convertDef split (AbsDFun fun typ def)
+    = do newTyp <- expandType split [] typ
+	 return (AbsDFun fun newTyp def)
+
+-- converting concrete "lincat" definitions
+convertDef split (CncDCat cat ctype x y)
+    = case splitableCat split cat of
+        Just newCats -> do newCat <- member newCats
+			   return $ CncDCat newCat ctype x y
+	Nothing -> return $ CncDCat cat ctype x y
+
+-- converting concrete "lin" definitions
+convertDef split (CncDFun fun (CIQ mod cat) args linterm x)
+    = case splitableFun split fun of
+        Just newCat -> return $ CncDFun fun (CIQ mod newCat) args linterm x
+	Nothing -> return $ CncDFun fun (CIQ mod cat) args linterm x
+
+convertDef _ def = return def
+
+----------------------------------------------------------------------
+-- expanding type expressions
+
+expandType :: Splitable -> [(Ident, Cat)] -> Exp -> CnvMonad Exp
+expandType split env (EProd x a@(EAtom (AC (CIQ mod cat))) b)
+    = case splitableCat split cat of
+        Nothing -> do b' <- expandType split env b
+		      return (EProd x a b')
+	Just newCats -> do newCat <- member newCats
+			   b' <- expandType split ((x,newCat):env) b
+			   return (EProd x (EAtom (AC (CIQ mod newCat))) b')
+expandType split env (EProd x a b)
+    = do a' <- expandType split env a
+	 b' <- expandType split env b
+	 return (EProd x a' b')
+expandType split env app
+    = expandApp split env [] app
+
+expandApp :: Splitable -> [(Ident, Cat)] -> [Cat] -> Exp -> CnvMonad Exp
+expandApp split env addons (EAtom (AC (CIQ mod cat)))
+    = return (EAtom (AC (CIQ mod (foldl mergeArg cat addons))))
+expandApp split env addons (EApp exp arg@(EAtom (AC (CIQ mod fun))))
+    = case splitableFun split fun of
+        Just newCat -> expandApp split env (newCat:addons) exp
+	Nothing -> do exp' <- expandApp split env addons exp
+		      return (EApp exp' arg)
+expandApp split env addons (EApp exp arg@(EAtom (AV x)))
+    = case lookup x env of
+        Just newCat -> expandApp split env (newCat:addons) exp
+	Nothing -> do exp' <- expandApp split env addons exp
+		      return (EApp exp' arg)
+
+----------------------------------------------------------------------
+-- splitable categories (finite, no dependencies)
+-- they should also be used as some dependency
+
+type Splitable = (Assoc Cat [Cat], Assoc Name Cat)
+
+splitableCat :: Splitable -> Cat -> Maybe [Cat]
+splitableCat = lookupAssoc . fst 
+
+splitableFun :: Splitable -> Name -> Maybe  Cat
+splitableFun = lookupAssoc . snd
+
+calcSplitable :: [Module] -> Splitable
+calcSplitable modules = (listAssoc splitableCats, listAssoc splitableFuns)
+    where splitableCats = tracePrt "splitableCats" (prtSep " ") $
+			  groupPairs $ nubsort 
+			  [ (cat, mergeFun fun cat) | (cat, fun) <- constantCats ]
+
+	  splitableFuns = tracePrt "splitableFuns" (prtSep " ") $
+			  nubsort
+			  [ (fun, mergeFun fun cat) | (cat, fun) <- constantCats ]
+
+	  constantCats = tracePrt "constantCats" (prtSep " ") $
+			 [ (cat, fun) |
+			   AbsDFun fun (EAtom (AC (CIQ _ cat))) _ <- absDefs,
+			   dependentConstants ?= cat ]
+
+          dependentConstants = listSet $
+			       tracePrt "dep consts" prt $
+			       dependentCats <\\> funCats
+
+	  funCats = tracePrt "fun cats" prt $
+		    nubsort [ resultCat typ |
+			      AbsDFun _ typ@(EProd _ _ _) _ <- absDefs ]
+
+          dependentCats = tracePrt "dep cats" prt $
+			  nubsort [ cat | AbsDCat _ decls _ <- absDefs,
+				    Decl _ (EAtom (AC (CIQ _ cat))) <- decls ]
+			    
+          absDefs = concat [ defs | Mod (MTAbs _) _ _ _ defs <- modules ]
+
+
+----------------------------------------------------------------------
+-- utilities
+
+-- the main result category of a type expression
+resultCat :: Exp -> Cat
+resultCat (EProd _ _ b) = resultCat b
+resultCat (EApp a _) = resultCat a
+resultCat (EAtom (AC (CIQ _ cat))) = cat
+
+-- mergeing categories
+mergeCats :: String -> String -> String -> Cat -> Cat -> Cat
+mergeCats before middle after (IC cat) (IC arg) 
+    = IC (before ++ cat ++ middle ++ arg ++ after)
+
+mergeFun, mergeArg :: Cat -> Cat -> Cat
+mergeFun = mergeCats "{" ":" "}"
+mergeArg = mergeCats "" "" ""
+
+----------------------------------------------------------------------
+-- obsolete?
+
+{-
+type FiniteCats = Assoc Cat Integer
+
+calculateFiniteness :: Canon -> FiniteCats
+calculateFiniteness canon@(Gr modules) 
+    = trace2 "#typeInfo" (prt tInfo) $
+      finiteCats
+
+    where finiteCats = listAssoc [ (cat, fin) | (cat, Just fin) <- finiteInfo ]
+          finiteInfo = map finInfo groups 
+
+	  finInfo :: (Cat, [[Cat]]) -> (Cat, Maybe Integer)
+	  finInfo (cat, ctxts)
+	      | cyclicCats ?= cat = (cat, Nothing)
+	      | otherwise = (cat, fmap (sum . map product) $
+			     sequence (map (sequence . map lookFinCat) ctxts))
+
+	  lookFinCat :: Cat -> Maybe Integer
+	  lookFinCat cat = maybe (error "lookFinCat: Nothing") id $
+			   lookup cat finiteInfo
+
+	  cyclicCats :: Set Cat
+	  cyclicCats = listSet $
+		       tracePrt "cyclic cats" prt $
+		       union $ map nubsort $ cyclesIn dependencies
+
+	  dependencies :: [(Cat, [Cat])]
+	  dependencies = tracePrt "dependencies" (prtAfter "\n") $
+			 mapSnd (union . nubsort) groups
+
+	  groups :: [(Cat, [[Cat]])]
+	  groups  = tracePrt "groups" (prtAfter "\n") $
+		    mapSnd (map snd) $ groupPairs (nubsort allFuns)
+
+	  allFuns = tracePrt "all funs" (prtAfter "\n") $
+		    [ (cat, (fun, ctxt)) |
+		      Mod (MTAbs _) _ _ _ defs <- modules,
+		      AbsDFun fun typ _ <- defs,
+		      let (cat, ctxt) = err error id $ typeForm typ ]
+
+          tInfo = calculateTypeInfo 30 finiteCats (splitDefs canon)
+
+-- | stolen from 'Macros.qTypeForm', converted to GFC, and severely simplified
+typeForm :: Monad m => Exp -> m (Cat, [Cat])
+typeForm t = case t of
+  EProd x a b  -> do
+    (cat, ctxt) <- typeForm b 
+    a' <- stripType a
+    return (cat, a':ctxt)
+  EApp c a -> do
+    (cat, _) <- typeForm c
+    return (cat, [])
+  EAtom (AC (CIQ _ con)) ->
+    return (con, []) 
+  _       -> 
+    fail $ "no normal form of type: " ++ prt t
+
+stripType :: Monad m => Exp -> m Cat
+stripType (EApp c a) = stripType c
+stripType (EAtom (AC (CIQ _ con))) = return con
+stripType t = fail $ "can't strip type: " ++ prt t
+
+mapSnd f xs = [ (a, f b) | (a, b) <- xs ]
+-}
+
+----------------------------------------------------------------------
+-- obsolete?
+
+{-
+type SplitDefs = ([Def],  [Def],  [Def],  [Def])
+-----            AbsDCat AbsDFun CncDCat CncDFun
+
+splitDefs :: Canon -> SplitDefs
+splitDefs (Gr modules) = foldr splitDef ([], [], [], []) $ 
+			 concat [ defs | Mod _ _ _ _ defs <- modules ]
+
+splitDef :: Def -> SplitDefs -> SplitDefs
+splitDef ac@(AbsDCat _ _ _) (acs, afs, ccs, cfs) = (ac:acs, afs, ccs, cfs)
+splitDef af@(AbsDFun _ _ _) (acs, afs, ccs, cfs) = (acs, af:afs, ccs, cfs)
+splitDef cc@(CncDCat _ _ _ _) (acs, afs, ccs, cfs) = (acs, afs, cc:ccs, cfs)
+splitDef cf@(CncDFun _ _ _ _ _) (acs, afs, ccs, cfs) = (acs, afs, ccs, cf:cfs)
+splitDef _ sd = sd
+
+--calculateTypeInfo :: Integer -> FiniteCats -> SplitDefs -> ?
+calculateTypeInfo maxFin allFinCats (acs, afs, ccs, cfs)
+    = (depCatsToExpand, catsToSplit)
+    where absDefsToExpand = tracePrt "absDefsToExpand" prt $
+			    [ ((cat, fin), cats) | 
+			      AbsDCat cat args _ <- acs, 
+			      not (null args),
+			      cats <- mapM catOfDecl args,
+			      fin <- lookupAssoc allFinCats cat,
+			      fin <= maxFin
+			    ]
+	  (depCatsToExpand, argsCats') = unzip absDefsToExpand
+	  catsToSplit = union (map nubsort argsCats')
+	  catOfDecl (Decl _ exp) = err fail return $ stripType exp
+-}
diff --git a/src-2.9/GF/OldParsing/ConvertFiniteSimple.hs b/src-2.9/GF/OldParsing/ConvertFiniteSimple.hs
new file mode 100644
index 000000000..a05092550
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertFiniteSimple.hs
@@ -0,0 +1,121 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:43 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Calculating the finiteness of each type in a grammar
+-----------------------------------------------------------------------------
+
+module GF.OldParsing.ConvertFiniteSimple
+    (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+
+import GF.Data.Operations
+import GF.Infra.Ident (Ident(..))
+import GF.OldParsing.SimpleGFC
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.Data.BacktrackM
+
+type CnvMonad a = BacktrackM () a
+
+convertGrammar :: Grammar -> Grammar
+convertGrammar rules = solutions cnvMonad () 
+    where split = calcSplitable rules
+	  cnvMonad = member rules >>= convertRule split
+
+convertRule :: Splitable -> Rule -> CnvMonad Rule
+convertRule split (Rule name typing term) 
+    = do newTyping <- convertTyping split name typing
+	 return $ Rule name newTyping term
+
+convertTyping :: Splitable -> Name -> Typing -> CnvMonad Typing
+convertTyping split name (typ, decls)
+    = case splitableFun split name of
+        Just newCat -> return (newCat :@ [], decls)
+	Nothing -> expandTyping split [] typ decls []
+
+
+expandTyping :: Splitable -> [(Var, Cat)] -> Type -> [Decl] -> [Decl] -> CnvMonad Typing
+expandTyping split env (cat :@ atoms) [] decls 
+    = return (substAtoms split env cat atoms [], reverse decls)
+expandTyping split env typ ((x ::: (xcat :@ xatoms)) : declsToDo) declsDone
+    = do env' <- calcNewEnv
+         expandTyping split env' typ declsToDo (decl : declsDone)
+    where decl = x ::: substAtoms split env xcat xatoms []
+	  calcNewEnv = case splitableCat split xcat of
+		         Just newCats -> do newCat <- member newCats
+					    return ((x,newCat) : env)
+			 Nothing -> return env
+
+substAtoms :: Splitable -> [(Var, Cat)] -> Cat -> [Atom] -> [Atom] -> Type
+substAtoms split env cat [] atoms = cat :@ reverse atoms
+substAtoms split env cat (atom:atomsToDo) atomsDone
+    = case atomLookup split env atom of
+        Just newCat -> substAtoms split env (mergeArg cat newCat) atomsToDo atomsDone
+	Nothing -> substAtoms split env cat atomsToDo (atom : atomsDone)
+
+atomLookup split env (AVar x) = lookup x env 
+atomLookup split env (ACon con) = splitableFun split (constr2name con)
+      
+
+----------------------------------------------------------------------
+-- splitable categories (finite, no dependencies)
+-- they should also be used as some dependency
+
+type Splitable = (Assoc Cat [Cat], Assoc Name Cat)
+
+splitableCat :: Splitable -> Cat -> Maybe [Cat]
+splitableCat = lookupAssoc . fst 
+
+splitableFun :: Splitable -> Name -> Maybe Cat
+splitableFun = lookupAssoc . snd
+
+calcSplitable :: [Rule] -> Splitable
+calcSplitable rules = (listAssoc splitableCats, listAssoc splitableFuns)
+    where splitableCats = tracePrt "splitableCats" (prtSep " ") $
+			  groupPairs $ nubsort 
+			  [ (cat, mergeFun fun cat) | (cat, fun) <- constantCats ]
+
+	  splitableFuns = tracePrt "splitableFuns" (prtSep " ") $
+			  nubsort
+			  [ (fun, mergeFun fun cat) | (cat, fun) <- constantCats ]
+
+	  constantCats = tracePrt "constantCats" (prtSep " ") $
+			 [ (cat, fun) |
+			   Rule fun (cat :@ [], []) _ <- rules,
+			   dependentConstants ?= cat ]
+
+          dependentConstants = listSet $
+			       tracePrt "dep consts" prt $
+			       dependentCats <\\> funCats
+
+	  funCats = tracePrt "fun cats" prt $
+		    nubsort [ cat | Rule _ (cat :@ _, decls) _ <- rules,
+			      not (null decls) ]
+
+          dependentCats = tracePrt "dep cats" prt $
+			  nubsort [ cat | Rule _ (cat :@ [], []) _ <- rules ]
+
+
+----------------------------------------------------------------------
+-- utilities
+
+-- mergeing categories
+mergeCats :: String -> String -> String -> Cat -> Cat -> Cat
+mergeCats before middle after (IC cat) (IC arg) 
+    = IC (before ++ cat ++ middle ++ arg ++ after)
+
+mergeFun, mergeArg :: Cat -> Cat -> Cat
+mergeFun = mergeCats "{" ":" "}"
+mergeArg = mergeCats "" "" ""
+
+
diff --git a/src-2.9/GF/OldParsing/ConvertGFCtoMCFG.hs b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG.hs
new file mode 100644
index 000000000..c32812eb2
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG.hs
@@ -0,0 +1,34 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ConvertGFCtoMCFG
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:44 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- All different conversions from GFC to MCFG
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertGFCtoMCFG
+    (convertGrammar) where
+
+import GF.Canon.GFC (CanonGrammar)
+import GF.OldParsing.GrammarTypes
+import GF.Infra.Ident (Ident(..))
+import GF.Infra.Option
+import GF.System.Tracing
+
+import qualified GF.OldParsing.ConvertGFCtoMCFG.Old as Old
+import qualified GF.OldParsing.ConvertGFCtoMCFG.Nondet as Nondet
+import qualified GF.OldParsing.ConvertGFCtoMCFG.Strict as Strict
+import qualified GF.OldParsing.ConvertGFCtoMCFG.Coercions as Coerce
+
+convertGrammar :: String -> (CanonGrammar, Ident) -> MCFGrammar
+convertGrammar "nondet" = Coerce.addCoercions . Nondet.convertGrammar
+convertGrammar "strict" = Strict.convertGrammar
+convertGrammar "old" = Old.convertGrammar
+
diff --git a/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Coercions.hs b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Coercions.hs
new file mode 100644
index 000000000..3ed6a3f48
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Coercions.hs
@@ -0,0 +1,71 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ConvertGFCtoMCFG.Coercions
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:54 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Adding coercion functions to a MCFG if necessary.
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertGFCtoMCFG.Coercions (addCoercions) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+-- import PrintGFC
+-- import qualified PrGrammar as PG
+
+import qualified GF.Infra.Ident as Ident
+import GF.OldParsing.Utilities
+import GF.OldParsing.GrammarTypes 
+import GF.OldParsing.MCFGrammar (Rule(..), Lin(..))
+import GF.Data.SortedList
+import Data.List (groupBy) -- , transpose)
+
+----------------------------------------------------------------------
+
+addCoercions :: MCFGrammar -> MCFGrammar
+addCoercions rules = coercions ++ rules
+    where (allHeads, allArgs) = unzip [ ((head, lbls), nubsort args) | 
+					Rule head args lins _ <- rules, 
+					let lbls = [ lbl | Lin lbl _ <- lins ] ]
+	  allHeadSet = nubsort allHeads
+	  allArgSet  = union   allArgs <\\> map fst allHeadSet
+	  coercions = tracePrt "#coercions total" (prt . length) $
+		      concat $
+		      tracePrt "#coercions per cat" (prtList . map length) $
+		      combineCoercions 
+		        (groupBy sameCatFst allHeadSet) 
+			(groupBy sameCat    allArgSet)
+	  sameCatFst a b = sameCat (fst a) (fst b)
+
+
+combineCoercions [] _ = []
+combineCoercions _ [] = []
+combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs) 
+    = case compare (mainCat $ fst $ head heads) (mainCat $ head args) of
+        LT -> combineCoercions allHeads  allArgs'
+	GT -> combineCoercions allHeads' allArgs
+	EQ -> makeCoercion heads args : combineCoercions allHeads allArgs
+
+
+makeCoercion heads args = [ Rule arg [head] lins coercionName |
+			    (head@(MCFCat _ headCns), lbls) <- heads, 
+			    let lins = [ Lin lbl [Cat (head, lbl, 0)] | lbl <- lbls ],
+			    arg@(MCFCat _ argCns) <- args,
+			    argCns `subset` headCns ]
+
+
+coercionName = Ident.IW
+
+mainCat (MCFCat c _) = c
+
+sameCat mc1 mc2 = mainCat mc1 == mainCat mc2
+
+
diff --git a/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Nondet.hs b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Nondet.hs
new file mode 100644
index 000000000..7727aa15f
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Nondet.hs
@@ -0,0 +1,281 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ConvertGFCtoMCFG.Nondet
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 14:15:18 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.3 $
+--
+-- Converting GFC grammars to MCFG grammars, nondeterministically.
+--
+-- the resulting grammars might be /very large/
+--
+-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
+-- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertGFCtoMCFG.Nondet (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+-- import PrintGFC
+-- import qualified PrGrammar as PG
+
+import Control.Monad
+import GF.Infra.Ident (Ident(..))
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.Canon.Look
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+import GF.Canon.CMacros (defLinType)
+import GF.Canon.MkGFC (grammar2canon)
+import GF.OldParsing.Utilities
+import GF.OldParsing.GrammarTypes 
+import GF.OldParsing.MCFGrammar (Grammar, Rule(..), Lin(..))
+import GF.Data.SortedList
+-- import Maybe (listToMaybe)
+import Data.List (groupBy) -- , transpose)
+
+import GF.Data.BacktrackM
+
+----------------------------------------------------------------------
+
+type Env  = (CanonGrammar, Ident)
+
+convertGrammar :: Env -- ^ the canonical grammar, together with the selected language
+	       -> MCFGrammar -- ^ the resulting MCF grammar
+convertGrammar gram = trace2 "language" (prt (snd gram)) $
+		      trace2 "modules" (prtSep " " modnames) $
+		      tracePrt "#mcf-rules total" (prt . length) $
+		      solutions conversion undefined
+    where Gr modules = grammar2canon (fst gram)
+	  modnames   = uncurry M.allExtends gram
+	  conversion = member modules >>= convertModule
+	  convertModule (Mod (MTCnc modname _) _ _ _ defs)
+	      | modname `elem` modnames = member defs >>= convertDef gram
+	  convertModule _ = failure
+
+convertDef :: Env -> Def -> CnvMonad MCFRule
+convertDef env (CncDFun fun (CIQ _ cat) args term _)
+    | trace2 "converting function" (prt fun) True
+    = do let iCat : iArgs = map initialMCat (cat : map catOfArg args)
+	 writeState (iCat, iArgs, [])
+	 convertTerm env cat term
+	 (newCat, newArgs, linRec) <- readState
+	 let newTerm = map (instLin newArgs) linRec
+	 return (Rule newCat newArgs newTerm fun)
+convertDef _ _ = failure
+
+instLin newArgs (Lin lbl lin) = Lin lbl (map instSym lin)
+    where instSym = mapSymbol instCat id
+	  instCat (_, lbl, arg) = (newArgs !! arg, lbl, arg)
+
+convertTerm :: Env -> Cat -> Term -> CnvMonad ()
+convertTerm env cat term = do rterm <- simplTerm env term
+			      let ctype = lookupCType env cat
+			      reduceT env ctype rterm emptyPath
+
+------------------------------------------------------------
+
+type CnvMonad a = BacktrackM CMRule a
+
+type CMRule = (MCFCat, [MCFCat], LinRec)
+type LinRec = [Lin Cat Path Tokn]
+
+initialMCat :: Cat -> MCFCat
+initialMCat cat = MCFCat cat []
+
+----------------------------------------------------------------------
+
+simplTerm :: Env -> Term -> CnvMonad STerm
+simplTerm env = simplifyTerm
+ where
+  simplifyTerm :: Term -> CnvMonad STerm
+  simplifyTerm (Arg (A cat nr))  = return (SArg (fromInteger nr) cat emptyPath)
+  simplifyTerm (Par con terms)   = liftM (SCon con) $ mapM simplifyTerm terms
+  simplifyTerm (R record)        = liftM SRec       $ mapM simplifyAssign record
+  simplifyTerm (P term lbl)      = liftM (+. lbl)   $      simplifyTerm term
+  simplifyTerm (T ct table)      = liftM STbl $ sequence $ concatMap simplifyCase table
+  simplifyTerm (V ct terms)  
+      = liftM STbl $ sequence [ liftM ((,) pat) (simplifyTerm term) |
+				(pat, term) <- zip (groundTerms env ct) terms ]
+  simplifyTerm (S term sel)      
+      = do sterm <- simplifyTerm term
+	   ssel <- simplifyTerm sel
+	   case sterm of
+	     STbl table  -> do (pat, val) <- member table
+			       pat =?= ssel
+			       return val
+	     _ -> do sel' <- expandTerm env ssel
+		     return (sterm +! sel')
+  simplifyTerm (FV terms)        = liftM SVariants $ mapM simplifyTerm terms
+  simplifyTerm (term1 `C` term2) = liftM2 (SConcat) (simplifyTerm term1) (simplifyTerm term2)
+  simplifyTerm (K tokn)          = return $ SToken tokn
+  simplifyTerm (E)               = return $ SEmpty
+  simplifyTerm x                 = error $ "simplifyTerm: " ++ show x
+-- error constructors:
+--   (I CIdent) - from resource
+--   (LI Ident) - pattern variable
+--   (EInt Integer) - integer
+
+  simplifyAssign :: Assign -> CnvMonad (Label, STerm)
+  simplifyAssign (Ass lbl term) = liftM ((,) lbl) $ simplifyTerm term
+
+  simplifyCase :: Case -> [CnvMonad (STerm, STerm)]
+  simplifyCase (Cas pats term) = [ liftM2 (,) (simplifyPattern pat) (simplifyTerm term) |
+				 pat <- pats ]
+
+  simplifyPattern :: Patt -> CnvMonad STerm
+  simplifyPattern (PC con pats) = liftM (SCon con) $ mapM simplifyPattern pats
+  simplifyPattern (PW)          = return SWildcard
+  simplifyPattern (PR record)   = do record' <- mapM simplifyPattAssign record
+				     case filter (\row -> snd row /= SWildcard) record' of
+				       []       -> return SWildcard
+				       record'' -> return (SRec record')
+  simplifyPattern x = error $ "simplifyPattern: " ++ show x
+-- error constructors:
+--   (PV Ident) - pattern variable
+
+  simplifyPattAssign :: PattAssign -> CnvMonad (Label, STerm)
+  simplifyPattAssign (PAss lbl pat) = liftM ((,) lbl) $ simplifyPattern pat
+
+
+------------------------------------------------------------
+-- reducing simplified terms, collecting mcf rules
+
+reduceT :: Env -> CType -> STerm -> Path -> CnvMonad ()
+reduceT env = reduce
+ where
+  reduce :: CType -> STerm -> Path -> CnvMonad ()
+  reduce TStr   term path = updateLin (path, term)
+  reduce (Cn _) term path
+      = do pat <- expandTerm env term
+	   updateHead (path, pat)
+  reduce ctype (SVariants terms) path 
+      = do term <- member terms
+	   reduce ctype term path
+  reduce (RecType rtype) term path
+      = sequence_ [ reduce ctype (term +. lbl) (path ++. lbl) |
+		    Lbg lbl ctype <- rtype ]
+  reduce (Table _ ctype) (STbl table) path
+      = sequence_ [ reduce ctype term (path ++! pat) |
+		    (pat, term) <- table ]
+  reduce (Table ptype vtype) arg@(SArg _ _ _) path 
+      = sequence_ [ reduce vtype (arg +! pat) (path ++! pat) |
+		    pat <- groundTerms env ptype ]
+  reduce ctype term path = error ("reduce:\n  ctype = (" ++ show ctype ++ 
+				  ")\n  term = (" ++ show term ++ 
+				  ")\n  path = (" ++ show path ++ ")\n")
+
+
+------------------------------------------------------------
+-- expanding a term to ground terms
+
+expandTerm :: Env -> STerm -> CnvMonad STerm
+expandTerm env arg@(SArg _ _ _) 
+    = do pat <- member $ groundTerms env $ cTypeForArg env arg
+	 pat =?= arg
+	 return pat
+expandTerm env (SCon con terms)  = liftM (SCon con) $ mapM (expandTerm env) terms
+expandTerm env (SRec record)     = liftM  SRec      $ mapM (expandAssign env) record
+expandTerm env (SVariants terms) = member terms >>= expandTerm env
+expandTerm env term = error $ "expandTerm: " ++ show term
+
+expandAssign :: Env -> (Label, STerm) -> CnvMonad (Label, STerm)
+expandAssign env (lbl, term)   = liftM ((,) lbl) $ expandTerm env term
+
+------------------------------------------------------------
+-- unification of patterns and selection terms
+
+(=?=) :: STerm -> STerm -> CnvMonad ()
+SWildcard     =?= _                = return ()
+SRec precord  =?= arg@(SArg _ _ _) = sequence_ [ pat =?= (arg +. lbl) |
+						 (lbl, pat) <- precord ]
+pat           =?= SArg arg _ path  = updateArg arg (path, pat)
+SCon con pats =?= SCon con' terms  = do guard (con==con' && length pats==length terms)
+					sequence_ $ zipWith (=?=) pats terms
+SRec precord  =?= SRec record      = sequence_ [ maybe mzero (pat =?=) mterm |
+						 (lbl, pat) <- precord,
+						 let mterm = lookup lbl record ]
+pat =?= term = error $ "(=?=): " ++ show pat ++ " =?= " ++ show term
+
+
+------------------------------------------------------------
+-- updating the mcf rule
+
+updateArg :: Int -> Constraint -> CnvMonad ()
+updateArg arg cn
+    = do (head, args, lins) <- readState 
+	 args' <- updateNth (addToMCFCat cn) arg args
+	 writeState (head, args', lins)
+
+updateHead :: Constraint -> CnvMonad ()
+updateHead cn
+    = do (head, args, lins) <- readState
+	 head' <- addToMCFCat cn head
+	 writeState (head', args, lins)
+
+updateLin :: Constraint -> CnvMonad ()
+updateLin (path, term) 
+    = do let newLins = term2lins term
+	 (head, args, lins) <- readState
+	 let lins' = lins ++ map (Lin path) newLins
+	 writeState (head, args, lins')
+
+term2lins :: STerm -> [[Symbol (Cat, Path, Int) Tokn]]
+term2lins (SArg arg cat path) = return [Cat (cat, path, arg)]
+term2lins (SToken str)        = return [Tok str]
+term2lins (SConcat t1 t2)     = liftM2 (++) (term2lins t1) (term2lins t2)
+term2lins (SEmpty)            = return []
+term2lins (SVariants terms)   = terms >>= term2lins
+term2lins term = error $ "term2lins: " ++ show term
+
+addToMCFCat :: Constraint -> MCFCat -> CnvMonad MCFCat
+addToMCFCat cn (MCFCat cat cns) = liftM (MCFCat cat) $ addConstraint cn cns
+
+addConstraint :: Constraint -> [Constraint] -> CnvMonad [Constraint]
+addConstraint cn0 (cn : cns)
+    | fst cn0 >  fst cn = liftM (cn:) (addConstraint cn0 cns)
+    | fst cn0 == fst cn = guard (snd cn0 == snd cn) >>
+			  return (cn : cns)
+addConstraint cn0 cns   = return (cn0 : cns)
+
+
+----------------------------------------------------------------------
+-- utilities 
+
+updateNth :: Monad m => (a -> m a) -> Int -> [a] -> m [a]
+updateNth update 0 (a : as) = liftM (:as) (update a)
+updateNth update n (a : as) = liftM (a:)  (updateNth update (n-1) as)
+
+catOfArg (A aCat _) = aCat
+catOfArg (AB aCat _ _) = aCat
+
+lookupCType :: Env -> Cat -> CType
+lookupCType env cat = errVal defLinType $ 
+		      lookupLincat (fst env) (CIQ (snd env) cat)
+
+groundTerms :: Env -> CType -> [STerm]
+groundTerms env ctype = err error (map term2spattern) $
+			allParamValues (fst env) ctype
+
+cTypeForArg :: Env -> STerm -> CType
+cTypeForArg env (SArg nr cat (Path path))
+    = follow path $ lookupCType env cat
+    where follow [] ctype = ctype
+	  follow (Right pat : path) (Table _ ctype) = follow path ctype
+	  follow (Left lbl : path) (RecType rec)
+	      = case [ ctype | Lbg lbl' ctype <- rec, lbl == lbl' ] of
+		  [ctype] -> follow path ctype
+		  err     -> error $ "follow: " ++ show rec ++ " . " ++ show lbl ++ 
+			             " results in " ++ show err
+
+term2spattern (R rec)         = SRec [ (lbl, term2spattern term) | Ass lbl term <- rec ]
+term2spattern (Par con terms) = SCon con $ map term2spattern terms
+
diff --git a/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Old.hs b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Old.hs
new file mode 100644
index 000000000..8b9b4a9ec
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Old.hs
@@ -0,0 +1,277 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ConvertGFCtoMCFG.Old
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 14:15:18 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.3 $
+--
+-- Converting GFC grammars to MCFG grammars. (Old variant)
+--
+-- the resulting grammars might be /very large/
+--
+-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
+-- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertGFCtoMCFG.Old (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+--import PrintGFC
+import qualified GF.Grammar.PrGrammar as PG
+
+import Control.Monad (liftM, liftM2, guard)
+-- import Maybe (listToMaybe)
+import GF.Infra.Ident (Ident(..))
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.Canon.Look
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+import GF.Canon.CMacros (defLinType)
+import GF.Canon.MkGFC (grammar2canon)
+import GF.OldParsing.Utilities
+import GF.OldParsing.GrammarTypes 
+import GF.OldParsing.MCFGrammar (Rule(..), Lin(..))
+import GF.Data.SortedList (nubsort, groupPairs)
+import Data.Maybe (listToMaybe)
+import Data.List (groupBy, transpose)
+
+----------------------------------------------------------------------
+-- old style types
+
+data XMCFCat = XMCFCat Cat [(XPath, Term)] deriving (Eq, Ord, Show)
+type XMCFLabel = XPath
+
+cnvXMCFCat :: XMCFCat -> MCFCat
+cnvXMCFCat (XMCFCat cat constrs) = MCFCat cat [ (cnvXPath path, cnvTerm term) | 
+						(path, term) <- constrs ]
+
+cnvXMCFLabel :: XMCFLabel -> MCFLabel
+cnvXMCFLabel = cnvXPath
+
+cnvXMCFLin :: Lin XMCFCat XMCFLabel Tokn -> Lin MCFCat MCFLabel Tokn
+cnvXMCFLin (Lin lbl lin) = Lin (cnvXMCFLabel lbl) $
+			   map (mapSymbol cnvSym id) lin
+    where cnvSym (cat, lbl, nr) = (cnvXMCFCat cat, cnvXMCFLabel lbl, nr)
+
+-- Term -> STerm
+
+cnvTerm (R rec) = SRec [ (lbl, cnvTerm term) | Ass lbl term <- rec ]
+cnvTerm (T _ tbl) = STbl [ (cnvPattern pat, cnvTerm term) | 
+			   Cas pats term <- tbl, pat <- pats ]
+cnvTerm (Par con terms) = SCon con $ map cnvTerm terms
+cnvTerm term
+    | isArgPath term = cnvArgPath term
+
+cnvPattern (PR rec) = SRec [ (lbl, cnvPattern term) | PAss lbl term <- rec ]
+cnvPattern (PC con pats) = SCon con $ map cnvPattern pats
+cnvPattern (PW) = SWildcard
+
+isArgPath (Arg _) = True
+isArgPath (P _ _) = True
+isArgPath (S _ _) = True
+isArgPath _ = False
+
+cnvArgPath (Arg (A cat nr)) = SArg (fromInteger nr) cat emptyPath
+cnvArgPath (term `P` lbl) = cnvArgPath term +. lbl
+cnvArgPath (term `S` sel) = cnvArgPath term +! cnvTerm sel
+
+-- old style paths
+
+newtype XPath = XPath [Either Label Term] deriving (Eq, Ord, Show)
+
+cnvXPath :: XPath -> Path
+cnvXPath (XPath path) = Path (map (either Left (Right . cnvTerm)) (reverse path))
+
+emptyXPath :: XPath
+emptyXPath = XPath []
+
+(++..) :: XPath -> Label -> XPath 
+XPath path ++.. lbl = XPath (Left lbl : path)
+
+(++!!) :: XPath -> Term -> XPath 
+XPath path ++!! sel = XPath (Right sel : path)
+
+----------------------------------------------------------------------
+
+-- | combining alg. 1 and alg. 2 from Ljunglöf's PhD thesis
+convertGrammar :: (CanonGrammar, Ident) -> MCFGrammar
+convertGrammar (gram, lng) = trace2 "language" (prt lng) $
+			     trace2 "modules" (prtSep " " modnames) $
+			     trace2 "#lin-terms" (prt (length cncdefs)) $
+			     tracePrt "#mcf-rules total" (prt.length) $
+			     concat $
+			     tracePrt "#mcf-rules per fun" 
+			     (\rs -> concat [" "++show n++"="++show (length r) | 
+					     (n, r) <- zip [1..] rs]) $
+			     map (convertDef gram lng) cncdefs
+    where Gr mods = grammar2canon gram
+	  cncdefs = [ def | Mod (MTCnc modname _) _ _ _ defs <- mods, 
+		      modname `elem` modnames, 
+		      def@(CncDFun _ _ _ _ _) <- defs ]
+	  modnames = M.allExtends gram lng
+
+
+convertDef :: CanonGrammar -> Ident -> Def -> [MCFRule]
+convertDef gram lng (CncDFun fun (CIQ _ cat) args term _)
+    = [ Rule (cnvXMCFCat newCat) (map cnvXMCFCat newArgs) (map cnvXMCFLin newTerm) fun |
+	let ctype     = lookupCType gram lng cat,
+	instArgs     <- mapM (enumerateInsts gram lng) args,
+	let instTerm  = substitutePaths gram lng instArgs term,
+	newCat       <- emcfCat gram lng cat instTerm,
+	newArgs      <- mapM (extractArg gram lng instArgs) args,
+	let newTerm   = concatMap (extractLin newArgs) $ strPaths gram lng ctype instTerm
+      ]
+
+
+-- gammalt skräp:
+-- mergeArgs = zipWith mergeRec
+-- mergeRec (R r1) (R r2) = R (r1 ++ r2)
+
+extractArg :: CanonGrammar -> Ident -> [Term] -> ArgVar -> [XMCFCat]
+extractArg gram lng args (A cat nr) = emcfCat gram lng cat (args !!! nr)
+
+
+emcfCat :: CanonGrammar -> Ident -> Ident -> Term -> [XMCFCat]
+emcfCat gram lng cat = map (XMCFCat cat) . parPaths gram lng (lookupCType gram lng cat) 
+
+
+extractLin :: [XMCFCat] -> (XPath, Term) -> [Lin XMCFCat XMCFLabel Tokn]
+extractLin args (path, term) = map (Lin path) (convertLin term)
+    where convertLin (t1 `C` t2) = liftM2 (++) (convertLin t1) (convertLin t2)
+	  convertLin (E) = [[]]
+	  convertLin (K tok) = [[Tok tok]]
+	  convertLin (FV terms) = concatMap convertLin terms
+	  convertLin term = map (return . Cat) $ flattenTerm emptyXPath term
+	  flattenTerm path (Arg (A _ nr)) = [(args !!! nr, path, fromInteger nr)]
+	  flattenTerm path (term `P` lbl) = flattenTerm (path ++.. lbl) term
+	  flattenTerm path (term `S` sel) = flattenTerm (path ++!! sel) term
+	  flattenTerm path (FV terms)     = concatMap (flattenTerm path) terms
+	  flattenTerm path term = error $ "flattenTerm: \n  " ++ show path ++ "\n  " ++ prt term 
+
+
+enumerateInsts :: CanonGrammar -> Ident -> ArgVar -> [Term]
+enumerateInsts gram lng arg@(A argCat _) = enumerate (Arg arg) (lookupCType gram lng argCat)
+    where enumerate path (TStr) = [ path ]
+	  enumerate path (Cn con) = okError $ lookupParamValues gram con
+	  enumerate path (RecType r) 
+	      = map R $ sequence [ map (lbl `Ass`) $ 
+				   enumerate (path `P` lbl) ctype |
+				   lbl `Lbg` ctype <- r ]
+	  enumerate path (Table s t)
+	      = map (T s) $ sequence [ map ([term2pattern sel] `Cas`) $ 
+				       enumerate (path `S` sel) t |
+				       sel <- enumerate (error "enumerate") s ]
+
+
+
+termPaths :: CanonGrammar -> Ident -> CType -> Term -> [(XPath, (CType, Term))]
+termPaths gr l (TStr) term = [ (emptyXPath, (TStr, term)) ]
+termPaths gr l (RecType rtype) (R record) 
+    = [ (path ++.. lbl, value) |
+	lbl `Ass` term <- record,
+	let ctype = okError $ maybeErr "termPaths/record" $ lookupLabelling lbl rtype,
+	(path, value) <- termPaths gr l ctype term ]
+termPaths gr l (Table _ ctype) (T _ table)
+    = [ (path ++!! pattern2term pat, value) |
+	pats `Cas` term <- table, pat <- pats,
+	(path, value) <- termPaths gr l ctype term ]
+termPaths gr l (Table _ ctype) (V ptype table)
+    = [ (path ++!! pat, value) |
+	(pat, term) <- zip (okError $ allParamValues gr ptype) table,
+	(path, value) <- termPaths gr l ctype term ]
+termPaths gr l ctype (FV terms)
+    = concatMap (termPaths gr l ctype) terms
+termPaths gr l (Cn pc) term = [ (emptyXPath, (Cn pc, term)) ]
+
+{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
+{a=a1; b=b1}  | {a=a2; b=b2}   ==>  {a=a1|a2; b=b1|b2}
+[p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
+-}
+
+parPaths :: CanonGrammar -> Ident -> CType -> Term -> [[(XPath, Term)]]
+parPaths gr l ctype term = mapM (uncurry (map . (,))) (groupPairs paths)
+    where paths = nubsort [ (path, value) | (path, (Cn _, value)) <- termPaths gr l ctype term ]
+
+strPaths :: CanonGrammar -> Ident -> CType -> Term -> [(XPath, Term)]
+strPaths gr l ctype term = [ (path, evalFV values) | (path, values) <- groupPairs paths ]
+    where paths = nubsort [ (path, value) | (path, (TStr, value)) <- termPaths gr l ctype term ]
+
+
+-- Substitute each instantiated parameter path for its instantiation
+substitutePaths :: CanonGrammar -> Ident -> [Term] -> Term -> Term
+substitutePaths gr l arguments trm  = subst trm
+    where subst (con `Par` terms) = con `Par` map subst terms
+	  subst (R record)        = R $ map substAss record
+	  subst (term `P` lbl)    = subst term `evalP` lbl
+	  subst (T ptype table)   = T ptype $ map substCas table
+	  subst (V ptype table)   = T ptype [ [term2pattern pat] `Cas` subst term | 
+					      (pat, term) <- zip (okError $ allParamValues gr ptype) table ]
+	  subst (term `S` select) = subst term `evalS` subst select
+	  subst (term `C` term')  = subst term `C` subst term'
+	  subst (FV terms)        = evalFV $ map subst terms
+	  subst (Arg (A _ arg))   = arguments !!! arg
+	  subst term              = term
+
+          substAss (l `Ass` term) = l `Ass` subst term
+	  substCas (p `Cas` term) = p `Cas` subst term
+
+
+evalP (R record) lbl = okError $ maybeErr errStr $ lookupAssign lbl record
+    where errStr = "evalP: " ++ prt (R record `P` lbl)
+evalP (FV terms) lbl = evalFV [ evalP term lbl | term <- terms ]
+evalP term       lbl = term `P` lbl
+
+evalS t@(T _ tbl) sel = maybe (t `S` sel) id $ lookupCase sel tbl
+evalS (FV terms)  sel = evalFV [ term `evalS` sel | term <- terms ]
+evalS term   (FV sels)= evalFV [ term `evalS` sel | sel <- sels ]
+evalS term        sel = term `S` sel
+
+evalFV terms0 = case nubsort (concatMap flattenFV terms0) of
+	          [term] -> term
+		  terms  -> FV terms
+    where flattenFV (FV ts) = ts
+	  flattenFV  t      = [t]
+
+
+----------------------------------------------------------------------
+-- utilities 
+
+-- lookup a CType for an Ident
+lookupCType :: CanonGrammar -> Ident -> Ident -> CType
+lookupCType gr lng c = errVal defLinType $ lookupLincat gr (CIQ lng c)
+
+-- lookup a label in a (record / record ctype / table)
+lookupAssign    :: Label -> [Assign]    -> Maybe Term
+lookupLabelling :: Label -> [Labelling] -> Maybe CType
+lookupCase      :: Term  -> [Case]      -> Maybe Term
+
+lookupAssign    lbl rec  = listToMaybe [ term | lbl' `Ass` term <- rec, lbl == lbl' ] 
+lookupLabelling lbl rtyp = listToMaybe [ ctyp | lbl' `Lbg` ctyp <- rtyp, lbl == lbl' ]
+lookupCase      sel tbl  = listToMaybe [ term | pats `Cas` term <- tbl, sel `matchesPats` pats ]
+
+matchesPats :: Term -> [Patt] -> Bool
+matchesPats term patterns = or [ term == pattern2term pattern | pattern <- patterns ]
+
+-- converting between patterns and terms
+pattern2term :: Patt -> Term
+term2pattern :: Term -> Patt
+
+pattern2term (con `PC` patterns) = con `Par` map pattern2term patterns
+pattern2term (PR record) = R [ lbl `Ass` pattern2term pattern | 
+			       lbl `PAss` pattern <- record ]
+
+term2pattern (con `Par` terms) = con `PC` map term2pattern terms
+term2pattern (R record) = PR [ lbl `PAss` term2pattern term |
+			       lbl `Ass` term <- record ]
+
+-- list lookup for Integers instead of Ints
+(!!!) :: [a] -> Integer -> a
+xs !!! n = xs !! fromInteger n
diff --git a/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Strict.hs b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Strict.hs
new file mode 100644
index 000000000..d088bdebc
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertGFCtoMCFG/Strict.hs
@@ -0,0 +1,189 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ConvertGFCtoMCFG.Strict
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 14:15:18 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.3 $
+--
+-- Converting GFC grammars to MCFG grammars, nondeterministically.
+--
+-- the resulting grammars might be /very large/
+--
+-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
+-- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertGFCtoMCFG.Strict (convertGrammar) where
+
+import GF.System.Tracing
+-- import IOExts (unsafePerformIO)
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+-- import PrintGFC
+-- import qualified PrGrammar as PG
+
+import Control.Monad
+import GF.Infra.Ident (Ident(..))
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.Canon.Look
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+import GF.Canon.CMacros (defLinType)
+import GF.Canon.MkGFC (grammar2canon)
+import GF.OldParsing.Utilities
+import GF.OldParsing.GrammarTypes 
+import GF.OldParsing.MCFGrammar (Grammar, Rule(..), Lin(..))
+import GF.Data.SortedList
+-- import Maybe (listToMaybe)
+import Data.List (groupBy) -- , transpose)
+
+import GF.Data.BacktrackM
+
+----------------------------------------------------------------------
+
+type Env  = (CanonGrammar, Ident)
+
+convertGrammar :: Env -- ^ the canonical grammar, together with the selected language
+	       -> MCFGrammar -- ^ the resulting MCF grammar
+convertGrammar gram = trace2 "language" (prt (snd gram)) $
+		      trace2 "modules" (prtSep " " modnames) $
+		      tracePrt "#mcf-rules total" (prt . length) $
+		      solutions conversion undefined
+    where Gr modules = grammar2canon (fst gram)
+	  modnames   = uncurry M.allExtends gram
+	  conversion = member modules >>= convertModule
+	  convertModule (Mod (MTCnc modname _) _ _ _ defs)
+	      | modname `elem` modnames = member defs >>= convertDef gram
+	  convertModule _ = failure
+
+convertDef :: Env -> Def -> CnvMonad MCFRule
+convertDef env (CncDFun fun (CIQ _ cat) args term _)
+    | trace2 "converting function" (prt fun) True
+    = do let ctype = lookupCType env cat
+	 instArgs <- mapM (enumerateArg env) args
+	 let instTerm = substitutePaths env instArgs term
+	 newCat <- emcfCat env cat instTerm
+	 newArgs <- mapM (extractArg env instArgs) args
+	 let newTerm = strPaths env ctype instTerm >>= extractLin newArgs
+	 return (Rule newCat newArgs newTerm fun)
+convertDef _ _ = failure
+
+------------------------------------------------------------
+
+type CnvMonad a = BacktrackM () a
+
+----------------------------------------------------------------------
+-- strict conversion
+
+extractArg :: Env -> [STerm] -> ArgVar -> CnvMonad MCFCat
+extractArg env args (A cat nr) = emcfCat env cat (args !! fromInteger nr)
+
+emcfCat :: Env -> Cat -> STerm -> CnvMonad MCFCat
+emcfCat env cat term = member $ map (MCFCat cat) $ parPaths env (lookupCType env cat) term
+
+enumerateArg :: Env -> ArgVar -> CnvMonad STerm
+enumerateArg env (A cat nr) = let ctype = lookupCType env cat
+			      in enumerate (SArg (fromInteger nr) cat emptyPath) ctype
+    where enumerate arg (TStr) = return arg 
+	  enumerate arg ctype@(Cn _) = member $ groundTerms env ctype
+	  enumerate arg (RecType rtype) 
+	      = liftM SRec $ sequence [ liftM ((,) lbl) $ 
+					enumerate (arg +. lbl) ctype |
+					lbl `Lbg` ctype <- rtype ]
+	  enumerate arg (Table stype ctype)
+	      = do state <- readState
+		   liftM STbl $ sequence [ liftM ((,) sel) $ 
+					   enumerate (arg +! sel) ctype |
+					   sel <- solutions (enumerate err stype) state ]
+	      where err = error "enumerate: parameter type should not be string"
+
+-- Substitute each instantiated parameter path for its instantiation
+substitutePaths :: Env -> [STerm] -> Term -> STerm
+substitutePaths env arguments trm  = subst trm
+    where subst (con `Par` terms) = con `SCon` map subst terms
+	  subst (R record)        = SRec [ (lbl, subst term) | lbl `Ass` term <- record ]
+	  subst (term `P` lbl)    = subst term +. lbl
+	  subst (T ptype table)   = STbl [ (pattern2sterm pat, subst term) | 
+					   pats `Cas` term <- table, pat <- pats ]
+	  subst (V ptype table)   = STbl [ (pat, subst term) | 
+					   (pat, term) <- zip (groundTerms env ptype) table ]
+	  subst (term `S` select) = subst term +! subst select
+	  subst (term `C` term')  = subst term `SConcat` subst term'
+	  subst (K str)           = SToken str
+	  subst (E)               = SEmpty
+	  subst (FV terms)        = evalFV $ map subst terms
+	  subst (Arg (A _ arg))   = arguments !! fromInteger arg
+
+
+termPaths :: Env -> CType -> STerm -> [(Path, (CType, STerm))]
+termPaths env (TStr) term = [ (emptyPath, (TStr, term)) ]
+termPaths env (RecType rtype) (SRec record) 
+    = [ (path ++. lbl, value) |
+	(lbl, term) <- record,
+	let ctype = lookupLabelling lbl rtype,
+	(path, value) <- termPaths env ctype term ]
+termPaths env (Table _ ctype) (STbl table)
+    = [ (path ++! pat, value) |
+	(pat, term) <- table,
+	(path, value) <- termPaths env ctype term ]
+termPaths env ctype (SVariants terms)
+    = terms >>= termPaths env ctype
+termPaths env (Cn pc) term = [ (emptyPath, (Cn pc, term)) ]
+
+{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
+{a=a1; b=b1}  | {a=a2; b=b2}   ==>  {a=a1|a2; b=b1|b2}
+[p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
+-}
+
+parPaths :: Env -> CType -> STerm -> [[(Path, STerm)]]
+parPaths env ctype term = mapM (uncurry (map . (,))) (groupPairs paths)
+    where paths = nubsort [ (path, value) | (path, (Cn _, value)) <- termPaths env ctype term ]
+
+strPaths :: Env -> CType -> STerm -> [(Path, STerm)]
+strPaths env ctype term = [ (path, evalFV values) | (path, values) <- groupPairs paths ]
+    where paths = nubsort [ (path, value) | (path, (TStr, value)) <- termPaths env ctype term ]
+
+extractLin :: [MCFCat] -> (Path, STerm) -> [Lin MCFCat MCFLabel Tokn]
+extractLin args (path, term) = map (Lin path) (convertLin term)
+    where convertLin (t1 `SConcat` t2) = liftM2 (++) (convertLin t1) (convertLin t2)
+	  convertLin (SEmpty) = [[]]
+	  convertLin (SToken tok) = [[Tok tok]]
+	  convertLin (SVariants terms) = concatMap convertLin terms
+	  convertLin (SArg nr _ path) = [[Cat (args !! nr, path, nr)]]
+
+evalFV terms0 = case nubsort (concatMap flattenFV terms0) of
+	          [term] -> term
+		  terms  -> SVariants terms
+    where flattenFV (SVariants ts) = ts
+	  flattenFV  t      = [t]
+
+----------------------------------------------------------------------
+-- utilities 
+
+lookupCType :: Env -> Cat -> CType
+lookupCType env cat = errVal defLinType $ 
+		      lookupLincat (fst env) (CIQ (snd env) cat)
+
+lookupLabelling :: Label -> [Labelling] -> CType
+lookupLabelling lbl rtyp = case [ ctyp | lbl' `Lbg` ctyp <- rtyp, lbl == lbl' ] of
+			     [ctyp] -> ctyp
+			     err -> error $ "lookupLabelling:" ++ show err
+
+groundTerms :: Env -> CType -> [STerm]
+groundTerms env ctype = err error (map term2spattern) $
+			allParamValues (fst env) ctype
+
+term2spattern (R rec)         = SRec [ (lbl, term2spattern term) | Ass lbl term <- rec ]
+term2spattern (Par con terms) = SCon con $ map term2spattern terms
+
+pattern2sterm :: Patt -> STerm
+pattern2sterm (con `PC` patterns) = con `SCon` map pattern2sterm patterns
+pattern2sterm (PR record) = SRec [ (lbl, pattern2sterm pattern) | 
+				   lbl `PAss` pattern <- record ]
+
diff --git a/src-2.9/GF/OldParsing/ConvertGFCtoSimple.hs b/src-2.9/GF/OldParsing/ConvertGFCtoSimple.hs
new file mode 100644
index 000000000..69a8b13c3
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertGFCtoSimple.hs
@@ -0,0 +1,122 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 14:15:18 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.3 $
+--
+-- Converting GFC to SimpleGFC
+--
+-- the conversion might fail if the GFC grammar has dependent or higher-order types
+-----------------------------------------------------------------------------
+
+module GF.OldParsing.ConvertGFCtoSimple where
+
+import qualified GF.Canon.AbsGFC as A
+import qualified GF.Infra.Ident as I
+import GF.OldParsing.SimpleGFC 
+
+import GF.Canon.GFC
+import GF.Canon.MkGFC (grammar2canon)
+import qualified GF.Canon.Look as Look (lookupLin, allParamValues, lookupLincat)
+import qualified GF.Canon.CMacros as CMacros (defLinType)
+import GF.Data.Operations (err, errVal)
+import qualified GF.Infra.Modules as M
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+
+----------------------------------------------------------------------
+
+type Env = (CanonGrammar, I.Ident)
+
+convertGrammar :: Env -> Grammar
+convertGrammar gram = trace2 "language" (show (snd gram)) $
+		      tracePrt "#simple-rules total" (show . length) $
+		      [ convertAbsFun gram fun typing |
+			A.Mod (A.MTAbs modname) _ _ _ defs <- modules,
+			A.AbsDFun fun typing _ <- defs ]
+    where A.Gr modules = grammar2canon (fst gram)
+
+convertAbsFun :: Env -> I.Ident -> A.Exp -> Rule
+convertAbsFun gram fun aTyping 
+    = -- trace2 "absFun" (show fun) $
+      Rule fun sTyping sTerm
+    where sTyping = convertTyping [] aTyping
+	  sTerm = do lin <- lookupLin gram fun
+		     return (convertTerm gram lin, convertCType gram cType)
+	  cType = lookupCType gram sTyping
+
+convertTyping :: [Decl] -> A.Exp -> Typing
+-- convertTyping env tp | trace2 "typing" (prt env ++ " / " ++ prt tp) False = undefined
+convertTyping env (A.EProd x a b) 
+    = convertTyping ((x ::: convertType [] a) : env) b
+convertTyping env a = (convertType [] a, reverse env)
+
+convertType :: [Atom] -> A.Exp -> Type
+-- convertType args tp | trace2 "type" (prt args ++ " / " ++ prt tp) False = undefined
+convertType args (A.EApp a (A.EAtom at)) = convertType (convertAtom at : args) a
+convertType args (A.EAtom at) = convertCat at :@ args
+
+convertAtom :: A.Atom -> Atom
+convertAtom (A.AC con) = ACon con
+convertAtom (A.AV var) = AVar var
+
+convertCat :: A.Atom -> Cat
+convertCat (A.AC (A.CIQ _ cat)) = cat
+convertCat at = error $ "convertCat: " ++ show at
+
+convertCType :: Env -> A.CType -> CType
+convertCType gram (A.RecType rec) 
+    = RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ]
+convertCType gram (A.Table ptype vtype) 
+    = TblT (convertCType gram ptype) (convertCType gram vtype)
+convertCType gram ct@(A.Cn con) = ConT con $ map (convertTerm gram) $ groundTerms gram ct
+convertCType gram (A.TStr) = StrT
+convertCType gram (A.TInts n) = error "convertCType: cannot handle 'TInts' constructor"
+
+convertTerm :: Env -> A.Term -> Term
+convertTerm gram (A.Arg arg) = convertArgVar arg
+convertTerm gram (A.Par con terms) = con :^ map (convertTerm gram) terms
+convertTerm gram (A.LI var) = Var var
+convertTerm gram (A.R rec) = Rec [ (lbl, convertTerm gram term) | A.Ass lbl term <- rec ]
+convertTerm gram (A.P term lbl) = convertTerm gram term +. lbl
+convertTerm gram (A.V ctype terms) = Tbl [ (convertTerm gram pat, convertTerm gram term) |
+					  (pat, term) <- zip (groundTerms gram ctype) terms ]
+convertTerm gram (A.T ctype tbl) = Tbl [ (convertPatt pat, convertTerm gram term) |
+					A.Cas pats term <- tbl, pat <- pats ]
+convertTerm gram (A.S term sel) = convertTerm gram term +! convertTerm gram sel
+convertTerm gram (A.C term1 term2) = convertTerm gram term1 ?++ convertTerm gram term2
+convertTerm gram (A.FV terms) = Variants (map (convertTerm gram) terms)
+convertTerm gram (A.K tok) = Token tok
+convertTerm gram (A.E) = Empty
+convertTerm gram (A.I con) = error "convertTerm: cannot handle 'I' constructor"
+convertTerm gram (A.EInt int) = error "convertTerm: cannot handle 'EInt' constructor"
+
+convertArgVar :: A.ArgVar -> Term
+convertArgVar (A.A cat nr) = Arg (fromInteger nr) cat emptyPath
+convertArgVar (A.AB cat bindings nr) = Arg (fromInteger nr) cat emptyPath
+
+convertPatt (A.PC con pats) = con :^ map convertPatt pats
+convertPatt (A.PV x) = Var x
+convertPatt (A.PW) = Wildcard
+convertPatt (A.PR rec) = Rec [ (lbl, convertPatt pat) | A.PAss lbl pat <- rec ]
+convertPatt (A.PI n) = error "convertPatt: cannot handle 'PI' constructor"
+
+----------------------------------------------------------------------
+
+lookupLin gram fun = err fail Just $
+		     Look.lookupLin (fst gram) (A.CIQ (snd gram) fun)
+
+--lookupCType :: Env -> Typing -> CType
+lookupCType env (cat :@ _, _) = errVal CMacros.defLinType $ 
+				Look.lookupLincat (fst env) (A.CIQ (snd env) cat)
+
+groundTerms :: Env -> A.CType -> [A.Term]
+groundTerms gram ctype = err error id $
+			 Look.allParamValues (fst gram) ctype
+
diff --git a/src-2.9/GF/OldParsing/ConvertGrammar.hs b/src-2.9/GF/OldParsing/ConvertGrammar.hs
new file mode 100644
index 000000000..0dcd90770
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertGrammar.hs
@@ -0,0 +1,44 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ConvertGrammar
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:45 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- All (?) grammar conversions which are used in GF
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertGrammar
+    (pInfo, emptyPInfo,
+     module GF.OldParsing.GrammarTypes
+    ) where
+
+import GF.Canon.GFC (CanonGrammar)
+import GF.Canon.MkGFC (grammar2canon)
+import GF.OldParsing.GrammarTypes
+import GF.Infra.Ident (Ident(..))
+import GF.Infra.Option
+import GF.System.Tracing
+
+-- import qualified GF.OldParsing.FiniteTypes.Calc  as Fin
+import qualified GF.OldParsing.ConvertGFCtoMCFG  as G2M
+import qualified GF.OldParsing.ConvertMCFGtoCFG  as M2C
+import qualified GF.OldParsing.MCFGrammar        as MCFG
+import qualified GF.OldParsing.CFGrammar         as CFG
+
+pInfo :: Options -> CanonGrammar -> Ident -> PInfo 
+pInfo opts canon lng = PInfo mcfg cfg mcfp cfp
+    where mcfg = G2M.convertGrammar cnv (canon, lng)
+	  cnv  = maybe "nondet" id $ getOptVal opts gfcConversion 
+	  cfg  = M2C.convertGrammar mcfg
+	  mcfp = MCFG.pInfo mcfg
+	  cfp  = CFG.pInfo cfg
+
+emptyPInfo :: PInfo
+emptyPInfo = PInfo [] [] (MCFG.pInfo []) (CFG.pInfo [])
+
diff --git a/src-2.9/GF/OldParsing/ConvertMCFGtoCFG.hs b/src-2.9/GF/OldParsing/ConvertMCFGtoCFG.hs
new file mode 100644
index 000000000..58d141166
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertMCFGtoCFG.hs
@@ -0,0 +1,52 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ConvertMCFGtoCFG
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:46 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Converting MCFG grammars to (possibly overgenerating) CFG
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertMCFGtoCFG
+    (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+
+import Control.Monad
+import GF.OldParsing.Utilities
+import qualified GF.OldParsing.MCFGrammar as MCFG
+import qualified GF.OldParsing.CFGrammar as CFG
+import GF.OldParsing.GrammarTypes
+
+convertGrammar :: MCFGrammar -> CFGrammar
+convertGrammar gram = tracePrt "#cf-rules" (prt.length) $
+		      concatMap convertRule gram
+
+convertRule :: MCFRule -> [CFRule]
+convertRule (MCFG.Rule cat args record name) 
+    = [ CFG.Rule (CFCat cat lbl) rhs (CFName name profile) |
+	MCFG.Lin lbl lin <- record,
+	let rhs = map (mapSymbol convertArg id) lin,
+	let profile = map (argPlaces lin) [0 .. length args-1]
+      ]
+
+convertArg (cat, lbl, _arg) = CFCat cat lbl
+
+argPlaces lin arg = [ place | ((_cat, _lbl, arg'), place) <- 
+		      zip (filterCats lin) [0::Int ..], arg == arg' ]
+
+filterCats syms = [ cat | Cat cat <- syms ]
+
+
+
+
+
+
+
diff --git a/src-2.9/GF/OldParsing/ConvertSimpleToMCFG.hs b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG.hs
new file mode 100644
index 000000000..e111444f9
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG.hs
@@ -0,0 +1,30 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/11 13:52:53 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- All different conversions from SimpleGFC to MCFG
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertSimpleToMCFG
+    (convertGrammar) where
+
+import qualified GF.OldParsing.SimpleGFC as S
+--import GF.OldParsing.GrammarTypes
+
+import qualified GF.OldParsing.ConvertFiniteSimple as Fin
+import qualified GF.OldParsing.ConvertSimpleToMCFG.Nondet as Nondet
+--import qualified GF.OldParsing.ConvertSimpleToMCFG.Strict as Strict
+import qualified GF.OldParsing.ConvertSimpleToMCFG.Coercions as Coerce
+
+--convertGrammar :: String -> S.Grammar -> MCFGrammar
+convertGrammar ('f':'i':'n':'-':cnv) = convertGrammar cnv . Fin.convertGrammar
+convertGrammar "nondet" = Coerce.addCoercions . Nondet.convertGrammar
+--convertGrammar "strict" = Strict.convertGrammar
+
diff --git a/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Coercions.hs b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Coercions.hs
new file mode 100644
index 000000000..adc42115a
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Coercions.hs
@@ -0,0 +1,70 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:57 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.3 $
+--
+-- Adding coercion functions to a MCFG if necessary.
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertSimpleToMCFG.Coercions (addCoercions) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+-- import PrintGFC
+-- import qualified PrGrammar as PG
+
+import qualified GF.Infra.Ident as Ident
+import GF.OldParsing.Utilities
+--import GF.OldParsing.GrammarTypes 
+import GF.OldParsing.MCFGrammar (Rule(..), Lin(..))
+import GF.Data.SortedList
+import Data.List (groupBy) -- , transpose)
+
+----------------------------------------------------------------------
+
+--addCoercions :: MCFGrammar -> MCFGrammar
+addCoercions rules = coercions ++ rules
+    where (allHeads, allArgs) = unzip [ ((head, lbls), nubsort args) | 
+					Rule head args lins _ <- rules, 
+					let lbls = [ lbl | Lin lbl _ <- lins ] ]
+	  allHeadSet = nubsort allHeads
+	  allArgSet  = union   allArgs <\\> map fst allHeadSet
+	  coercions = tracePrt "#coercions total" (prt . length) $
+		      concat $
+		      tracePrt "#coercions per cat" (prtList . map length) $
+		      combineCoercions 
+		        (groupBy sameCatFst allHeadSet) 
+			(groupBy sameCat    allArgSet)
+	  sameCatFst a b = sameCat (fst a) (fst b)
+
+
+combineCoercions [] _ = []
+combineCoercions _ [] = []
+combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs) 
+    = case compare (mainCat $ fst $ head heads) (mainCat $ head args) of
+        LT -> combineCoercions allHeads  allArgs'
+	GT -> combineCoercions allHeads' allArgs
+	EQ -> makeCoercion heads args : combineCoercions allHeads allArgs
+
+
+makeCoercion heads args = [ Rule arg [head] lins coercionName |
+			    head@((_, headCns), lbls) <- heads, 
+			    let lins = [ Lin lbl [Cat (head, lbl, 0)] | lbl <- lbls ],
+			    arg@(_, argCns) <- args,
+			    argCns `subset` headCns ]
+
+
+coercionName = Ident.IW
+
+mainCat (c, _) = c
+
+sameCat mc1 mc2 = mainCat mc1 == mainCat mc2
+
+
diff --git a/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Nondet.hs b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Nondet.hs
new file mode 100644
index 000000000..6627c5f2e
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Nondet.hs
@@ -0,0 +1,245 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:58 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Converting SimpleGFC grammars to MCFG grammars, nondeterministically.
+--
+-- the resulting grammars might be /very large/
+--
+-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertSimpleToMCFG.Nondet (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+-- import PrintGFC
+-- import qualified PrGrammar as PG
+
+import Control.Monad
+-- import Ident (Ident(..))
+import qualified GF.Canon.AbsGFC as AbsGFC
+-- import GFC
+import GF.Canon.Look
+import GF.Data.Operations
+-- import qualified Modules as M
+import GF.Canon.CMacros (defLinType)
+-- import MkGFC (grammar2canon)
+import GF.OldParsing.Utilities
+-- import GF.OldParsing.GrammarTypes 
+import GF.Data.SortedList
+import qualified GF.OldParsing.MCFGrammar as MCF (Grammar, Rule(..), Lin(..)) 
+import GF.OldParsing.SimpleGFC 
+-- import Maybe (listToMaybe)
+import Data.List (groupBy) -- , transpose)
+
+import GF.Data.BacktrackM
+
+----------------------------------------------------------------------
+
+--convertGrammar :: Grammar -> MCF.Grammar
+convertGrammar rules = tracePrt "#mcf-rules total" (prt . length) $
+		       solutions conversion rules undefined
+    where conversion = member rules >>= convertRule
+
+--convertRule :: Rule -> CnvMonad MCF.Rule
+convertRule (Rule fun (cat :@ _, decls) (Just (term, ctype)))
+    = do let args = [ arg | _ ::: (arg :@ _) <- decls ]
+	 writeState (initialMCat cat, map initialMCat args, [])
+	 convertTerm cat term
+	 (newCat, newArgs, linRec) <- readState
+	 let newTerm = map (instLin newArgs) linRec
+	 return (MCF.Rule newCat newArgs newTerm fun)	 
+convertRule _ = failure
+
+instLin newArgs (MCF.Lin lbl lin) = MCF.Lin lbl (map instSym lin)
+    where instSym = mapSymbol instCat id
+	  instCat (_, lbl, arg) = (newArgs !! arg, lbl, arg)
+
+--convertTerm :: Cat -> Term -> CnvMonad ()
+convertTerm cat term = do rterm <- simplifyTerm term
+			  env <- readEnv
+			  let ctype = lookupCType env cat
+			  reduce ctype rterm emptyPath
+
+------------------------------------------------------------
+
+{-
+type CnvMonad a = BacktrackM Grammar CMRule a
+
+type CMRule = (MCFCat, [MCFCat], LinRec)
+type LinRec = [Lin Cat Path Tokn]
+-}
+
+--initialMCat :: Cat -> MCFCat
+initialMCat cat = (cat, []) --MCFCat cat []
+
+----------------------------------------------------------------------
+
+--simplifyTerm :: Term -> CnvMonad STerm
+simplifyTerm (con :^ terms) = liftM (con :^) $ mapM simplifyTerm terms
+simplifyTerm (Rec record)   = liftM Rec      $ mapM simplifyAssign record
+simplifyTerm (term :. lbl)  = liftM (+. lbl) $      simplifyTerm term
+simplifyTerm (Tbl table)    = Tbl $ mapM simplifyCase table
+simplifyTerm (term :! sel)      
+    = do sterm <- simplifyTerm term
+	 ssel <- simplifyTerm sel
+	 case sterm of
+	   Tbl table  -> do (pat, val) <- member table
+			    pat =?= ssel
+			    return val
+	   _ -> do sel' <- expandTerm ssel
+		   return (sterm +! sel')
+simplifyTerm (Variants terms)  = liftM Variants $ mapM simplifyTerm terms
+simplifyTerm (term1 :++ term2) = liftM2 (:++) (simplifyTerm term1) (simplifyTerm term2)
+simplifyTerm term              = return term
+-- error constructors:
+--   (I CIdent) - from resource
+--   (LI Ident) - pattern variable
+--   (EInt Integer) - integer
+
+--simplifyAssign :: Assign -> CnvMonad (Label, STerm)
+simplifyAssign (lbl, term) = liftM ((,) lbl) $ simplifyTerm term
+
+--simplifyCase :: Case -> [CnvMonad (STerm, STerm)]
+simplifyCase (pat, term) = liftM2 (,) (simplifyTerm pat) (simplifyTerm term)
+
+
+------------------------------------------------------------
+-- reducing simplified terms, collecting mcf rules
+
+--reduce :: CType -> STerm -> Path -> CnvMonad ()
+reduce StrT   term path = updateLin (path, term)
+reduce (ConT _) term path
+    = do pat <- expandTerm term
+	 updateHead (path, pat)
+reduce ctype (Variants terms) path 
+    = do term <- member terms
+	 reduce ctype term path
+reduce (RecT rtype) term path
+    = sequence_ [ reduce ctype (term +. lbl) (path ++. lbl) |
+		  (lbl, ctype) <- rtype ]
+reduce (TblT _ ctype) (Tbl table) path
+    = sequence_ [ reduce ctype term (path ++! pat) |
+		  (pat, term) <- table ]
+reduce (TblT ptype vtype) arg@(Arg _ _ _) path 
+    = do env <- readEnv
+	 sequence_ [ reduce vtype (arg +! pat) (path ++! pat) |
+		     pat <- groundTerms ptype ]
+reduce ctype term path = error ("reduce:\n  ctype = (" ++ show ctype ++ 
+				")\n  term = (" ++ show term ++ 
+				")\n  path = (" ++ show path ++ ")\n")
+
+
+------------------------------------------------------------
+-- expanding a term to ground terms
+
+--expandTerm :: STerm -> CnvMonad STerm
+expandTerm arg@(Arg _ _ _) 
+    = do env <- readEnv
+	 pat <- member $ groundTerms $ cTypeForArg env arg
+	 pat =?= arg
+	 return pat
+expandTerm (con :^ terms)  = liftM (con :^) $ mapM expandTerm terms
+expandTerm (Rec record)     = liftM  Rec      $ mapM expandAssign record
+expandTerm (Variants terms) = member terms >>= expandTerm
+expandTerm term = error $ "expandTerm: " ++ show term
+
+--expandAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
+expandAssign (lbl, term)   = liftM ((,) lbl) $ expandTerm term
+
+------------------------------------------------------------
+-- unification of patterns and selection terms
+
+--(=?=) :: STerm -> STerm -> CnvMonad ()
+Wildcard     =?= _                = return ()
+Rec precord  =?= arg@(Arg _ _ _) = sequence_ [ pat =?= (arg +. lbl) |
+						 (lbl, pat) <- precord ]
+pat           =?= Arg arg _ path  = updateArg arg (path, pat)
+(con :^ pats) =?= (con' :^ terms)  = do guard (con==con' && length pats==length terms)
+					sequence_ $ zipWith (=?=) pats terms
+Rec precord  =?= Rec record      = sequence_ [ maybe mzero (pat =?=) mterm |
+						 (lbl, pat) <- precord,
+						 let mterm = lookup lbl record ]
+pat =?= term = error $ "(=?=): " ++ show pat ++ " =?= " ++ show term
+
+
+------------------------------------------------------------
+-- updating the mcf rule
+
+--updateArg :: Int -> Constraint -> CnvMonad ()
+updateArg arg cn
+    = do (head, args, lins) <- readState 
+	 args' <- updateNth (addToMCFCat cn) arg args
+	 writeState (head, args', lins)
+
+--updateHead :: Constraint -> CnvMonad ()
+updateHead cn
+    = do (head, args, lins) <- readState
+	 head' <- addToMCFCat cn head
+	 writeState (head', args, lins)
+
+--updateLin :: Constraint -> CnvMonad ()
+updateLin (path, term) 
+    = do let newLins = term2lins term
+	 (head, args, lins) <- readState
+	 let lins' = lins ++ map (MCF.Lin path) newLins
+	 writeState (head, args, lins')
+
+--term2lins :: STerm -> [[Symbol (Cat, Path, Int) Tokn]]
+term2lins (Arg arg cat path) = return [Cat (cat, path, arg)]
+term2lins (Token str)        = return [Tok str]
+term2lins (t1 :++ t2)     = liftM2 (++) (term2lins t1) (term2lins t2)
+term2lins (Empty)            = return []
+term2lins (Variants terms)   = terms >>= term2lins
+term2lins term = error $ "term2lins: " ++ show term
+
+--addToMCFCat :: Constraint -> MCFCat -> CnvMonad MCFCat
+addToMCFCat cn ({-MCFCat-} cat, cns) = liftM ({-MCFCat-} (,) cat) $ addConstraint cn cns
+
+--addConstraint :: Constraint -> [Constraint] -> CnvMonad [Constraint]
+addConstraint cn0 (cn : cns)
+    | fst cn0 >  fst cn = liftM (cn:) (addConstraint cn0 cns)
+    | fst cn0 == fst cn = guard (snd cn0 == snd cn) >>
+			  return (cn : cns)
+addConstraint cn0 cns   = return (cn0 : cns)
+
+
+----------------------------------------------------------------------
+-- utilities 
+
+updateNth :: Monad m => (a -> m a) -> Int -> [a] -> m [a]
+updateNth update 0 (a : as) = liftM (:as) (update a)
+updateNth update n (a : as) = liftM (a:)  (updateNth update (n-1) as)
+
+--lookupCType :: GrammarEnv -> Cat -> CType
+lookupCType env cat = errVal defLinType $ 
+		      lookupLincat (fst env) (AbsGFC.CIQ (snd env) cat)
+
+--groundTerms :: GrammarEnv -> CType -> [STerm]
+groundTerms env ctype = err error (map term2spattern) $
+			allParamValues (fst env) ctype
+
+--cTypeForArg :: GrammarEnv -> STerm -> CType
+cTypeForArg env (Arg nr cat (Path path))
+    = follow path $ lookupCType env cat
+    where follow [] ctype = ctype
+	  follow (Right pat : path) (TblT _ ctype) = follow path ctype
+	  follow (Left lbl : path) (RecT rec)
+	      = case [ ctype | (lbl', ctype) <- rec, lbl == lbl' ] of
+		  [ctype] -> follow path ctype
+		  err     -> error $ "follow: " ++ show rec ++ " . " ++ show lbl ++ 
+			             " results in " ++ show err
+
+term2spattern (AbsGFC.R rec)         = Rec [ (lbl, term2spattern term) | 
+					     AbsGFC.Ass lbl term <- rec ]
+term2spattern (AbsGFC.Con con terms) = con :^ map term2spattern terms
+
diff --git a/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Old.hs b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Old.hs
new file mode 100644
index 000000000..dd2ff0713
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Old.hs
@@ -0,0 +1,277 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ConvertGFCtoMCFG.Old
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:59 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Converting GFC grammars to MCFG grammars. (Old variant)
+--
+-- the resulting grammars might be /very large/
+--
+-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
+-- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertSimpleToMCFG.Old (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+--import PrintGFC
+import qualified GF.Grammar.PrGrammar as PG
+
+import Control.Monad (liftM, liftM2, guard)
+-- import Maybe (listToMaybe)
+import GF.Infra.Ident (Ident(..))
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.Canon.Look
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+import GF.Canon.CMacros (defLinType)
+import GF.Canon.MkGFC (grammar2canon)
+import GF.OldParsing.Utilities
+import GF.OldParsing.GrammarTypes 
+import GF.OldParsing.MCFGrammar (Rule(..), Lin(..))
+import GF.Data.SortedList (nubsort, groupPairs)
+import Data.Maybe (listToMaybe)
+import Data.List (groupBy, transpose)
+
+----------------------------------------------------------------------
+-- old style types
+
+data XMCFCat = XMCFCat Cat [(XPath, Term)] deriving (Eq, Ord, Show)
+type XMCFLabel = XPath
+
+cnvXMCFCat :: XMCFCat -> MCFCat
+cnvXMCFCat (XMCFCat cat constrs) = MCFCat cat [ (cnvXPath path, cnvTerm term) | 
+						(path, term) <- constrs ]
+
+cnvXMCFLabel :: XMCFLabel -> MCFLabel
+cnvXMCFLabel = cnvXPath
+
+cnvXMCFLin :: Lin XMCFCat XMCFLabel Tokn -> Lin MCFCat MCFLabel Tokn
+cnvXMCFLin (Lin lbl lin) = Lin (cnvXMCFLabel lbl) $
+			   map (mapSymbol cnvSym id) lin
+    where cnvSym (cat, lbl, nr) = (cnvXMCFCat cat, cnvXMCFLabel lbl, nr)
+
+-- Term -> STerm
+
+cnvTerm (R rec) = SRec [ (lbl, cnvTerm term) | Ass lbl term <- rec ]
+cnvTerm (T _ tbl) = STbl [ (cnvPattern pat, cnvTerm term) | 
+			   Cas pats term <- tbl, pat <- pats ]
+cnvTerm (Con con terms) = SCon con $ map cnvTerm terms
+cnvTerm term
+    | isArgPath term = cnvArgPath term
+
+cnvPattern (PR rec) = SRec [ (lbl, cnvPattern term) | PAss lbl term <- rec ]
+cnvPattern (PC con pats) = SCon con $ map cnvPattern pats
+cnvPattern (PW) = SWildcard
+
+isArgPath (Arg _) = True
+isArgPath (P _ _) = True
+isArgPath (S _ _) = True
+isArgPath _ = False
+
+cnvArgPath (Arg (A cat nr)) = SArg (fromInteger nr) cat emptyPath
+cnvArgPath (term `P` lbl) = cnvArgPath term +. lbl
+cnvArgPath (term `S` sel) = cnvArgPath term +! cnvTerm sel
+
+-- old style paths
+
+newtype XPath = XPath [Either Label Term] deriving (Eq, Ord, Show)
+
+cnvXPath :: XPath -> Path
+cnvXPath (XPath path) = Path (map (either Left (Right . cnvTerm)) (reverse path))
+
+emptyXPath :: XPath
+emptyXPath = XPath []
+
+(++..) :: XPath -> Label -> XPath 
+XPath path ++.. lbl = XPath (Left lbl : path)
+
+(++!!) :: XPath -> Term -> XPath 
+XPath path ++!! sel = XPath (Right sel : path)
+
+----------------------------------------------------------------------
+
+-- | combining alg. 1 and alg. 2 from Ljunglöf's PhD thesis
+convertGrammar :: (CanonGrammar, Ident) -> MCFGrammar
+convertGrammar (gram, lng) = trace2 "language" (prt lng) $
+			     trace2 "modules" (prtSep " " modnames) $
+			     trace2 "#lin-terms" (prt (length cncdefs)) $
+			     tracePrt "#mcf-rules total" (prt.length) $
+			     concat $
+			     tracePrt "#mcf-rules per fun" 
+			     (\rs -> concat [" "++show n++"="++show (length r) | 
+					     (n, r) <- zip [1..] rs]) $
+			     map (convertDef gram lng) cncdefs
+    where Gr mods = grammar2canon gram
+	  cncdefs = [ def | Mod (MTCnc modname _) _ _ _ defs <- mods, 
+		      modname `elem` modnames, 
+		      def@(CncDFun _ _ _ _ _) <- defs ]
+	  modnames = M.allExtends gram lng
+
+
+convertDef :: CanonGrammar -> Ident -> Def -> [MCFRule]
+convertDef gram lng (CncDFun fun (CIQ _ cat) args term _)
+    = [ Rule (cnvXMCFCat newCat) (map cnvXMCFCat newArgs) (map cnvXMCFLin newTerm) fun |
+	let ctype     = lookupCType gram lng cat,
+	instArgs     <- mapM (enumerateInsts gram lng) args,
+	let instTerm  = substitutePaths gram lng instArgs term,
+	newCat       <- emcfCat gram lng cat instTerm,
+	newArgs      <- mapM (extractArg gram lng instArgs) args,
+	let newTerm   = concatMap (extractLin newArgs) $ strPaths gram lng ctype instTerm
+      ]
+
+
+-- gammalt skräp:
+-- mergeArgs = zipWith mergeRec
+-- mergeRec (R r1) (R r2) = R (r1 ++ r2)
+
+extractArg :: CanonGrammar -> Ident -> [Term] -> ArgVar -> [XMCFCat]
+extractArg gram lng args (A cat nr) = emcfCat gram lng cat (args !!! nr)
+
+
+emcfCat :: CanonGrammar -> Ident -> Ident -> Term -> [XMCFCat]
+emcfCat gram lng cat = map (XMCFCat cat) . parPaths gram lng (lookupCType gram lng cat) 
+
+
+extractLin :: [XMCFCat] -> (XPath, Term) -> [Lin XMCFCat XMCFLabel Tokn]
+extractLin args (path, term) = map (Lin path) (convertLin term)
+    where convertLin (t1 `C` t2) = liftM2 (++) (convertLin t1) (convertLin t2)
+	  convertLin (E) = [[]]
+	  convertLin (K tok) = [[Tok tok]]
+	  convertLin (FV terms) = concatMap convertLin terms
+	  convertLin term = map (return . Cat) $ flattenTerm emptyXPath term
+	  flattenTerm path (Arg (A _ nr)) = [(args !!! nr, path, fromInteger nr)]
+	  flattenTerm path (term `P` lbl) = flattenTerm (path ++.. lbl) term
+	  flattenTerm path (term `S` sel) = flattenTerm (path ++!! sel) term
+	  flattenTerm path (FV terms)     = concatMap (flattenTerm path) terms
+	  flattenTerm path term = error $ "flattenTerm: \n  " ++ show path ++ "\n  " ++ prt term 
+
+
+enumerateInsts :: CanonGrammar -> Ident -> ArgVar -> [Term]
+enumerateInsts gram lng arg@(A argCat _) = enumerate (Arg arg) (lookupCType gram lng argCat)
+    where enumerate path (TStr) = [ path ]
+	  enumerate path (Cn con) = okError $ lookupParamValues gram con
+	  enumerate path (RecType r) 
+	      = map R $ sequence [ map (lbl `Ass`) $ 
+				   enumerate (path `P` lbl) ctype |
+				   lbl `Lbg` ctype <- r ]
+	  enumerate path (Table s t)
+	      = map (T s) $ sequence [ map ([term2pattern sel] `Cas`) $ 
+				       enumerate (path `S` sel) t |
+				       sel <- enumerate (error "enumerate") s ]
+
+
+
+termPaths :: CanonGrammar -> Ident -> CType -> Term -> [(XPath, (CType, Term))]
+termPaths gr l (TStr) term = [ (emptyXPath, (TStr, term)) ]
+termPaths gr l (RecType rtype) (R record) 
+    = [ (path ++.. lbl, value) |
+	lbl `Ass` term <- record,
+	let ctype = okError $ maybeErr "termPaths/record" $ lookupLabelling lbl rtype,
+	(path, value) <- termPaths gr l ctype term ]
+termPaths gr l (Table _ ctype) (T _ table)
+    = [ (path ++!! pattern2term pat, value) |
+	pats `Cas` term <- table, pat <- pats,
+	(path, value) <- termPaths gr l ctype term ]
+termPaths gr l (Table _ ctype) (V ptype table)
+    = [ (path ++!! pat, value) |
+	(pat, term) <- zip (okError $ allParamValues gr ptype) table,
+	(path, value) <- termPaths gr l ctype term ]
+termPaths gr l ctype (FV terms)
+    = concatMap (termPaths gr l ctype) terms
+termPaths gr l (Cn pc) term = [ (emptyXPath, (Cn pc, term)) ]
+
+{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
+{a=a1; b=b1}  | {a=a2; b=b2}   ==>  {a=a1|a2; b=b1|b2}
+[p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
+-}
+
+parPaths :: CanonGrammar -> Ident -> CType -> Term -> [[(XPath, Term)]]
+parPaths gr l ctype term = mapM (uncurry (map . (,))) (groupPairs paths)
+    where paths = nubsort [ (path, value) | (path, (Cn _, value)) <- termPaths gr l ctype term ]
+
+strPaths :: CanonGrammar -> Ident -> CType -> Term -> [(XPath, Term)]
+strPaths gr l ctype term = [ (path, evalFV values) | (path, values) <- groupPairs paths ]
+    where paths = nubsort [ (path, value) | (path, (TStr, value)) <- termPaths gr l ctype term ]
+
+
+-- Substitute each instantiated parameter path for its instantiation
+substitutePaths :: CanonGrammar -> Ident -> [Term] -> Term -> Term
+substitutePaths gr l arguments trm  = subst trm
+    where subst (con `Con` terms) = con `Con` map subst terms
+	  subst (R record)        = R $ map substAss record
+	  subst (term `P` lbl)    = subst term `evalP` lbl
+	  subst (T ptype table)   = T ptype $ map substCas table
+	  subst (V ptype table)   = T ptype [ [term2pattern pat] `Cas` subst term | 
+					      (pat, term) <- zip (okError $ allParamValues gr ptype) table ]
+	  subst (term `S` select) = subst term `evalS` subst select
+	  subst (term `C` term')  = subst term `C` subst term'
+	  subst (FV terms)        = evalFV $ map subst terms
+	  subst (Arg (A _ arg))   = arguments !!! arg
+	  subst term              = term
+
+          substAss (l `Ass` term) = l `Ass` subst term
+	  substCas (p `Cas` term) = p `Cas` subst term
+
+
+evalP (R record) lbl = okError $ maybeErr errStr $ lookupAssign lbl record
+    where errStr = "evalP: " ++ prt (R record `P` lbl)
+evalP (FV terms) lbl = evalFV [ evalP term lbl | term <- terms ]
+evalP term       lbl = term `P` lbl
+
+evalS t@(T _ tbl) sel = maybe (t `S` sel) id $ lookupCase sel tbl
+evalS (FV terms)  sel = evalFV [ term `evalS` sel | term <- terms ]
+evalS term   (FV sels)= evalFV [ term `evalS` sel | sel <- sels ]
+evalS term        sel = term `S` sel
+
+evalFV terms0 = case nubsort (concatMap flattenFV terms0) of
+	          [term] -> term
+		  terms  -> FV terms
+    where flattenFV (FV ts) = ts
+	  flattenFV  t      = [t]
+
+
+----------------------------------------------------------------------
+-- utilities 
+
+-- lookup a CType for an Ident
+lookupCType :: CanonGrammar -> Ident -> Ident -> CType
+lookupCType gr lng c = errVal defLinType $ lookupLincat gr (CIQ lng c)
+
+-- lookup a label in a (record / record ctype / table)
+lookupAssign    :: Label -> [Assign]    -> Maybe Term
+lookupLabelling :: Label -> [Labelling] -> Maybe CType
+lookupCase      :: Term  -> [Case]      -> Maybe Term
+
+lookupAssign    lbl rec  = listToMaybe [ term | lbl' `Ass` term <- rec, lbl == lbl' ] 
+lookupLabelling lbl rtyp = listToMaybe [ ctyp | lbl' `Lbg` ctyp <- rtyp, lbl == lbl' ]
+lookupCase      sel tbl  = listToMaybe [ term | pats `Cas` term <- tbl, sel `matchesPats` pats ]
+
+matchesPats :: Term -> [Patt] -> Bool
+matchesPats term patterns = or [ term == pattern2term pattern | pattern <- patterns ]
+
+-- converting between patterns and terms
+pattern2term :: Patt -> Term
+term2pattern :: Term -> Patt
+
+pattern2term (con `PC` patterns) = con `Con` map pattern2term patterns
+pattern2term (PR record) = R [ lbl `Ass` pattern2term pattern | 
+			       lbl `PAss` pattern <- record ]
+
+term2pattern (con `Con` terms) = con `PC` map term2pattern terms
+term2pattern (R record) = PR [ lbl `PAss` term2pattern term |
+			       lbl `Ass` term <- record ]
+
+-- list lookup for Integers instead of Ints
+(!!!) :: [a] -> Integer -> a
+xs !!! n = xs !! fromInteger n
diff --git a/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs
new file mode 100644
index 000000000..aa741518a
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs
@@ -0,0 +1,139 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:00 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Converting SimpleGFC grammars to MCFG grammars, deterministic.
+--
+-- the resulting grammars might be /very large/
+--
+-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ConvertSimpleToMCFG.Strict (convertGrammar) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import Control.Monad
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG 
+import GF.Formalism.MCFG 
+import GF.Formalism.SimpleGFC 
+import GF.Conversion.Types
+
+import GF.Data.BacktrackM
+
+{-
+import GF.Infra.Ident (Ident(..))
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.Canon.Look
+import GF.Data.Operations
+import qualified GF.Infra.Modules as M
+import GF.Canon.CMacros (defLinType)
+import GF.Canon.MkGFC (grammar2canon)
+import GF.OldParsing.Utilities
+import GF.OldParsing.GrammarTypes 
+import GF.OldParsing.MCFGrammar (Grammar, Rule(..), Lin(..))
+import GF.Data.SortedList
+-- import Maybe (listToMaybe)
+import Data.List (groupBy) -- , transpose)
+
+import GF.Data.BacktrackM
+-}
+
+----------------------------------------------------------------------
+
+convertGrammar :: SimpleGrammar -> MGrammar 
+convertGrammar rules = tracePrt "#mcf-rules total" (prt . length) $
+		       solutions conversion undefined
+    where conversion = member rules >>= convertRule
+
+convertRule :: SimpleRule -> CnvMonad MRule
+convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term)))
+    = do let cat : args = map decl2cat (decl : decls)
+	     args_ctypes = zip3 [0..] args ctypes
+	 instArgs <- mapM enumerateArg args_ctypes
+	 let instTerm = substitutePaths instArgs term
+	 newCat <- extractMCat cat ctype instTerm
+	 newArgs <- mapM (extractArg instArgs) args
+	 let newLinRec = strPaths ctype instTerm >>= extractLin newArgs
+	     lintype : lintypes = map (convertLinType emptyPath) (ctype : ctypes)
+	 return $ Rule (Abs newCat newArgs fun) (Cnc lintype lintypes newLinRec)
+convertRule _ = failure
+
+----------------------------------------------------------------------
+
+type CnvMonad a = BacktrackM () a
+
+----------------------------------------------------------------------
+-- strict conversion
+
+--extractArg :: [Term] -> (Int, Cat, LinType) -> CnvMonad MCat
+extractArg args (nr, cat, ctype) = emcfCat cat ctype (args !! nr)
+
+--emcfCat :: Cat -> LinType -> Term -> CnvMonad MCat
+extractMCat cat ctype term = map (MCat cat) $ parPaths ctype term
+
+--enumerateArg :: (Int, Cat, LinType) -> CnvMonad Term
+enumerateArg (nr, cat, ctype) = enumerateTerms (Arg nr cat emptyPath) ctype
+
+-- Substitute each instantiated parameter path for its instantiation
+substitutePaths :: [Term] -> Term -> Term
+substitutePaths arguments = subst 
+    where subst (Arg nr _ path)  = followPath path (arguments !! nr)
+	  subst (con :^ terms)   = con :^ map subst terms
+	  subst (Rec record)        = Rec [ (lbl, subst term) | (lbl, term) <- record ]
+	  subst (term :. lbl)    = subst term +. lbl
+	  subst (Tbl table)      = Tbl [ (pat, subst term) | 
+				      (pat, term) <- table ]
+	  subst (term :! select) = subst term +! subst select
+	  subst (term :++ term') = subst term ?++ subst term'
+	  subst (Variants terms) = Variants $ map subst terms
+	  subst term = term
+
+
+--termPaths :: CType -> STerm -> [(Path, (CType, STerm))]
+termPaths ctype (Variants terms) = terms >>= termPaths ctype
+termPaths (StrT) term = [ (emptyPath, (StrT, term)) ]
+termPaths (RecT rtype) (Rec record) 
+    = [ (path ++. lbl, value) |
+	(lbl, term) <- record,
+	let Just ctype = lookup lbl rtype,
+	(path, value) <- termPaths ctype term ]
+termPaths (TblT _ ctype) (Tbl table)
+    = [ (path ++! pat, value) |
+	(pat, term) <- table,
+	(path, value) <- termPaths ctype term ]
+termPaths (ConT pc _) term = [ (emptyPath, (ConT pc, term)) ]
+
+{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
+{a=a1; b=b1}  | {a=a2; b=b2}   ==>  {a=a1|a2; b=b1|b2}
+[p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
+-}
+
+--parPaths :: CType -> STerm -> [[(Path, STerm)]]
+parPaths ctype term = mapM (uncurry (map . (,))) $ groupPairs $
+		      nubsort [ (path, value) | 
+				(path, (ConT _, value)) <- termPaths ctype term ]
+
+--strPaths :: CType -> STerm -> [(Path, STerm)]
+strPaths ctype term = [ (path, variants values) | (path, values) <- groupPairs paths ]
+    where paths = nubsort [ (path, value) | (path, (StrT, value)) <- termPaths ctype term ]
+
+--extractLin :: [MCFCat] -> (Path, STerm) -> [Lin MCFCat MCFLabel Tokn]
+extractLin args (path, term) = map (Lin path) (convertLin term)
+    where convertLin (t1 :++ t2) = liftM2 (++) (convertLin t1) (convertLin t2)
+	  convertLin (Empty) = [[]]
+	  convertLin (Token tok) = [[Tok tok]]
+	  convertLin (Variants terms) = concatMap convertLin terms
+	  convertLin (Arg nr _ path) = [[Cat (args !! nr, path, nr)]]
+
diff --git a/src-2.9/GF/OldParsing/GCFG.hs b/src-2.9/GF/OldParsing/GCFG.hs
new file mode 100644
index 000000000..33a710e5d
--- /dev/null
+++ b/src-2.9/GF/OldParsing/GCFG.hs
@@ -0,0 +1,43 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/11 13:52:53 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Simplistic GFC format
+-----------------------------------------------------------------------------
+
+module GF.OldParsing.GCFG where
+
+import GF.Printing.PrintParser
+
+----------------------------------------------------------------------
+
+type Grammar c n l t  = [Rule c n l t]
+data Rule    c n l t  = Rule (Abstract c n) (Concrete l t)
+			deriving (Eq, Ord, Show)
+
+data Abstract cat name = Abs cat [cat] name 
+			 deriving (Eq, Ord, Show)
+data Concrete lin term = Cnc lin [lin] term 
+			 deriving (Eq, Ord, Show)
+
+----------------------------------------------------------------------
+
+instance (Print c, Print n, Print l, Print t) => Print (Rule n c l t) where
+    prt (Rule abs cnc) = prt abs ++ " := " ++ prt cnc ++ "\n"
+    prtList = concatMap prt
+
+instance (Print c, Print n) => Print (Abstract c n) where
+    prt (Abs cat args name) = prt name ++ ". " ++ prt cat ++ 
+			      ( if null args then ""
+				else " -> " ++ prtSep " " args )
+
+instance (Print l, Print t) => Print (Concrete l t) where
+    prt (Cnc lcat args term) = prt term ++ " : " ++ prt lcat ++ 
+			      ( if null args then ""
+				else " [ " ++ prtSep " " args ++ " ]" )
diff --git a/src-2.9/GF/OldParsing/GeneralChart.hs b/src-2.9/GF/OldParsing/GeneralChart.hs
new file mode 100644
index 000000000..1d51da025
--- /dev/null
+++ b/src-2.9/GF/OldParsing/GeneralChart.hs
@@ -0,0 +1,86 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GeneralChart
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/11 13:52:53 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.1 $
+--
+-- Simple implementation of deductive chart parsing
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.GeneralChart
+    (-- * Type definition
+     Chart,
+     -- * Main functions
+     chartLookup,
+     buildChart,
+     -- * Probably not needed
+     emptyChart,
+     chartMember,
+     chartInsert,
+     chartList,
+     addToChart
+    ) where
+
+-- import Trace 
+
+import GF.Data.RedBlackSet
+
+-- main functions
+
+chartLookup :: (Ord item, Ord key) => Chart item key -> key -> [item]
+buildChart  :: (Ord item, Ord key) => (item -> key) -> 
+	       [Chart item key -> item -> [item]] -> [item] -> [item]
+
+buildChart keyof rules axioms     = chartList (addItems axioms emptyChart)
+    where addItems []             = id
+	  addItems (item:items)   = addItems items . addItem item
+
+          -- addItem item | trace ("+ "++show item++"\n") False = undefined
+          addItem item            = addToChart item (keyof item) 
+				    (\chart -> foldr (consequence item) chart rules)
+
+          consequence item rule chart = addItems (rule chart item) chart
+
+-- probably not needed
+
+emptyChart  :: (Ord item, Ord key) => Chart item key
+chartMember :: (Ord item, Ord key) => Chart item key -> item -> key -> Bool
+chartInsert :: (Ord item, Ord key) => Chart item key -> item -> key -> Maybe (Chart item key)
+chartList   :: (Ord item, Ord key) => Chart item key -> [item]
+addToChart  :: (Ord item, Ord key) => item -> key -> (Chart item key -> Chart item key) -> Chart item key -> Chart item key
+
+addToChart item key after chart = maybe chart after (chartInsert chart item key)
+
+
+--------------------------------------------------------------------------------
+-- key charts as red/black trees
+
+newtype Chart         item key = KC (RedBlackMap key item)
+    deriving Show
+
+emptyChart                     = KC rbmEmpty
+chartMember (KC tree) item key = rbmElem key item tree
+chartInsert (KC tree) item key = fmap KC (rbmInsert key item tree)
+chartLookup (KC tree)      key = rbmLookup key tree
+chartList   (KC tree)          = concatMap snd (rbmList tree)
+--------------------------------------------------------------------------------}
+
+
+{--------------------------------------------------------------------------------
+-- key charts as unsorted association lists -- OBSOLETE!
+
+newtype Chart          item key = SC [(key, item)]
+
+emptyChart = SC []
+chartMember (SC chart) item key = (key,item) `elem` chart
+chartInsert (SC chart) item key = if (key,item) `elem` chart then Nothing else Just (SC ((key,item):chart))
+chartLookup (SC chart)      key = [ item | (key',item) <- chart, key == key' ]
+chartList   (SC chart)          = map snd chart
+--------------------------------------------------------------------------------}
+
diff --git a/src-2.9/GF/OldParsing/GrammarTypes.hs b/src-2.9/GF/OldParsing/GrammarTypes.hs
new file mode 100644
index 000000000..fc514fc75
--- /dev/null
+++ b/src-2.9/GF/OldParsing/GrammarTypes.hs
@@ -0,0 +1,148 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:46 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- All possible instantiations of different grammar formats used for parsing
+--
+-- Plus some helper types and utilities
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.GrammarTypes
+    (-- * Main parser information
+     PInfo(..),
+     -- * Multiple context-free grammars
+     MCFGrammar, MCFRule, MCFPInfo,
+     MCFCat(..), MCFLabel,
+     Constraint,
+     -- * Context-free grammars
+     CFGrammar, CFRule, CFPInfo,
+     CFProfile, CFName(..), CFCat(..),
+     -- * Assorted types
+     Cat, Name, Constr, Label, Tokn,
+     -- * Simplified terms
+     STerm(..), (+.), (+!),
+     -- * Record\/table paths
+     Path(..), emptyPath,
+     (++.), (++!)
+    ) where
+
+import GF.Infra.Ident (Ident(..))
+import GF.Canon.AbsGFC
+-- import qualified GF.OldParsing.FiniteTypes.Calc as Fin
+import qualified GF.OldParsing.CFGrammar as CFG
+import qualified GF.OldParsing.MCFGrammar as MCFG
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+
+import qualified GF.OldParsing.ConvertGFCtoSimple
+
+----------------------------------------------------------------------
+
+data PInfo = PInfo { mcfg :: MCFGrammar,
+		     cfg :: CFGrammar,
+		     mcfPInfo :: MCFPInfo,
+		     cfPInfo :: CFPInfo }
+
+type MCFGrammar  = MCFG.Grammar Name MCFCat MCFLabel Tokn
+type MCFRule     = MCFG.Rule    Name MCFCat MCFLabel Tokn
+type MCFPInfo    = MCFG.PInfo   Name MCFCat MCFLabel Tokn
+
+data MCFCat      = MCFCat Cat [Constraint] deriving (Eq, Ord, Show)
+type MCFLabel    = Path
+
+type Constraint  = (Path, STerm)
+
+type CFGrammar   = CFG.Grammar CFName CFCat Tokn
+type CFRule      = CFG.Rule    CFName CFCat Tokn
+type CFPInfo     = CFG.PInfo   CFName CFCat Tokn
+
+type CFProfile   = [[Int]]
+data CFName      = CFName Name   CFProfile deriving (Eq, Ord, Show)
+data CFCat       = CFCat  MCFCat MCFLabel  deriving (Eq, Ord, Show)
+
+----------------------------------------------------------------------
+
+type Cat    = Ident
+type Name   = Ident
+type Constr = CIdent
+
+data STerm    = SArg Int Cat Path     -- ^ argument variable, the 'Path' is a path 
+				      -- pointing into the term 
+	      | SCon Constr [STerm]   -- ^ constructor
+	      | SRec [(Label, STerm)] -- ^ record
+	      | STbl [(STerm, STerm)] -- ^ table of patterns\/terms
+	      | SVariants [STerm]     -- ^ variants
+	      | SConcat STerm STerm   -- ^ concatenation
+	      | SToken Tokn           -- ^ single token
+	      | SEmpty                -- ^ empty string
+	      | SWildcard             -- ^ wildcard pattern variable
+
+	      -- SRes CIdent        -- resource identifier
+	      -- SVar Ident         -- bound pattern variable
+	      -- SInt Integer       -- integer
+		deriving (Eq, Ord, Show)
+
+(+.) :: STerm -> Label -> STerm
+SRec record +. lbl = maybe err id $ lookup lbl record
+    where err = error $ "(+.), label not in record: " ++ show (SRec record) ++ " +. " ++ show lbl
+SArg arg cat path +. lbl = SArg arg cat (path ++. lbl)
+SVariants terms +. lbl = SVariants $ map (+. lbl) terms 
+sterm +. lbl = error $ "(+.): " ++ show sterm ++ " +. " ++ show lbl
+
+(+!) :: STerm -> STerm -> STerm
+STbl table +! pat = maybe err id $ lookup pat table
+    where err = error $ "(+!), pattern not in table: " ++ show (STbl table) ++ " +! " ++ show pat
+SArg arg cat path +! pat = SArg arg cat (path ++! pat)
+SVariants terms +! pat = SVariants $ map (+! pat) terms 
+term +! SVariants pats = SVariants $ map (term +!) pats 
+sterm +! pat = error $ "(+!): " ++ show sterm ++ " +! " ++ show pat
+
+----------------------------------------------------------------------
+
+newtype Path = Path [Either Label STerm] deriving (Eq, Ord, Show)
+
+emptyPath :: Path
+emptyPath = Path []
+
+(++.) :: Path -> Label -> Path 
+Path path ++. lbl = Path (Left lbl : path)
+
+(++!) :: Path -> STerm -> Path 
+Path path ++! sel = Path (Right sel : path)
+
+------------------------------------------------------------
+
+instance Print STerm where
+    prt (SArg n c p) = prt c ++ "@" ++ prt n ++ prt p
+    prt (SCon c [])  = prt c 
+    prt (SCon c ts)  = prt c ++ prtList ts
+    prt (SRec rec)   = "{" ++ concat [ prt l ++ "=" ++ prt t ++ ";" | (l,t) <- rec ] ++ "}"
+    prt (STbl tbl)   = "[" ++ concat [ prt p ++ "=>" ++ prt t ++ ";" | (p,t) <- tbl ] ++ "}"
+    prt (SVariants ts)  = "{| " ++ prtSep " | " ts ++ " |}"
+    prt (SConcat t1 t2) = prt t1 ++ "++" ++ prt t2
+    prt (SToken t)   = prt t
+    prt (SEmpty)     = "[]"
+    prt (SWildcard)  = "_"
+
+instance Print MCFCat where
+    prt (MCFCat cat params) 
+	= prt cat ++ "{" ++ concat [ prt path ++ "=" ++ prt term ++ ";" |
+				     (path, term) <- params ] ++ "}"
+
+instance Print CFName where
+    prt (CFName name profile) = prt name ++ prt profile
+
+instance Print CFCat where
+    prt (CFCat cat lbl) = prt cat ++ prt lbl
+
+instance Print Path where
+    prt (Path path) = concatMap prtEither (reverse path)
+	where prtEither (Left  lbl)  = "." ++ prt lbl
+	      prtEither (Right patt) = "!" ++ prt patt
diff --git a/src-2.9/GF/OldParsing/IncrementalChart.hs b/src-2.9/GF/OldParsing/IncrementalChart.hs
new file mode 100644
index 000000000..132ed4dc4
--- /dev/null
+++ b/src-2.9/GF/OldParsing/IncrementalChart.hs
@@ -0,0 +1,50 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : IncrementalChart
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:47 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Implementation of /incremental/ deductive parsing,
+-- i.e. parsing one word at the time.
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.IncrementalChart
+    (-- * Type definitions
+     IncrementalChart,
+     -- * Functions
+     buildChart,
+     chartList
+    ) where
+
+import Data.Array
+import GF.Data.SortedList
+import GF.Data.Assoc
+
+buildChart :: (Ord item, Ord key) => (item -> key) -> 
+	      (Int -> item -> SList item) -> 
+	      (Int ->         SList item) -> 
+	      (Int, Int) -> IncrementalChart item key
+
+chartList :: (Ord item, Ord key) => (Int -> item -> edge) -> IncrementalChart item key -> [edge]
+
+type IncrementalChart item key = Array Int (Assoc key (SList item))
+
+----------
+
+buildChart keyof rules axioms bounds = finalChartArray
+    where buildState k     = limit (rules k) $ axioms k
+	  finalChartList   = map buildState [fst bounds .. snd bounds]
+	  finalChartArray  = listArray bounds $ map stateAssoc finalChartList
+	  stateAssoc state = accumAssoc id [ (keyof item, item) | item <- state ]
+
+chartList combine chart = [ combine k item | 
+			    (k, state) <- assocs chart, 
+			    item <- concatMap snd $ aAssocs state ]
+
+
diff --git a/src-2.9/GF/OldParsing/MCFGrammar.hs b/src-2.9/GF/OldParsing/MCFGrammar.hs
new file mode 100644
index 000000000..ff9d7de1b
--- /dev/null
+++ b/src-2.9/GF/OldParsing/MCFGrammar.hs
@@ -0,0 +1,206 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : MCFGrammar
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:48 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Definitions of multiple context-free grammars,
+-- parser information and chart conversion
+-----------------------------------------------------------------------------
+
+module GF.OldParsing.MCFGrammar
+    (-- * Type definitions
+     Grammar,
+     Rule(..),
+     Lin(..),
+     -- * Parser information
+     MCFParser,
+     MEdge,
+     edges2chart,
+     PInfo,
+     pInfo,
+     -- * Ranges
+     Range(..),
+     makeRange,
+     concatRange,
+     unifyRange,
+     unionRange,
+     failRange,
+     -- * Utilities
+     select,
+     updateIndex
+    ) where
+
+-- gf modules:
+import GF.Data.SortedList
+import GF.Data.Assoc
+-- parser modules:
+import GF.OldParsing.Utilities
+import GF.Printing.PrintParser
+
+
+
+select :: [a] -> [(a, [a])]
+select [] = []
+select (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- select xs ]
+
+updateIndex :: Functor f => Int -> [a] -> (a -> f a) -> f [a]
+updateIndex 0 (a:as) f = fmap (:as) $ f a
+updateIndex n (a:as) f = fmap (a:)  $ updateIndex (n-1) as f
+updateIndex _ _ _ = error "ParserUtils.updateIndex: Index out of range"
+
+
+------------------------------------------------------------
+-- grammar types
+
+type Grammar n c l t = [Rule n c l t]
+data Rule    n c l t = Rule c [c] [Lin c l t] n
+		       deriving (Eq, Ord, Show)
+data Lin       c l t = Lin l [Symbol (c, l, Int) t]
+		       deriving (Eq, Ord, Show)
+
+-- variants is simply several linearizations with the same label
+
+
+------------------------------------------------------------
+-- parser information
+
+type PInfo n c l t = Grammar n c l t
+
+pInfo :: Grammar n c l t -> PInfo n c l t
+pInfo = id
+
+type MCFParser n c l t = PInfo n c l t -> [c] -> Input t -> ParseChart n (MEdge c l)
+
+type MEdge c l = (c, [(l, Range)])
+
+edges2chart :: (Ord n, Ord c, Ord l) =>
+	       [(n, MEdge c l, [MEdge c l])] -> ParseChart n (MEdge c l)
+edges2chart edges = fmap groupPairs $ accumAssoc id $
+		    [ (medge, (name, medges)) | (name, medge, medges) <- edges ]
+
+
+------------------------------------------------------------
+-- ranges as sets of int-pairs
+
+newtype Range = Rng (SList (Int, Int)) deriving (Eq, Ord, Show)
+
+makeRange :: SList (Int, Int) -> Range
+makeRange rho = Rng rho
+
+concatRange :: Range -> Range -> Range
+concatRange (Rng rho) (Rng rho') = Rng $ nubsort [ (i,k) | (i,j) <- rho, (j',k) <- rho', j==j' ]
+
+unifyRange :: Range -> Range -> Range
+unifyRange  (Rng rho) (Rng rho') = Rng $ rho <**> rho'
+
+unionRange :: Range -> Range -> Range
+unionRange  (Rng rho) (Rng rho') = Rng $ rho <++> rho'
+
+failRange :: Range
+failRange = Rng []
+
+
+------------------------------------------------------------
+-- pretty-printing
+
+instance (Print n, Print c, Print l, Print t) => Print (Rule n c l t) where
+    prt (Rule cat args record name) 
+	= prt name ++ ". " ++ prt cat ++ " -> " ++ prtSep " " args ++ "\n" ++ prt record
+    prtList = concatMap prt
+
+instance (Print c, Print l, Print t) => Print (Lin c l t) where
+    prt (Lin lbl lin) = prt lbl ++ " = " ++ prtSep " " (map (symbol prArg (show.prt)) lin)
+	where prArg (cat, lbl, arg) = prt cat ++ "@" ++ prt arg ++ "." ++ prt lbl
+    prtList = prtBeforeAfter "\t" "\n" 
+
+instance Print Range where
+    prt (Rng rho) = "(" ++ prtSep "|" [ show i ++ "-" ++ show j | (i,j) <- rho ] ++ ")"
+
+{-
+------------------------------------------------------------
+-- items & forests
+
+data Item    n c l   = Item n (MEdge c l) [[MEdge c l]]
+		       deriving (Eq, Ord, Show)
+type MEdge     c l   = (c, [Edge l])
+
+items2forests :: (Ord n, Ord c, Ord l) => Edge ((c, l) -> Bool) -> [Item n c l] -> [ParseForest n]
+
+----------
+
+items2forests (Edge i0 k0 startCat) items 
+    = concatMap edge2forests $ filter checkEdge $ aElems chart
+    where edge2forests (cat, []) = [FMeta]
+	  edge2forests edge = filter checkForest $ map item2forest (chart ? edge)
+
+	  item2forest (Item name _ children) = FNode name [ forests | edges <- children,
+							    forests <- mapM edge2forests edges ]
+
+	  checkEdge (cat, [Edge i k lbl]) = i == i0 && k == k0 && startCat (cat, lbl)
+	  checkEdge _ = False
+
+          checkForest (FNode _ children) = not (null children)
+
+          chart = accumAssoc id [ (edge, item) | item@(Item _ edge _) <- items ]
+-}
+
+
+------------------------------------------------------------
+-- grammar checking
+{-
+--checkGrammar :: (Ord c, Ord l, Print n, Print c, Print l, Print t) => Grammar n c l t -> [String]
+
+checkGrammar rules
+    = do rule@(Rule cat rhs record name) <- rules
+	 if null record 
+            then [ "empty linearization record in rule: " ++ prt rule ]
+	    else [ "category does not exist: " ++ prt rcat ++ "\n" ++
+		   "  - in rule: " ++ prt rule |
+		   rcat <- rhs, rcat `notElem` lhsCats ] ++
+ 	         do Lin _ lin <- record  
+		    Cat (arg, albl) <- lin
+		    if arg<0 || arg>=length rhs 
+		       then [ "argument index out of range: " ++ show arg ++ "/" ++ prt albl ++ "\n" ++
+			      "  - in rule: " ++ prt rule ]
+		       else [ "label does not exist: " ++ prt albl ++ "\n" ++
+			      "  - from rule: " ++ prt rule ++
+			      "  - in rule: " ++ prt arule |
+			      arule@(Rule _ acat _ arecord) <- rules,
+			      acat == rhs !! arg,
+			      albl `notElem` [ lbl | Lin lbl _ <- arecord ] ]
+    where lhsCats = nubsort [ cat | Rule _ cat _ _ <- rules ]
+-}
+
+
+
+
+
+{-----
+------------------------------------------------------------
+-- simplifications 
+
+splitMRule :: (Ord n, Ord c, Ord l, Ord t) => Grammar n c l t -> Rule n c l t -> [Rule n c l t]
+splitMRule rules (Rule name cat args record) = nubsort [ (Rule name cat args splitrec) |
+							 (cat', lbls) <- rhsCats, cat == cat',
+							 let splitrec = [ lin | lin@(Lin lbl _) <- record, lbl `elem` lbls ] ]
+    where rhsCats = limit rhsC lhsCats
+	  lhsCats = nubsort [ (cat, [lbl]) | Rule _ cat _ record <- rules, Lin lbl _ <- record ]
+	  rhsC (cat, lbls) = nubsort [ (rcat, rlbls) |
+				       Rule _ cat' rhs lins <- rules, cat == cat',
+				       (arg, rcat) <- zip [0..] rhs,
+				       let rlbls = nubsort [ rlbl | Lin lbl lin <- lins, lbl `elem` lbls,
+							     Cat (arg', rlbl) <- lin, arg == arg' ],
+				       not $ null rlbls
+				     ]
+
+
+----}
+
+
+
diff --git a/src-2.9/GF/OldParsing/ParseCF.hs b/src-2.9/GF/OldParsing/ParseCF.hs
new file mode 100644
index 000000000..e1ef32aee
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ParseCF.hs
@@ -0,0 +1,82 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseCF
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:49 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Chart parsing of grammars in CF format
+-----------------------------------------------------------------------------
+
+module GF.OldParsing.ParseCF (parse, alternatives) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+
+import GF.Data.SortedList (nubsort)
+import GF.Data.Assoc
+import qualified GF.CF.CF as CF
+import qualified GF.CF.CFIdent as CFI
+import GF.OldParsing.Utilities
+import GF.OldParsing.CFGrammar
+import qualified GF.OldParsing.ParseCFG as P
+
+type Token    = CFI.CFTok
+type Name     = CFI.CFFun
+type Category = CFI.CFCat
+
+alternatives :: [(String, [String])]
+alternatives = [ ("gb",  ["G","GB","_gen","_genBU"]),
+		 ("gt",  ["GT","_genTD"]),
+		 ("ibn", ["","I","B","IB","IBN","_inc","BU","_incBU"]),
+		 ("ibb", ["BB","IBB","BU_BUF","_incBU_BUF"]),
+		 ("ibt", ["BT","IBT","BU_TDF","_incBU_TDF"]),
+		 ("iba", ["BA","IBA","BU_BTF","BU_TBF","_incBU_BTF","_incBU_TBF"]),
+		 ("itn", ["T","IT","ITN","TD","_incTD"]),
+		 ("itb", ["TB","ITB","TD_BUF","_incTD_BUF"])
+	       ]
+
+parse :: String -> CF.CF -> Category -> CF.CFParser
+parse = buildParser . P.parse 
+
+buildParser :: CFParser Name Category Token -> CF.CF -> Category -> CF.CFParser
+buildParser parser cf start tokens = trace "ParseCF" $
+				     (parseResults, parseInformation)
+    where parseInformation = prtSep "\n" trees
+	  parseResults     = {-take maxTake-} [ (tree2cfTree t, []) | t <- trees ]
+	  theInput = input tokens
+	  edges    = tracePrt "#edges" (prt.length) $
+		     parser pInf [start] theInput
+	  chart    = tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
+		     edges2chart theInput $ map (fmap addCategory) edges
+	  forests  = tracePrt "#forests" (prt.length) $
+		     chart2forests chart (const False) $ 
+		     uncurry Edge (inputBounds theInput) start
+	  trees    = tracePrt "#trees" (prt.length) $
+		     concatMap forest2trees forests
+	  pInf     = pInfo $ cf2grammar cf (nubsort tokens)
+	  
+
+addCategory (Rule cat rhs name) = Rule cat rhs (name, cat)
+
+tree2cfTree (TNode (name, cat) trees) = CF.CFTree (name, (cat, map tree2cfTree trees))
+
+cf2grammar :: CF.CF -> [Token] -> Grammar Name Category Token
+cf2grammar cf tokens = [ Rule cat rhs name |
+			 (name, (cat, rhs0)) <- cfRules, 
+			 rhs <- mapM item2symbol rhs0 ] 
+    where cfRules = concatMap (CF.predefRules (CF.predefOfCF cf)) tokens ++ 
+		    CF.rulesOfCF cf 
+	  item2symbol (CF.CFNonterm cat) = [Cat cat]
+	  item2symbol item = map Tok $ filter (CF.matchCFTerm item) tokens
+
+-- maxTake :: Int
+-- maxTake = 500
+-- maxTake = maxBound
+
+
diff --git a/src-2.9/GF/OldParsing/ParseCFG.hs b/src-2.9/GF/OldParsing/ParseCFG.hs
new file mode 100644
index 000000000..03c1d7dcc
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ParseCFG.hs
@@ -0,0 +1,43 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseCFG
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:49 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Main parsing module for context-free grammars
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ParseCFG (parse) where
+
+import Data.Char (toLower)
+import GF.OldParsing.Utilities
+import GF.OldParsing.CFGrammar
+import qualified GF.OldParsing.ParseCFG.General as PGen
+import qualified GF.OldParsing.ParseCFG.Incremental as PInc
+
+
+parse :: (Ord n, Ord c, Ord t, Show t) => 
+	 String -> CFParser n c t
+parse = decodeParser . map toLower
+
+decodeParser ['g',s]   = PGen.parse (decodeStrategy s)
+decodeParser ['i',s,f] = PInc.parse (decodeStrategy s, decodeFilter f)
+decodeParser _ = decodeParser "ibn"
+
+decodeStrategy 'b' = (True, False)
+decodeStrategy 't' = (False, True)
+
+decodeFilter 'a' = (True, True)
+decodeFilter 'b' = (True, False)
+decodeFilter 't' = (False, True)
+decodeFilter 'n' = (False, False)
+
+
+
+
diff --git a/src-2.9/GF/OldParsing/ParseCFG/General.hs b/src-2.9/GF/OldParsing/ParseCFG/General.hs
new file mode 100644
index 000000000..438c89f1a
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ParseCFG/General.hs
@@ -0,0 +1,83 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseCFG.General
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:00 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Several implementations of CFG chart parsing
+-----------------------------------------------------------------------------
+
+module GF.OldParsing.ParseCFG.General
+    (parse, Strategy) where
+
+import GF.System.Tracing
+
+import GF.OldParsing.Utilities
+import GF.OldParsing.CFGrammar
+import GF.OldParsing.GeneralChart 
+import GF.Data.Assoc
+
+parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser n c t
+parse strategy grammar start = extract . process strategy grammar start
+
+type Strategy = (Bool, Bool) -- (isBottomup, isTopdown)
+
+extract :: [Item n (Symbol c t)] -> [Edge (Rule n c t)]
+extract edges =
+    edges'
+    where edges' = [ Edge j k (Rule cat (reverse found) name) |
+		     Edge j k (Cat cat, found, [], Just name) <- edges ]
+
+process :: (Ord n, Ord c, Ord t) => Strategy -> PInfo n c t -> 
+	   [c] -> Input t -> [Item n (Symbol c t)]
+process (isBottomup, isTopdown) grammar start
+    = trace2 "CFParserGeneral" ((if isBottomup then " BU" else "") ++ 
+				(if isTopdown  then " TD" else "")) $
+      buildChart keyof [predict, combine] . axioms 
+    where axioms input = initial ++ scan input
+
+          scan input = map (fmap mkEdge) (inputEdges input)
+	  mkEdge tok = (Tok tok, [], [], Nothing)
+
+          -- the combine rule
+          combine chart (Edge j k (next, _, [], _))
+	      = [ edge `forwardTo` k | edge <- chartLookup chart (Active next j) ]
+          combine chart edge@(Edge _ j (_, _, next:_, _))
+	      = [ edge `forwardTo` k | Edge _ k _ <- chartLookup chart (Passive next j) ]
+
+          -- initial predictions
+          initial = [ loopingEdge 0 rule | cat <- start, rule <- tdRuleLookup ? cat ]
+
+          -- predictions
+          predict chart (Edge j k (next, _, [], _)) | isBottomup 
+	      = [ loopingEdge j rule `forwardTo` k | rule <- bottomupRules grammar ? next ]
+	      -- - - - - - - - - -   ^^^^^^^^^^^^^ Kilbury prediction: move dot forward
+	  predict chart (Edge _ k (_, _, Cat cat:_, _))
+	      = [ loopingEdge k rule | rule <- tdRuleLookup ? cat ]
+	  predict _ _ = []
+
+          tdRuleLookup | isTopdown  = topdownRules grammar
+		       | isBottomup = emptyLeftcornerRules grammar
+
+-- internal representation of parse items
+
+type Item   n s = Edge (s, [s], [s], Maybe n)
+type IChart n s = Chart (Item n s) (IKey s)
+data IKey     s = Active  s Int
+		| Passive s Int
+		  deriving (Eq, Ord, Show)
+
+keyof (Edge _ j (_, _, next:_, _)) = Active next j
+keyof (Edge j _ (cat, _, [], _))   = Passive cat j
+
+forwardTo (Edge i j (cat, found, next:tofind, name)) k = Edge i k (cat, next:found, tofind, name)
+
+loopingEdge k (Rule cat tofind name) = Edge k k (Cat cat, [], tofind, Just name)
+
+
+
diff --git a/src-2.9/GF/OldParsing/ParseCFG/Incremental.hs b/src-2.9/GF/OldParsing/ParseCFG/Incremental.hs
new file mode 100644
index 000000000..f1bcde404
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ParseCFG/Incremental.hs
@@ -0,0 +1,142 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseCFG.Incremental
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:01 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Incremental chart parsing for context-free grammars
+-----------------------------------------------------------------------------
+
+ 
+
+module GF.OldParsing.ParseCFG.Incremental
+    (parse, Strategy) where
+
+import GF.System.Tracing
+import GF.Printing.PrintParser
+
+-- haskell modules:
+import Data.Array
+-- gf modules:
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.Data.Operations
+-- parser modules:
+import GF.OldParsing.Utilities
+import GF.OldParsing.CFGrammar
+import GF.OldParsing.IncrementalChart
+
+
+type Strategy = ((Bool, Bool), (Bool, Bool)) -- (predict:(BU, TD), filter:(BU, TD))
+
+parse :: (Ord n, Ord c, Ord t, Show t) => 
+	 Strategy -> CFParser n c t
+parse ((isPredictBU, isPredictTD), (isFilterBU, isFilterTD)) grammar start input =
+    trace2 "CFParserIncremental" 
+	       ((if isPredictBU then "BU-predict " else "") ++
+		(if isPredictTD then "TD-predict " else "") ++
+		(if isFilterBU  then "BU-filter " else "") ++
+		(if isFilterTD  then "TD-filter " else "")) $
+    finalEdges
+    where finalEdges = [ Edge j k (Rule cat (reverse found) name) |
+			 (k, state) <- 
+			   tracePrt "#passiveChart"
+			   (prt . map (length . (?Passive) . snd)) $
+			   tracePrt "#activeChart" 
+			   (prt . map (length . concatMap snd . aAssocs . snd)) $
+			   assocs finalChart,
+			 Item j (Rule cat _Nil name) found <- state ? Passive ]
+
+	  finalChart = buildChart keyof rules axioms $ inputBounds input
+
+          axioms 0 = --tracePrt ("axioms 0") (prtSep "\n") $
+		     union $ map (tdInfer 0) start
+	  axioms k = --tracePrt ("axioms "++show k) (prtSep "\n") $
+		     union [ buInfer j k (Tok token) |
+			     (token, js) <- aAssocs (inputTo input ! k), j <- js ]
+
+          rules k (Item j (Rule cat [] _) _)
+	      = buInfer j k (Cat cat)
+          rules k (Item j rule@(Rule _ (Cat next:_) _) found) 
+	      = tdInfer k next <++> 
+	        -- hack for empty rules:
+		[ Item j (forward rule) (Cat next:found) | 
+		  emptyCategories grammar ?= next ]
+	  rules _ _ = []
+
+          buInfer j k next = --tracePrt ("buInfer "++show(j,k)++" "++prt next) (prtSep "\n") $
+			     buPredict j k next <++> buCombine j k next 
+          tdInfer   k next = tdPredict   k next
+
+	  -- the combine rule
+          buCombine j k next
+	      | j == k    = [] -- hack for empty rules
+	      | otherwise = [ Item i (forward rule) (next:found) | 
+			      Item i rule found <- (finalChart ! j) ? Active next ]
+
+	  -- kilbury bottom-up prediction
+          buPredict j k next
+	      = [ Item j rule [next] | isPredictBU,
+		  rule <- map forward $ --tracePrt ("buRules "++prt next) (prtSep "\n") $
+		                        bottomupRules grammar ? next,
+		  buFilter rule k, 
+		  tdFilter rule j k ]
+
+	  -- top-down prediction
+          tdPredict k cat
+	      = [ Item k rule [] | isPredictTD || isFilterTD,
+		  rule <- topdownRules grammar ? cat,
+		  buFilter rule k ] <++>
+		-- hack for empty rules:
+		[ Item k rule [] | isPredictBU,
+		  rule <- emptyLeftcornerRules grammar ? cat ]
+
+          -- bottom up filtering: input symbol k can begin the given symbol list (first set)
+	  -- leftcornerTokens DOESN'T WORK WITH EMPTY RULES!!!
+	  buFilter (Rule _ (Cat cat:_) _) k | isFilterBU
+	      = k < snd (inputBounds input) && 
+		hasCommonElements (leftcornerTokens grammar ? cat) 
+				      (aElems (inputFrom input ! k))
+	  buFilter _ _ = True
+
+          -- top down filtering: 'cat' is reachable by an active edge ending in node j < k
+          tdFilter (Rule cat _ _) j k | isFilterTD && j < k
+					  = (tdFilters ! j) ?= cat
+	  tdFilter _ _ _ = True
+
+	  tdFilters    = listArray (inputBounds input) $ 
+			 map (listSet . limit leftCats . activeCats) [0..]
+	  activeCats j = [ next | Active (Cat next) <- aElems (finalChart ! j) ]
+	  leftCats cat = [ left | Rule _cat (Cat left:_) _ <- topdownRules grammar ? cat ]
+
+
+-- type declarations, items & keys
+data Item n c t = Item Int (Rule n c t) [Symbol c t]
+		  deriving (Eq, Ord, Show)
+
+data IKey   c t = Active (Symbol c t) | Passive
+		  deriving (Eq, Ord, Show)
+
+keyof :: Item n c t -> IKey c t
+keyof (Item _ (Rule _ (next:_) _) _) = Active next
+keyof (Item _ (Rule _ [] _) _)       = Passive
+
+forward :: Rule n c t -> Rule n c t 
+forward (Rule cat (_:rest) name) = Rule cat rest name
+
+
+instance (Print n, Print c, Print t) => Print (Item n c t) where
+    prt (Item k (Rule cat rhs name) syms) 
+	= "<" ++show k++ ": "++prt name++". "++
+	  prt cat++" -> "++prt rhs++" / "++prt syms++">"
+
+instance (Print c, Print t) => Print (IKey c t) where
+    prt (Active sym) = "?" ++ prt sym
+    prt (Passive) = "!"
+
+
diff --git a/src-2.9/GF/OldParsing/ParseGFC.hs b/src-2.9/GF/OldParsing/ParseGFC.hs
new file mode 100644
index 000000000..fbc6cff5a
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ParseGFC.hs
@@ -0,0 +1,177 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseGFC
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:50 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- The main parsing module, parsing GFC grammars
+-- by translating to simpler formats, such as PMCFG and CFG
+----------------------------------------------------------------------
+
+module GF.OldParsing.ParseGFC (newParser) where
+
+import GF.System.Tracing 
+import GF.Printing.PrintParser
+import qualified GF.Grammar.PrGrammar as PrGrammar
+
+-- Haskell modules
+import Control.Monad
+-- import Ratio ((%))
+-- GF modules
+import qualified GF.Grammar.Grammar as GF
+import GF.Grammar.Values
+import qualified GF.Grammar.Macros as Macros
+import qualified GF.Infra.Modules as Mods
+import qualified GF.Canon.AbsGFC as AbsGFC
+import qualified GF.Infra.Ident as Ident
+import qualified GF.Compile.ShellState as SS
+import GF.Data.Operations
+import GF.Data.SortedList 
+-- Conversion and parser modules
+import GF.Data.Assoc
+import GF.OldParsing.Utilities
+-- import ConvertGrammar
+import GF.OldParsing.GrammarTypes
+import qualified GF.OldParsing.MCFGrammar as M
+import qualified GF.OldParsing.CFGrammar as C
+import qualified GF.OldParsing.ParseMCFG as PM
+import qualified GF.OldParsing.ParseCFG as PC
+--import MCFRange
+
+newParser :: String -> SS.StateGrammar -> GF.Cat -> String -> Err [GF.Term]
+
+-- parsing via MCFG
+newParser (m:strategy) gr (_, startCat) inString 
+    | m=='m' || m=='M' = trace2 "Parser" "MCFG" $ Ok terms
+    where terms    = map (ptree2term abstract) trees
+	  trees    = --tracePrt "trees" (prtBefore "\n") $
+		     tracePrt "#trees" (prt . length) $
+		     concatMap forest2trees forests
+	  forests  = --tracePrt "forests" (prtBefore "\n") $
+		     tracePrt "#forests" (prt . length) $
+		     concatMap (chart2forests chart isMeta) finalEdges
+	  isMeta = null . snd
+	  finalEdges = tracePrt "finalEdges" (prtBefore "\n") $
+		       filter isFinalEdge $ aElems chart
+-- 		       nubsort [ (cat, [(lbl, E.makeRange [(i,j)])]) | 
+-- 				 let (i, j) = inputBounds inTokens,
+-- 				 E.Rule cat _ [E.Lin lbl _] _ <- pInf,
+-- 				 isStartCat cat ]
+	  isFinalEdge (cat, rows) 
+	      = isStartCat cat && 
+		inputBounds inTokens `elem` concat [ rho | (_, M.Rng rho) <- rows ]
+	  chart    = --tracePrt "chart" (prtBefore "\n" . aAssocs) $
+		     tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
+		     PM.parse strategy pInf starters inTokens
+	  inTokens = input $ map AbsGFC.KS $ words inString
+	  pInf     = -- tracePrt "avg rec" (\gr -> show (sum [ length rec | E.Rule _ _ rec _ <- gr ] % length gr)) $
+		     mcfPInfo $ SS.statePInfoOld gr
+	  starters = tracePrt "startCats" prt $
+		     filter isStartCat $ nubsort [ cat | M.Rule cat _ _ _ <- pInf ]
+	  isStartCat (MCFCat cat _) = cat == startCat
+	  abstract = tracePrt "abstract module" PrGrammar.prt $
+		     SS.absId gr
+
+-- parsing via CFG
+newParser (c:strategy) gr (_, startCat) inString 
+    | c=='c' || c=='C' = trace2 "Parser" "CFG" $ Ok terms
+    where terms    = -- tracePrt "terms" (unlines . map PrGrammar.prt) $
+		     map (ptree2term abstract) trees
+	  trees    = tracePrt "#trees" (prt . length) $
+		     --tracePrt "trees" (prtSep "\n") $
+		     concatMap forest2trees forests
+	  forests  = tracePrt "$cfForests" (prt) $ -- . length) $
+		     tracePrt "forests" (unlines . map prt) $
+		     concatMap convertFromCFForest cfForests
+	  cfForests= tracePrt "cfForests" (unlines . map prt) $
+		     concatMap (chart2forests chart (const False)) finalEdges
+	  finalEdges = tracePrt "finalChartEdges" prt $
+		       map (uncurry Edge (inputBounds inTokens)) starters
+	  chart    = --tracePrt "finalChartEdges" (prt . (? finalEdge)) $
+		     tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
+		     C.edges2chart inTokens edges
+	  edges    = --tracePrt "finalEdges" 
+		     --(prt . filter (\(Edge i j _) -> (i,j)==inputBounds inTokens)) $
+		     tracePrt "#edges" (prt . length) $
+		     PC.parse strategy pInf starters inTokens
+	  inTokens = input $ map AbsGFC.KS $ words inString
+	  pInf     = cfPInfo $ SS.statePInfoOld gr
+	  starters = tracePrt "startCats" prt $
+		     filter isStartCat $ map fst $ aAssocs $ C.topdownRules pInf
+	  isStartCat (CFCat (MCFCat cat _) _) = cat == startCat
+	  abstract = tracePrt "abstract module" PrGrammar.prt $
+		     SS.absId gr
+		     --ifNull (Ident.identC "ABS") last $ 
+		     --[i | (i, Mods.ModMod m) <- Mods.modules (SS.grammar gr), Mods.isModAbs m]
+
+newParser "" gr start inString = newParser "c" gr start inString
+
+newParser opt gr (_,cat) _ = 
+  Bad ("new-parser '" ++ opt ++ "' not defined yet")
+
+ptree2term :: Ident.Ident -> ParseTree Name -> GF.Term
+ptree2term a (TNode f ts) = Macros.mkApp (Macros.qq (a,f)) (map (ptree2term a) ts)
+ptree2term a (TMeta)      = GF.Meta (GF.MetaSymb 0)
+
+----------------------------------------------------------------------
+-- conversion and unification of forests
+
+convertFromCFForest :: ParseForest CFName -> [ParseForest Name]
+convertFromCFForest (FNode (CFName name profile) children) 
+    | isCoercion name = concat chForests
+    | otherwise       = [ FNode name chForests | not (null chForests) ]
+    where chForests   = concat [ mapM (checkProfile forests) profile |
+				 forests0 <- children,
+				 forests <- mapM convertFromCFForest forests0 ]
+	  checkProfile forests = unifyManyForests . map (forests !!)
+				 -- foldM unifyForests FMeta . map (forests !!)
+
+isCoercion Ident.IW = True
+isCoercion _        = False
+
+unifyManyForests :: Eq n => [ParseForest n] -> [ParseForest n]
+unifyManyForests [] = [FMeta]
+unifyManyForests [f] = [f]
+unifyManyForests (f:g:fs) = do h <- unifyForests f g
+			       unifyManyForests (h:fs)
+
+unifyForests :: Eq n => ParseForest n -> ParseForest n -> [ParseForest n]
+unifyForests FMeta  forest = [forest]
+unifyForests forest FMeta  = [forest]
+unifyForests (FNode name1 children1) (FNode name2 children2)
+    = [ FNode name1 children | name1 == name2, not (null children) ]
+    where children = [ forests | forests1 <- children1, forests2 <- children2,
+		       forests <- zipWithM unifyForests forests1 forests2 ]
+
+
+
+{-
+----------------------------------------------------------------------
+-- conversion and unification for parse trees instead of forests
+
+convertFromCFTree :: ParseTree CFName -> [ParseTree Name]
+convertFromCFTree (TNode (CFName name profile) children0) 
+    = [ TNode name children |
+	children1 <- mapM convertFromCFTree children0,
+	children <- mapM (checkProfile children1) profile ]
+    where checkProfile trees = unifyManyTrees . map (trees !!)
+
+unifyManyTrees :: Eq n => [ParseTree n] -> [ParseTree n]
+unifyManyTrees [] = [TMeta]
+unifyManyTrees [f] = [f]
+unifyManyTrees (f:g:fs) = do h <- unifyTrees f g
+			     unifyManyTrees (h:fs)
+
+unifyTrees TMeta tree = [tree]
+unifyTrees tree TMeta = [tree]
+unifyTrees (TNode name1 children1) (TNode name2 children2)
+    = [ TNode name1 children | name1 == name2, 
+	children <- zipWithM unifyTrees children1 children2 ]
+
+-}
+
diff --git a/src-2.9/GF/OldParsing/ParseMCFG.hs b/src-2.9/GF/OldParsing/ParseMCFG.hs
new file mode 100644
index 000000000..c845a76b3
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ParseMCFG.hs
@@ -0,0 +1,37 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseMCFG
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:52 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Main module for MCFG parsing
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.ParseMCFG (parse) where
+
+import Data.Char (toLower)
+import GF.OldParsing.Utilities
+import GF.OldParsing.MCFGrammar
+import qualified GF.OldParsing.ParseMCFG.Basic as PBas
+import GF.Printing.PrintParser
+---- import qualified MCFParserBasic2 as PBas2 -- file not found AR
+
+
+parse :: (Ord n, Ord c, Ord l, Ord t,
+	  Print n, Print c, Print l, Print t) => 
+	 String -> MCFParser n c l t
+parse str = decodeParser (map toLower str)
+
+decodeParser "b"  = PBas.parse
+---- decodeParser "c"  = PBas2.parse
+decodeParser _    = decodeParser "b"
+
+
+
+
diff --git a/src-2.9/GF/OldParsing/ParseMCFG/Basic.hs b/src-2.9/GF/OldParsing/ParseMCFG/Basic.hs
new file mode 100644
index 000000000..baf7e4b2a
--- /dev/null
+++ b/src-2.9/GF/OldParsing/ParseMCFG/Basic.hs
@@ -0,0 +1,156 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ParseMCFG.Basic
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:03 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Simplest possible implementation of MCFG chart parsing
+-----------------------------------------------------------------------------
+
+module GF.OldParsing.ParseMCFG.Basic
+    (parse) where
+
+import GF.System.Tracing
+
+import Data.Ix
+import GF.OldParsing.Utilities
+import GF.OldParsing.MCFGrammar
+import GF.OldParsing.GeneralChart 
+import GF.Data.Assoc
+import GF.Data.SortedList
+import GF.Printing.PrintParser
+
+
+parse :: (Ord n, Ord c, Ord l, Ord t,
+	  Print n, Print c, Print l, Print t) => 
+	 MCFParser n c l t
+parse grammar start = edges2chart . extract . process grammar 
+
+
+extract :: [Item n c l t] -> [(n, MEdge c l, [MEdge c l])]
+extract items = tracePrt "#passives" (prt.length) $
+		--trace2 "passives" (prtAfter "\n" [ i | i@(PItem _) <- items ]) $
+		[ item | PItem item <- items ]
+
+
+process :: (Ord n, Ord c, Ord l, Ord t, 
+	    Print n, Print c, Print l, Print t) => 
+	   Grammar n c l t -> Input t -> [Item n c l t]
+process grammar input = buildChart keyof rules axioms
+    where axioms = initial
+	  rules  = [combine, scan, predict]
+
+          -- axioms
+	  initial = traceItems "axiom" [] $
+		    [ nextLin name tofind (addNull cat) (map addNull args) |
+		      Rule cat args tofind name <- grammar ]
+
+	  addNull a = (a, [])
+
+	  -- predict 
+	  predict chart i1@(Item name tofind rho (Lin lbl []) (cat, found0) children)
+	      = traceItems "predict" [i1] 
+		[ nextLin name tofind (cat, found) children | 
+		  let found = insertRow lbl rho found0 ]
+	  predict _ _ = []
+
+          -- combine 
+	  combine chart active@(Item _ _ _ (Lin _ (Cat(cat,_,_):_)) _ _)
+	      = do passive <- chartLookup chart (Passive cat)
+		   combineItems active passive
+	  combine chart passive@(PItem (_, (cat, _), _))
+	      = do active <- chartLookup chart (Active cat)
+		   combineItems active passive
+	  combine _ _ = []
+
+          combineItems i1@(Item name tofind rho0 (Lin lbl (Cat(_,lbl',nr):rest)) found children0)
+		       i2@(PItem (_, found', _))
+	      = traceItems "combine" [i1,i2]
+		[ Item name tofind rho (Lin lbl rest) found children |
+		  rho1 <- lookupLbl lbl' found',
+		  let rho = concatRange rho0 rho1,
+		  children <- updateChild nr children0 (snd found') ]
+
+          -- scan
+	  scan chart i1@(Item name tofind rho0 (Lin lbl (Tok tok:rest)) found children)
+	      = traceItems "scan" [i1]
+		[ Item name tofind rho (Lin lbl rest) found children |
+		  let rho = concatRange rho0 (rangeOfToken tok) ]
+	  scan _ _ = []
+
+          -- utilities
+          rangeOfToken tok = makeRange $ inputToken input ? tok
+
+          zeroRange = makeRange $ map (\i -> (i,i)) $ range $ inputBounds input
+
+          nextLin name [] found children = PItem (name, found, children)
+          nextLin name (lin : tofind) found children 
+	      = Item name tofind zeroRange lin found children 
+
+lookupLbl a = map snd . filter (\b -> a == fst b) . snd
+updateChild nr children found = updateIndex nr children $
+				\child -> if null (snd child)
+					     then [ (fst child, found) ]
+					     else [ child | snd child == found ]
+
+insertRow lbl rho [] = [(lbl, rho)]
+insertRow lbl rho rows'@(row@(lbl', rho') : rows)
+    = case compare lbl lbl' of
+        LT -> row : insertRow lbl rho rows
+	GT -> (lbl, rho) : rows'
+	EQ -> (lbl, unionRange rho rho') : rows
+
+
+-- internal representation of parse items
+
+data Item n c l t
+    = Item n [Lin c l t] -- tofind
+      Range (Lin c l t) -- current row
+      (MEdge c l) -- found rows
+      [MEdge c l] -- found children
+    | PItem (n, MEdge c l, [MEdge c l])
+    deriving (Eq, Ord, Show)
+
+data IKey c = Passive c | Active c | AnyItem
+		deriving (Eq, Ord, Show)
+
+keyof (PItem (_, (cat, _), _)) = Passive cat
+keyof (Item _ _ _ (Lin _ (Cat(cat,_,_):_)) _ _) = Active cat
+keyof _ = AnyItem
+
+
+-- tracing
+
+--type TraceItem = Item String String Char String
+traceItems :: (Print n, Print l, Print c, Print t) =>
+	      String -> [Item n c l t] -> [Item n c l t] -> [Item n c l t] 
+traceItems rule trigs items
+    | null items || True = items
+    | otherwise = trace ("\n" ++ rule ++ ":" ++ 
+			 unlines [ "\t" ++ prt i | i <- trigs ] ++ "=>" ++
+			 unlines [ "\t" ++ prt i | i <- items ]) items
+
+-- pretty-printing
+
+instance (Print n, Print c, Print l, Print t) => Print (Item n c l t) where
+    prt (Item name tofind rho lin (cat, found) children)
+	= prt name ++ ". " ++ prt cat ++ prtRhs (map fst children) ++ 
+	  "   { " ++ prt rho ++ prt lin ++ " ; " ++
+	  concat [ prt lbl ++ "=" ++ prt ln ++ " " | 
+		   Lin lbl ln <- tofind ] ++ "; " ++
+	  concat [ prt lbl ++ "=" ++ prt rho ++ " " | 
+		   (lbl, rho) <- found ] ++ "}   " ++
+	  concat [ "[ " ++ concat [ prt lbl ++ "=" ++ prt rho ++ " " | 
+				    (lbl,rho) <- child ] ++ "]   " | 
+		   child <- map snd children ]
+    prt (PItem (name, edge, edges)) 
+	= prt name ++ ". " ++ prt edge ++ prtRhs edges
+
+prtRhs [] = ""
+prtRhs rhs = " -> " ++ prtSep " " rhs
+
diff --git a/src-2.9/GF/OldParsing/SimpleGFC.hs b/src-2.9/GF/OldParsing/SimpleGFC.hs
new file mode 100644
index 000000000..59f379bb4
--- /dev/null
+++ b/src-2.9/GF/OldParsing/SimpleGFC.hs
@@ -0,0 +1,161 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:52 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Simplistic GFC format
+-----------------------------------------------------------------------------
+
+module GF.OldParsing.SimpleGFC where
+
+import qualified GF.Canon.AbsGFC as AbsGFC
+import qualified GF.Infra.Ident as Ident
+
+import GF.Printing.PrintParser
+import GF.Printing.PrintSimplifiedTerm
+
+import GF.Data.Operations (ifNull)
+
+----------------------------------------------------------------------
+
+type Name   = Ident.Ident
+type Cat    = Ident.Ident
+type Constr = AbsGFC.CIdent
+type Var    = Ident.Ident
+type Token  = AbsGFC.Tokn
+type Label  = AbsGFC.Label
+
+constr2name :: Constr -> Name
+constr2name (AbsGFC.CIQ _ name) = name
+
+----------------------------------------------------------------------
+
+type Grammar  = [Rule]
+data Rule     = Rule Name Typing (Maybe (Term, CType))
+		deriving (Eq, Ord, Show)
+
+type Typing = (Type, [Decl])
+
+data Decl = Var ::: Type
+	    deriving (Eq, Ord, Show)
+data Type = Cat :@ [Atom]
+	    deriving (Eq, Ord, Show)
+data Atom = ACon Constr
+	  | AVar Var
+	    deriving (Eq, Ord, Show)
+
+data CType = RecT [(Label, CType)]
+	   | TblT CType CType
+	   | ConT Constr [Term]
+	   | StrT
+	     deriving (Eq, Ord, Show)
+
+
+data Term = Arg Int Cat Path     -- ^ argument variable, the 'Path' is a path 
+				 -- pointing into the term 
+	  | Constr :^ [Term]     -- ^ constructor
+	  | Rec [(Label, Term)]  -- ^ record
+	  | Term :. Label        -- ^ record projection
+	  | Tbl [(Term, Term)]   -- ^ table of patterns\/terms
+	  | Term :! Term         -- ^ table selection
+	  | Variants [Term]      -- ^ variants
+	  | Term :++ Term        -- ^ concatenation
+	  | Token Token          -- ^ single token
+	  | Empty                -- ^ empty string
+	  | Wildcard             -- ^ wildcard pattern variable
+	  | Var Var              -- ^ bound pattern variable
+
+	    -- Res CIdent        -- resource identifier
+	    -- Int Integer       -- integer
+	    deriving (Eq, Ord, Show)
+
+
+----------------------------------------------------------------------
+
+(+.) :: Term -> Label -> Term
+Variants terms +. lbl = Variants $ map (+. lbl) terms 
+Rec record +. lbl = maybe err id $ lookup lbl record
+    where err = error $ "(+.), label not in record: " ++ show (Rec record) ++ " +. " ++ show lbl
+Arg arg cat path +. lbl = Arg arg cat (path ++. lbl)
+term +. lbl = term :. lbl
+
+(+!) :: Term -> Term -> Term
+Variants terms +! pat = Variants $ map (+! pat) terms 
+term +! Variants pats = Variants $ map (term +!) pats 
+Tbl table +! pat = maybe err id $ lookup pat table
+    where err = error $ "(+!), pattern not in table: " ++ show (Tbl table) ++ " +! " ++ show pat
+Arg arg cat path +! pat = Arg arg cat (path ++! pat)
+term +! pat = term :! pat
+
+(?++) :: Term -> Term -> Term
+Variants terms ?++ term  = Variants $ map (?++ term) terms
+term  ?++ Variants terms = Variants $ map (term ?++) terms
+Empty ?++ term  = term
+term  ?++ Empty = term
+term1 ?++ term2 = term1 :++ term2
+
+----------------------------------------------------------------------
+
+newtype Path = Path [Either Label Term] deriving (Eq, Ord, Show)
+
+emptyPath :: Path
+emptyPath = Path []
+
+(++.) :: Path -> Label -> Path 
+Path path ++. lbl = Path (Left lbl : path)
+
+(++!) :: Path -> Term -> Path 
+Path path ++! sel = Path (Right sel : path)
+
+----------------------------------------------------------------------
+
+instance Print Rule where
+    prt (Rule name (typ, args) term) 
+	= prt name ++ " : " ++ 
+	  prtAfter " " args ++ 
+	  (if null args then "" else "-> ") ++
+	  prt typ ++ 
+	  maybe "" (\(t,c) -> " := " ++ prt t ++ " : " ++ prt c) term ++
+          "\n"
+    prtList = concatMap prt
+
+instance Print Decl where
+    prt (var ::: typ) = "(" ++ prt var ++ ":" ++ prt typ ++ ")"
+
+instance Print Type where
+    prt (cat :@ ats) = prt cat ++ prtList ats
+
+instance Print Atom where
+    prt (ACon con) = prt con
+    prt (AVar var) = "?" ++ prt var
+
+instance Print CType where
+    prt (RecT rec) = "{" ++ concat [ prt l ++ ":" ++ prt t ++ "; " | (l,t) <- rec ] ++ "}"
+    prt (TblT t1 t2) = "(" ++ prt t1 ++ " => " ++ prt t2 ++ ")"
+    prt (ConT t ts) = prt t ++ "(|" ++ prtSep "|" ts ++ "|)"
+    prt (StrT) = "Str"
+
+instance Print Term where
+    prt (Arg n c p) = prt c ++ "@" ++ prt n ++ prt p
+    prt (c :^ [])  = prt c 
+    prt (c :^ ts)  = prt c ++ prtList ts
+    prt (Rec rec)   = "{" ++ concat [ prt l ++ "=" ++ prt t ++ "; " | (l,t) <- rec ] ++ "}"
+    prt (Tbl tbl)   = "[" ++ concat [ prt p ++ "=>" ++ prt t ++ "; " | (p,t) <- tbl ] ++ "}"
+    prt (Variants ts)  = "{| " ++ prtSep " | " ts ++ " |}"
+    prt (t1 :++ t2) = prt t1 ++ "++" ++ prt t2
+    prt (Token t)   = prt t
+    prt (Empty)     = "[]"
+    prt (Wildcard)  = "_"
+    prt (term :. lbl) = prt term ++ "." ++ prt lbl
+    prt (term :! sel) = prt term ++ " ! " ++ prt sel
+    prt (Var var) = "?" ++ prt var
+
+instance Print Path where
+    prt (Path path) = concatMap prtEither (reverse path)
+	where prtEither (Left  lbl)  = "." ++ prt lbl
+	      prtEither (Right patt) = "!" ++ prt patt
diff --git a/src-2.9/GF/OldParsing/Utilities.hs b/src-2.9/GF/OldParsing/Utilities.hs
new file mode 100644
index 000000000..6bacfe1fe
--- /dev/null
+++ b/src-2.9/GF/OldParsing/Utilities.hs
@@ -0,0 +1,188 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Parsing.Utilities
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:22:54 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Basic type declarations and functions to be used when parsing
+-----------------------------------------------------------------------------
+
+
+module GF.OldParsing.Utilities
+    ( -- * Symbols
+      Symbol(..), symbol, mapSymbol,
+      -- * Edges
+      Edge(..),
+      -- * Parser input
+      Input(..), makeInput, input, inputMany,
+      -- * charts, parse forests & trees
+      ParseChart, ParseForest(..), ParseTree(..),
+      chart2forests, forest2trees
+    ) where
+
+-- haskell modules:
+import Control.Monad
+import Data.Array
+-- gf modules:
+import GF.Data.SortedList
+import GF.Data.Assoc
+-- parsing modules:
+import GF.Printing.PrintParser
+
+------------------------------------------------------------
+-- symbols
+
+data Symbol c t = Cat c | Tok t
+		  deriving (Eq, Ord, Show)
+
+symbol    :: (c -> a) -> (t -> a) -> Symbol c t -> a
+mapSymbol :: (c -> d) -> (t -> u) -> Symbol c t -> Symbol d u
+
+----------
+
+symbol fc ft (Cat cat) = fc cat
+symbol fc ft (Tok tok) = ft tok
+
+mapSymbol fc ft = symbol (Cat . fc) (Tok . ft)
+
+
+------------------------------------------------------------
+-- edges
+
+data Edge s = Edge Int Int s
+	      deriving (Eq, Ord, Show)
+
+instance Functor Edge where
+    fmap f (Edge i j s) = Edge i j (f s)
+
+
+------------------------------------------------------------
+-- parser input 
+
+data Input t = MkInput { inputEdges  :: [Edge t],
+			 inputBounds :: (Int, Int),
+			 inputFrom   :: Array Int (Assoc t [Int]),
+			 inputTo     :: Array Int (Assoc t [Int]),
+			 inputToken  :: Assoc t [(Int, Int)]
+		       }
+
+makeInput :: Ord t => [Edge t] -> Input t
+input     :: Ord t =>  [t]     -> Input t
+inputMany :: Ord t => [[t]]    -> Input t
+
+----------
+
+makeInput inEdges  | null inEdges = input []
+		   | otherwise    = MkInput inEdges inBounds inFrom inTo inToken
+    where inBounds = foldr1 minmax [ (i, j) | Edge i j _ <- inEdges ]
+	      where minmax (a, b) (a', b') = (min a a', max b b')
+	  inFrom   = fmap (accumAssoc id) $ accumArray (<++>) [] inBounds $
+		     [ (i, [(tok, j)]) | Edge i j tok <- inEdges ]
+	  inTo     = fmap (accumAssoc id) $ accumArray (<++>) [] inBounds
+		     [ (j, [(tok, i)]) | Edge i j tok <- inEdges ]
+	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
+
+input toks         = MkInput inEdges inBounds inFrom inTo inToken
+    where inEdges  = zipWith3 Edge [0..] [1..] toks
+	  inBounds = (0, length toks)
+	  inFrom   = listArray inBounds $
+		     [ listAssoc [(tok, [j])] | (tok, j) <- zip toks [1..] ] ++ [ listAssoc [] ]
+	  inTo     = listArray inBounds $
+		     [ listAssoc [] ] ++ [ listAssoc [(tok, [i])] | (tok, i) <- zip toks [0..] ]
+	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
+
+inputMany toks     = MkInput inEdges inBounds inFrom inTo inToken
+    where inEdges  = [ Edge i j t | (i, j, ts) <- zip3 [0..] [1..] toks, t <- ts ]
+	  inBounds = (0, length toks)
+	  inFrom   = listArray inBounds $
+		     [ listAssoc [ (t, [j]) | t <- nubsort ts ] | (ts, j) <- zip toks [1..] ]
+		     ++ [ listAssoc [] ]
+	  inTo     = listArray inBounds $
+		     [ listAssoc [] ] ++ 
+		     [ listAssoc [ (t, [i]) | t <- nubsort ts ] | (ts, i) <- zip toks [0..] ]
+	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
+
+
+------------------------------------------------------------
+-- charts, parse forests & trees
+
+type ParseChart n e = Assoc e [(n, [[e]])]
+
+data ParseForest n = FNode n [[ParseForest n]] | FMeta 
+		     deriving (Eq, Ord, Show)
+
+data ParseTree n = TNode n [ParseTree n] | TMeta 
+		   deriving (Eq, Ord, Show)
+
+chart2forests :: Ord e => ParseChart n e -> (e -> Bool) -> e -> [ParseForest n]
+
+--filterCoercions :: (n -> Bool) -> ParseForest n -> [ParseForest n]
+
+forest2trees :: ParseForest n -> [ParseTree n]
+
+instance Functor ParseTree where
+    fmap f (TNode n trees) = TNode (f n) $ map (fmap f) trees
+    fmap f (TMeta) = TMeta 
+	     
+instance Functor ParseForest where
+    fmap f (FNode n forests) = FNode (f n) $ map (map (fmap f)) forests
+    fmap f (FMeta) = FMeta 
+
+----------
+
+chart2forests chart isMeta = edge2forests
+    where item2forest (name, children) = FNode name $
+					 do edges <- children
+					    mapM edge2forests edges 
+          edge2forests edge 
+	      | isMeta     edge = [FMeta]
+	      | otherwise       = filter checkForest $ map item2forest $ chart ? edge
+	  checkForest (FNode _ children) = not (null children)
+
+-- filterCoercions _ (FMeta) = [FMeta]
+-- filterCoercions isCoercion (FNode s forests) 
+--     | isCoercion s = do [forest] <- forests ; filterCoercions isCoercion forest
+--     | otherwise    = FNode s $ do children <- forests ; mapM (filterCoercions isCoercion)
+
+forest2trees (FNode s forests) = map (TNode s) $ forests >>= mapM forest2trees
+forest2trees (FMeta) = [TMeta]
+
+
+
+------------------------------------------------------------
+-- pretty-printing
+
+instance (Print c, Print t) => Print (Symbol c t) where
+    prt = symbol prt (simpleShow.prt)
+    prtList = prtSep " "
+
+simpleShow :: String -> String
+simpleShow s = "\"" ++ concatMap mkEsc s ++ "\""
+    where
+    mkEsc :: Char -> String
+    mkEsc c = case c of
+		     _ | elem c "\\\"" -> '\\' : [c]
+		     '\n' -> "\\n"
+		     '\t' -> "\\t"
+		     _ -> [c]
+
+instance (Print s) => Print (Edge s) where
+    prt (Edge i j s) = "[" ++ show i ++ "-" ++ show j ++ ": " ++ prt s ++ "]"
+    prtList = prtSep ""
+
+instance (Print s) => Print (ParseTree s) where
+    prt (TNode s trees) = prt s ++ "^{" ++ prtSep " " trees ++ "}"
+    prt (TMeta) = "?"
+    prtList = prtAfter "\n"
+
+instance (Print s) => Print (ParseForest s) where
+    prt (FNode s forests) = prt s ++ "^{" ++ prtSep " | " (map (prtSep " ") forests) ++ "}"
+    prt (FMeta) = "?"
+    prtList = prtAfter "\n"
+
+
diff --git a/src-2.9/GF/Parsing/CF.hs b/src-2.9/GF/Parsing/CF.hs
new file mode 100644
index 000000000..1a65f6caf
--- /dev/null
+++ b/src-2.9/GF/Parsing/CF.hs
@@ -0,0 +1,66 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:04 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- Chart parsing of grammars in CF format
+-----------------------------------------------------------------------------
+
+module GF.Parsing.CF (parse) where
+
+import GF.Data.Operations (errVal)
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import GF.Data.SortedList (nubsort)
+import GF.Data.Assoc
+import qualified GF.CF.CF as CF
+import qualified GF.CF.CFIdent as CFI
+import GF.Formalism.Utilities
+import GF.Formalism.CFG
+import qualified GF.Parsing.CFG as P
+
+type Token    = CFI.CFTok
+type Name     = CFI.CFFun
+type Category = CFI.CFCat
+
+parse :: String -> CF.CF -> Category -> CF.CFParser
+parse = buildParser . errVal (errVal undefined (P.parseCF "")) . P.parseCF 
+
+buildParser :: P.CFParser Category Name Token -> CF.CF -> Category -> CF.CFParser
+buildParser parser cf start tokens = (parseResults, parseInformation)
+    where parseInformation = prtSep "\n" trees
+	  parseResults     = [ (tree2cfTree t, []) | t <- trees ]
+	  theInput = input tokens
+	  edges    = tracePrt "Parsing.CF - nr. edges" (prt.length) $
+		     parser pInf [start] theInput
+	  chart    = tracePrt "Parsing.CF - sz. chart" (prt . map (length.snd) . aAssocs) $
+		     grammar2chart $ map addCategory edges
+	  forests  = tracePrt "Parsing.CF - nr. forests" (prt.length) $
+		     chart2forests chart (const False) 
+		     [ uncurry Edge (inputBounds theInput) start ]
+	  trees    = tracePrt "Parsing.CF - nr. trees" (prt.length) $
+		     concatMap forest2trees forests
+	  pInf     = P.buildCFPInfo $ cf2grammar cf (nubsort tokens)
+	  
+
+addCategory (CFRule cat rhs name) = CFRule cat rhs (name, cat)
+
+tree2cfTree (TNode (name, Edge _ _ cat) trees) = CF.CFTree (name, (cat, map tree2cfTree trees))
+
+cf2grammar :: CF.CF -> [Token] -> CFGrammar Category Name Token
+cf2grammar cf tokens = [ CFRule cat rhs name |
+			 (name, (cat, rhs0)) <- cfRules, 
+			 rhs <- mapM item2symbol rhs0 ] 
+    where cfRules = concatMap (CF.predefRules (CF.predefOfCF cf)) tokens ++ 
+		    CF.rulesOfCF cf 
+	  item2symbol (CF.CFNonterm cat) = [Cat cat]
+	  item2symbol item = map Tok $ filter (CF.matchCFTerm item) tokens
+
+
diff --git a/src-2.9/GF/Parsing/CFG.hs b/src-2.9/GF/Parsing/CFG.hs
new file mode 100644
index 000000000..f64ce55f1
--- /dev/null
+++ b/src-2.9/GF/Parsing/CFG.hs
@@ -0,0 +1,51 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/11 10:28:16 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- CFG parsing
+-----------------------------------------------------------------------------
+
+module GF.Parsing.CFG
+    (parseCF, module GF.Parsing.CFG.PInfo) where
+
+import GF.Data.Operations (Err(..))
+
+import GF.Formalism.Utilities
+import GF.Formalism.CFG
+import GF.Parsing.CFG.PInfo
+
+import qualified GF.Parsing.CFG.Incremental as Inc
+import qualified GF.Parsing.CFG.General as Gen
+
+----------------------------------------------------------------------
+-- parsing
+
+parseCF :: (Ord n, Ord c, Ord t) => String -> Err (CFParser c n t) 
+
+parseCF "bottomup" = Ok $ Gen.parse bottomup
+parseCF "topdown"  = Ok $ Gen.parse topdown
+
+parseCF "gb"    = Ok $ Gen.parse bottomup
+parseCF "gt"    = Ok $ Gen.parse topdown
+parseCF "ib"    = Ok $ Inc.parse (bottomup, noFilter)
+parseCF "it"    = Ok $ Inc.parse (topdown, noFilter)
+parseCF "ibFT"  = Ok $ Inc.parse (bottomup, topdown)
+parseCF "ibFB"  = Ok $ Inc.parse (bottomup, bottomup)
+parseCF "ibFTB" = Ok $ Inc.parse (bottomup, bothFilters)
+parseCF "itF"   = Ok $ Inc.parse (topdown, bottomup)
+
+-- error parser:
+parseCF prs = Bad $ "CFG parsing strategy not defined: " ++ prs
+
+bottomup = (True, False)
+topdown = (False, True)
+noFilter = (False, False)
+bothFilters = (True, True)
+
+
diff --git a/src-2.9/GF/Parsing/CFG/General.hs b/src-2.9/GF/Parsing/CFG/General.hs
new file mode 100644
index 000000000..4f5959a85
--- /dev/null
+++ b/src-2.9/GF/Parsing/CFG/General.hs
@@ -0,0 +1,103 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:08 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- CFG parsing with a general chart
+-----------------------------------------------------------------------------
+
+module GF.Parsing.CFG.General
+    (parse, Strategy) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import GF.Formalism.Utilities
+import GF.Formalism.CFG
+import GF.Parsing.CFG.PInfo
+import GF.Data.GeneralDeduction
+import GF.Data.Assoc
+import Control.Monad
+
+parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser c n t
+parse strategy grammar start = extract .
+			       tracePrt "Parsing.CFG.General - size internal of chart" 
+					    (prt . length . chartList) .
+      			       process strategy grammar start 
+
+-- | parsing strategy: (isBottomup, isTopdown)
+type Strategy = (Bool, Bool)
+
+extract :: (Ord n, Ord c, Ord t) =>
+	   IChart n (Symbol c t) -> CFChart c n t
+extract chart = [ CFRule (Edge j k cat) daughters name |
+		  Edge j k (Cat cat, found, [], Just name) <- chartList chart,
+		  daughters <- path j k (reverse found) ]
+    where path i k [] = [ [] | i==k ]
+	  path i k (Tok tok : found) 
+	      = [ Tok tok : daughters |
+		  daughters <- path (i+1) k found ]
+	  path i k (Cat cat : found)
+	      = [ Cat (Edge i j cat) : daughters |
+		  Edge _i j _cat <- chartLookup chart (Passive (Cat cat) i),
+		  daughters <- path j k found ]
+
+
+process :: (Ord n, Ord c, Ord t) => 
+	   Strategy         -- ^ (isBottomup, isTopdown) :: (Bool, Bool)
+	-> CFPInfo c n t    -- ^ parser information (= grammar)
+	-> [c]              -- ^ list of starting categories
+	-> Input t          -- ^ input string
+	-> IChart n (Symbol c t)
+process (isBottomup, isTopdown) grammar start
+    = trace2 "Parsing.CFG.General - strategy" ((if isBottomup then " BU" else "") ++ 
+					       (if isTopdown  then " TD" else "")) $
+      buildChart keyof [predict, combine] . axioms 
+    where axioms input = initial ++ scan input
+
+          scan input = map (fmap mkEdge) (inputEdges input)
+	  mkEdge tok = (Tok tok, [], [], Nothing)
+
+          -- the combine rule
+          combine chart (Edge j k (next, _, [], _))
+	      = [ edge `forwardTo` k | edge <- chartLookup chart (Active next j) ]
+          combine chart edge@(Edge _ j (_, _, next:_, _))
+	      = [ edge `forwardTo` k | Edge _ k _ <- chartLookup chart (Passive next j) ]
+
+          -- initial predictions
+          initial = [ loopingEdge 0 rule | cat <- start, rule <- tdRuleLookup ? cat ]
+
+          -- predictions
+          predict chart (Edge j k (next, _, [], _)) | isBottomup 
+	      = [ loopingEdge j rule `forwardTo` k | rule <- bottomupRules grammar ? next ]
+	      -- - - - - - - - - -   ^^^^^^^^^^^^^ Kilbury prediction: move dot forward
+	  predict chart (Edge _ k (_, _, Cat cat:_, _))
+	      = [ loopingEdge k rule | rule <- tdRuleLookup ? cat ]
+	  predict _ _ = []
+
+          tdRuleLookup | isTopdown  = topdownRules grammar
+		       | isBottomup = emptyLeftcornerRules grammar
+
+-- internal representation of parse items
+
+type Item   n s = Edge (s, [s], [s], Maybe n)
+type IChart n s = ParseChart (Item n s) (IKey s)
+data IKey     s = Active  s Int
+		| Passive s Int
+		  deriving (Eq, Ord, Show)
+
+keyof (Edge _ j (_, _, next:_, _)) = Active next j
+keyof (Edge j _ (cat, _, [], _))   = Passive cat j
+
+forwardTo (Edge i j (cat, found, next:tofind, name)) k 
+    = Edge i k (cat, next:found, tofind, name)
+
+loopingEdge k (CFRule cat tofind name) = Edge k k (Cat cat, [], tofind, Just name)
+
+
+
diff --git a/src-2.9/GF/Parsing/CFG/Incremental.hs b/src-2.9/GF/Parsing/CFG/Incremental.hs
new file mode 100644
index 000000000..adab2b73c
--- /dev/null
+++ b/src-2.9/GF/Parsing/CFG/Incremental.hs
@@ -0,0 +1,150 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:09 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- Incremental chart parsing for CFG
+-----------------------------------------------------------------------------
+ 
+
+module GF.Parsing.CFG.Incremental
+    (parse, Strategy) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import Data.Array
+
+import GF.Data.Operations
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.Formalism.Utilities
+import GF.Formalism.CFG
+import GF.Parsing.CFG.PInfo
+import GF.Data.IncrementalDeduction
+
+
+-- | parsing strategy: (predict:(BU, TD), filter:(BU, TD))
+type Strategy = ((Bool, Bool), (Bool, Bool))
+
+parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser c n t
+parse strategy grammar start = extract . 
+			       tracePrt "Parsing.CFG.Incremental - size of internal chart" 
+					    (prt . length . flip chartList const) .
+			       process strategy grammar start
+
+extract :: (Ord n, Ord c, Ord t) => 
+	   IChart c n t -> CFChart c n t
+extract finalChart = [ CFRule (Edge j k cat) daughters name |
+		       (k, Item j (CFRule cat [] name) found) <- chartList finalChart (,),
+		       daughters <- path j k (reverse found) ]
+    where path i k [] = [ [] | i==k ]
+	  path i k (Tok tok : found) 
+	      = [ Tok tok : daughters |
+		  daughters <- path (i+1) k found ]
+	  path i k (Cat cat : found)
+	      = [ Cat (Edge i j cat) : daughters |
+		  Item j _ _ <- chartLookup finalChart i (Passive cat),
+		  daughters <- path j k found ]
+
+process :: (Ord n, Ord c, Ord t) => 
+	   Strategy -> CFPInfo c n t -> [c] -> Input t -> IChart c n t
+process ((isPredictBU, isPredictTD), (isFilterBU, isFilterTD)) grammar start input
+    = trace2 "Parsing.CFG.Incremental - strategy" ((if isPredictBU then "BU-predict " else "") ++
+						   (if isPredictTD then "TD-predict " else "") ++
+						   (if isFilterBU  then "BU-filter " else "") ++
+						   (if isFilterTD  then "TD-filter " else "")) $
+      finalChart
+    where finalChart = buildChart keyof rules axioms $ inputBounds input
+
+          axioms 0 = union $ map (tdInfer 0) start
+	  axioms k = union [ buInfer j k (Tok token) |
+			     (token, js) <- aAssocs (inputTo input ! k), j <- js ]
+
+          rules k (Item j (CFRule cat [] _) _)
+	      = buInfer j k (Cat cat)
+          rules k (Item j rule@(CFRule _ (sym@(Cat next):_) _) found) 
+	      = tdInfer k next <++> 
+	        -- hack for empty rules:
+		[ Item j (forward rule) (sym:found) | 
+		  emptyCategories grammar ?= next ]
+	  rules _ _ = []
+
+          buInfer j k next = buPredict j k next <++> buCombine j k next 
+          tdInfer   k next = tdPredict   k next
+
+	  -- the combine rule
+          buCombine j k next
+	      | j == k    = [] -- hack for empty rules, see rules above and tdPredict below
+	      | otherwise = [ Item i (forward rule) (next:found) | 
+			      Item i rule found <- (finalChart ! j) ? Active next ]
+
+	  -- kilbury bottom-up prediction
+          buPredict j k next
+	      = [ Item j rule [next] | isPredictBU,
+		  rule <- map forward $ bottomupRules grammar ? next,
+		  buFilter rule k, 
+		  tdFilter rule j k ]
+
+	  -- top-down prediction
+          tdPredict k cat
+	      = [ Item k rule [] | isPredictTD || isFilterTD,
+		  rule <- topdownRules grammar ? cat,
+		  buFilter rule k ] <++>
+		-- hack for empty rules:
+		[ Item k rule [] | isPredictBU,
+		  rule <- emptyLeftcornerRules grammar ? cat ]
+
+          -- bottom up filtering: input symbol k can begin the given symbol list (first set)
+	  -- leftcornerTokens DOESN'T WORK WITH EMPTY RULES!!!
+	  buFilter (CFRule _ (Cat cat:_) _) k | isFilterBU
+	      = k < snd (inputBounds input) && 
+		hasCommonElements (leftcornerTokens grammar ? cat) 
+				      (aElems (inputFrom input ! k))
+	  buFilter _ _ = True
+
+          -- top down filtering: 'cat' is reachable by an active edge ending in node j < k
+          tdFilter (CFRule cat _ _) j k | isFilterTD && j < k
+					    = (tdFilters ! j) ?= cat
+	  tdFilter _ _ _ = True
+
+	  tdFilters    = listArray (inputBounds input) $ 
+			 map (listSet . limit leftCats . activeCats) [0..]
+	  activeCats j = [ next | Active (Cat next) <- aElems (finalChart ! j) ]
+	  leftCats cat = [ left | CFRule _cat (Cat left:_) _ <- topdownRules grammar ? cat ]
+
+
+----------------------------------------------------------------------
+-- type declarations, items & keys
+
+data Item c n t = Item Int (CFRule c n t) [Symbol c t]
+		  deriving (Eq, Ord, Show)
+
+data IKey c t = Active (Symbol c t) | Passive c
+		deriving (Eq, Ord, Show)
+
+type IChart c n t = IncrementalChart (Item c n t) (IKey c t) 
+
+keyof :: Item c n t -> IKey c t
+keyof (Item _ (CFRule _ (next:_) _) _) = Active next
+keyof (Item _ (CFRule cat [] _) _)     = Passive cat
+
+forward :: CFRule c n t -> CFRule c n t
+forward (CFRule cat (_:rest) name) = CFRule cat rest name
+
+----------------------------------------------------------------------
+
+instance (Print n, Print c, Print t) => Print (Item c n t) where
+    prt (Item k rule syms) 
+	= "<"++show k++ ": "++ prt rule++" / "++prt syms++">"
+
+instance (Print c, Print t) => Print (IKey c t) where
+    prt (Active sym) = "?" ++ prt sym
+    prt (Passive cat) = "!" ++ prt cat
+
+
diff --git a/src-2.9/GF/Parsing/CFG/PInfo.hs b/src-2.9/GF/Parsing/CFG/PInfo.hs
new file mode 100644
index 000000000..f877b225e
--- /dev/null
+++ b/src-2.9/GF/Parsing/CFG/PInfo.hs
@@ -0,0 +1,98 @@
+---------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:45 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- CFG parsing, parser information
+-----------------------------------------------------------------------------
+
+module GF.Parsing.CFG.PInfo
+    (CFParser, CFPInfo(..), buildCFPInfo) where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import GF.Formalism.Utilities
+import GF.Formalism.CFG
+import GF.Data.SortedList
+import GF.Data.Assoc
+
+----------------------------------------------------------------------
+-- type declarations
+
+-- | the list of categories = possible starting categories
+type CFParser c n t = CFPInfo c n t 
+		    -> [c]
+		    -> Input t
+		    -> CFChart c n t
+
+------------------------------------------------------------
+-- parser information
+
+data CFPInfo c n t
+    = CFPInfo { grammarTokens        :: SList t,
+		nameRules            :: Assoc n            (SList (CFRule c n t)),
+		topdownRules         :: Assoc c            (SList (CFRule c n t)),
+		bottomupRules        :: Assoc (Symbol c t) (SList (CFRule c n t)),
+		emptyLeftcornerRules :: Assoc c            (SList (CFRule c n t)),
+		emptyCategories      :: Set c,
+		cyclicCategories     :: SList c,
+		-- ^ ONLY FOR DIRECT CYCLIC RULES!!!
+		leftcornerTokens     :: Assoc c (SList t)
+		-- ^ DOES NOT WORK WITH EMPTY RULES!!!
+	      }
+
+buildCFPInfo :: (Ord c, Ord n, Ord t) => CFGrammar c n t -> CFPInfo c n t
+
+-- this is not permanent...
+buildCFPInfo grammar = traceCalcFirst grammar $
+		       tracePrt "CFG.PInfo - parser info" (prt) $
+		       pInfo' (filter (not . isCyclic) grammar)
+
+pInfo' grammar = CFPInfo grToks nmRules tdRules buRules elcRules emptyCats cyclicCats leftToks 
+    where grToks          = union [ nubsort [ tok | Tok tok <- rhs ] | 
+				    CFRule _ rhs _ <- grammar ]
+	  nmRules         = accumAssoc id [ (name, rule) | 
+					    rule@(CFRule _ _ name) <- grammar ]
+	  tdRules         = accumAssoc id [ (cat,  rule) | 
+					    rule@(CFRule cat _ _) <- grammar ]
+	  buRules         = accumAssoc id [ (next, rule) | 
+					    rule@(CFRule _ (next:_) _) <- grammar ]
+	  elcRules        = accumAssoc id $ limit lc emptyRules
+	  leftToks        = accumAssoc id $ limit lc $ 
+			    nubsort [ (cat, token) | 
+				      CFRule cat (Tok token:_) _ <- grammar ]
+	  lc (left, res)  = nubsort [ (cat, res)   | 
+				      CFRule cat _ _ <- buRules ? Cat left ]
+	  emptyRules      = nubsort [ (cat, rule)  | 
+				      rule@(CFRule cat [] _) <- grammar ]
+	  emptyCats       = listSet $ limitEmpties $ map fst emptyRules
+	  limitEmpties es = if es==es' then es else limitEmpties es'
+	      where es'   = nubsort [ cat | CFRule cat rhs _ <- grammar, 
+				      all (symbol (\e -> e `elem` es) (const False)) rhs ]
+	  cyclicCats      = nubsort [ cat | CFRule cat [Cat cat'] _ <- grammar, cat == cat' ]
+
+isCyclic (CFRule cat [Cat cat'] _) = cat==cat'
+isCyclic _ = False
+
+
+----------------------------------------------------------------------
+-- pretty-printing of statistics
+
+instance (Ord c, Ord n, Ord t) => Print (CFPInfo c n t) where
+    prt pI = "[ tokens=" ++ sl grammarTokens ++
+	     "; names=" ++ sla nameRules ++ 
+	     "; tdCats=" ++ sla topdownRules ++
+	     "; buCats=" ++ sla bottomupRules ++ 
+	     "; elcCats=" ++ sla emptyLeftcornerRules ++
+	     "; eCats=" ++ sla emptyCategories ++
+	     -- "; cCats=" ++ sl cyclicCategories ++
+	     -- "; lctokCats=" ++ sla leftcornerTokens ++ 
+	     " ]"
+	where sla f = show $ length $ aElems $ f pI
+	      sl  f = show $ length $ f pI
diff --git a/src-2.9/GF/Parsing/FCFG.hs b/src-2.9/GF/Parsing/FCFG.hs
new file mode 100644
index 000000000..30a7801c8
--- /dev/null
+++ b/src-2.9/GF/Parsing/FCFG.hs
@@ -0,0 +1,100 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : Krasimir Angelov
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- FCFG parsing
+-----------------------------------------------------------------------------
+
+module GF.Parsing.FCFG
+    (parseFCF,buildFCFPInfo,FCFPInfo(..),makeFinalEdge) where
+
+import GF.Data.SortedList 
+import GF.Data.Assoc
+
+import GF.Infra.PrintClass
+
+import GF.Formalism.FCFG
+import GF.Formalism.Utilities
+
+import qualified GF.Parsing.FCFG.Active as Active
+import GF.Parsing.FCFG.PInfo
+
+import GF.GFCC.DataGFCC
+import GF.GFCC.CId
+import GF.GFCC.Macros
+import GF.Data.ErrM
+
+import qualified Data.Map as Map
+
+----------------------------------------------------------------------
+-- parsing
+
+-- main parsing function
+
+parseFCF :: 
+      String ->         -- ^ parsing strategy
+      FCFPInfo ->       -- ^ compiled grammar (fcfg) 
+      CId ->            -- ^ starting category
+      [String] ->       -- ^ input tokens
+      Err [Exp]         -- ^ resulting GF terms
+parseFCF strategy pinfo startCat inString =
+    do let inTokens = input inString
+       startCats <- Map.lookup startCat (startupCats pinfo)
+       fcfParser <- {- trace lctree $ -} parseFCF strategy
+       let chart = fcfParser pinfo startCats inTokens
+	   (i,j) = inputBounds inTokens
+	   finalEdges = [makeFinalEdge cat i j | cat <- startCats]
+	   forests = map cnv_forests $ chart2forests chart (const False) finalEdges
+           filteredForests = forests >>= applyProfileToForest
+	   trees = nubsort $ filteredForests >>= forest2trees
+       return $ map tree2term trees
+    where
+      parseFCF :: String -> Err (FCFParser)
+      parseFCF "bottomup" = Ok  $ Active.parse "b"
+      parseFCF "topdown"  = Ok  $ Active.parse "t"
+      parseFCF strat      = Bad $ "FCFG parsing strategy not defined: " ++ strat
+
+
+cnv_forests FMeta         = FMeta
+cnv_forests (FNode (Name (CId n) p) fss) = FNode (Name (CId n) (map cnv_profile p)) (map (map cnv_forests) fss)
+cnv_forests (FString x)   = FString x
+cnv_forests (FInt    x)   = FInt    x
+cnv_forests (FFloat  x)   = FFloat  x
+
+cnv_profile (Unify    x) = Unify x
+cnv_profile (Constant x) = Constant (cnv_forests2 x)
+
+cnv_forests2 FMeta         = FMeta
+cnv_forests2 (FNode (CId n) fss) = FNode (CId n) (map (map cnv_forests2) fss)
+cnv_forests2 (FString x)   = FString x
+cnv_forests2 (FInt    x)   = FInt    x
+cnv_forests2 (FFloat  x)   = FFloat  x
+
+----------------------------------------------------------------------
+-- parse trees to GFCC terms
+
+tree2term :: SyntaxTree CId -> Exp
+tree2term (TNode f ts) = tree (AC f) (map tree2term ts)
+
+tree2term (TString  s) = tree (AS s) []
+tree2term (TInt     n) = tree (AI n) []
+tree2term (TFloat   f) = tree (AF f) []
+tree2term (TMeta)      = exp0
+
+----------------------------------------------------------------------
+-- conversion and unification of forests
+
+-- simplest implementation
+applyProfileToForest :: SyntaxForest FName -> [SyntaxForest CId]
+applyProfileToForest (FNode name@(Name fun profile) children) 
+    | isCoercionF name = concat chForests
+    | otherwise       = [ FNode fun chForests | not (null chForests) ]
+    where chForests   = concat [ applyProfileM unifyManyForests profile forests |
+				 forests0 <- children,
+				 forests <- mapM applyProfileToForest forests0 ]
+applyProfileToForest (FString s) = [FString s]
+applyProfileToForest (FInt    n) = [FInt    n]
+applyProfileToForest (FFloat  f) = [FFloat  f]
+applyProfileToForest (FMeta)     = [FMeta]
diff --git a/src-2.9/GF/Parsing/FCFG/Active.hs b/src-2.9/GF/Parsing/FCFG/Active.hs
new file mode 100644
index 000000000..df55793f8
--- /dev/null
+++ b/src-2.9/GF/Parsing/FCFG/Active.hs
@@ -0,0 +1,179 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : Krasimir Angelov
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- MCFG parsing, the active algorithm
+-----------------------------------------------------------------------------
+
+module GF.Parsing.FCFG.Active (parse) where
+
+import GF.Data.GeneralDeduction
+import GF.Data.Assoc
+import GF.Data.SortedList
+import GF.Data.Utilities
+
+import GF.Formalism.FCFG
+import GF.Formalism.Utilities
+
+import GF.Infra.PrintClass
+
+import GF.Parsing.FCFG.Range
+import GF.Parsing.FCFG.PInfo
+
+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
+
+parse :: String -> FCFParser
+parse strategy pinfo starts toks = xchart2syntaxchart chart pinfo
+    where chart = process strategy pinfo toks axioms emptyXChart
+          axioms | isBU  strategy = literals pinfo toks ++ initialBU pinfo toks
+		 | isTD  strategy = literals pinfo toks ++ initialTD pinfo starts toks
+
+isBU  s = s=="b"
+isTD  s = s=="t"
+
+-- used in prediction
+emptyChildren :: RuleId -> FCFPInfo -> SyntaxNode RuleId RangeRec
+emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) [])
+  where
+    FRule _ rhs _ _ = allRules pinfo ! ruleid
+
+process :: String -> FCFPInfo -> 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 c r d -> 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 (i,j) <- inputToken toks ? tok
+	                                     rng' <- concatRange rng (makeRange i j)
+	                                     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 fn _ 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 _ _ _ lins = allRules pinfo ! ruleid
+                                         FSymCat cat r d  = lins ! l ! ppos
+                                     rng  <- concatRange rng (found' !! r)
+                                     return (cat, Active found rng l (ppos+1) (updateChildren node d found'))
+                                  ++
+    			          do guard (isBU strategy)
+			             ruleid <- leftcornerCats pinfo ? cat
+			             let FRule _ _ _ lins = allRules pinfo ! ruleid
+			                 FSymCat cat r d  = lins ! 0 ! 0
+                                     return (cat, 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 !(ParseChart Item c) !(ParseChart Item c)
+
+emptyXChart :: Ord c => XChart c
+emptyXChart = XChart emptyChart emptyChart
+
+insertXChart (XChart actives finals) item@(Active _ _ _ _ _) c = 
+  case chartInsert actives item c of
+    Nothing      -> Nothing
+    Just actives -> Just (XChart actives finals)
+
+insertXChart (XChart actives finals) item@(Final _ _) c =
+  case chartInsert finals item c of
+    Nothing     -> Nothing
+    Just finals -> Just (XChart actives finals)
+
+lookupXChartAct   (XChart actives finals) c = chartLookup actives c
+lookupXChartFinal (XChart actives finals) c = chartLookup finals  c
+
+xchart2syntaxchart :: XChart FCat -> FCFPInfo -> SyntaxChart FName (FCat,RangeRec)
+xchart2syntaxchart (XChart actives finals) pinfo =
+  accumAssoc groupSyntaxNodes $
+    [ case node of
+        SNode ruleid rrecs -> let FRule fun rhs cat _ = allRules pinfo ! ruleid
+		              in ((cat,found), SNode fun (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) <- chartAssocs finals
+    ]
+
+literals :: FCFPInfo -> Input FToken -> [(FCat,Item)]
+literals pinfo toks =
+  [let (c,node) = lexer t in (c,Final [makeRange i j] node) | Edge i j t <- inputEdges toks, 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 :: FCFPInfo -> [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 :: FCFPInfo -> Input FToken -> [(FCat,Item)]
+initialBU pinfo toks =
+    do (tok,rngs) <- aAssocs (inputToken toks)
+       ruleid <- leftcornerTokens pinfo ? tok
+       let FRule _ _ cat _ = allRules pinfo ! ruleid
+       (i,j) <- rngs
+       return (cat,Active [] (makeRange i j) 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-2.9/GF/Parsing/FCFG/Incremental.hs b/src-2.9/GF/Parsing/FCFG/Incremental.hs
new file mode 100644
index 000000000..5ee77a061
--- /dev/null
+++ b/src-2.9/GF/Parsing/FCFG/Incremental.hs
@@ -0,0 +1,107 @@
+module GF.Parsing.FCFG.Incremental where
+
+import Data.Array
+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.GeneralDeduction
+import GF.Formalism.FCFG
+import GF.Formalism.Utilities 
+import GF.Parsing.FCFG.PInfo
+import GF.Parsing.FCFG.Range
+import GF.GFCC.CId
+import Debug.Trace
+
+initState :: FCFPInfo -> CId -> State
+initState pinfo start = 
+  let items = do
+        starts <- Map.lookup start (startupCats pinfo)
+        c <- starts
+        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 process pinfo items (State emptyChart [] emptyChart Map.empty forest max_fid 0)
+
+nextState :: FCFPInfo -> FToken -> State -> State
+nextState pinfo t state =
+  process pinfo (chartLookup (tokens state) t) state{ chart=emptyChart
+                                                    , charts=chart state : charts state
+                                                    , tokens=emptyChart
+                                                    , passive=Map.empty
+                                                    , currOffset=currOffset state+1
+                                                    }
+
+getCompletions :: State -> FToken -> [FToken]
+getCompletions state w =
+  [t | t <- chartKeys (tokens state), take (length w) t == w]
+
+process pinfo []                                                 state = state
+process pinfo (item@(Active j lbl ppos ruleid args fid0):xitems) state
+  | inRange (bounds lin) ppos =
+      case lin ! ppos of
+        FSymCat _ r d -> let fid = args !! d
+                         in case chartInsert (chart state) item (fid,r) of
+                              Nothing     -> process pinfo xitems state
+                              Just actCat -> let items = do exprs <- IntMap.lookup fid (forest state)
+                                                            (Passive ruleid args) <- Set.toList exprs
+                                                            return (Active k r 0 ruleid args fid)
+                                                         `mplus`
+                                                         do id <- Map.lookup (fid,r,k) (passive state)
+		   		 	                    return (Active j lbl (ppos+1) ruleid (updateAt d id args) fid0)
+                                             in process pinfo (xitems++items) state{chart=actCat}
+      	FSymTok tok   -> case chartInsert (tokens state) (Active j lbl (ppos+1) ruleid args fid0) tok of
+                           Nothing     -> process pinfo xitems state
+                           Just actTok -> process pinfo xitems state{tokens=actTok}
+  | otherwise = case Map.lookup (fid0, lbl, j) (passive state) of
+                  Nothing -> let fid = nextId state
+                                 items = do Active j' lbl ppos ruleid args fidc <- chartLookup ((chart state:charts state) !! (k-j)) (fid0,lbl)
+	                                    let FSymCat _ _ d = rhs ruleid lbl ! ppos
+	                                    return (Active j' lbl (ppos+1) ruleid (updateAt d fid args) fidc)
+	                     in process pinfo (xitems++items) state{passive=Map.insert (fid0, lbl, j) fid (passive state)
+                                                                   ,forest =IntMap.insert fid (Set.singleton (Passive ruleid args)) (forest state)
+                                                                   ,nextId =nextId state+1
+                                                                   }
+                  Just id -> process pinfo xitems state{forest = IntMap.insertWith Set.union id (Set.singleton (Passive ruleid args)) (forest state)}
+  where
+   lin = rhs ruleid lbl
+   k   = currOffset state
+
+   rhs ruleid lbl = lins ! lbl
+     where
+       (FRule _ _ cat lins) = allRules pinfo ! ruleid
+
+   updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs]
+
+
+data Active
+  = Active Int FIndex FPointPos RuleId [FCat] FCat
+  deriving (Eq,Show,Ord)
+data Passive
+  = Passive RuleId [FCat]
+  deriving (Eq,Ord,Show)
+
+
+data State
+  = State
+      { chart   :: Chart
+      , charts  :: [Chart]
+      , tokens  :: ParseChart Active  FToken
+      , passive :: Map.Map (FCat, FIndex, Int) FCat
+      , forest  :: IntMap.IntMap (Set.Set Passive)
+      , nextId  :: FCat
+      , currOffset :: Int
+      }
+      deriving Show
+
+type Chart = ParseChart Active (FCat, FIndex)
diff --git a/src-2.9/GF/Parsing/FCFG/PInfo.hs b/src-2.9/GF/Parsing/FCFG/PInfo.hs
new file mode 100644
index 000000000..8b288f2f1
--- /dev/null
+++ b/src-2.9/GF/Parsing/FCFG/PInfo.hs
@@ -0,0 +1,121 @@
+---------------------------------------------------------------------
+-- |
+-- Maintainer  : Krasimir Angelov
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- FCFG parsing, parser information
+-----------------------------------------------------------------------------
+
+module GF.Parsing.FCFG.PInfo where
+
+import GF.Infra.PrintClass
+import GF.Formalism.Utilities
+import GF.Formalism.FCFG
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.Parsing.FCFG.Range
+import qualified GF.GFCC.CId as AbsGFCC
+
+import Data.Array
+import Data.Maybe
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Debug.Trace
+
+----------------------------------------------------------------------
+-- type declarations
+
+-- | the list of categories = possible starting categories
+type FCFParser =  FCFPInfo
+               -> [FCat]
+               -> Input FToken
+               -> SyntaxChart FName (FCat,RangeRec)
+
+makeFinalEdge cat 0 0 = (cat, [EmptyRange])
+makeFinalEdge cat i j = (cat, [makeRange i j])
+
+------------------------------------------------------------
+-- parser information
+
+type RuleId = Int
+
+data FCFPInfo
+    = FCFPInfo { allRules           :: Array RuleId FRule
+               , topdownRules       :: Assoc FCat (SList RuleId)
+		 -- ^ used in 'GF.Parsing.MCFG.Active' (Earley):
+	         -- , emptyRules    :: [RuleId]
+	       , epsilonRules       :: [RuleId]
+		 -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
+	       , leftcornerCats     :: Assoc FCat (SList RuleId)
+	       , leftcornerTokens   :: Assoc FToken (SList RuleId)
+		 -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
+	       , grammarCats        :: SList FCat
+	       , grammarToks        :: SList FToken
+	       , startupCats        :: Map.Map AbsGFCC.CId [FCat]
+	       }
+
+
+getLeftCornerTok lins
+  | inRange (bounds syms) 0 = case syms ! 0 of
+                                FSymTok tok -> Just tok
+                                _           -> Nothing
+  | otherwise               = Nothing
+  where
+    syms = lins ! 0
+
+getLeftCornerCat lins
+  | inRange (bounds syms) 0 = case syms ! 0 of
+                                FSymCat c _ _ -> Just c
+                                _             -> Nothing
+  | otherwise               = Nothing
+  where
+    syms = lins ! 0
+
+buildFCFPInfo :: FGrammar -> FCFPInfo
+buildFCFPInfo (grammar,startup) = -- trace (unlines [prt (x,Set.toList set) | (x,set) <- Map.toList leftcornFilter]) $
+    FCFPInfo { 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]
+	  -- emptyrules    = [ruleid | (ruleid, FRule _ [] _ _) <- assocs allrules]
+	  epsilonrules  = [ ruleid | (ruleid, FRule _ _ _ lins) <- assocs allrules,
+                            not (inRange (bounds (lins ! 0)) 0) ]
+	  leftcorncats  = accumAssoc id
+			  [ (fromJust (getLeftCornerCat lins), ruleid) | 
+			    (ruleid, FRule _ _ _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ]
+	  leftcorntoks  = accumAssoc id 
+			  [ (fromJust (getLeftCornerTok lins), ruleid) | 
+			    (ruleid, FRule _ _ _ lins) <- assocs allrules, isJust (getLeftCornerTok lins) ]
+	  grammarcats   = aElems topdownrules
+	  grammartoks   = nubsort [t | (FRule _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]
+
+fcfPInfoToFGrammar :: FCFPInfo -> FGrammar
+fcfPInfoToFGrammar pinfo = (elems (allRules pinfo), startupCats pinfo)
+
+----------------------------------------------------------------------
+-- pretty-printing of statistics
+
+instance Print FCFPInfo where
+    prt pI = "[ allRules=" ++ sl (elems . allRules) ++
+	     "; tdRules=" ++ sla topdownRules ++
+	     -- "; emptyRules=" ++ sl emptyRules ++ 
+	     "; epsilonRules=" ++ sl epsilonRules ++ 
+	     "; lcCats=" ++ sla leftcornerCats ++
+	     "; lcTokens=" ++ sla leftcornerTokens ++
+	     "; categories=" ++ sl grammarCats ++ 
+	     " ]"
+
+	where sl  f = show $ length $ f pI
+	      sla f = let (as, bs) = unzip $ aAssocs $ f pI
+		       in show (length as) ++ "/" ++ show (length (concat bs))
+
diff --git a/src-2.9/GF/Parsing/FCFG/Range.hs b/src-2.9/GF/Parsing/FCFG/Range.hs
new file mode 100644
index 000000000..24674f58b
--- /dev/null
+++ b/src-2.9/GF/Parsing/FCFG/Range.hs
@@ -0,0 +1,50 @@
+---------------------------------------------------------------------
+-- |
+-- Maintainer  : Krasimir Angelov
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- Definitions of ranges, and operations on ranges
+-----------------------------------------------------------------------------
+
+module GF.Parsing.FCFG.Range
+    ( RangeRec, Range(..), makeRange, concatRange, rangeEdge, edgeRange, minRange, maxRange,
+    ) where
+
+
+-- GF modules
+import GF.Formalism.Utilities
+import GF.Infra.PrintClass
+
+------------------------------------------------------------
+-- 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']
+
+rangeEdge :: a -> Range -> Edge a
+rangeEdge a (Range i j) = Edge i j a
+
+edgeRange :: Edge a -> Range
+edgeRange (Edge i j _) = Range i j
+
+minRange :: Range -> Int
+minRange (Range i j) = i
+
+maxRange :: Range -> Int
+maxRange (Range i j) = j
+
+instance Print Range where
+    prt (Range i j)  = "(" ++ show i ++ "-" ++ show j ++ ")"
+    prt (EmptyRange) = "(?)"
diff --git a/src-2.9/GF/Parsing/GFC.hs b/src-2.9/GF/Parsing/GFC.hs
new file mode 100644
index 000000000..9f1328a50
--- /dev/null
+++ b/src-2.9/GF/Parsing/GFC.hs
@@ -0,0 +1,208 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/13 12:40:19 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.9 $
+--
+-- The main parsing module, parsing GFC grammars
+-- by translating to simpler formats, such as PMCFG and CFG
+----------------------------------------------------------------------
+
+module GF.Parsing.GFC
+    (parse, PInfo(..), buildPInfo) where
+
+import GF.System.Tracing 
+import GF.Infra.Print
+import qualified GF.Grammar.PrGrammar as PrGrammar
+
+import GF.Data.ErrM
+
+import qualified GF.Grammar.Grammar as Grammar
+import qualified GF.Grammar.Macros as Macros
+import qualified GF.Canon.AbsGFC as AbsGFC
+import qualified GF.GFCC.DataGFCC as AbsGFCC
+import GF.GFCC.CId
+import qualified GF.Infra.Ident as Ident
+import GF.CF.CFIdent (CFCat, cfCat2Ident, CFTok, wordsCFTok, prCFTok)
+
+import GF.Data.SortedList 
+import GF.Data.Assoc
+import GF.Formalism.Utilities
+import GF.Conversion.Types
+
+import qualified GF.Formalism.GCFG as G
+import qualified GF.Formalism.SimpleGFC as S
+import qualified GF.Formalism.MCFG as M
+import GF.Formalism.FCFG
+import qualified GF.Formalism.CFG as C
+import qualified GF.Parsing.MCFG as PM
+import qualified GF.Parsing.FCFG as PF
+import qualified GF.Parsing.CFG as PC
+
+----------------------------------------------------------------------
+-- parsing information
+
+data PInfo = PInfo { mcfPInfo :: MCFPInfo
+		   , fcfPInfo :: PF.FCFPInfo
+		   , cfPInfo  :: CFPInfo
+		   }
+
+type MCFPInfo = PM.MCFPInfo MCat Name MLabel Token
+type CFPInfo  = PC.CFPInfo CCat Name Token
+
+buildPInfo :: MGrammar -> FGrammar -> CGrammar -> PInfo
+buildPInfo mcfg fcfg cfg = PInfo { mcfPInfo = PM.buildMCFPInfo mcfg
+                                 , fcfPInfo = PF.buildFCFPInfo fcfg
+			         , cfPInfo  = PC.buildCFPInfo  cfg
+			         }
+
+instance Print PInfo where
+    prt (PInfo m f c) = prt m ++ "\n" ++ prt c
+
+----------------------------------------------------------------------
+-- main parsing function
+
+parse :: String         -- ^ parsing algorithm (mcfg or cfg)
+      -> String         -- ^ parsing strategy
+      -> PInfo          -- ^ compiled grammars (mcfg and cfg) 
+      -> Ident.Ident    -- ^ abstract module name
+      -> CFCat          -- ^ starting category
+      -> [CFTok]        -- ^ input tokens
+      -> Err [Grammar.Term] -- ^ resulting GF terms
+
+
+-- parsing via CFG
+parse "c" strategy pinfo abs startCat inString
+    = do let inTokens = tracePrt "Parsing.GFC - input tokens" prt $
+		      inputMany (map wordsCFTok inString)
+	 let startCats = tracePrt "Parsing.GFC - starting CF categories" prt $
+			 filter isStart $ map fst $ aAssocs $ PC.topdownRules cfpi
+	     isStart cat = ccat2scat cat == cfCat2Ident startCat
+	     cfpi = cfPInfo pinfo
+	 cfParser <- PC.parseCF strategy
+	 let cfChart = tracePrt "Parsing.GFC - CF chart" (prt . length) $
+		       cfParser cfpi startCats inTokens
+	     chart = tracePrt "Parsing.GFC - chart" (prt . map (length.snd) . aAssocs) $
+		     C.grammar2chart cfChart
+	     finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $
+			  map (uncurry Edge (inputBounds inTokens)) startCats
+	     forests = chart2forests chart (const False) finalEdges
+         traceM "Parsing.GFC - nr. unfiltered forests" (prt (length forests))
+         traceM "Parsing.GFC - nr. unfiltered trees" (prt (length (forests >>= forest2trees)))
+         let filteredForests = tracePrt "Parsing.GFC - nr. forests" (prt . length) $
+	  		       forests >>= applyProfileToForest
+	     -- compactFs = tracePrt "#compactForests" (prt . length) $
+	     -- 	          tracePrt "compactForests" (prtBefore "\n") $
+	     -- 	          compactForests forests
+	     trees = tracePrt "Parsing.GFC - nr. trees" (prt . length) $
+	  	     nubsort $ filteredForests >>= forest2trees
+		     -- compactFs >>= forest2trees
+         return $ map (tree2term abs) trees
+
+
+-- parsing via MCFG
+parse "m" strategy pinfo abs startCat inString
+    = do let inTokens = tracePrt "Parsing.GFC - input tokens" prt $
+		      inputMany (map wordsCFTok inString)
+         let startCats = tracePrt "Parsing.GFC - starting MCF categories" prt $
+			 filter isStart $ PM.grammarCats mcfpi
+	     isStart cat = mcat2scat cat == cfCat2Ident startCat
+	     mcfpi = mcfPInfo pinfo
+	 mcfParser <- PM.parseMCF strategy
+	 let chart = mcfParser mcfpi startCats inTokens
+	     finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $
+			  [ PM.makeFinalEdge cat lbl (inputBounds inTokens) | 
+			    cat@(MCat _ [lbl]) <- startCats ]
+	     forests = chart2forests chart (const False) finalEdges
+         traceM "Parsing.GFC - nr. unfiltered forests" (prt (length forests))
+         traceM "Parsing.GFC - nr. unfiltered trees" (prt (length (forests >>= forest2trees)))
+         let filteredForests = tracePrt "Parsing.GFC - nr. forests" (prt . length) $
+	  		       forests >>= applyProfileToForest
+	     -- compactFs = tracePrt "#compactForests" (prt . length) $
+	     -- 	          tracePrt "compactForests" (prtBefore "\n") $
+	     -- 	          compactForests forests
+	     trees = tracePrt "Parsing.GFC - nr. trees" (prt . length) $
+	  	     nubsort $ filteredForests >>= forest2trees
+		     -- compactFs >>= forest2trees
+         return $ map (tree2term abs) trees
+
+
+-- parsing via FCFG
+parse "f" strategy pinfo abs startCat inString =
+  let Ident.IC x = cfCat2Ident startCat
+      cat' = CId x
+  in case PF.parseFCF strategy (fcfPInfo pinfo) cat' (map prCFTok inString) of
+       Ok  es  -> Ok  (map (exp2term abs) es)
+       Bad msg -> Bad msg
+
+
+-- error parser: 
+selectParser prs strategy _ _ _ = Bad $ "Parser '" ++ prs ++ "' not defined with strategy: " ++ strategy 
+
+cnv_forests FMeta         = FMeta
+cnv_forests (FNode (Name (CId n) p) fss) = FNode (Name (Ident.IC n) (map cnv_profile p)) (map (map cnv_forests) fss)
+cnv_forests (FString x)   = FString x
+cnv_forests (FInt    x)   = FInt    x
+cnv_forests (FFloat  x)   = FFloat  x
+
+cnv_profile (Unify    x) = Unify x
+cnv_profile (Constant x) = Constant (cnv_forests2 x)
+
+cnv_forests2 FMeta         = FMeta
+cnv_forests2 (FNode (CId n) fss) = FNode (Ident.IC n) (map (map cnv_forests2) fss)
+cnv_forests2 (FString x)   = FString x
+cnv_forests2 (FInt    x)   = FInt    x
+cnv_forests2 (FFloat  x)   = FFloat  x
+
+----------------------------------------------------------------------
+-- parse trees to GF terms
+
+tree2term :: Ident.Ident -> SyntaxTree Fun -> Grammar.Term
+tree2term abs (TNode f ts) = Macros.mkApp (Macros.qq (abs,f)) (map (tree2term abs) ts)
+tree2term abs (TString  s) = Macros.string2term s
+tree2term abs (TInt     n) = Macros.int2term    n
+tree2term abs (TFloat   f) = Macros.float2term  f
+tree2term abs (TMeta)      = Macros.mkMeta 0
+
+exp2term :: Ident.Ident -> AbsGFCC.Exp -> Grammar.Term
+exp2term abs (AbsGFCC.DTr _ a es) =  ---- TODO: bindings
+  Macros.mkApp (atom2term abs a) (map (exp2term abs) es)
+
+atom2term :: Ident.Ident -> AbsGFCC.Atom -> Grammar.Term
+atom2term abs (AbsGFCC.AC (CId f)) = Macros.qq (abs,Ident.IC f)
+atom2term abs (AbsGFCC.AS s) = Macros.string2term s
+atom2term abs (AbsGFCC.AI n) = Macros.int2term    n
+atom2term abs (AbsGFCC.AF f) = Macros.float2term  f
+atom2term abs (AbsGFCC.AM i) = Macros.mkMeta (fromInteger i)
+
+----------------------------------------------------------------------
+-- conversion and unification of forests
+
+-- simplest implementation
+applyProfileToForest :: SyntaxForest Name -> [SyntaxForest Fun]
+applyProfileToForest (FNode name@(Name fun profile) children) 
+    | isCoercion name = concat chForests
+    | otherwise       = [ FNode fun chForests | not (null chForests) ]
+    where chForests   = concat [ applyProfileM unifyManyForests profile forests |
+				 forests0 <- children,
+				 forests <- mapM applyProfileToForest forests0 ]
+applyProfileToForest (FString s) = [FString s]
+applyProfileToForest (FInt    n) = [FInt    n]
+applyProfileToForest (FFloat  f) = [FFloat  f]
+applyProfileToForest (FMeta)     = [FMeta]
+
+{-
+-- more intelligent(?) implementation
+applyProfileToForest (FNode (Name name profile) children) 
+    | isCoercion name = concat chForests
+    | otherwise       = [ FNode name chForests | not (null chForests) ]
+    where chForests   = concat [ mapM (checkProfile forests) profile |
+				 forests0 <- children,
+				 forests <- mapM applyProfileToForest forests0 ]
+-}
+
+
diff --git a/src-2.9/GF/Parsing/MCFG.hs b/src-2.9/GF/Parsing/MCFG.hs
new file mode 100644
index 000000000..bda3af675
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG.hs
@@ -0,0 +1,68 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/11 10:28:16 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- MCFG parsing
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG
+    (parseMCF, module GF.Parsing.MCFG.PInfo) where
+
+import GF.Data.Operations (Err(..))
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Parsing.MCFG.PInfo
+
+import qualified GF.Parsing.MCFG.Naive as Naive
+import qualified GF.Parsing.MCFG.Active as Active
+import qualified GF.Parsing.MCFG.FastActive as FastActive
+-- import qualified GF.Parsing.MCFG.Active2 as Active2
+import qualified GF.Parsing.MCFG.Incremental as Incremental
+-- import qualified GF.Parsing.MCFG.Incremental2 as Incremental2
+
+----------------------------------------------------------------------
+-- parsing
+
+parseMCF :: (Ord c, Ord n, Ord l, Ord t) => String -> Err (MCFParser c n l t)
+parseMCF prs | prs `elem` strategies = Ok $ parseMCF' prs
+	     | otherwise = Bad $ "MCFG parsing strategy not defined: " ++ prs 
+
+
+strategies = words "bottomup topdown n an ab at i rn ran rab rat ri ft fb"
+
+
+parseMCF' :: (Ord c, Ord n, Ord l, Ord t) => String -> MCFParser c n l t
+
+parseMCF' "bottomup" pinfo starts toks = parseMCF' "fb" pinfo starts toks 
+parseMCF' "topdown"  pinfo starts toks = parseMCF' "ft" pinfo starts toks 
+
+parseMCF' "n"  pinfo starts toks = Naive.parse pinfo starts toks 
+parseMCF' "an" pinfo starts toks = Active.parse "n" pinfo starts toks 
+parseMCF' "ab" pinfo starts toks = Active.parse "b" pinfo starts toks 
+parseMCF' "at" pinfo starts toks = Active.parse "t" pinfo starts toks 
+parseMCF' "i"  pinfo starts toks = Incremental.parse pinfo starts toks 
+
+-- parseMCF' "an2" pinfo starts toks = Active2.parse "n" pinfo starts toks 
+-- parseMCF' "ab2" pinfo starts toks = Active2.parse "b" pinfo starts toks 
+-- parseMCF' "at2" pinfo starts toks = Active2.parse "t" pinfo starts toks 
+-- parseMCF' "i2"  pinfo starts toks = Incremental2.parse pinfo starts toks
+
+parseMCF' "rn"  pinfo starts toks = Naive.parseR (rrP pinfo toks) starts 
+parseMCF' "ran" pinfo starts toks = Active.parseR "n" (rrP pinfo toks) starts 
+parseMCF' "rab" pinfo starts toks = Active.parseR "b" (rrP pinfo toks) starts 
+parseMCF' "rat" pinfo starts toks = Active.parseR "t" (rrP pinfo toks) starts 
+parseMCF' "ri"  pinfo starts toks = Incremental.parseR (rrP pinfo toks) starts ntoks
+    where ntoks = snd (inputBounds toks)
+
+parseMCF' "fb" pinfo starts toks = FastActive.parse "b" (rrP pinfo toks) starts 
+parseMCF' "ft" pinfo starts toks = FastActive.parse "t" (rrP pinfo toks) starts 
+
+rrP pi = rangeRestrictPInfo pi
diff --git a/src-2.9/GF/Parsing/MCFG/Active.hs b/src-2.9/GF/Parsing/MCFG/Active.hs
new file mode 100644
index 000000000..c6e9c6b06
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG/Active.hs
@@ -0,0 +1,318 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/08 09:01:25 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- MCFG parsing, the active algorithm
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG.Active (parse, parseR) where
+
+import GF.Data.GeneralDeduction
+import GF.Data.Assoc
+
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.Utilities
+
+import GF.Parsing.MCFG.Range
+import GF.Parsing.MCFG.PInfo
+
+import GF.System.Tracing
+
+import Control.Monad (guard)
+
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+-- * parsing
+
+parse :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
+parse strategy pinfo starts toks =
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs)) |
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
+    where chart = process strategy pinfo starts toks
+
+-- parseR :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
+parseR strategy pinfo starts =
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs))  |
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
+    where chart = processR strategy pinfo starts 
+
+process :: (Ord n, Ord c, Ord l, Ord t) => 
+	   String -> MCFPInfo c n l t -> [c] -> Input t -> AChart c n l
+process strategy pinfo starts toks 
+    = tracePrt "MCFG.Active - chart size" prtSizes $
+      buildChart keyof (complete : combine : convert : rules) axioms
+    where rules  | isNil strategy = [scan]
+		 | isBU  strategy = [scan, predictKilbury pinfo toks]
+		 | isTD  strategy = [scan, predictEarley pinfo toks]
+	  axioms | isNil strategy = predict pinfo toks
+		 | isBU  strategy = {- terminal pinfo toks ++ -} initialScan pinfo toks
+		 | isTD  strategy = initial pinfo starts toks
+
+--processR :: (Ord n, Ord c, Ord l) => 
+--	    String -> MCFPInfo c n l Range -> [c] -> AChart c n l
+processR strategy pinfo starts  
+    = tracePrt "MCFG.Active Range - chart size" prtSizes $
+      -- tracePrt "MCFG.Active Range - final chart" prtChart $
+      buildChart keyof (complete : combine : convert : rules) axioms
+    where rules  | isNil strategy = [scan]
+		 | isBU  strategy = [scan, predictKilburyR pinfo]
+		 | isTD  strategy = [scan, predictEarleyR pinfo]
+	  axioms | isNil strategy = predictR pinfo
+		 | isBU  strategy = {- terminalR pinfo ++ -} initialScanR pinfo
+		 | isTD  strategy = initialR pinfo starts
+
+isNil s = s=="n"
+isBU  s = s=="b"
+isTD  s = s=="t"
+
+-- used in prediction
+emptyChildren :: Abstract c n -> [RangeRec l]
+emptyChildren (Abs _ rhs _) = replicate (length rhs) []
+
+makeMaxRange (Range (_, j)) = Range (j, j)
+makeMaxRange EmptyRange     = EmptyRange
+
+
+----------------------------------------------------------------------
+-- * inference rules
+
+-- completion
+complete :: (Ord c, Ord n, Ord l) => AChart c n l -> Item c n l -> [Item c n l]
+complete _ (Active rule found rng (Lin l []) (lin:lins) recs) = 
+    return $ Active rule (found ++ [(l, rng)]) EmptyRange lin lins recs 
+complete _ _ = []
+
+-- scanning
+scan :: (Ord c, Ord n, Ord l) => AChart c n l -> Item c n l -> [Item c n l]
+scan _ (Active rule found rng (Lin l (Tok rng':syms)) lins recs) = 
+    do rng'' <- concatRange rng rng' 
+       return $ Active rule found rng'' (Lin l syms) lins recs 
+scan _ _ = []
+
+-- | Creates an Active Item every time it is possible to combine 
+-- an Active Item from the agenda with a Passive Item from the Chart 
+combine :: (Ord c, Ord n, Ord l) => AChart c n l -> Item c n l -> [Item c n l]
+combine chart item@(Active _ _ _ (Lin _ (Cat (c,_,_):_)) _ _) =
+    do Passive _c found <- chartLookup chart (Pass c)
+       combine2 chart found item
+combine chart (Passive c found) = 
+    do item <- chartLookup chart (Act c)
+       combine2 chart found item
+combine _ _ = []      
+
+combine2 chart found' (Active rule found rng (Lin l (Cat (c, r, d):syms)) lins recs) =
+    do rng' <- projection r found'
+       rng'' <- concatRange rng rng'
+       recs' <- unifyRec recs d found'
+       return $ Active rule found rng'' (Lin l syms) lins recs'
+
+-- | Active Items with nothing to find are converted to Final items,
+-- which in turn are converted to Passive Items
+convert :: (Ord c, Ord n, Ord l) => AChart c n l -> Item c n l -> [Item c n l]
+convert _ (Active rule found rng (Lin lbl []) [] recs) = 
+    return $ Final rule (found ++ [(lbl,rng)]) recs
+convert _ (Final (Abs cat _ _) found _) = 
+    return $ Passive cat found
+convert _ _ = []
+
+
+----------------------------------------------------------------------
+-- Naive --
+
+predict :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l]
+predict pinfo toks = tracePrt "MCFG.Active (Naive) - predicted rules" (prt . length) $
+		     do (Rule abs (Cnc _ _ lins)) <- rulesMatchingInput pinfo toks
+			(lin':lins') <- rangeRestRec toks lins
+			return $ Active abs [] EmptyRange lin' lins' (emptyChildren abs)
+
+
+----------------------------------------------------------------------
+-- NaiveR --
+
+predictR :: (Ord c, Ord n, Ord l) => MCFPInfo c n l Range -> [Item c n l]
+predictR pinfo = tracePrt "MCFG.Active (Naive Range) - predicted rules" (prt . length) $
+		 do (Rule abs (Cnc _ _ (lin:lins))) <- allRules pinfo 
+		    return $ Active abs [] EmptyRange lin lins (emptyChildren abs)
+
+
+----------------------------------------------------------------------
+-- Earley --
+
+-- anropas med alla startkategorier
+initial :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> [c] -> Input t -> [Item c n l]
+initial pinfo starts toks = 
+    tracePrt "MCFG.Active (Earley) - initial rules" (prt . length) $
+    do cat <- starts
+       Rule abs (Cnc _ _ lins) <- topdownRules pinfo ? cat
+       lin' : lins' <- rangeRestRec toks lins 
+       return $ Active abs [] (Range (0, 0)) lin' lins' (emptyChildren abs)
+
+predictEarley :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t
+	      -> AChart c n l -> Item c n l -> [Item c n l]
+predictEarley pinfo toks _ item@(Active (Abs _ _ f) _ rng (Lin _ (Cat (cat,_,_):_)) _ _) = 
+    topdownRules pinfo ? cat >>= predictEarley2 toks rng 
+predictEarley _ _ _ _ = []
+
+predictEarley2 :: (Ord c, Ord n, Ord l, Ord t) => Input t -> Range -> MCFRule c n l t -> [Item c n l]
+predictEarley2 toks _ (Rule abs@(Abs _ [] _) (Cnc _ _ lins)) = 
+    do lins' <- rangeRestRec toks lins 
+       return $ Final abs (makeRangeRec lins') []
+predictEarley2 toks rng (Rule abs (Cnc _ _ lins)) =
+    do lin' : lins' <- rangeRestRec toks lins 
+       return $ Active abs [] EmptyRange lin' lins' (emptyChildren abs)
+
+
+----------------------------------------------------------------------
+-- Earley Range --
+
+initialR :: (Ord c, Ord n, Ord l) => MCFPInfo c n l Range -> [c] -> [Item c n l]
+initialR pinfo starts = 
+    tracePrt "MCFG.Active (Earley Range) - initial rules" (prt . length) $
+    do cat <- starts
+       Rule abs (Cnc _ _ (lin : lins)) <- topdownRules pinfo ? cat
+       return $ Active abs [] (Range (0, 0)) lin lins (emptyChildren abs)
+
+predictEarleyR :: (Ord c, Ord n, Ord l) => MCFPInfo c n l Range
+	      -> AChart c n l -> Item c n l -> [Item c n l]
+predictEarleyR pinfo _ item@(Active (Abs _ _ f) _ rng (Lin _ (Cat (cat,_,_):_)) _ _) = 
+    topdownRules pinfo ? cat >>= predictEarleyR2 rng 
+predictEarleyR _ _ _ = []
+
+predictEarleyR2 :: (Ord c, Ord n, Ord l) => Range -> MCFRule c n l Range -> [Item c n l]
+predictEarleyR2 _ (Rule abs@(Abs _ [] _) (Cnc _ _ lins)) = 
+    return $ Final abs (makeRangeRec lins) []
+predictEarleyR2 rng (Rule abs (Cnc _ _ (lin : lins))) =
+    return $ Active abs [] EmptyRange lin lins (emptyChildren abs)
+
+
+----------------------------------------------------------------------
+-- Kilbury --
+
+-- terminal :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l]
+-- terminal pinfo toks = 
+--     tracePrt "MCFG.Active (Kilbury) - initial terminal rules" (prt . length) $
+--     do Rule abs (Cnc _ _ lins) <- emptyRules pinfo
+--        lins' <- rangeRestRec toks lins 
+--        return $ Final abs (makeRangeRec lins') []
+
+initialScan :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l]
+initialScan pinfo toks =
+    tracePrt "MCFG.Active (Kilbury) - initial scanned rules + epsilon rules" (prt . length) $
+    do tok <- aElems (inputToken toks)
+       Rule abs (Cnc _ _ lins) <- 
+           leftcornerTokens pinfo ? tok ++ 
+           epsilonRules pinfo
+       lin' : lins' <- rangeRestRec toks lins
+       return $ Active abs [] EmptyRange lin' lins' (emptyChildren abs)
+
+predictKilbury :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t
+	       -> AChart c n l -> Item c n l -> [Item c n l]
+predictKilbury pinfo toks _ (Passive cat found) = 
+    do Rule abs (Cnc _ _ (Lin l (Cat (_,r,i):syms) : lins)) <- leftcornerCats pinfo ? cat
+       lin' : lins' <- rangeRestRec toks (Lin l syms : lins)
+       rng <- projection r found
+       children <- unifyRec (emptyChildren abs) i found 
+       return $ Active abs [] rng lin' lins' children
+predictKilbury _ _ _ _ = []
+
+
+
+----------------------------------------------------------------------
+-- KilburyR --
+
+-- terminalR :: (Ord c, Ord n, Ord l) => MCFPInfo c n l Range -> [Item c n l]
+-- terminalR pinfo = 
+--     tracePrt "MCFG.Active (Kilbury Range) - initial terminal rules" (prt . length) $
+--     do Rule abs (Cnc _ _ lins) <- emptyRules pinfo
+--        return $ Final abs (makeRangeRec lins) []
+
+initialScanR :: (Ord c, Ord n, Ord l) => MCFPInfo c n l Range -> [Item c n l]
+initialScanR pinfo =
+    tracePrt "MCFG.Active (Kilbury Range) - initial scanned rules" (prt . length) $
+    do Rule abs (Cnc _ _ (lin : lins)) <- 
+           concatMap snd (aAssocs (leftcornerTokens pinfo)) ++
+           epsilonRules pinfo
+       return $ Active abs [] EmptyRange lin lins (emptyChildren abs)
+
+predictKilburyR :: (Ord c, Ord n, Ord l) => MCFPInfo c n l Range
+	       -> AChart c n l -> Item c n l -> [Item c n l]
+predictKilburyR pinfo _ (Passive cat found) = 
+    do Rule abs (Cnc _ _ (Lin l (Cat (_,r,i):syms) : lins)) <- leftcornerCats pinfo ? cat
+       rng <- projection r found
+       children <- unifyRec (emptyChildren abs) i found 
+       return $ Active abs [] rng (Lin l syms) lins children
+predictKilburyR _ _ _ = []
+
+
+----------------------------------------------------------------------
+-- * type definitions
+
+type AChart c n l = ParseChart (Item c n l) (AKey c) 
+
+data Item   c n l = Active (Abstract c n) 
+                           (RangeRec l)  
+			   Range 
+			   (Lin c l Range) 
+			   (LinRec c l Range) 
+			   [RangeRec l]
+		  | Final (Abstract c n) (RangeRec l) [RangeRec l]
+		  | Passive c (RangeRec l)
+		     deriving (Eq, Ord, Show)
+
+data AKey       c = Act c
+		  | Pass c
+		  | Useless
+		  | Fin
+		    deriving (Eq, Ord, Show)
+
+
+keyof :: Item c n l -> AKey c
+keyof (Active _ _ _ (Lin _ (Cat (next, _, _):_)) _ _) = Act next
+keyof (Final _ _ _) = Fin
+keyof (Passive cat _) = Pass cat
+keyof _ = Useless
+
+
+----------------------------------------------------------------------
+-- for tracing purposes
+
+prtSizes chart = "final=" ++ show (length (chartLookup chart Fin)) ++
+		 ", passive=" ++ show (sum [length (chartLookup chart k) | 
+					    k@(Pass _) <- chartKeys chart ]) ++
+		 ", active=" ++ show (sum [length (chartLookup chart k) | 
+					   k@(Act _) <- chartKeys chart ]) ++
+		 ", useless=" ++ show (length (chartLookup chart Useless)) 
+
+prtChart chart = concat [ "\n*** KEY: " ++ prt k ++ 
+			  prtBefore "\n  " (chartLookup chart k) | 
+			  k <- chartKeys chart ] 
+
+prtFinals chart = prtBefore "\n  " (chartLookup chart Fin) 
+
+instance (Print c, Print n, Print l) => Print (Item c n l) where
+    prt (Active abs found rng lin tofind children) = 
+	"? " ++ prt abs ++ ";\n\t" ++ 
+	"{" ++ prtSep " " found ++ "}  " ++ prt rng ++ " . " ++ 
+	prt lin ++ "  {" ++ prtSep " " tofind ++ "}" ++
+        ( if null children then ";" else ";\n\t" ++
+	  "{" ++ prtSep "}  {" (map (prtSep " ") children) ++ "}" )
+    prt (Passive c rrec) = "- " ++ prt c ++ "; {" ++ prtSep " " rrec ++ "}"
+    prt (Final abs rr rrs) = ": " ++ prt abs ++ ";\n\t{" ++ prtSep " " rr ++ "}" ++ 
+			     ( if null rrs then ";" else ";\n\t" ++ 
+			       "{" ++ prtSep "}  {" (map (prtSep " ") rrs) ++ "}" )
+
+instance Print c => Print (AKey c) where
+    prt (Act c) = "Active " ++ prt c
+    prt (Pass c) = "Passive " ++ prt c
+    prt (Fin) = "Final"
+    prt (Useless) = "Useless"
diff --git a/src-2.9/GF/Parsing/MCFG/Active2.hs b/src-2.9/GF/Parsing/MCFG/Active2.hs
new file mode 100644
index 000000000..7ad8627bc
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG/Active2.hs
@@ -0,0 +1,237 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/08 09:01:25 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.2 $
+--
+-- MCFG parsing, the active algorithm (alternative version)
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG.Active2 (parse) where
+
+import GF.Data.GeneralDeduction
+import GF.Data.Assoc
+
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.Utilities
+
+import GF.Parsing.MCFG.Range
+import GF.Parsing.MCFG.PInfo
+
+import GF.System.Tracing
+
+import Control.Monad (guard)
+
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+-- * parsing
+
+--parse :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
+parse strategy pinfo starts toks =
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs)) |
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
+    where chart = process strategy pinfo starts toks
+
+process :: (Ord n, Ord c, Ord l, Ord t) => 
+	   String -> MCFPInfo c n l t -> [c] -> Input t -> AChart c n l t
+process strategy pinfo starts toks 
+    = tracePrt "MCFG.Active - chart size" prtSizes $
+      buildChart keyof (complete : combine : convert : rules) axioms
+    where rules  | isNil strategy = [scan toks]
+		 | isBU  strategy = [scan toks, predictKilbury pinfo toks]
+		 | isTD  strategy = [scan toks, predictEarley pinfo toks]
+	  axioms | isNil strategy = predict pinfo toks
+		 | isBU  strategy = terminal pinfo toks ++ initialScan pinfo toks
+		 | isTD  strategy = initial pinfo starts toks
+
+isNil s = s=="n"
+isBU  s = s=="b"
+isTD  s = s=="t"
+
+-- used in prediction
+emptyChildren :: Abstract c n -> [RangeRec l]
+emptyChildren (Abs _ rhs _) = replicate (length rhs) []
+
+makeMaxRange (Range (_, j)) = Range (j, j)
+makeMaxRange EmptyRange     = EmptyRange
+
+
+----------------------------------------------------------------------
+-- * inference rules
+
+-- completion
+complete :: (Ord c, Ord n, Ord l, Ord t) => AChart c n l t -> Item c n l t -> [Item c n l t]
+complete _ (Active rule found rng (Lin l []) (lin:lins) recs) = 
+    return $ Active rule (found ++ [(l, rng)]) EmptyRange lin lins recs 
+complete _ _ = []
+
+-- scanning
+--scan :: (Ord c, Ord n, Ord l, Ord t) => AChart c n l t -> Item c n l t -> [Item c n l t]
+scan inp _ (Active rule found rng (Lin l (Tok tok:syms)) lins recs) = 
+    do rng' <- map makeRange (inputToken inp ? tok)
+       rng'' <- concatRange rng rng' 
+       return $ Active rule found rng'' (Lin l syms) lins recs 
+scan _ _ _ = []
+
+-- | Creates an Active Item every time it is possible to combine 
+-- an Active Item from the agenda with a Passive Item from the Chart 
+combine :: (Ord c, Ord n, Ord l, Ord t) => AChart c n l t -> Item c n l t -> [Item c n l t]
+combine chart item@(Active _ _ _ (Lin _ (Cat (c,_,_):_)) _ _) =
+    do Passive _c found <- chartLookup chart (Pass c)
+       combine2 chart found item
+combine chart (Passive c found) = 
+    do item <- chartLookup chart (Act c)
+       combine2 chart found item
+combine _ _ = []      
+
+combine2 chart found' (Active rule found rng (Lin l (Cat (c, r, d):syms)) lins recs) =
+    do rng' <- projection r found'
+       rng'' <- concatRange rng rng'
+       recs' <- unifyRec recs d found'
+       return $ Active rule found rng'' (Lin l syms) lins recs'
+
+-- | Active Items with nothing to find are converted to Final items,
+-- which in turn are converted to Passive Items
+convert :: (Ord c, Ord n, Ord l, Ord t) => AChart c n l t -> Item c n l t -> [Item c n l t]
+convert _ (Active rule found rng (Lin lbl []) [] recs) = 
+    return $ Final rule (found ++ [(lbl,rng)]) recs
+convert _ (Final (Abs cat _ _) found _) = 
+    return $ Passive cat found
+convert _ _ = []
+
+
+----------------------------------------------------------------------
+-- Naive --
+
+predict :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l t]
+predict pinfo toks = tracePrt "MCFG.Active (Naive) - predicted rules" (prt . length) $
+		     do Rule abs (Cnc _ _ (lin:lins)) <- rulesMatchingInput pinfo toks
+			return $ Active abs [] EmptyRange lin lins (emptyChildren abs)
+
+
+----------------------------------------------------------------------
+-- Earley --
+
+-- anropas med alla startkategorier
+initial :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> [c] -> Input t -> [Item c n l t]
+initial pinfo starts toks = 
+    tracePrt "MCFG.Active (Earley) - initial rules" (prt . length) $
+    do cat <- starts
+       Rule abs (Cnc _ _ (lin:lins)) <- topdownRules pinfo ? cat
+       return $ Active abs [] (Range (0, 0)) lin lins (emptyChildren abs)
+
+predictEarley :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t
+	      -> AChart c n l t -> Item c n l t -> [Item c n l t]
+predictEarley pinfo toks _ item@(Active (Abs _ _ f) _ rng (Lin _ (Cat (cat,_,_):_)) _ _) = 
+    topdownRules pinfo ? cat >>= predictEarley2 toks rng 
+predictEarley _ _ _ _ = []
+
+predictEarley2 :: (Ord c, Ord n, Ord l, Ord t) => Input t -> Range -> MCFRule c n l t -> [Item c n l t]
+predictEarley2 toks _ (Rule abs@(Abs _ [] _) (Cnc _ _ lins)) = 
+    do lins' <- rangeRestRec toks lins 
+       return $ Final abs (makeRangeRec lins') []
+predictEarley2 toks rng (Rule abs (Cnc _ _ (lin:lins))) =
+    return $ Active abs [] EmptyRange lin lins (emptyChildren abs)
+
+
+----------------------------------------------------------------------
+-- Kilbury --
+
+terminal :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l t]
+terminal pinfo toks = 
+    tracePrt "MCFG.Active (Kilbury) - initial terminal rules" (prt . length) $
+    do Rule abs (Cnc _ _ lins) <- emptyRules pinfo
+       lins' <- rangeRestRec toks lins 
+       return $ Final abs (makeRangeRec lins') []
+
+initialScan :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l t]
+initialScan pinfo toks =
+    tracePrt "MCFG.Active (Kilbury) - initial scanned rules" (prt . length) $
+    do tok <- aElems (inputToken toks)
+       Rule abs (Cnc _ _ (lin:lins)) <- leftcornerTokens pinfo ? tok
+       return $ Active abs [] EmptyRange lin lins (emptyChildren abs)
+
+predictKilbury :: (Ord c, Ord n, Ord l, Ord t) => MCFPInfo c n l t -> Input t
+	       -> AChart c n l t -> Item c n l t -> [Item c n l t]
+predictKilbury pinfo toks _ (Passive cat found) = 
+    do Rule abs (Cnc _ _ (Lin l (Cat (_,r,i):syms) : lins)) <- leftcornerCats pinfo ? cat
+       rng <- projection r found
+       children <- unifyRec (emptyChildren abs) i found 
+       return $ Active abs [] rng (Lin l syms) lins children
+predictKilbury _ _ _ _ = []
+
+
+----------------------------------------------------------------------
+-- * type definitions
+
+type AChart c n l t = ParseChart (Item c n l t) (AKey c t) 
+
+data Item   c n l t = Active (Abstract c n) 
+                             (RangeRec l)  
+			     Range 
+			     (Lin c l t) 
+			     (LinRec c l t) 
+			     [RangeRec l]
+		    | Final (Abstract c n) (RangeRec l) [RangeRec l]
+		    | Passive c (RangeRec l)
+		      deriving (Eq, Ord, Show)
+
+data AKey       c t = Act c
+		    | ActTok t
+		    | Pass c
+		    | Useless
+		    | Fin
+		      deriving (Eq, Ord, Show)
+
+
+keyof :: Item c n l t -> AKey c t
+keyof (Active _ _ _ (Lin _ (Cat (next, _, _):_)) _ _) = Act next
+keyof (Active _ _ _ (Lin _ (Tok tok:_)) _ _) = ActTok tok
+keyof (Final _ _ _) = Fin
+keyof (Passive cat _) = Pass cat
+keyof _ = Useless
+
+
+----------------------------------------------------------------------
+-- for tracing purposes
+
+prtSizes chart = "final=" ++ show (length (chartLookup chart Fin)) ++
+		 ", passive=" ++ show (sum [length (chartLookup chart k) | 
+					    k@(Pass _) <- chartKeys chart ]) ++
+		 ", active=" ++ show (sum [length (chartLookup chart k) | 
+					   k@(Act _) <- chartKeys chart ]) ++
+		 ", active-tok=" ++ show (sum [length (chartLookup chart k) | 
+					       k@(ActTok _) <- chartKeys chart ]) ++
+		 ", useless=" ++ show (length (chartLookup chart Useless)) 
+
+prtChart chart = concat [ "\n*** KEY: " ++ prt k ++ 
+			  prtBefore "\n  " (chartLookup chart k) | 
+			  k <- chartKeys chart ] 
+
+prtFinals chart = prtBefore "\n  " (chartLookup chart Fin) 
+
+instance (Print c, Print n, Print l, Print t) => Print (Item c n l t) where
+    prt (Active abs found rng lin tofind children) = 
+	"? " ++ prt abs ++ ";\n\t" ++ 
+	"{" ++ prtSep " " found ++ "}  " ++ prt rng ++ " . " ++ 
+	prt lin ++ "  {" ++ prtSep " " tofind ++ "}" ++
+        ( if null children then ";" else ";\n\t" ++
+	  "{" ++ prtSep "}  {" (map (prtSep " ") children) ++ "}" )
+    prt (Passive c rrec) = "- " ++ prt c ++ "; {" ++ prtSep " " rrec ++ "}"
+    prt (Final abs rr rrs) = ": " ++ prt abs ++ ";\n\t{" ++ prtSep " " rr ++ "}" ++ 
+			     ( if null rrs then ";" else ";\n\t" ++ 
+			       "{" ++ prtSep "}  {" (map (prtSep " ") rrs) ++ "}" )
+
+instance (Print c, Print t) => Print (AKey c t) where
+    prt (Act c) = "Active " ++ prt c
+    prt (ActTok t) = "Active-Tok " ++ prt t
+    prt (Pass c) = "Passive " ++ prt c
+    prt (Fin) = "Final"
+    prt (Useless) = "Useless"
diff --git a/src-2.9/GF/Parsing/MCFG/FastActive.hs b/src-2.9/GF/Parsing/MCFG/FastActive.hs
new file mode 100644
index 000000000..0a8e24b55
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG/FastActive.hs
@@ -0,0 +1,176 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : Peter Ljunglöf
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- MCFG parsing, the active algorithm, optimized version
+-- structure stolen from Krasimir Angelov's GF.Parsing.FCFG.Active
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG.FastActive (parse) where
+
+import GF.Data.GeneralDeduction
+import GF.Data.Assoc
+import GF.Data.Utilities
+
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.Utilities
+
+import GF.Infra.Ident
+
+import GF.Parsing.MCFG.Range
+import GF.Parsing.MCFG.PInfo
+
+import GF.System.Tracing
+
+import Control.Monad (guard)
+
+import GF.Infra.Print
+
+import qualified Data.List as List
+import qualified Data.Map  as Map
+import qualified Data.Set  as Set
+import Data.Array
+
+----------------------------------------------------------------------
+-- * parsing
+
+-- parse :: (Ord c, Ord n, Ord l, Ord t) => String -> MCFParser c n l t
+parse strategy pinfo starts =
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs)) |
+        Final (Abs cat rhs fun) found rrecs <- listXChartFinal chart ]
+    where chart = process strategy pinfo axioms emptyXChart
+    
+          -- axioms | isBU  strategy = terminal pinfo toks ++ initialScan pinfo toks
+          axioms | isBU  strategy = initialBU pinfo
+		 | isTD  strategy = initialTD pinfo starts
+
+isBU  s = s=="b"
+isTD  s = s=="t"
+
+-- used in prediction
+emptyChildren :: Abstract c n -> [RangeRec l]
+emptyChildren (Abs _ rhs _) = replicate (length rhs) []
+
+updateChildren :: Eq l => [RangeRec l] -> Int -> RangeRec l -> [[RangeRec l]]
+updateChildren recs i rec = updateNthM update i recs
+    where update rec' = do guard (null rec' || rec' == rec)
+                           return rec
+
+process :: (Ord c, Ord n, Ord l) => String -> MCFPInfo c n l Range -> [Item c n l] -> XChart c n l -> XChart c n l
+process strategy pinfo []           chart = chart
+process strategy pinfo (item:items) chart = process strategy pinfo items $! univRule item chart
+  where
+    univRule item@(Active abs found rng (Lin l syms) lins recs) chart 
+        = case syms of
+            Cat(c,r,d) : syms' -> 
+                case insertXChart chart item c of
+	          Nothing    -> chart
+	          Just chart -> 
+                      let items = -- predict topdown
+                                  [ Active abs [] EmptyRange lin lins (emptyChildren abs) |
+	     			    isTD strategy,
+	     			    Rule abs (Cnc _ _ (lin:lins)) <- topdownRules pinfo ? c ] ++
+
+                                  -- combine
+                                  [ Active abs found rng'' (Lin l syms') lins recs' |
+                                    Final _ found' _ <- lookupXChartFinal chart c,
+                                    rng'  <- projection r found',
+	         	            rng'' <- concatRange rng rng',
+	         	            recs' <- updateChildren recs d found' ]
+	     	      in process strategy pinfo items chart
+
+            -- scan
+	    Tok rng' : syms' -> 
+                let items = [ Active abs found rng'' (Lin l syms') lins recs |
+                              rng'' <- concatRange rng rng' ]
+                in process strategy pinfo items chart
+
+            -- complete
+            [] -> case lins of
+                    (lin':lins') -> univRule (Active abs ((l,rng):found) EmptyRange lin' lins' recs) chart
+                    []           -> univRule (Final  abs (reverse ((l,rng):found))             recs) chart 
+
+    univRule item@(Final abs@(Abs cat _ _) found' recs) chart =
+      case insertXChart chart item cat of
+        Nothing    -> chart
+        Just chart -> 
+            let items = -- predict bottomup
+    			[ Active abs [] rng (Lin l syms') lins children |
+                          isBU strategy,
+			  Rule abs (Cnc _ _ (Lin l (Cat(c,r,d):syms') : lins)) <- leftcornerCats pinfo ? cat,
+                          -- lin' : lins' <- rangeRestRec toks (Lin l syms' : lins),
+                          rng <- projection r found',
+                          children <- unifyRec (emptyChildren abs) d found' ] ++
+
+                        -- combine
+                        [ Active abs found rng'' (Lin l syms') lins recs' |
+                          Active abs found rng (Lin l (Cat(c,r,d):syms')) lins recs <- lookupXChartAct chart cat,
+                          rng'  <- projection r found',
+                          rng'' <- concatRange rng rng',
+                          recs' <- updateChildren recs d found' ] 
+            in process strategy pinfo items chart
+
+----------------------------------------------------------------------
+-- * XChart
+
+data XChart c n l = XChart !(AChart c n l) !(AChart c n l)
+type AChart c n l = ParseChart (Item c n l) c
+
+data Item   c n l = Active (Abstract c n) 
+                           (RangeRec l)  
+			   Range 
+			   (Lin c l Range) 
+			   (LinRec c l Range) 
+			   [RangeRec l]
+		  | Final (Abstract c n) (RangeRec l) [RangeRec l]
+-- 		  | Passive c (RangeRec l)
+		     deriving (Eq, Ord, Show)
+
+emptyXChart :: (Ord c, Ord n, Ord l) => XChart c n l
+emptyXChart = XChart emptyChart emptyChart
+
+insertXChart (XChart actives finals) item@(Active _ _ _ _ _ _) c = 
+  case chartInsert actives item c of
+    Nothing      -> Nothing
+    Just actives -> Just (XChart actives finals)
+
+insertXChart (XChart actives finals) item@(Final _ _ _)       c =
+  case chartInsert finals item c of
+    Nothing     -> Nothing
+    Just finals -> Just (XChart actives finals)
+
+lookupXChartAct   (XChart actives finals) c = chartLookup actives c
+lookupXChartFinal (XChart actives finals) c = chartLookup finals  c
+
+listXChartAct   (XChart actives finals) = chartList actives
+listXChartFinal (XChart actives finals) = chartList finals
+
+
+----------------------------------------------------------------------
+-- Earley --
+
+-- called with all starting categories
+initialTD :: (Ord c, Ord n, Ord l) => MCFPInfo c n l Range -> [c] -> [Item c n l]
+initialTD pinfo starts = 
+    [ Active abs [] (Range (0, 0)) lin' lins' (emptyChildren abs) |
+      cat <- starts,
+      Rule abs (Cnc _ _ (lin':lins')) <- topdownRules pinfo ? cat ]
+       -- lin' : lins' <- rangeRestRec toks lins
+
+
+----------------------------------------------------------------------
+-- Kilbury --
+
+initialBU :: (Ord c, Ord n, Ord l) => MCFPInfo c n l Range -> [Item c n l]
+initialBU pinfo =
+    [ Active abs [] EmptyRange lin' lins' (emptyChildren abs) |
+      -- do tok <- aElems (inputToken toks)
+      Rule abs (Cnc _ _ (lin':lins')) <- 
+          concatMap snd (aAssocs (leftcornerTokens pinfo)) ++
+          -- leftcornerTokens pinfo ? tok ++
+          epsilonRules pinfo ]
+       -- lin' : lins' <- rangeRestRec toks lins
diff --git a/src-2.9/GF/Parsing/MCFG/Incremental.hs b/src-2.9/GF/Parsing/MCFG/Incremental.hs
new file mode 100644
index 000000000..bd5b4114d
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG/Incremental.hs
@@ -0,0 +1,178 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/08 09:01:25 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.4 $
+--
+-- MCFG parsing, the incremental algorithm
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG.Incremental (parse, parseR) where
+
+import Data.List
+import Control.Monad (guard) 
+
+import GF.Data.Utilities (select)
+import GF.Data.GeneralDeduction
+import GF.Data.Assoc
+
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.Utilities
+
+import GF.Parsing.MCFG.Range
+import GF.Parsing.MCFG.PInfo
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+-- parsing
+
+parse :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
+parse pinfo starts toks =
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs)) |
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
+    where chart = process pinfo toks ntoks
+	  ntoks = snd (inputBounds toks)
+
+-- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
+parseR pinfo starts ntoks =
+    accumAssoc groupSyntaxNodes $
+    [ ((cat, found), SNode fun (zip rhs rrecs)) |
+      Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
+    where chart = processR pinfo ntoks 
+
+process :: (Ord n, Ord c, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> Int -> IChart c n l
+process pinfo toks ntoks
+    = tracePrt "MCFG.Incremental - chart size" prtSizes $
+      buildChart keyof [complete ntoks, scan, combine, convert] (predict pinfo toks ntoks)
+
+processR :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> Int -> IChart c n l
+processR pinfo ntoks
+    = tracePrt "MCFG.Incremental Range - chart size" prtSizes $
+      buildChart keyof [complete ntoks, scan, combine, convert] (predictR pinfo ntoks)
+
+complete ::  (Ord n, Ord c, Ord l) => Int -> IChart c n l -> Item c n l -> [Item c n l]
+complete ntoks _ (Active rule found rng (Lin l []) lins recs) = 
+    do (lin, lins') <- select lins
+       k <- [minRange rng .. ntoks]
+       return $ Active rule (found ++ [(l, rng)]) (Range (k,k)) lin lins' recs 
+complete _ _ _ = []
+
+
+predict :: (Ord n, Ord c, Ord l, Ord t) => MCFPInfo c n l t -> Input t -> Int -> [Item c n l]
+predict pinfo toks n = 
+    tracePrt "MCFG.Incremental - predicted rules" (prt . length) $
+    do Rule abs@(Abs _ rhs _) (Cnc _ _ lins) <- rulesMatchingInput pinfo toks
+       let daughters = replicate (length rhs) []
+       lins' <- rangeRestRec toks lins
+       (lin', lins'') <- select lins'
+       k <- [0..n] 
+       return $ Active abs [] (Range (k,k)) lin' lins'' daughters 
+
+
+predictR :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> Int -> [Item c n l]
+predictR pinfo n = 
+    tracePrt "MCFG.Incremental Range - predicted rules" (prt . length) $
+    do Rule abs@(Abs _ rhs _) (Cnc _ _ lins) <- allRules pinfo 
+       let daughters = replicate (length rhs) []
+       (lin, lins') <- select lins
+       k <- [0..n] 
+       return $ Active abs [] (Range (k,k)) lin lins' daughters 
+
+
+scan :: (Ord n, Ord c, Ord l) => IChart c n l -> Item c n l -> [Item c n l]
+scan _ (Active abs found rng (Lin l (Tok rng':syms)) lins recs) = 
+    do rng'' <- concatRange rng rng' 
+       return $ Active abs found rng'' (Lin l syms) lins recs 
+scan _ _ = []
+
+
+combine :: (Ord n, Ord c, Ord l) => IChart c n l -> Item c n l -> [Item c n l]
+combine chart active@(Active _ _ rng (Lin _ (Cat (c,l,_):_)) _ _) = 
+    do passive <- chartLookup chart (Pass c l (maxRange rng))
+       combine2 active passive
+combine chart passive@(Active (Abs c _ _) _ rng (Lin l []) _ _) = 
+    do active <- chartLookup chart (Act c l (minRange rng))
+       combine2 active passive
+combine _ _ = [] 
+
+combine2 (Active abs found rng (Lin l (Cat (c,l',d):syms)) lins recs) 
+	     (Active _ found' rng' _ _ _)
+    = do rng'' <- concatRange rng rng' 
+	 recs' <- unifyRec recs d found''
+	 return $ Active abs found rng'' (Lin l syms) lins recs'
+    where found'' = found' ++ [(l',rng')]
+
+
+convert _ (Active rule found rng (Lin lbl []) [] recs) = 
+    return $ Final rule (found ++ [(lbl,rng)]) recs
+convert _ _ = []
+
+----------------------------------------------------------------------
+-- type definitions
+
+type IChart c n l = ParseChart (Item c n l) (IKey c l) 
+
+data Item   c n l = Active (Abstract c n) 
+                           (RangeRec l) 
+			   Range 
+			   (Lin c l Range) 
+			   (LinRec c l Range) 
+			   [RangeRec l]
+		  | Final (Abstract c n) (RangeRec l) [RangeRec l]
+--		  | Passive c (RangeRec l) 
+		    deriving (Eq, Ord, Show)
+
+data IKey     c l = Act c l Int
+                  | Pass c l Int
+		  | Useless
+		  | Fin
+		    deriving (Eq, Ord, Show)
+
+keyof :: Item c n l -> IKey c l
+keyof (Active _ _ rng (Lin _ (Cat (next,lbl,_):_)) _ _) 
+    = Act next lbl (maxRange rng)
+keyof (Active (Abs cat _ _) found rng (Lin lbl []) _ _) 
+    = Pass cat lbl (minRange rng)
+keyof (Final _ _ _) = Fin
+keyof _                                                       
+    = Useless
+
+
+----------------------------------------------------------------------
+-- for tracing purposes
+prtSizes chart = "final=" ++ show (length (chartLookup chart Fin)) ++
+		 ", passive=" ++ show (sum [length (chartLookup chart k) | 
+					    k@(Pass _ _ _) <- chartKeys chart ]) ++
+		 ", active=" ++ show (sum [length (chartLookup chart k) | 
+					   k@(Act _ _ _) <- chartKeys chart ]) ++
+		 ", useless=" ++ show (length (chartLookup chart Useless)) 
+
+prtChart chart = concat [ "\n*** KEY: " ++ prt k ++ 
+			  prtBefore "\n  " (chartLookup chart k) | 
+			  k <- chartKeys chart ] 
+
+instance (Print c, Print n, Print l) => Print (Item c n l) where
+    prt (Active abs found rng lin tofind children) = 
+	"? " ++ prt abs ++ ";\n\t" ++ 
+	"{" ++ prtSep " " found ++ "} " ++ prt rng ++ " . " ++ 
+	prt lin ++ "{" ++ prtSep " " tofind ++ "}" ++
+        ( if null children then ";" else ";\n\t" ++
+	  "{" ++ prtSep "} {" (map (prtSep " ") children) ++ "}" )
+--    prt (Passive c rrec) = "- " ++ prt c ++ "; {" ++ prtSep " " rrec ++ "}"
+    prt (Final abs rr rrs) = ": " ++ prt abs ++ ";\n\t{" ++ prtSep " " rr ++ "}" ++ 
+			     ( if null rrs then ";" else ";\n\t" ++ 
+			       "{" ++ prtSep "} {" (map (prtSep " ") rrs) ++ "}" )
+
+instance (Print c, Print l) => Print (IKey c l) where
+    prt (Act c l i) = "Active " ++ prt c ++ " " ++ prt l ++ " @ " ++ prt i
+    prt (Pass c l i) = "Passive " ++ prt c ++ " " ++ prt l ++ " @ " ++ prt i
+    prt (Fin) = "Final"
+    prt (Useless) = "Useless"
diff --git a/src-2.9/GF/Parsing/MCFG/Incremental2.hs b/src-2.9/GF/Parsing/MCFG/Incremental2.hs
new file mode 100644
index 000000000..db6c3084e
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG/Incremental2.hs
@@ -0,0 +1,157 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/08 09:01:25 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.3 $
+--
+-- MCFG parsing, the incremental algorithm (alternative version)
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG.Incremental2 (parse) where
+
+import Data.List
+import Data.Array
+import Control.Monad (guard) 
+
+import GF.Data.Utilities (select)
+import GF.Data.Assoc 
+import GF.Data.IncrementalDeduction
+
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.Utilities
+
+import GF.Parsing.MCFG.Range
+import GF.Parsing.MCFG.PInfo
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+-- parsing
+
+-- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
+parse pinfo starts inp =
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs)) |
+        k <- uncurry enumFromTo (inputBounds inp),
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart k Fin ]
+    where chart = process pinfo inp 
+
+--process :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> (Int, Int) -> IChart c n l
+process pinfo inp
+    = tracePrt "MCFG.Incremental - chart size" 
+          (prt . map (prtSizes finalChart . fst) . assocs) $ 
+      finalChart
+    where finalChart    = buildChart keyof rules axioms inBounds
+	  axioms k      = tracePrt ("MCFG.Incremental - axioms for " ++ show k) (prt . length) $
+			  predict k ++ scan k ++ complete1 k 
+	  rules  k item = complete2 k item ++ combine k item ++ convert k item
+	  inBounds      = inputBounds inp
+
+          -- axioms: predict + scan + complete
+	  predict k = do Rule abs@(Abs _ rhs _) (Cnc _ _ lins) <- rulesMatchingInput pinfo inp
+			 let daughters = replicate (length rhs) []
+			 (lin, lins') <- select lins
+			 return $ Active abs [] k lin lins' daughters 
+
+	  scan k = do (tok, js) <- aAssocs (inputTo inp ! k)
+		      j <- js
+		      Active abs found i (Lin l (Tok _tok:syms)) lins recs <- 
+			  chartLookup finalChart j (ActTok tok)
+		      return $ Active abs found i  (Lin l syms) lins recs 
+
+	  complete1 k = do j <- [fst inBounds .. k-1]
+			   Active abs found i (Lin l _Nil) lins recs <- 
+			       chartLookup finalChart j Pass
+			   let found' = found ++ [(l, makeRange (i,j))]
+			   (lin, lins') <- select lins
+			   return $ Active abs found' k lin lins' recs 
+
+          -- rules: convert + combine + complete
+	  convert k (Active rule found j (Lin lbl []) [] recs) = 
+	      let found' = found ++ [(lbl, makeRange (j,k))]
+	       in return $ Final rule found' recs
+	  convert _ _ = []
+
+	  combine k (Active (Abs cat _ _) found' j (Lin lbl []) _ _) = 
+	      do guard (j < k) ---- cannot handle epsilon-rules
+		 Active abs found i (Lin l (Cat (_cat,_lbl,nr):syms)) lins recs <- 
+		     chartLookup finalChart j (Act cat lbl)
+		 let found'' = found' ++ [(lbl, makeRange (j,k))]
+		 recs' <- unifyRec recs nr found''
+		 return $ Active abs found i (Lin l syms) lins recs'
+	  combine _ _ = []
+
+	  complete2 k (Active abs found i (Lin l []) lins recs) =
+	      do let found' = found ++ [(l, makeRange (i,k))]
+		 (lin, lins') <- select lins
+		 return $ Active abs found' k lin lins' recs 
+	  complete2 _ _ = []
+
+----------------------------------------------------------------------
+-- type definitions
+
+type IChart c n l t = IncrementalChart (Item c n l t) (IKey c l t) 
+
+data Item   c n l t = Active (Abstract c n) 
+                             (RangeRec l) 
+			     Int 
+			     (Lin c l t) 
+			     (LinRec c l t) 
+			     [RangeRec l]
+		    | Final (Abstract c n) (RangeRec l) [RangeRec l]
+		    ---- | Passive c (RangeRec l) 
+		      deriving (Eq, Ord, Show)
+
+data IKey     c l t = Act c l 
+		    | ActTok t
+		    ---- | Useless
+		    | Pass
+		    | Fin
+		      deriving (Eq, Ord, Show)
+
+keyof :: Item c n l t -> IKey c l t
+keyof (Active _ _ _ (Lin _ (Cat (next,lbl,_):_)) _ _) = Act next lbl 
+keyof (Active _ _ _ (Lin _ (Tok tok:_)) _ _) = ActTok tok 
+keyof (Active _ _ _ (Lin _ []) _ _) = Pass
+keyof (Final _ _ _) = Fin
+-- keyof _ = Useless
+
+
+----------------------------------------------------------------------
+-- for tracing purposes
+prtSizes chart k = "f=" ++ show (length (chartLookup chart k Fin)) ++
+		   " p=" ++ show (length (chartLookup chart k Pass)) ++ 
+		   " a=" ++ show (sum [length (chartLookup chart k key) | 
+					     key@(Act _ _) <- chartKeys chart k ]) ++
+		   " t=" ++ show (sum [length (chartLookup chart k key) | 
+						 key@(ActTok _) <- chartKeys chart k ]) 
+		   -- " u=" ++ show (length (chartLookup chart k Useless)) 
+
+-- prtChart chart = concat [ "\n*** KEY: " ++ prt k ++ 
+-- 			  prtBefore "\n  " (chartLookup chart k) | 
+-- 			  k <- chartKeys chart ] 
+
+instance (Print c, Print n, Print l, Print t) => Print (Item c n l t) where
+    prt (Active abs found rng lin tofind children) = 
+	"? " ++ prt abs ++ ";\n\t" ++ 
+	"{" ++ prtSep " " found ++ "} " ++ prt rng ++ " . " ++ 
+	prt lin ++ "{" ++ prtSep " " tofind ++ "}" ++
+        ( if null children then ";" else ";\n\t" ++
+	  "{" ++ prtSep "} {" (map (prtSep " ") children) ++ "}" )
+    -- prt (Passive c rrec) = "- " ++ prt c ++ "; {" ++ prtSep " " rrec ++ "}"
+    prt (Final abs rr rrs) = ": " ++ prt abs ++ ";\n\t{" ++ prtSep " " rr ++ "}" ++ 
+			     ( if null rrs then ";" else ";\n\t" ++ 
+			       "{" ++ prtSep "} {" (map (prtSep " ") rrs) ++ "}" )
+
+instance (Print c, Print l, Print t) => Print (IKey c l t) where
+    prt (Act c l) = "Active " ++ prt c ++ " " ++ prt l
+    prt (ActTok t) = "ActiveTok " ++ prt t
+    -- prt (Pass c l i) = "Passive " ++ prt c ++ " " ++ prt l ++ " @ " ++ prt i
+    prt (Fin) = "Final"
+    -- prt (Useless) = "Useless"
diff --git a/src-2.9/GF/Parsing/MCFG/Naive.hs b/src-2.9/GF/Parsing/MCFG/Naive.hs
new file mode 100644
index 000000000..7d1fa0a8a
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG/Naive.hs
@@ -0,0 +1,142 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/08 09:01:25 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- MCFG parsing, the naive algorithm
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG.Naive (parse, parseR) where
+
+import Control.Monad (guard)
+
+-- GF modules
+import GF.Data.GeneralDeduction
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.Utilities
+import GF.Parsing.MCFG.Range
+import GF.Parsing.MCFG.PInfo
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.System.Tracing
+
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+-- * parsing
+
+-- | Builds a chart from the initial agenda, given by prediction, and the inference rules 
+parse :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t
+parse pinfo starts toks
+    = accumAssoc groupSyntaxNodes $
+        [ ((cat, makeRangeRec lins), SNode fun (zip rhs rrecs)) |
+          Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ]
+    where chart = process pinfo toks
+
+-- | Builds a chart from the initial agenda, given by prediction, and the inference rules 
+-- parseR :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t
+parseR pinfo starts
+    = accumAssoc groupSyntaxNodes $
+        [ ((cat, makeRangeRec lins), SNode fun (zip rhs rrecs)) |
+	  Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ]
+    where chart = processR pinfo
+
+process :: (Ord t, Ord n, Ord c, Ord l) => MCFPInfo c n l t -> Input t -> NChart c n l
+process pinfo toks
+    = tracePrt "MCFG.Naive - chart size" prtSizes $
+      buildChart keyof [convert, combine] (predict pinfo toks)
+
+processR :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> NChart c n l
+processR pinfo
+    = tracePrt "MCFG.Naive Range - chart size" prtSizes $
+      buildChart keyof [convert, combine] (predictR pinfo)
+
+
+----------------------------------------------------------------------
+-- * inference rules
+
+-- Creates an Active Item of every Rule in the Grammar to give the initial Agenda
+predict :: (Ord l, Ord t) => MCFPInfo c n l t -> Input t -> [Item c n l]  
+predict pinfo toks = tracePrt "MCFG.Naive - predicted rules" (prt . length) $
+		     do Rule abs (Cnc _ _ lins) <- rulesMatchingInput pinfo toks
+			lins' <- rangeRestRec toks lins
+			return $ Active (abs, []) lins' [] 
+
+-- Creates an Active Item of every Rule in the Grammar to give the initial Agenda
+predictR :: (Ord l) => MCFPInfo c n l Range -> [Item c n l]  
+predictR pinfo = tracePrt "MCFG.Naive Range - predicted rules" (prt . length) $
+		 do Rule abs (Cnc _ _ lins) <- allRules pinfo 
+		    return $ Active (abs, []) lins [] 
+
+-- | Creates an Active Item every time it is possible to combine 
+-- an Active Item from the agenda with a Passive Item from the Chart 
+combine :: (Ord n, Ord c, Ord l) => NChart c n l -> Item c n l -> [Item c n l]
+combine chart item@(Active (Abs _ (c:_) _, _) _ _) = 
+    do Passive _c rrec <- chartLookup chart (Pass c)
+       combine2 chart rrec item
+combine chart (Passive c rrec) = 
+    do item <- chartLookup chart (Act c)
+       combine2 chart rrec item
+combine _ _ = []
+
+combine2 chart rrec (Active (Abs nt (c:find) f, found) lins rrecs) = 
+    do lins' <- substArgRec (length found) rrec lins
+       return $ Active (Abs nt find f, found ++ [c]) lins' (rrecs ++ [rrec])
+
+-- | Active Items with nothing to find are converted to Passive Items
+convert :: (Ord n, Ord c, Ord l) => NChart c n l -> Item c n l -> [Item c n l]
+convert _ (Active (Abs cat [] fun, _) lins _) = [Passive cat (makeRangeRec lins)]
+convert _ _                                   = []
+
+
+----------------------------------------------------------------------
+-- * type definitions
+
+type NChart   c n l = ParseChart (Item c n l) (NKey c)
+
+data Item     c n l = Active (DottedRule c n) (LinRec c l Range) [RangeRec l]
+	            | Passive c (RangeRec l)
+	              deriving (Eq, Ord, Show)      
+
+type DottedRule c n = (Abstract c n, [c])
+
+data NKey         c = Act c
+	            | Pass c
+	            | Final
+	              deriving (Eq, Ord, Show)
+
+keyof :: Item c n l -> NKey c
+keyof (Active (Abs _ (next:_) _, _) _ _) = Act next 
+keyof (Passive cat _)                    = Pass cat
+keyof _                                  = Final
+
+-- for tracing purposes
+prtSizes chart = "final=" ++ show (length (chartLookup chart Final)) ++
+		 ", passive=" ++ show (sum [length (chartLookup chart k) | 
+					    k@(Pass _) <- chartKeys chart ]) ++
+		 ", active=" ++ show (sum [length (chartLookup chart k) | 
+					   k@(Act _) <- chartKeys chart ]) 
+
+prtChart chart = concat [ "\n*** KEY: " ++ prt k ++ 
+			  prtBefore "\n  " (chartLookup chart k) | 
+			  k <- chartKeys chart ] 
+
+instance (Print c, Print n, Print l) => Print (Item c n l) where
+    prt (Active (abs, cs) lrec rrecs) = "? " ++ prt abs ++ " . " ++ prtSep " " cs ++ ";\n\t" ++
+					"{" ++ prtSep " " lrec ++ "}" ++ 
+					( if null rrecs then ";" else ";\n\t" ++
+					  "{" ++ prtSep "} {" (map (prtSep " ") rrecs) ++ "}" )
+    prt (Passive c rrec) = "- " ++ prt c ++ "; {" ++ prtSep " " rrec ++ "}"
+
+instance Print c => Print (NKey c) where
+    prt (Act c) = "Active " ++ prt c
+    prt (Pass c) = "Passive " ++ prt c
+    prt (Final) = "Final"
+
+
diff --git a/src-2.9/GF/Parsing/MCFG/PInfo.hs b/src-2.9/GF/Parsing/MCFG/PInfo.hs
new file mode 100644
index 000000000..56119dcec
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG/PInfo.hs
@@ -0,0 +1,162 @@
+---------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/13 12:40:19 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- MCFG parsing, parser information
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG.PInfo where
+
+import GF.System.Tracing
+import GF.Infra.Print
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.Parsing.MCFG.Range
+
+----------------------------------------------------------------------
+-- type declarations
+
+-- | the list of categories = possible starting categories
+type MCFParser c n l t = MCFPInfo c n l t 
+		       -> [c]
+		       -> Input t
+		       -> SyntaxChart n (c, RangeRec l)
+
+makeFinalEdge :: c -> l -> (Int, Int) -> (c, RangeRec l)
+makeFinalEdge cat lbl bnds = (cat, [(lbl, makeRange bnds)])
+
+
+------------------------------------------------------------
+-- parser information
+
+data MCFPInfo c n l t
+    = MCFPInfo { grammarTokens :: SList t
+	       , nameRules     :: Assoc n (SList (MCFRule c n l t))
+	       , topdownRules  :: Assoc c (SList (MCFRule c n l t))
+		 -- ^ used in 'GF.Parsing.MCFG.Active' (Earley):
+	       , epsilonRules    :: [MCFRule c n l t]
+		 -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
+	       , leftcornerCats :: Assoc c (SList (MCFRule c n l t))
+	       , leftcornerTokens :: Assoc t (SList (MCFRule c n l t))
+		 -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
+	       , grammarCats   :: SList c
+		 -- ^ used when calculating starting categories
+	       , rulesByToken  :: Assoc t (SList (MCFRule c n l t, SList t))
+	       , rulesWithoutTokens :: SList (MCFRule c n l t)
+		 -- ^ used by 'rulesMatchingInput' 
+	       , allRules :: MCFGrammar c n l t
+		 -- ^ used by any unoptimized algorithm
+
+		 --bottomupRules        :: Assoc (Symbol c t) (SList (CFRule c n t)),
+		 --emptyLeftcornerRules :: Assoc c            (SList (CFRule c n t)),
+		 --emptyCategories      :: Set c,
+	       }
+
+
+rangeRestrictPInfo :: (Ord c, Ord n, Ord l, Ord t) => 
+		      MCFPInfo c n l t -> Input t -> MCFPInfo c n l Range
+rangeRestrictPInfo (pinfo{-::MCFPInfo c n l t-}) inp =
+    tracePrt "MCFG.PInfo - Restricting the parser information" (prt . grammarTokens)
+    MCFPInfo { grammarTokens = nubsort (map edgeRange (inputEdges inp))
+	     , nameRules = rrAssoc (nameRules pinfo)
+	     , topdownRules = rrAssoc (topdownRules pinfo)
+	     , epsilonRules = rrRules (epsilonRules pinfo)
+	     , leftcornerCats = rrAssoc (leftcornerCats pinfo)
+	     , leftcornerTokens = lctokens
+	     , grammarCats = grammarCats pinfo
+	     , rulesByToken = emptyAssoc -- error "MCFG.PInfo.rulesByToken - no range restriction"
+	     , rulesWithoutTokens = [] -- error "MCFG.PInfo.rulesByToken - no range restriction"
+	     , allRules = allrules -- rrRules (allRules pinfo)
+	     }
+
+    where lctokens = accumAssoc id 
+		     [ (rng, rule) | (tok, rules) <- aAssocs (leftcornerTokens pinfo),
+		       inputToken inp ?= tok,
+		       rule@(Rule _ (Cnc _ _ (Lin _ (Tok rng:_) : _))) 
+		           <- concatMap (rangeRestrictRule inp) rules ]
+
+          allrules = rrRules $ rulesMatchingInput pinfo inp
+
+	  rrAssoc assoc = filterNull $ fmap rrRules assoc
+	  filterNull assoc = assocFilter (not . null) assoc
+	  rrRules rules = concatMap (rangeRestrictRule inp) rules
+
+
+buildMCFPInfo :: (Ord c, Ord n, Ord l, Ord t) => MCFGrammar c n l t -> MCFPInfo c n l t
+buildMCFPInfo grammar = 
+    traceCalcFirst grammar $
+    tracePrt "MCFG.PInfo - parser info" (prt) $
+    MCFPInfo { grammarTokens = grammartokens
+	     , nameRules = namerules
+	     , topdownRules = topdownrules
+	     , epsilonRules = epsilonrules
+	     , leftcornerCats = leftcorncats
+	     , leftcornerTokens = leftcorntoks
+	     , grammarCats = grammarcats
+	     , rulesByToken = rulesbytoken
+	     , rulesWithoutTokens = ruleswithouttokens
+	     , allRules = allrules
+	     }
+
+    where allrules      = concatMap expandVariants grammar
+	  grammartokens = union (map fst ruletokens)
+	  namerules     = accumAssoc id 
+			  [ (name, rule) | rule@(Rule (Abs _ _ name) _) <- allrules ]
+	  topdownrules  = accumAssoc id
+			  [ (cat, rule) | rule@(Rule (Abs cat _ _) _) <- allrules ]
+	  epsilonrules    = [ rule | rule@(Rule _ (Cnc _ _ (Lin _ [] : _))) <- allrules ]
+	  leftcorncats  = accumAssoc id 
+			  [ (cat, rule) | 
+			    rule@(Rule _ (Cnc _ _ (Lin _ (Cat(cat,_,_):_) : _))) <- allrules ]
+	  leftcorntoks  = accumAssoc id 
+			  [ (tok, rule) | 
+			    rule@(Rule _ (Cnc _ _ (Lin _ (Tok tok:_) : _))) <- allrules ]
+	  grammarcats   = aElems topdownrules
+	  ruletokens    = [ (toksoflins lins, rule) | 
+			    rule@(Rule _ (Cnc _ _ lins)) <- allrules ]
+	  toksoflins lins = nubsort [ tok | Lin _ syms <- lins, Tok tok <- syms ]
+	  rulesbytoken  = accumAssoc id 
+			  [ (tok, (rule, toks)) | (tok:toks, rule) <- ruletokens ]
+	  ruleswithouttokens = nubsort [ rule | ([], rule) <- ruletokens ]
+
+
+-- | return only the rules for which all tokens are in the input string
+rulesMatchingInput :: Ord t => MCFPInfo c n l t -> Input t -> [MCFRule c n l t]
+rulesMatchingInput pinfo inp =
+    [ rule | tok <- toks,
+      (rule, ruletoks) <- rulesByToken pinfo ? tok,
+      ruletoks `subset` toks ]
+    ++ rulesWithoutTokens pinfo
+    where toks = aElems (inputToken inp)
+
+
+----------------------------------------------------------------------
+-- pretty-printing of statistics
+
+instance (Ord c, Ord n, Ord l, Ord t) => Print (MCFPInfo c n l t) where
+    prt pI = "[ tokens=" ++ sl grammarTokens ++
+	     "; categories=" ++ sl grammarCats ++ 
+	     "; nameRules=" ++ sla nameRules ++ 
+	     "; tdRules=" ++ sla topdownRules ++
+	     "; epsilonRules=" ++ sl epsilonRules ++ 
+	     "; lcCats=" ++ sla leftcornerCats ++
+	     "; lcTokens=" ++ sla leftcornerTokens ++
+	     "; byToken=" ++ sla rulesByToken ++
+	     "; noTokens=" ++ sl rulesWithoutTokens ++
+	     "; allRules=" ++ sl allRules ++
+	     " ]"
+
+	where sl  f = show $ length $ f pI
+	      sla f = let (as, bs) = unzip $ aAssocs $ f pI
+		       in show (length as) ++ "/" ++ show (length (concat bs))
+
diff --git a/src-2.9/GF/Parsing/MCFG/Range.hs b/src-2.9/GF/Parsing/MCFG/Range.hs
new file mode 100644
index 000000000..91671fa00
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG/Range.hs
@@ -0,0 +1,206 @@
+---------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/08 09:01:25 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
+--
+-- Definitions of ranges, and operations on ranges
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG.Range
+    ( Range(..), makeRange, concatRange, rangeEdge, edgeRange, minRange, maxRange,
+      LinRec, RangeRec,
+      makeRangeRec, rangeRestRec, rangeRestrictRule, 
+      projection, unifyRec, substArgRec
+    ) where
+
+
+-- Haskell
+import Data.List
+import Control.Monad
+
+-- GF modules
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.Utilities
+import GF.Infra.Print
+import GF.Data.Assoc ((?))
+import GF.Data.Utilities (updateNthM)
+
+------------------------------------------------------------
+-- ranges as single pairs
+
+data Range = Range (Int, Int)
+	   | EmptyRange
+             deriving (Eq, Ord, Show)
+
+makeRange   :: (Int, Int) -> Range
+concatRange :: Range -> Range -> [Range]
+rangeEdge   :: a -> Range -> Edge a
+edgeRange   :: Edge a -> Range
+minRange    :: Range -> Int
+maxRange    :: Range -> Int
+
+makeRange                              = Range 
+concatRange EmptyRange rng = return rng
+concatRange rng EmptyRange = return rng
+concatRange (Range(i,j)) (Range(j',k)) = [ Range(i,k) | j==j']
+rangeEdge    a           (Range(i,j))  = Edge i j a
+edgeRange   (Edge i j _)               = Range (i,j)
+minRange    (Range rho)                = fst rho
+maxRange    (Range rho)                = snd rho
+
+instance Print Range where
+    prt (Range (i,j)) = "(" ++ show i ++ "-" ++ show j ++ ")"
+    prt (EmptyRange)  = "(?)"
+
+{-- Types --------------------------------------------------------------------
+  Linearization- and Range records implemented as lists
+-----------------------------------------------------------------------------}
+
+type LinRec c l t = [Lin c l t]
+ 
+type RangeRec   l = [(l, Range)]
+
+
+{-- Functions ----------------------------------------------------------------
+  Concatenation         : Concatenation of Ranges, Symbols and Linearizations 
+                          and records of Linearizations 
+  Record transformation : Makes a Range record from a fully instantiated
+                          Linearization record 
+  Record projection     : Given a label, returns the corresponding Range
+  Range restriction     : Range restriction of Tokens, Symbols, 
+                          Linearizations and Records given a list of Tokens
+  Record replacment     : Substitute a record for another in a list of Range 
+                          records
+  Argument substitution : Substitution of a Cat c to a Tok Range, where 
+                          Range is the cover of c
+			  Note: The argument is still a Symbol c Range
+  Subsumation           : Checks if a Range record subsumes another Range 
+                          record
+  Record unification    : Unification of two Range records
+-----------------------------------------------------------------------------}
+
+
+--- Concatenation ------------------------------------------------------------
+
+
+concSymbols :: [Symbol c Range] -> [[Symbol c Range]]
+concSymbols (Tok rng:Tok rng':toks) = do rng'' <- concatRange rng rng'
+					 concSymbols (Tok rng'':toks)
+concSymbols (sym:syms)              = do syms' <- concSymbols syms
+					 return (sym:syms')
+concSymbols []                      = return []
+
+
+concLin :: Lin c l Range -> [Lin c l Range]
+concLin (Lin lbl syms) = do syms' <- concSymbols syms
+			    return (Lin lbl syms')
+
+
+concLinRec :: LinRec c l Range -> [LinRec c l Range]
+concLinRec = mapM concLin 
+
+
+--- Record transformation ----------------------------------------------------
+
+makeRangeRec :: LinRec c l Range -> RangeRec l
+makeRangeRec lins = map convLin lins
+    where convLin (Lin lbl [Tok rng]) = (lbl, rng)
+	  convLin (Lin lbl []) = (lbl, EmptyRange)
+	  convLin _ = error "makeRangeRec"
+
+
+--- Record projection --------------------------------------------------------
+
+projection :: Ord l => l -> RangeRec l -> [Range]
+projection l rec = maybe (fail "projection") return $ lookup l rec
+
+
+--- Range restriction --------------------------------------------------------
+
+rangeRestTok :: Ord t => Input t -> t -> [Range]
+rangeRestTok toks tok = do rng <- inputToken toks ? tok
+			   return (makeRange rng)
+
+
+rangeRestSym :: Ord t => Input t -> Symbol a t -> [Symbol a Range]
+rangeRestSym toks (Tok tok) = do rng <- rangeRestTok toks tok
+				 return (Tok rng)
+rangeRestSym _ (Cat c)      = return (Cat c)
+
+
+rangeRestLin :: Ord t => Input t -> Lin c l t -> [Lin c l Range]
+rangeRestLin toks (Lin lbl syms) = do syms' <- mapM (rangeRestSym toks) syms
+				      concLin (Lin lbl syms')
+				      -- return (Lin lbl syms')
+
+
+rangeRestRec :: Ord t => Input t -> LinRec c l t -> [LinRec c l Range]
+rangeRestRec toks = mapM (rangeRestLin toks) 
+
+
+rangeRestrictRule :: Ord t => Input t -> MCFRule c n l t -> [MCFRule c n l Range]
+rangeRestrictRule toks (Rule abs (Cnc l ls lins)) = liftM (Rule abs . Cnc l ls) $
+						    rangeRestRec toks lins
+
+--- Argument substitution ----------------------------------------------------
+
+substArgSymbol :: Ord l => Int -> RangeRec l -> Symbol (c, l, Int) Range 
+	       -> Symbol (c, l, Int) Range
+substArgSymbol i rec tok@(Tok rng) = tok
+substArgSymbol i rec cat@(Cat (c, l, j))
+    | i==j      = maybe err Tok $ lookup l rec 
+    | otherwise = cat
+    where err = error "substArg: Label not in range-record"
+
+substArgLin :: Ord l => Int -> RangeRec l -> Lin c l Range 
+	    -> [Lin c l Range]
+substArgLin i rec (Lin lbl syms) = 
+    concLin (Lin lbl (map (substArgSymbol i rec) syms))
+
+
+substArgRec :: Ord l => Int -> RangeRec l -> LinRec c l Range 
+	    -> [LinRec c l Range]
+substArgRec i rec lins = mapM (substArgLin i rec) lins
+
+
+-- Record unification & replacment ---------------------------------------------------------
+
+unifyRec :: Ord l => [RangeRec l] -> Int -> RangeRec l -> [[RangeRec l]]
+unifyRec recs i rec = updateNthM update i recs
+    where update rec' = guard (subsumes rec' rec) >> return rec
+
+-- unifyRec recs i rec = do guard $ subsumes (recs !! i) rec
+-- 			 return $ replaceRec recs i rec
+
+replaceRec :: [RangeRec l] -> Int -> RangeRec l -> [RangeRec l]
+replaceRec recs i rec = before ++ (rec : after)
+    where (before, _ : after) = splitAt i recs
+
+subsumes :: Ord l => RangeRec l -> RangeRec l -> Bool
+subsumes rec rec' = and [r `elem` rec' | r <- rec]
+-- subsumes rec rec' = all (`elem` rec') rec
+
+
+{-
+--- Record unification -------------------------------------------------------
+unifyRangeRecs :: Ord l => [RangeRec l] -> [RangeRec l] -> [[RangeRec l]]
+unifyRangeRecs recs recs' = zipWithM unify recs recs'
+    where unify :: Ord l => RangeRec l -> RangeRec l -> [RangeRec l]
+	  unify rec [] = return rec
+	  unify [] rec = return rec
+	  unify rec1'@(p1@(l1, r1):rec1) rec2'@(p2@(l2, r2):rec2) 
+	      = case compare l1 l2 of
+		LT -> do rec3 <- unify rec1 rec2'
+			 return (p1:rec3)
+		GT -> do rec3 <- unify rec1' rec2
+			 return (p2:rec3)
+		EQ -> do guard (r1 == r2)
+			 rec3 <- unify rec1 rec2
+			 return (p1:rec3)
+-}
diff --git a/src-2.9/GF/Parsing/MCFG/ViaCFG.hs b/src-2.9/GF/Parsing/MCFG/ViaCFG.hs
new file mode 100644
index 000000000..9204ea9f1
--- /dev/null
+++ b/src-2.9/GF/Parsing/MCFG/ViaCFG.hs
@@ -0,0 +1,186 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/08 09:01:25 $
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.4 $
+--
+-- MCFG parsing, through context-free approximation
+-----------------------------------------------------------------------------
+
+module GF.Parsing.MCFG.ViaCFG where
+
+
+-- Haskell modules
+import Data.List
+import Control.Monad
+
+-- GF modules 
+import ConvertMCFGtoDecoratedCFG
+import qualified DecoratedCFParser as CFP
+import qualified DecoratedGrammar as CFG
+import Examples
+import GF.OldParsing.GeneralChart
+import qualified GF.OldParsing.MCFGrammar as MCFG
+import MCFParser
+import Nondet 
+import Parser
+import GF.Parsing.MCFG.Range
+
+
+{-- Datatypes -----------------------------------------------------------------
+Chart
+Item
+Key
+
+
+  Item  : Four different Items are used. PreMCFG for MCFG Pre Items, Pre are 
+          the Items returned by the pre-Functions and Mark are the 
+	  corresponding Items for the mark-Functions. For convenience correctly
+	  marked Mark Items are converted to Passive Items.
+I use dottedrule for convenience to keep track of wich daughter's RangeRec to look for.
+  AChart: A RedBlackMap with Items and Keys
+  AKey  :  
+------------------------------------------------------------------------------}
+
+--Ev ta bort några typer av Item och bara nyckla på det som är unikt för den typen...
+data Item     n c l   = PreMCFG (n, c) (RangeRec l) [RangeRec l]
+		      | Pre     (n, c) (RangeRec l) [l] [RangeRec l]
+		      | Mark    (n, c) (RangeRec l) (RangeRec l) [RangeRec l]
+		      | Passive (n, c) (RangeRec l) (RangeRec l)
+			deriving (Eq, Ord, Show)
+
+type AChart   n c l   = ParseChart (Item n c l) (AKey n c l)
+
+data AKey n c l       = Pr (n, c) l 
+		      | Pm (n, c) l
+                      | Mk (RangeRec l)
+		      | Ps (RangeRec l)
+                      | Useless
+			deriving (Eq, Ord, Show)
+
+
+{-- Parsing -------------------------------------------------------------------
+  recognize:
+  parse    : The Agenda consists of the Passive Items from context-free 
+             approximation (as PreMCFG Items) and the Pre Items inferred by
+             pre-prediction.
+  keyof    : Given an Item returns an appropriate Key for the Chart
+------------------------------------------------------------------------------}
+
+recognize strategy mcfg toks = chartMember (parse strategy mcfg toks)
+			       (Passive ("f", S) 
+				[("s" , MCFG.Range (0, n))]
+				[("p" , MCFG.Range (0, n2)), ("q", MCFG.Range (n2, n))])
+			       (Ps [("s" , MCFG.Range (0, n))])
+    where n  = length toks
+	  n2 = n `div` 2
+
+
+--parse :: (Ord n, Ord NT, Ord String, Eq t) => CFP.Strategy -> MCFG.Grammar n NT String t -> [t] 
+--      -> AChart n NT String
+parse strategy mcfg toks
+    = buildChart keyof 
+      [preCombine, markPredict, markCombine, convert]
+      (makePreItems (CFP.parse strategy (CFG.pInfo (convertGrammar mcfg)) [(S, "s")] toks) ++
+       (prePredict mcfg))
+
+ 
+keyof :: Item n c l -> AKey n c l
+keyof (PreMCFG head [(lbl, rng)] _) = Pm head lbl
+keyof (Pre head _ (lbl:lbls) _)     = Pr head lbl
+keyof (Mark _ _ _ (rec:recs))       = Mk rec
+keyof (Passive _ rec _)             = Ps rec
+keyof _                             = Useless
+
+
+{-- Initializing agenda -------------------------------------------------------
+  makePreItems: 
+------------------------------------------------------------------------------}
+
+makePreItems :: (Eq c, Ord i) => CFG.Grammar n (Edge (c, l)) i t -> [Item n c l]
+makePreItems cfchart 
+    = [ PreMCFG (fun, cat) [(lbl, MCFG.makeRange (i, j))] (symToRec beta) | 
+        CFG.Rule (Edge i j (cat,lbl)) beta fun <- cfchart ]
+
+
+prePredict :: (Ord n, Ord c, Ord l) => MCFG.Grammar n c l t -> [Item n c l]
+prePredict mcfg = 
+    [ Pre (f, nt) [] (getLables lins) (replicate (nrOfCats (head lins)) []) | 
+      MCFG.Rule nt nts lins f <- mcfg ]
+
+
+{-- Inference rules ---------------------------------------------------------
+  prePredict :  
+  preCombine :
+  markPredict:
+  markCombine:
+  convert    :
+----------------------------------------------------------------------------}
+
+preCombine :: (Ord n, Ord c, Ord l) => ParseChart (Item n c l) (AKey n c l) 
+	   -> Item n c l -> [Item n c l]
+preCombine chart (Pre head rec (l:ls) recs) =
+    [ Pre head (rec ++ [(l, r)]) ls recs'' |
+      PreMCFG head [(l, r)] recs' <- chartLookup chart (Pm head l),
+      recs'' <- solutions (unifyRangeRecs recs recs') ]
+preCombine chart (PreMCFG head [(l, r)] recs) =
+    [ Pre head (rec ++ [(l, r)]) ls recs'' |
+      Pre head rec (l:ls) recs' <- chartLookup chart (Pr head l),
+      recs'' <- solutions (unifyRangeRecs recs recs') ]
+preCombine _ _ = []
+
+
+markPredict :: (Ord n, Ord c, Ord l) => ParseChart (Item n c l) (AKey n c l) 
+	    -> Item n c l -> [Item n c l]
+markPredict _ (Pre (n, c) rec [] recs) = [Mark (n, c) rec [] recs]
+markPredict _ _                        = []
+
+
+markCombine :: (Ord n, Ord c, Ord l) => ParseChart (Item n c l) (AKey n c l) 
+	    -> Item n c l -> [Item n c l]
+markCombine chart (Mark (f, c) rec mRec (r:recs)) = 
+    [ Mark (f, c) rec (mRec ++ r) recs |
+      Passive _ r _ <- chartLookup chart (Ps r)]
+markCombine chart (Passive _ r _) =
+    [ Mark (f, c) rec (mRec++r) recs |
+      Mark (f, c) rec mRec (r:recs) <- chartLookup chart (Mk r) ]
+markCombine _ _ = []
+
+
+convert :: (Ord n, Ord c, Ord l) => ParseChart (Item n c l) (AKey n c l) 
+	-> Item n c l -> [Item n c l]
+convert _ (Mark (f, c) r rec []) = [Passive (f, c) r rec]
+convert _ _                      = []
+
+
+{-- Help functions ----------------------------------------------------------------
+  getRHS   :  
+  getLables:
+  symToRec :
+----------------------------------------------------------------------------------}
+
+-- FULKOD !
+nrOfCats :: Eq c => MCFG.Lin c l t  -> Int
+nrOfCats (MCFG.Lin l syms) = length $ nub [(c, i) | Cat (c, l, i) <- syms]
+
+
+--
+getLables :: LinRec c l t -> [l] 
+getLables lins = [l | MCFG.Lin l syms <- lins]
+
+
+--
+symToRec :: Ord i => [Symbol (Edge (c, l), i) d] -> [[(l, MCFG.Range)]]
+symToRec beta = map makeLblRng $ groupBy (\(_, d) (_, d') -> (d == d')) 
+		$ sortBy sBd [(Edge i j (c, l) , d) | Cat (Edge i j (c, l), d)  
+		    <- beta]
+    where makeLblRng edges = [(l, (MCFG.makeRange (i, j))) | (Edge i j (_, l), _) 
+			   <- edges]
+	  sBd (_, d) (_, d') 
+	      | d < d' = LT
+	      | d > d' = GT
+	      | otherwise = EQ
diff --git a/src-2.9/GF/Printing/PrintParser.hs b/src-2.9/GF/Printing/PrintParser.hs
new file mode 100644
index 000000000..d9041ecaa
--- /dev/null
+++ b/src-2.9/GF/Printing/PrintParser.hs
@@ -0,0 +1,83 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrintParser
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:16 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.3 $
+--
+-- Pretty-printing of parser objects
+-----------------------------------------------------------------------------
+
+module GF.Printing.PrintParser (Print(..),
+		    prtBefore, prtAfter, prtSep, 
+		    prtBeforeAfter,
+		    prIO
+		   ) where
+
+-- haskell modules:
+import Data.List (intersperse)
+-- gf modules:
+import GF.Data.Operations (Err(..))
+import GF.Infra.Ident (Ident(..))
+import qualified GF.Canon.PrintGFC as P
+
+------------------------------------------------------------
+
+prtBefore :: Print a => String -> [a] -> String
+prtBefore before = prtBeforeAfter before ""
+
+prtAfter :: Print a => String -> [a] -> String
+prtAfter after = prtBeforeAfter "" after
+
+prtSep :: Print a => String -> [a] -> String
+prtSep sep = concat . intersperse sep . map prt
+
+prtBeforeAfter :: Print a => String -> String -> [a] -> String
+prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
+
+prIO :: Print a => a -> IO ()
+prIO = putStr . prt
+
+class Print a where
+    prt :: a -> String
+    prtList :: [a] -> String
+    prtList as = "[" ++ prtSep "," as ++ "]"
+
+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"
+
+instance Print a => Print (Err a) where
+    prt (Ok a) = prt a
+    prt (Bad str) = str
+
+instance Print Ident where
+    prt ident = str
+	where str = P.printTree ident
+
diff --git a/src-2.9/GF/Printing/PrintSimplifiedTerm.hs b/src-2.9/GF/Printing/PrintSimplifiedTerm.hs
new file mode 100644
index 000000000..ccd107558
--- /dev/null
+++ b/src-2.9/GF/Printing/PrintSimplifiedTerm.hs
@@ -0,0 +1,127 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrintSimplifiedTerm
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/17 14:15:19 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- Instances for printing terms in a simplified format
+-----------------------------------------------------------------------------
+
+
+module GF.Printing.PrintSimplifiedTerm () where
+
+import GF.Canon.AbsGFC
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.Printing.PrintParser
+import qualified GF.Canon.PrintGFC as P
+
+instance Print Term where
+    prt (Arg arg)         = prt arg
+    prt (con `Par` [])    = prt con
+    prt (con `Par` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
+    prt (LI ident)        = prt ident
+    prt (R record)        = "{" ++ prtSep ";" record ++ "}"
+    prt (term `P` lbl)    = prt term ++ "." ++ prt lbl
+    prt (T _ table)       = "table{" ++ prtSep ";" table ++ "}"
+    prt (term `S` sel)    = prt term ++ "!" ++ prt sel
+    prt (FV terms)        = "variants{" ++ prtSep "|" terms ++ "}"
+    prt (term `C` term')  = prt term ++ "  " ++ prt term'
+    prt (K tokn)          = show (prt tokn)
+    prt (E)               = show ""
+
+instance Print Patt where
+    prt (con `PC` [])     = prt con
+    prt (con `PC` pats)   = prt con ++ "(" ++ prtSep "," pats ++ ")"
+    prt (PV ident)        = prt ident
+    prt (PW)              = "_"
+    prt (PR record)       = "{" ++ prtSep ";" record ++ "}"
+
+instance Print Label where
+    prt (L ident)          = prt ident
+    prt (LV nr)            = "$" ++ show nr
+
+instance Print Tokn where
+    prt (KS str)          = str
+    prt tokn@(KP _ _)     = show tokn
+
+instance Print ArgVar where
+    prt (A cat argNr)     = prt cat ++ "#" ++ show argNr
+
+instance Print CIdent where
+    prt (CIQ _ ident)     = prt ident
+
+instance Print Case where
+    prt (pats `Cas` term) = prtSep "|" pats ++ "=>" ++ prt term
+
+instance Print Assign where
+    prt (lbl `Ass` term)  = prt lbl ++ "=" ++ prt term
+
+instance Print PattAssign where
+    prt (lbl `PAss` pat)  = prt lbl ++ "=" ++ prt pat
+
+instance Print Atom where
+    prt (AC c) = prt c
+    prt (AD c) = "<" ++ prt c ++ ">"
+    prt (AV i) = "$" ++ prt i
+    prt (AM n) = "?" ++ show n
+    prt (AS s) = show s
+    prt (AI n) = show n
+    prt (AT s) = show s
+
+instance Print CType where
+    prt (RecType rtype) = "{" ++ prtSep ";" rtype ++ "}"
+    prt (Table ptype vtype) = "(" ++ prt ptype ++ "=>" ++ prt vtype ++ ")"
+    prt (Cn cn) = prt cn
+    prt (TStr) = "Str"
+
+instance Print Labelling where
+    prt (lbl `Lbg` ctype) = prt lbl ++ ":" ++ prt ctype
+
+instance Print CFItem where
+    prt (CFTerm regexp) = prt regexp
+    prt (CFNonterm cat) = prt cat
+
+instance Print RegExp where
+    prt (RegAlts words) = "("++prtSep "|" words ++ ")"
+    prt (RegSpec tok) = prt tok
+
+instance Print CFTok where
+    prt (TS str) = str
+    prt tok = show tok
+
+instance Print CFCat where
+    prt (CFCat (cid,lbl)) = prt cid ++ "-" ++ prt lbl
+
+instance Print CFFun where 
+    prt (CFFun fun) = prt (fst fun)
+
+instance Print Exp where
+    prt = P.printTree
+
+
+sizeCT :: CType -> Int
+sizeCT (RecType rt) = 1 + sum [ sizeCT t | _ `Lbg` t <- rt ]
+sizeCT (Table pt vt) = 1 + sizeCT pt + sizeCT vt
+sizeCT (Cn cn) = 1
+sizeCT (TStr) = 1
+
+sizeT :: Term -> Int
+sizeT (_ `Par` ts) = 2 + sum (map sizeT ts)
+sizeT (R rec) = 1 + sum [ sizeT t | _ `Ass` t <- rec ]
+sizeT (t `P` _) = 1 + sizeT t
+sizeT (T _ tbl) = 1 + sum [ sum (map sizeP ps) + sizeT t | ps `Cas` t <- tbl ]
+sizeT (t `S` s) = 1 + sizeT t + sizeT s
+sizeT (t `C` t') = 1 + sizeT t + sizeT t'
+sizeT (FV ts) = 1 + sum (map sizeT ts)
+sizeT _ = 1
+
+sizeP :: Patt -> Int
+sizeP (con `PC` pats) = 2 + sum (map sizeP pats)
+sizeP (PR record)     = 1 + sum [ sizeP p | _ `PAss` p <- record ]
+sizeP _ = 1
diff --git a/src-2.9/GF/Probabilistic/Probabilistic.hs b/src-2.9/GF/Probabilistic/Probabilistic.hs
new file mode 100644
index 000000000..25258db52
--- /dev/null
+++ b/src-2.9/GF/Probabilistic/Probabilistic.hs
@@ -0,0 +1,203 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Probabilistic
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/01 09:20:09 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.5 $
+--
+-- Probabilistic abstract syntax. AR 30\/10\/2005
+--
+-- (c) Aarne Ranta 2005 under GNU GPL
+--
+-- Contents: parsing and random generation with probabilistic grammars.
+-- To begin with, we use simple types and don't
+-- guarantee the correctness of bindings\/dependences.
+-----------------------------------------------------------------------------
+
+module GF.Probabilistic.Probabilistic (
+  generateRandomTreesProb -- :: Options -> StdGen -> GFCGrammar -> Probs -> Cat -> [Exp]
+ ,checkGrammarProbs       -- :: GFCGrammar -> Probs -> Err ()
+ ,computeProbTree         -- :: Probs -> Tree -> Double
+ ,rankByScore             -- :: Ord n => [(a,n)] -> [(a,n)]
+ ,Probs                   -- = BinTree Ident Double
+ ,getProbsFromFile        -- :: Opts -> IO Probs
+ ,emptyProbs              -- :: Probs
+ ,prProbs                 -- :: Probs -> String
+  ) where
+
+import GF.Canon.GFC
+import GF.Grammar.LookAbs
+import GF.Grammar.PrGrammar
+import GF.Grammar.Macros
+import GF.Grammar.Values
+import GF.Grammar.Grammar
+import GF.Grammar.SGrammar
+
+import GF.Infra.Ident
+import GF.Data.Zipper
+import GF.Data.Operations
+import GF.Infra.Option
+
+import Data.Char
+import Data.List
+import Control.Monad
+import System.Random
+
+-- | this parameter tells how many constructors at most are generated in a tree
+timeout :: Int
+timeout = 99
+
+-- | generate an infinite list of trees, with their probabilities
+generateRandomTreesProb :: Options -> StdGen -> GFCGrammar -> Probs -> Cat -> [Exp]
+generateRandomTreesProb opts gen gr probs cat = 
+  map str2tr $ randomTrees gen gr' cat' where
+    gr'  = gr2sgr opts probs gr
+    cat' = prt $ snd cat
+
+-- | check that probabilities attached to a grammar make sense
+checkGrammarProbs :: GFCGrammar -> Probs -> Err Probs
+checkGrammarProbs gr probs = 
+  err Bad (return . gr2probs) $ checkSGrammar $ gr2sgr noOptions probs gr where
+    gr2probs sgr = buildTree [(zIdent f,p) | (_,rs) <- tree2list sgr, ((p,f),_) <- rs]
+
+-- | compute the probability of a given tree
+computeProbTree :: Probs -> Tree -> Double
+computeProbTree probs (Tr (N (_,at,_,_,_),ts)) = case at of
+  AtC (_,f) -> case lookupTree prt f probs of
+    Ok p -> p * product (map prob ts)
+    _ -> product (map prob ts)
+  _ -> 1.0 ----
+ where
+   prob = computeProbTree probs
+
+-- | rank from highest to lowest score, e.g. probability
+rankByScore :: Ord n => [(a,n)] -> [(a,n)]
+rankByScore = sortBy (\ (_,p) (_,q) -> compare q p)
+
+getProbsFromFile :: Options -> FilePath -> IO Probs
+getProbsFromFile opts file = do 
+  s <- maybe (readFile file) readFile $ getOptVal opts probFile
+  return $ buildTree $ concatMap pProb $ lines s
+-- where
+pProb s = case words s of
+     "--#":"prob":f:p:_ | isDouble p -> [(zIdent f, read p)]
+     f:ps@(g:rest) -> case span (/= "--#") ps of
+       (_,_:"prob":p:_) | isDouble p -> [(zIdent f', readD p)] where 
+         f' = if elem f ["fun","lin","data"] then ident g else ident f
+       _ -> []
+     _ -> []
+  where
+   isDouble = all (flip elem ('.':['0'..'9']))
+   ident = takeWhile (flip notElem ".:")
+   readD :: String -> Double
+   readD = read
+
+------------------------------------------
+-- translate grammar to simpler form and generated trees back
+
+probTree :: STree -> Double
+probTree t = case t of
+  SApp ((p,_),ts) -> p * product (map probTree ts)
+  _ -> 1
+
+rankTrees :: [STree] -> [(STree,Double)]
+rankTrees ts = sortBy (\ (_,p) (_,q) -> compare q p) [(t,probTree t) | t <- ts]
+
+randomTrees :: StdGen -> SGrammar -> SCat -> [STree]
+randomTrees gen = genTrees (randomRs (0.0, 1.0) gen)
+
+genTrees :: [Double] -> SGrammar -> SCat -> [STree]
+genTrees ds0 gr cat = 
+  let (ds,ds2) = splitAt (timeout+1) ds0  -- for time out, else ds
+      (t,k) = genTree ds gr cat      
+  in (if k>timeout then id else (t:))     -- don't accept with metas
+           (genTrees ds2 gr cat)          -- else (drop k ds)
+
+genTree :: [Double] -> SGrammar -> SCat -> (STree,Int)
+genTree rs gr = gett rs where
+  gett [] cat = (SMeta cat,1) -- time-out case
+  gett ds "String" = (SString "foo",1)
+  gett ds "Int" = (SInt 1978,1)
+  gett ds "Float" = (SFloat 3.1415926, 1)
+  gett ds cat = case look cat of
+    [] -> (SMeta cat,1) -- if no productions, return ? 
+    fs -> let 
+        d:ds2     = ds
+        (pf,args) = getf d fs
+        (ts,k)    = getts ds2 args
+      in (SApp (pf,ts), k+1)
+  getf d fs = hitRegion d [(p,(pf,args)) | (pf@(p,_),(args,_)) <- fs]
+  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)
+  look cat = errVal [] $ lookupTree id cat gr
+
+hitRegion :: Double -> [(Double,a)] -> a
+hitRegion d vs = case vs of
+  (p1,v1):vs2 -> 
+    if d < p1 then v1 else hitRegion d [(p+p1,v) | (p,v) <- vs2]
+
+--- this should recover from rounding errors
+
+checkSGrammar :: SGrammar -> Err SGrammar
+checkSGrammar = mapMTree chCat where
+  chCat (c,rs) = case sum [p | ((p,f),_) <- rs] of
+    s | abs (s - 1.0) > 0.01 -> 
+      Bad $ "illegal probability sum " ++ show s ++ " in " ++ c
+    _ -> return (c,rs)
+
+
+{-
+------------------------------------------
+-- to test outside GF
+
+prSTree t = case t of
+  SApp ((p,f),ts) -> f ++ prParenth (show p) ++ concat (map pr1 ts)
+  SMeta c -> '?':c
+  SString s -> prQuotedString s
+  SInt i -> show i 
+  SFloat i -> show i 
+ where
+  pr1 t@(SApp (_,ts)) = ' ' : (if null ts then id else prParenth) (prSTree t)
+  pr1 t = prSTree t
+
+
+mkSGrammar :: [SRule] -> SGrammar 
+mkSGrammar rules = 
+  buildTree [(c, fillProb rs) | rs@((_,(_,c)):_) <- rules'] where
+    rules' =     
+      groupBy (\x y -> scat x == scat y) $
+        sortBy (\x y -> compare (scat x) (scat y)) 
+          rules 
+    scat (_,(_,c)) = c
+
+pSRule :: String -> SRule
+pSRule s = case words s of
+  p : f : c : cs -> 
+    if isDigit (head p) 
+      then ((read p, f),(init cs', last cs')) 
+      else ((2.0, p),(init (c:cs'), last (c:cs'))) --- hack for automatic probability
+     where cs' = [cs !! i | i <- [0,2..length cs - 1]]
+  _ -> error $ "not a rule" +++ s
+
+expSgr = mkSGrammar $ map pSRule [
+  "0.8 a : A"
+ ,"0.2 b : A"
+ ,"0.2 n : A -> S -> S"
+ ,"0.8 e : S"
+ ]
+
+ex1 :: IO ()
+ex1 = do
+  g <- newStdGen
+  mapM_ (putStrLn . prSTree) $ randomTrees g exSgr "S"
+
+-}
+
diff --git a/src-2.9/GF/Shell.hs b/src-2.9/GF/Shell.hs
new file mode 100644
index 000000000..1d723bc62
--- /dev/null
+++ b/src-2.9/GF/Shell.hs
@@ -0,0 +1,591 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Shell
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/07 20:15:05 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.50 $
+--
+-- GF shell command interpreter.
+-----------------------------------------------------------------------------
+
+module GF.Shell where
+
+--- abstract away from these?
+import GF.Data.Str
+import qualified GF.Grammar.Grammar as G
+import qualified GF.Infra.Ident as I
+import qualified GF.Grammar.Compute as Co
+import qualified GF.Compile.CheckGrammar as Ch
+import qualified GF.Grammar.Lookup as L
+import qualified GF.Canon.GFC as GFC
+import qualified GF.Canon.Look as Look
+import qualified GF.Canon.CMacros as CMacros
+import qualified GF.Grammar.MMacros as MMacros
+import qualified GF.Compile.GrammarToCanon as GrammarToCanon
+import GF.Grammar.Values
+import GF.UseGrammar.GetTree
+import GF.UseGrammar.Generate (generateAll) ---- should be in API
+import GF.UseGrammar.Treebank
+import GF.UseGrammar.TreeSelections (getOverloadResults)
+
+import GF.Shell.ShellCommands
+
+import GF.Visualization.VisualizeGrammar (visualizeCanonGrammar, visualizeSourceGrammar)
+import GF.Visualization.VisualizeTree (visualizeTrees)
+import GF.API
+import GF.API.IOGrammar
+import GF.Compile.Compile
+---- import GFTex
+import GF.Shell.TeachYourself -- also a subshell
+
+import GF.UseGrammar.Randomized ---
+import GF.UseGrammar.Editing (goFirstMeta) ---
+
+import GF.Probabilistic.Probabilistic
+
+import GF.Compile.ShellState
+import GF.Infra.Option
+import GF.UseGrammar.Information
+import GF.Shell.HelpFile
+import GF.Compile.PrOld
+import GF.Compile.Wordlist
+import GF.Grammar.PrGrammar
+
+import Control.Monad (foldM,liftM)
+import System (system)
+import System.IO (hPutStrLn, stderr)
+import System.Random (newStdGen) ----
+import Data.List (nub,isPrefixOf)
+import GF.Data.Zipper ----
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.Text.UTF8 (encodeUTF8)
+import Data.Char (isDigit)
+import Data.Maybe (fromMaybe)
+
+import GF.System.Signal (runInterruptibly)
+import System.Exit (exitFailure)
+import System.FilePath
+
+---- import qualified GrammarToGramlet as Gr
+---- import qualified GrammarToCanonXML2 as Canon
+
+-- AR 18/4/2000 - 7/11/2001
+
+-- data Command moved to ShellCommands. AR 27/5/2004
+
+type CommandLine = (CommandOpt, CommandArg,  [CommandOpt])
+
+-- | term as returned by the command parser
+type SrcTerm = G.Term 
+
+-- | history & CPU
+type HState  = (ShellState,([String],Integer,ShMacros,ShTerms)) 
+
+type ShMacros = [(String,[String])] -- dc %c = ... #1 ... #2 ...
+type ShTerms  = [(String,Tree)]     -- dt $e = f ...
+
+type ShellIO = (HState, CommandArg) -> IO (HState, CommandArg)
+
+initHState :: ShellState -> HState
+initHState st = (st,([],0,[],[]))
+
+cpuHState :: HState -> Integer
+cpuHState (_,(_,i,_,_)) = i
+
+optsHState :: HState -> Options
+optsHState (st,_) = globalOptions st
+
+putHStateCPU :: Integer -> HState -> HState
+putHStateCPU cpu (st,(h,_,c,t)) = (st,(h,cpu,c,t))
+
+updateHistory :: String -> HState -> HState
+updateHistory s (st,(h,cpu,c,t)) = (st,(s:h,cpu,c,t))
+
+addShMacro :: (String,[String]) -> HState -> HState
+addShMacro m (st,(h,cpu,c,t)) = (st,(h,cpu,m:c,t))
+
+addShTerm :: (String,Tree) -> HState -> HState
+addShTerm m (st,(h,cpu,c,t)) = (st,(h,cpu,c,m:t))
+
+resolveShMacro :: HState -> String -> [String] -> [String]
+resolveShMacro st@(_,(_,_,cs,_)) c args = case lookup c cs of
+  Just def -> map subst def
+  _ -> [] ----
+ where
+   subst s = case s of
+     "#1" -> unwords args
+     _ -> s
+ --- so far only one arg allowed - how to determine arg boundaries?
+{-
+   subst s = case s of
+     '#':d@(_:_) | all isDigit d -> 
+        let i = read d in if i > lg then s else args !! (i-1) -- #1 is first
+     _ -> s
+   lg = length args
+-}
+
+lookupShTerm :: HState -> String -> Maybe Tree
+lookupShTerm st@(_,(_,_,_,ts)) c = lookup c ts
+
+txtHelpMacros :: HState -> String
+txtHelpMacros (_,(_,_,cs,ts)) = unlines $
+  ["Defined commands:",""] ++
+  [c +++ "=" +++ unwords def | (c,def) <- cs] ++
+  ["","Defined terms:",""] ++
+  [c +++ "=" +++ prt_ def | (c,def) <- ts]
+
+-- | empty command if index over
+earlierCommandH :: HState -> Int -> String
+earlierCommandH (_,(h,_,_,_)) = ((h ++ repeat "") !!) 
+
+execLinesH :: String -> [CommandLine] -> HState -> IO HState
+execLinesH s cs hst@(st, (h,_,_,_)) = do
+  (_,st') <- execLinesI True cs hst
+  cpu     <- prOptCPU (optsHState st') (cpuHState hst)
+  return $ putHStateCPU cpu $ updateHistory s st'
+
+-- | Like 'execLines', but can be interrupted by SIGINT.
+execLinesI :: Bool -> [CommandLine] -> HState -> IO ([String],HState)
+execLinesI put cs st = 
+    do
+    x <- runInterruptibly (execLines put cs st)
+    case x of
+           Left ex -> do hPutStrLn stderr ""
+                         hPutStrLn stderr $ show ex
+                         return ([],st)
+           Right y -> return y
+
+ifImpure :: [CommandLine] -> Maybe (ImpureCommand,Options)
+ifImpure cls = foldr (const . Just) Nothing [(c,os) | ((CImpure c,os),_,_) <- cls]
+
+-- | the main function: execution of commands. 'put :: Bool' forces immediate output
+--
+-- command line with consecutive (;) commands: no value transmitted
+execLines :: Bool -> [CommandLine] -> HState -> IO ([String],HState)
+execLines put cs st = foldM (flip (execLine put)) ([],st) cs
+
+-- | command line with piped (|) commands: no value returned
+execLine :: Bool -> CommandLine -> ([String],HState) -> IO ([String],HState)
+execLine put (c@(co, os), arg, cs) (outps,st) = do
+  (st',val) <- execC c (st, arg)
+  let tr = oElem doTrace os || null cs    -- option -tr leaves trace in pipe
+      make = oElem (iOpt "make") os
+      isErr = case arg of 
+                AError _ -> True
+                _ -> False
+      utf = if (oElem useUTF8 os) then encodeUTF8 else id 
+      outp = if tr then [utf (prCommandArg val)] else []
+  if put then mapM_ putStrLnFlush outp else return ()
+  if make && isErr
+    then exitFailure
+    else execs cs val (if put then [] else outps ++ outp, st')
+ where
+    execs []     arg st = return st
+    execs (c:cs) arg st = execLine put (c, arg, cs) st
+
+-- | individual commands possibly piped: value returned; this is not a state monad
+execC :: CommandOpt -> ShellIO
+execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case comm of
+
+  CImport file | takeExtensions file == ".gfwl" -> do
+    fs <- mkWordlist file
+    foldM (\x y -> execC (CImport y, opts) x) sa fs
+
+  CImport file | oElem fromExamples opts -> do
+    es <- liftM nub $ getGFEFiles opts file
+    system $ "gf -examples" +++ unlines es
+    execC (comm, removeOption fromExamples opts) sa
+  CImport file -> useIOE sa $ do
+    st1 <- shellStateFromFiles opts st file
+    ioeIO $ changeState (const st1) sa --- \ ((_,h),a) -> ((st,h), a))
+
+  CEmptyState    -> changeState reinitShellState sa
+  CChangeMain ma -> changeStateErr (changeMain ma) sa
+  CStripState    -> changeState purgeShellState sa
+
+  CRemoveLanguage lan -> changeState (removeLang lan) sa
+{-
+  CTransformGrammar file -> do
+    s <- transformGrammarFile opts file
+    returnArg (AString s) sa
+  CConvertLatex file -> do
+    s <- readFileIf file
+    returnArg (AString (convertGFTex s)) sa 
+-}
+  CPrintHistory -> (returnArg $ AString $ unlines $ reverse h) sa
+  -- good to have here for piping; eh and ec must be done on outer level
+
+  CDefineCommand c args -> return (addShMacro (c,args) sh, AUnit)
+  CDefineTerm c -> do 
+    let 
+      a' = case a of
+        ASTrm _ -> s2t a
+        AString _ -> s2t a
+        _ -> a
+    case a' of
+      ATrms [trm] -> return (addShTerm (c,trm) sh, AUnit) 
+      _ ->  returnArg (AError "illegal term definition") sa
+
+  CLinearize [] 
+    | oElem showMulti opts -> 
+
+       changeArg (opTS2CommandArg (
+         unlines . 
+         (\t -> [optLinearizeTreeVal opts gr t | gr <- allStateGrammars st])) . s2t) sa
+
+    | otherwise -> changeArg (opTS2CommandArg (optLinearizeTreeVal opts gro) . s2t) sa
+----  CLinearize m -> changeArg (opTS2CommandArg (optLinearizeArgForm opts gro m)) sa
+
+  CParse 
+----    | oElem showMulti opts -> do
+    | oElem (iOpt "overload") opts -> do
+       p <- parse $ prCommandArg a
+       changeArg (opTTs2CommandArg getOverloadResults) p
+    | oElem byLines opts -> do
+        let ss = (if oElem showAll opts then id else filter (not . null)) $ 
+                     lines $ prCommandArg a
+        mts <- mapM parse ss
+        let mark s ts = case ts of
+              [] -> [MMacros.uTree] -- to leave a trace of unparsed line
+              _  -> ts
+        let a' = ATrms [t | (s,(_,ATrms ts)) <- zip ss mts, t <- mark s ts]
+        changeArg (const a') sa
+    | otherwise -> parse $ prCommandArg a
+   where 
+      parse x = do
+       warnDiscont opts
+       let p = optParseArgErrMsg opts gro x
+       case p of
+         Ok (ts,msg) 
+           | oElem (iOpt "fail") opts && null ts -> do
+                putStrLnFlush ("#FAIL:" +++ x) >> changeArg (const $ ATrms ts) sa
+           | oElem (iOpt "ambiguous") opts && length ts > 1 -> do
+                putStrLnFlush ("#AMBIGUOUS:" +++ x) >> changeArg (const $ ATrms ts) sa
+           | oElem (iOpt "prob") opts -> do
+                let probs = stateProbs gro 
+                let tps = rankByScore [(t,computeProbTree probs t) | t <- ts]
+                putStrLnFlush msg
+                mapM_ putStrLnFlush [show p | (t,p) <- tps]
+                changeArg (const $ ATrms (map fst tps)) sa
+           | otherwise -> putStrLnFlush msg >> changeArg (const $ ATrms ts) sa
+         Bad msg -> changeArg (const $ AError (msg +++ "input" +++ x)) sa
+
+  CTranslate il ol -> do
+    let a' = opST2CommandArg (optParseArgErr opts (sgr il)) a
+    returnArg (opTS2CommandArg (optLinearizeTreeVal opts (sgr ol)) a') sa
+
+  CGenerateRandom | oElem showCF opts || oElem (iOpt "prob") opts -> do
+    let probs = stateProbs gro 
+    let cat = firstAbsCat opts gro
+    let n = optIntOrN opts flagNumber 1
+    gen    <- newStdGen
+    let ts = take n $ generateRandomTreesProb opts gen cgr probs cat
+    returnArg (ATrms (map (term2tree gro) ts)) sa
+
+  CGenerateRandom -> do
+    let 
+      a' = case a of
+        ASTrm _ -> s2t a
+        AString _ -> s2t a
+        _ -> a
+    case a' of
+      ATrms (trm:_) -> case tree2exp trm of
+        G.EInt _ -> do
+          putStrLn "Warning: Number argument deprecated, use gr -number=n instead"
+          ts <- randomTreesIO opts gro (optIntOrN opts flagNumber 1)
+          returnArg (ATrms ts) sa
+        _ -> do
+            g    <- newStdGen
+            case (goFirstMeta (tree2loc trm) >>= refineRandom g 41 cgr) of
+              Ok trm' -> returnArg (ATrms [loc2tree trm']) sa
+              Bad s   -> returnArg (AError s) sa
+      _ -> do
+        ts <- randomTreesIO opts gro (optIntOrN opts flagNumber 1)
+        returnArg (ATrms ts) sa
+
+  CGenerateTrees | oElem showAll opts -> do
+    let 
+      cat = firstAbsCat opts gro
+      outp 
+       | oElem (iOpt "lin") opts = optLinearizeTreeVal opts gro . term2tree gro
+       | otherwise = prt_
+    justOutput opts (generateAll opts (putStrLn . outp) cgr cat) sa
+  CGenerateTrees -> do
+    let 
+      a' = case a of
+        ASTrm _ -> s2t a
+        AString _ -> s2t a
+        _ -> a
+      mt = case a' of
+        ATrms (tr:_) -> Just tr
+        _ -> Nothing
+    returnArg (ATrms $ generateTrees opts gro mt) sa
+
+  CTreeBank | oElem doCompute opts -> do -- -c
+    let bank = prCommandArg a
+    returnArg (AString $ unlines $ testMultiTreebank opts st bank) sa
+  CTreeBank | oElem getTrees opts -> do -- -trees
+    let bank  = prCommandArg a
+        tes   = map (string2treeErr gro) $ treesTreebank opts bank
+        terms = [t | Ok t <- tes] 
+    returnArg (ATrms terms) sa
+  CTreeBank -> do
+    let ts = strees $ s2t $ snd sa
+        comm = "command" ----
+    returnArg (AString $ unlines $ mkMultiTreebank opts st comm ts) sa
+
+  CLookupTreebank -> do
+    let tbs = treebanks st
+    let s   = prCommandArg a
+    if null tbs 
+      then returnArg (AError "no treebank") sa
+      else do
+        let tbi = maybe (fst $ head tbs) I.identC (getOptVal opts (aOpt "treebank"))
+        case lookup tbi tbs of
+          Nothing -> returnArg (AError ("no treebank" +++ prt tbi)) sa
+          Just tb -> case () of
+            _ | oElem (iOpt "strings") opts -> do
+              returnArg (AString $ unlines $ map fst $ assocsTreebank tb) sa
+            _ | oElem (iOpt "raw") opts -> do
+              returnArg (AString $ unlines $ lookupTreebank tb s) sa
+            _ | oElem (iOpt "assocs") opts -> do
+              returnArg (AString $ unlines $ map printAssoc $ assocsTreebank tb) sa
+            _ | oElem (iOpt "trees") opts -> do
+              returnArg (ATrms $ str2trees $ concatMap snd $ assocsTreebank tb) sa
+            _ -> do            
+              let tes = map (string2treeErr gro) $ lookupTreebank tb s
+                  terms = [t | Ok t <- tes]
+              returnArg (ATrms terms) sa
+
+  CShowTreeGraph | oElem emitCode opts -> do -- -o
+    returnArg (AString $ visualizeTrees opts $ strees $ s2t a) sa
+  CShowTreeGraph  -> do
+    let gv = if oElem (iOpt "mac") opts then "open" else "gv" ---- config!
+    let g0 = writeFile "grphtmp.dot" $ visualizeTrees opts $ strees $ s2t a
+        g1 = system "dot -Tps grphtmp.dot >grphtmp.ps" 
+        g2 = system (gv +++ "grphtmp.ps &") 
+        g3 = return () ---- system "rm -f grphtmp.*"
+    justOutput opts (g0 >> g1 >> g2 >> g3 >> return ()) sa
+
+  CPutTerm -> changeArg (opTT2CommandArg (return . optTermCommand opts gro) . s2t) sa
+
+  CWrapTerm f -> changeArg (opTT2CommandArg (return . return . wrapByFun opts gro f) . s2t) sa
+  CApplyTransfer f -> changeArg (opTT2CommandArg (applyTransfer opts gro transfs f) . s2t) sa
+  CMorphoAnalyse -> changeArg (AString . morphoAnalyse opts gro . prCommandArg) sa
+  CTestTokenizer -> changeArg (AString . optTokenizer opts gro . prCommandArg) sa
+
+  CComputeConcrete t -> do
+    let prin = if (oElem (iOpt "table") opts) then printParadigm else prt 
+    m <- return $
+         maybe (I.identC "?") id $  -- meaningful if no opers in t 
+           maybe (resourceOfShellState st) (return . I.identC) $ -- topmost res
+             getOptVal opts useResource             -- flag -res=m
+    returnArg (AString (err id (prin . stripTerm) (
+                string2srcTerm src m t >>= 
+                Ch.justCheckLTerm src  >>=
+                Co.computeConcrete src))) sa
+---                Co.computeConcreteRec src)) sa
+  CShowOpers t -> do
+    m <- return $
+         maybe (I.identC "?") id $  -- meaningful if no opers in t 
+           maybe (resourceOfShellState st) (return . I.identC) $ -- topmost res
+             getOptVal opts useResource             -- flag -res=m
+    justOutput opts (putStrLn (err id (unlines . map prOperSignature) (
+                string2srcTerm src m t >>= (\t' -> 
+                Co.computeConcrete src t' >>=  (\v -> 
+                return (L.opersForType src t' v)))))) sa
+
+
+  CTranslationQuiz il ol -> do
+    warnDiscont opts 
+    justOutput opts (teachTranslation opts (sgr il) (sgr ol)) sa
+  CTranslationList il ol -> do
+    warnDiscont opts
+    let n = optIntOrN opts flagNumber 10 
+    qs <- transTrainList opts (sgr il) (sgr ol) (toInteger n)
+    let hdr = unlines ["# From: " ++ prIdent il,
+                       "# To: " ++ prIdent ol]
+    returnArg (AString $ hdr ++++ foldr (+++++) [] [unlines (s:ss) | (s,ss) <- qs]) sa
+
+  CMorphoQuiz -> do
+    warnDiscont opts 
+    justOutput opts (teachMorpho opts gro) sa
+  CMorphoList -> do
+    let n = optIntOrN opts flagNumber 10  
+    warnDiscont opts 
+    qs <- useIOE [] $ morphoTrainList opts gro (toInteger n)
+    returnArg (AString $ foldr (+++++) [] [unlines (s:ss) | (s,ss) <- qs]) sa
+
+  CReadFile file   -> returnArgIO   (readFileIf file >>= return . AString) sa
+  CWriteFile file  -> justOutputArg opts (writeFile file) sa
+  CAppendFile file -> justOutputArg opts (appendFile file) sa
+  CSpeakAloud      -> justOutputArg opts (speechGenerate opts) sa
+  CSpeechInput     -> returnArgIO (speechInput opts gro >>= return . AString . unlines) sa
+  CSystemCommand s -> case a of
+    AUnit -> justOutput opts (system s >> return ()) sa
+    _     -> systemArg  opts a s sa 
+  CPutString       -> changeArg    (opSS2CommandArg (optStringCommand opts gro)) sa
+-----  CShowTerm        -> changeArg  (opTS2CommandArg (optPrintTerm opts gro) . s2t) sa
+  CGrep ms -> changeArg (AString . unlines . filter (grep ms) . lines . prCommandArg) sa
+
+
+  CSetFlag           -> changeState (addGlobalOptions opts0) sa
+---- deprec!  CSetLocalFlag lang -> changeState (addLocalOptions lang opts0) sa
+
+  CHelp (Just c) -> returnArg   (AString (txtHelpCommand c)) sa
+  CHelp _ -> case opts0 of
+    Opts [o] | o == showAll  -> returnArg   (AString txtHelpFile) sa
+    Opts [o] | o == showDefs -> returnArg   (AString (txtHelpMacros sh)) sa
+    Opts [o]        -> returnArg   (AString (txtHelpCommand ('-':prOpt o))) sa
+    _               -> returnArg   (AString txtHelpFileSummary) sa
+
+  CPrintGrammar       -> returnArg (AString (optPrintGrammar opts gro)) sa
+  CPrintGlobalOptions -> justOutput opts (putStrLn  $ prShellStateInfo st) sa
+  CPrintInformation c -> justOutput opts (useIOE () $ showInformation opts st c) sa
+  CPrintLanguages     -> justOutput opts 
+                         (putStrLn $ unwords $ map prLanguage $ allLanguages st) sa
+  CPrintMultiGrammar  -> do
+    let cgr' = canModules $ purgeShellState st
+    returnArg (AString (optPrintMultiGrammar opts cgr')) sa
+  CShowGrammarGraph  -> do
+    ---- sa' <- changeState purgeShellState sa
+    let gv = if oElem (iOpt "mac") opts then "open" else "gv" ---- config!
+    let g0 = writeFile "grphtmp.dot" $ visualizeCanonGrammar opts cgr
+        g1 = system "dot -Tps grphtmp.dot >grphtmp.ps" 
+        g2 = system (gv +++ "grphtmp.ps &") 
+        g3 = return () ---- system "rm -f grphtmp.*"
+    justOutput opts (g0 >> g1 >> g2 >> g3 >> return ()) sa
+  CPrintSourceGrammar -> 
+      returnArg (AString (visualizeSourceGrammar src)) sa
+
+----  CPrintGramlet       -> returnArg (AString (Gr.prGramlet st)) sa
+----  CPrintCanonXML      -> returnArg (AString (Canon.prCanonXML st False)) sa
+----  CPrintCanonXMLStruct -> returnArg (AString (Canon.prCanonXML st True)) sa
+  _ -> justOutput opts (putStrLn "command not understood") sa
+
+ where
+   sgr = stateGrammarOfLang st
+   gro = grammarOfOptState opts st
+   opts = addOptions opts0 (globalOptions st)
+   src = srcModules st
+   cgr = canModules st
+
+   transfs = transfers st
+
+   s2t a = case a of
+     ASTrm ('$':c) -> maybe (AError "undefined term") (ATrms . return) $ lookupShTerm sh c
+     ASTrm s  -> err AError (ATrms . return) $ string2treeErr gro s
+     AString s  -> err AError (ATrms . return) $ string2treeErr gro s
+     _ -> a
+
+   str2trees ts = [t | Ok t <- map (string2treeErr gro) ts]
+
+   strees a = case a of
+     ATrms ts -> ts
+     _ -> [] 
+
+   warnDiscont os = err putStrLn id $ do
+     let c0 = firstAbsCat os gro
+     c <- GrammarToCanon.redQIdent c0
+     lang <- maybeErr "no concrete" $ languageOfOptState os st
+     t <- return $ errVal CMacros.defLinType $ Look.lookupLincat cgr $ CMacros.redirectIdent lang c
+     return $ if CMacros.isDiscontinuousCType t 
+       then (putStrLn ("Warning: discontinuous category" +++ prt_ c))
+       else (return ())
+
+   grep ms s = (if oElem invertGrep opts then not else id) $ grepv ms s --- -v
+   grepv ms s = case s of
+     _:cs -> isPrefixOf ms s || grepv ms cs
+     _ -> isPrefixOf ms s
+
+-- commands either change the state or process the argument, but not both
+-- some commands just do output
+
+changeState :: ShellStateOper -> ShellIO
+changeState f ((st,h),a) = return ((f st,h), a)
+
+changeStateErr :: ShellStateOperErr -> ShellIO
+changeStateErr f ((st,h),a) = case f st of
+  Ok st' -> return ((st',h), a)
+  Bad s  -> return ((st, h),AError s)
+
+changeArg :: (CommandArg -> CommandArg) -> ShellIO
+changeArg f (st,a) = return (st, f a)
+
+changeArgMsg :: (CommandArg -> (CommandArg,String)) -> ShellIO
+changeArgMsg f (st,a) = do
+  let (b,msg) = f a
+  putStrLnFlush msg
+  return (st, b)
+
+returnArg :: CommandArg -> ShellIO
+returnArg = changeArg . const
+
+returnArgIO :: IO CommandArg -> ShellIO
+returnArgIO io (st,_) = io >>= (\a -> return (st,a))
+
+justOutputArg :: Options -> (String -> IO ()) -> ShellIO
+justOutputArg opts f sa@(st,a) = f (utf (prCommandArg a)) >> return (st, AUnit) 
+ where
+   utf = if (oElem useUTF8 opts) then encodeUTF8 else id
+
+justOutput :: Options -> IO () -> ShellIO
+justOutput opts = justOutputArg opts . const
+
+systemArg :: Options -> CommandArg -> String -> ShellIO
+systemArg _ cont syst sa = do
+  writeFile tmpi $ prCommandArg cont
+  system $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo 
+  s <- readFile tmpo
+  returnArg (AString s) sa
+ where
+   tmpi = "_tmpi" ---
+   tmpo = "_tmpo"
+
+-- | type system for command arguments; instead of plain strings...
+data CommandArg = 
+   AError  String 
+ | ATrms   [Tree] 
+ | ASTrm   String   -- ^ to receive from parser 
+ | AStrs   [Str] 
+ | AString String 
+ | AUnit 
+  deriving (Eq, Show)
+
+prCommandArg :: CommandArg -> String
+prCommandArg arg = case arg of
+  AError s   -> s
+  AStrs ss   -> sstrV ss
+  AString s  -> s
+  ATrms []   -> "no tree found"
+  ATrms tt   -> unlines $ map prt_Tree tt
+  ASTrm s    -> s
+  AUnit      -> ""
+
+opSS2CommandArg :: (String -> String) -> CommandArg -> CommandArg
+opSS2CommandArg f = AString . f . prCommandArg
+
+opST2CommandArg :: (String -> Err [Tree]) -> CommandArg -> CommandArg
+opST2CommandArg f = err AError ATrms . f . prCommandArg
+
+opTS2CommandArg :: (Tree -> String) -> CommandArg -> CommandArg
+opTS2CommandArg f (ATrms ts) = AString $ unlines $ map f ts
+opTS2CommandArg _ (AError s) = AError ("expected term, but got error:" ++++ s)
+opTS2CommandArg _ a = AError ("expected term, but got:" ++++ prCommandArg a)
+
+opTT2CommandArg :: (Tree -> Err [Tree]) -> CommandArg -> CommandArg
+opTT2CommandArg f (ATrms ts) = err AError (ATrms . concat) $ mapM f ts
+opTT2CommandArg _ (AError s) = AError ("expected term, but got error:" ++++ s)
+opTT2CommandArg _ a = AError ("expected term, but got:" ++++ prCommandArg a)
+
+opTTs2CommandArg :: ([Tree] -> [Tree]) -> CommandArg -> CommandArg
+opTTs2CommandArg f (ATrms ts) = ATrms $ f ts
+opTTs2CommandArg _ (AError s) = AError ("expected terms, but got error:" ++++ s)
+opTTs2CommandArg _ a = AError ("expected terms, but got:" ++++ prCommandArg a)
+
diff --git a/src-2.9/GF/Shell/CommandL.hs b/src-2.9/GF/Shell/CommandL.hs
new file mode 100644
index 000000000..efb6460b4
--- /dev/null
+++ b/src-2.9/GF/Shell/CommandL.hs
@@ -0,0 +1,198 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CommandL
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/17 15:13:55 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.21 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Shell.CommandL where
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+
+import GF.Canon.CMacros
+import GF.Grammar.Values (Tree)
+
+import GF.UseGrammar.GetTree
+import GF.Compile.ShellState
+import GF.Infra.Option
+import GF.UseGrammar.Session
+import GF.Shell.Commands
+import GF.UseGrammar.Tokenize (wordsLits)
+
+import Data.Char
+import Data.List (intersperse)
+import Control.Monad (foldM)
+
+import GF.Text.UTF8
+
+-- | a line-based shell
+initEditLoop :: CEnv -> IO () -> IO ()
+initEditLoop env resume = do
+  let env' = startEditEnv env
+  putStrLnFlush $ initEditMsg env'
+  let state = initSStateEnv env'
+  putStrLnFlush $ showCurrentState env' state
+  editLoop env' state resume
+
+editLoop :: CEnv -> SState -> IO () -> IO ()
+editLoop env state resume = do
+  putStrFlush "edit> "
+  c <- getCommand
+  if (isQuit c) then resume else do
+    (env',state') <- execCommand env c state
+    let package = case c of
+          CCEnvEmptyAndImport _ -> initEditMsgEmpty env'
+          _ -> showCurrentState env' state'
+    putStrLnFlush package
+
+    editLoop env' state' resume
+
+-- | execute a command script and return a tree
+execCommandHistory :: CEnv -> String -> IO (CEnv,Tree)
+execCommandHistory env s = do
+  let env'  = startEditEnv env
+  let state = initSStateEnv env'
+  (env',state') <- foldM exec (env,state) $ lines s
+  return $ (env',treeSState state')
+
+ where
+
+  exec (env,state) l = do
+    let c = pCommand l
+    execCommand env c state
+
+
+
+getCommand :: IO Command
+getCommand = do
+  s <- getLine
+  return $ pCommand s
+
+-- | decodes UTF8 if u==True, i.e. if the grammar uses UTF8;
+-- used in the Java GUI, which always uses UTF8
+getCommandUTF :: Bool -> IO [(String,Command)]
+getCommandUTF u = do
+  s <- getLine
+  return $ pCommandMsgs $ if u then decodeUTF8 s else s
+
+pCommandMsgs :: String -> [(String,Command)]
+pCommandMsgs = map (pCommandMsg . unwords) . concatMap (chunks ";;" . words) . lines
+
+pCommand :: String -> Command
+pCommand = snd . pCommandMsg
+
+
+pCommandMsg :: String -> (String,Command)
+pCommandMsg s = (m,pCommandWords $ words c) where
+  (m,c) = case s of
+    '[':s2 -> let (a,b) = span (/=']') s2 in (a,drop 1 b)
+    _ -> ("",s) 
+  pCommandWords s = case s of
+    "n" : cat : _ -> CNewCat cat
+    "t" : ws      -> CNewTree $ unwords ws
+    "g" : ws      -> CRefineWithTree $ unwords ws  -- example: *g*ive
+    "p" : ws      -> CRefineParse $ unwords ws
+    "rc": i : _   -> CRefineWithClip (readIntArg i)
+    ">" : i : _   -> CAhead $ readIntArg i
+    ">" : []      -> CAhead 1
+    "<" : i : _   -> CBack $ readIntArg i
+    "<" : []      -> CBack 1
+    ">>" : _      -> CNextMeta
+    "<<" : _      -> CPrevMeta
+    "'" : _       -> CTop
+    "+" : _       -> CLast
+    "mp" : p      -> CMovePosition (readIntList (unwords p))
+    "ct" : p:q:_  -> CCopyPosition (readIntList p) (readIntList q)
+    "r" : f : _   -> CRefineWithAtom f
+    "w" : f:i : _ -> CWrapWithFun (f, readIntArg i)
+    "ch": f : _   -> CChangeHead f
+    "ph": f:i : _ -> CPeelHead (f, readIntArg i)
+    "x" : ws      -> CAlphaConvert $ unwords ws
+    "s" : i : _   -> CSelectCand (readIntArg i)
+    "f" : "unstructured" : _ -> CRemoveOption showStruct --- hmmm
+    "f" : "structured" : _ -> CAddOption showStruct --- hmmm
+    "f" : s : _   -> CAddOption (filterString s)
+    "u" : i : _   -> CUndo (readIntArg i)
+    "u" : _       -> CUndo 1
+    "d" : _       -> CDelete
+    "ac" : _      -> CAddClip
+    "pc": i : _   -> CRemoveClip (readIntArg i)
+    "c" : s : _   -> CTermCommand s
+    "a" : _       -> CRefineRandom --- *a*leatoire
+    "m" :  _      -> CMenu
+    "ml" : s : _  -> changeMenuLanguage s
+    "ms" : s : _  -> changeMenuSize s
+    "mt" : s : _  -> changeMenuTyped s
+    "v" : _       -> CView
+    "q" : _       -> CQuit
+    "h" : _       -> CHelp initEditMsg
+
+    "i" : file: _ -> CCEnvImport file
+    "e" : []      -> CCEnvEmpty
+    "e" : file: _ -> CCEnvEmptyAndImport file
+
+    "open" : f: _ -> CCEnvOpenTerm f
+    "openstring": f: _ -> CCEnvOpenString f
+
+    "on" :lang: _ -> CCEnvOn  lang 
+    "off":lang: _ -> CCEnvOff lang 
+    "pfile" :f:_  -> CCEnvRefineParse f
+    "tfile" :f:_  -> CCEnvRefineWithTree f
+    "save":l:f:_  -> CCEnvSave l f
+
+-- openstring file
+-- pfile file
+-- tfile file
+-- on lang
+-- off lang
+
+    "gf": comm    -> CCEnvGFShell (unwords comm)
+
+    []            -> CVoid
+    _             -> CError
+
+-- | well, this lists the commands of the line-based editor
+initEditMsg :: CEnv -> String
+initEditMsg env = unlines $
+  "State-dependent editing commands are given in the menu:" :
+  "  n [Cat] = new, r [Fun] = refine, w [Fun] [Int] = wrap,":
+  "  ch [Fun] = change head, d = delete, s [Int] = select," :
+  "  x [Var] [Var] = alpha convert." :
+  "Commands changing the environment:" :
+  "  i [file] = import, e = empty." :
+  "Other commands:" : 
+  "  a = random, v = change view, u = undo, h = help, q = quit," :
+  "  ml [Lang] = change menu language," :
+  "  ms (short | long) = change menu command size," :
+  "  mt (typed | untyped) = change menu item typing," :
+  "  p [string] = refine by parsing, g [term] = refine by term," :             
+  "  > = down, < = up, ' = top, >> = next meta, << = previous meta." :
+---- ("  c [" ++ unwords (intersperse "|" allTermCommands) ++ "] = modify term") : 
+---- ("  f [" ++ unwords (intersperse "|" allStringCommands) ++ "] = modify output") : 
+  []
+
+initEditMsgEmpty :: CEnv -> String
+initEditMsgEmpty env = initEditMsg env +++++ unlines (
+  "Start editing by n Cat selecting category\n\n" :
+  "-------------\n" :
+  ["n" +++ cat | (_,cat) <- newCatMenu env]
+  )
+
+showCurrentState :: CEnv -> SState -> String
+showCurrentState env' state' =
+  unlines (tr ++ ["",""] ++ msg ++ ["",""] ++ map fst menu) 
+                 where (tr,msg,menu) = displaySStateIn env' state'
+
+-- | to read position; borrowed from Prelude; should be elsewhere
+readIntList :: String -> [Int]
+readIntList s = case [x | (x,t) <- reads s, ("","") <- lex t] of
+                  [x] -> x
+                  _   -> []
diff --git a/src-2.9/GF/Shell/Commands.hs b/src-2.9/GF/Shell/Commands.hs
new file mode 100644
index 000000000..8699c2fe7
--- /dev/null
+++ b/src-2.9/GF/Shell/Commands.hs
@@ -0,0 +1,568 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Commands
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/06 10:02:33 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.42 $
+--
+-- temporary hacks for GF 2.0
+--
+-- Abstract command language for syntax editing. AR 22\/8\/2001.
+-- Most arguments are strings, to make it easier to receive them from e.g. Java.
+-- See "CommandsL" for a parser of a command language.
+-----------------------------------------------------------------------------
+
+module GF.Shell.Commands where
+
+import GF.Data.Operations
+import GF.Data.Zipper
+
+import qualified GF.Grammar.Grammar as G ---- Cat, Fun, Q, QC
+import GF.Canon.GFC
+import GF.Canon.CMacros
+import GF.Grammar.Macros (qq)----
+import GF.Grammar.LookAbs
+import GF.Canon.Look
+import GF.Grammar.Values (loc2treeFocus,tree2exp)----
+
+import GF.UseGrammar.GetTree
+import GF.API
+import GF.Compile.ShellState
+
+import qualified GF.Shell as Shell
+import qualified GF.Shell.PShell as PShell
+import qualified GF.Grammar.Macros as M
+import GF.Grammar.PrGrammar
+import GF.Compile.PGrammar
+import GF.API.IOGrammar
+import GF.Infra.UseIO
+import GF.Text.Unicode
+
+import GF.CF.CF
+import GF.CF.CFIdent (cat2CFCat, cfCat2Cat)
+import GF.CF.PPrCF (prCFCat)
+import GF.UseGrammar.Linear
+import GF.UseGrammar.Randomized
+import GF.UseGrammar.Editing
+import GF.UseGrammar.Session
+import GF.UseGrammar.Custom
+
+import qualified GF.Infra.Ident as I
+import GF.Infra.Option
+import GF.Data.Str (sstr) ----
+import GF.Text.UTF8 ----
+
+import System.Random (StdGen, mkStdGen, newStdGen)
+import Control.Monad (liftM2, foldM)
+import Data.List (intersperse)
+
+--- temporary hacks for GF 2.0
+
+-- Abstract command language for syntax editing. AR 22/8/2001
+-- Most arguments are strings, to make it easier to receive them from e.g. Java.
+-- See CommandsL for a parser of a command language.
+
+data Command =
+   CNewCat String
+ | CNewTree String
+ | CAhead Int
+ | CBack Int
+ | CNextMeta
+ | CPrevMeta
+ | CTop
+ | CLast
+ | CMovePosition [Int]
+ | CCopyPosition [Int] [Int]
+ | CRefineWithTree String
+ | CRefineWithClip Int
+ | CRefineWithAtom String
+ | CRefineParse String
+ | CWrapWithFun (String,Int)
+ | CChangeHead String
+ | CPeelHead (String,Int)
+ | CAlphaConvert String
+ | CRefineRandom
+ | CSelectCand Int
+ | CTermCommand  String
+ | CAddOption Option
+ | CRemoveOption Option
+ | CDelete
+ | CAddClip
+ | CRemoveClip Int
+ | CUndo Int
+ | CView
+ | CMenu
+ | CQuit
+ | CHelp  (CEnv -> String) -- ^ help message depends on grammar and interface
+ | CError -- ^ syntax error in command
+ | CVoid  -- ^ empty command, e.g. just \<enter\>
+
+ | CCEnvImport String         -- ^ |-- commands affecting 'CEnv'
+ | CCEnvEmptyAndImport String -- ^ |
+ | CCEnvOpenTerm String       -- ^ |
+ | CCEnvOpenString String     -- ^ |
+ | CCEnvEmpty                 -- ^ |
+
+ | CCEnvOn  String            -- ^ |
+ | CCEnvOff String            -- ^ |
+
+ | CCEnvGFShell String        -- ^ |==========
+
+ | CCEnvRefineWithTree String -- ^ |-- other commands using 'IO'
+ | CCEnvRefineParse String    -- ^ |
+ | CCEnvSave String FilePath  -- ^ |==========
+
+isQuit :: Command -> Bool
+isQuit CQuit = True
+isQuit _ = False
+
+-- | an abstract environment type
+type CEnv    = ShellState
+
+grammarCEnv :: CEnv -> StateGrammar
+grammarCEnv  = firstStateGrammar
+
+canCEnv :: CEnv -> CanonGrammar
+canCEnv  = canModules
+
+concreteCEnv, abstractCEnv :: StateGrammar -> I.Ident
+concreteCEnv = cncId
+abstractCEnv = absId
+
+stdGenCEnv :: CEnv -> SState -> StdGen
+stdGenCEnv env s = mkStdGen (length (displayJustStateIn env s) * 31 +11) ---
+
+initSStateEnv :: CEnv -> SState
+initSStateEnv env = case getOptVal (stateOptions sgr) gStartCat of
+  Just cat -> action2commandNext (newCat gr (abs, I.identC cat)) initSState
+  _ -> initSState
+ where 
+   sgr = firstStateGrammar env
+   abs = absId sgr
+   gr  = stateGrammarST sgr
+
+-- | the main function
+execCommand :: CEnv -> Command -> SState -> IO (CEnv,SState)
+execCommand env c s = case c of
+
+-- these commands do need IO
+  CCEnvImport file -> useIOE (env,s) $ do
+    st <- shellStateFromFiles optss env file
+    return (st,s)
+
+  CCEnvEmptyAndImport file -> useIOE (emptyShellState, initSState) $ do
+    st <- shellStateFromFiles optss emptyShellState file
+    return (startEditEnv st,initSState)
+
+  CCEnvEmpty -> do
+    return (startEditEnv emptyShellState, initSState)
+
+  CCEnvGFShell command -> do
+    let hs = Shell.initHState env
+    let cs = PShell.pCommandLines hs command
+    (msg,(env',_)) <- Shell.execLines False cs hs
+    return (env', changeMsg msg s) ----
+
+  CCEnvOpenTerm file -> do
+    c <- readFileIf file
+    let (fs,t) = envAndTerm file c
+----    (env',_) <- execCommand env (CCEnvGFShell fs) s  --TODO; next deprec
+----    env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs 
+    let env' = env ----
+    return (env', execECommand env' (CNewTree t) s)
+
+  CCEnvOpenString file -> do
+    c <- readFileIf file
+    let (fs,t) = envAndTerm file c
+----    (env',_) <- execCommand env (CCEnvGFShell fs) s  --TODO; next deprec
+---- env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs
+    let env' = env ----
+    return (env', execECommand env' (CRefineParse t) s)
+
+  CCEnvOn  name -> return (languageOn  (language name) env,s)
+  CCEnvOff name -> return (languageOff (language name) env,s)
+
+  CCEnvSave lang file -> do
+    let str = optLinearizeTreeVal opts (stateGrammarOfLang env (language lang)) $ treeSState s
+    writeFile file str
+    let msg = ["wrote file" +++ file]
+    return (env,changeMsg msg s)
+
+-- this command is improved by the use of IO
+  CRefineRandom -> do
+    g <- newStdGen
+    return (env, action2commandNext (refineRandom g 41 cgr) s)
+
+-- these commands use IO
+  CCEnvRefineWithTree file -> do
+    str <- readFileIf file 
+    execCommand env (CRefineWithTree str) s 
+  CCEnvRefineParse file -> do
+    str <- readFileIf file 
+    execCommand env (CRefineParse str) s 
+
+-- other commands don't need IO; they are available in the fudget
+  c -> return (env, execECommand env c s)
+
+ where
+   gr = grammarCEnv env
+   cgr = canCEnv env
+   opts = globalOptions env
+   optss = addOption beSilent opts
+
+   -- format for documents: 
+   -- GF commands of form "-- command", then term or text  
+   envAndTerm f s = 
+     (unwords (intersperse ";;" fs), unlines ss) where
+       (fs,ss) = span isImport (lines s)
+       isImport l = take 2 l == "--"
+
+
+execECommand :: CEnv -> Command -> ECommand
+execECommand env c = case c of
+  CNewCat cat        -> action2commandNext $ \x -> do
+                          cat' <- string2cat sgr cat
+                          s' <- newCat cgr cat' x
+                          uniqueRefinements cgr s'
+  CNewTree s         -> action2commandNext $ \x -> do 
+                          t  <- string2treeErr gr s 
+                          s' <- newTree t x
+                          uniqueRefinements cgr s'
+  CAhead n           -> action2command (goAheadN n)
+  CBack n            -> action2command (goBackN n)
+  CTop               -> action2command $ return . goRoot
+  CLast              -> action2command $ goLast
+  CMovePosition p    -> action2command $ goPosition p
+  CNextMeta          -> action2command goNextNewMeta
+  CPrevMeta          -> action2command goPrevNewMeta
+  CRefineWithAtom s  -> action2commandNext $ \x -> do 
+                          t  <- string2ref gr s
+                          s' <- refineWithAtom der cgr t x
+                          uniqueRefinements cgr s'
+  CWrapWithFun (f,i) -> action2commandKeep $ wrapWithFun cgr (qualif f, i)
+  CChangeHead f      -> action2commandKeep $ changeFunHead cgr (qualif f)
+  CPeelHead (f,i)    -> action2commandKeep $ peelFunHead cgr (qualif f,i)
+
+  CAlphaConvert s    -> action2commandKeep $ \x ->
+                          string2varPair s >>= \xy -> alphaConvert cgr xy x
+
+  CRefineWithTree s  -> action2commandNext $ \x -> 
+                          (string2treeInState gr s x >>= 
+                            \t -> refineWithTree der cgr t x)
+  CRefineWithClip i  -> \s -> 
+                          let et = getNumberedClip i s
+                          in (case et of 
+                                Ok t -> refineByTrees der cgr [t] s
+                                Bad m -> changeMsg [m] s)
+  CCopyPosition p q -> action2command $ \s -> do
+                        s1    <- goPosition p s
+                        let t  = actTree s1
+                        s2    <- goPosition q s1
+                        let compat = actVal s1 == actVal s2
+                        if compat 
+                          then refineWithTree der cgr t s2
+                          else return s 
+
+  CRefineParse str   -> \s -> 
+                     let cat = cat2CFCat (qualifTop sgr (actCat (stateSState s)))
+                         ts = parseAny agrs cat str
+                     in (if null ts ---- debug
+                           then withMsg ["parse failed in cat" +++ prCFCat cat]
+                           else id) 
+                            (refineByTrees der cgr ts) s
+
+  CRefineRandom      -> \s -> action2commandNext
+                                (refineRandom (stdGenCEnv env s) 41 cgr) s 
+
+  CSelectCand i      -> selectCand cgr i
+
+  CTermCommand c     -> case c of
+                         "reindex" -> \s ->
+                           replaceByTermCommand der gr c (actTree (stateSState s)) s
+                         "paraphrase" -> \s ->
+                           replaceByTermCommand der gr c (actTree (stateSState s)) s
+----                          "transfer" -> action2commandNext $
+----                                       transferSubTree (stateTransferFun sgr) gr
+                         "generate" -> \s ->
+                           replaceByTermCommand der gr c (actTree (stateSState s)) s
+                         _ -> replaceByEditCommand gr c
+
+  CAddOption o       -> changeStOptions (addOption o)
+  CRemoveOption o    -> changeStOptions (removeOption o)
+  CDelete            -> action2commandKeep $ deleteSubTree cgr
+  CAddClip           -> \s -> (addtoClip (actTree (stateSState s))) s
+  CRemoveClip n      -> \s -> (removeClip n) s
+  CUndo n            -> undoCommand n
+  CMenu              -> \s -> changeMsg (menuState env s) s
+  CView              -> changeView
+  CHelp h            -> changeMsg [h env]
+  CVoid              -> id
+  _                  -> changeMsg ["command not yet implemented"]
+ where
+   sgr  = firstStateGrammar env 
+   agrs = allActiveGrammars env
+   cgr  = canCEnv env
+   gr   = grammarCEnv env
+   der  = maybe True not $ caseYesNo (globalOptions env) noDepTypes
+          -- if there are dep types, then derived refs;  deptypes is the default
+   abs = absId sgr
+   qualif = string2Fun gr
+
+--
+
+
+string2varPair :: String -> Err (I.Ident,I.Ident)
+string2varPair s = case words s of
+  x : y : [] -> liftM2 (,) (string2ident x) (string2ident y)
+  _          -> Bad "expected format 'x y'"
+
+
+startEditEnv :: CEnv -> CEnv
+startEditEnv env = addGlobalOptions (options [sizeDisplay "short"]) env
+
+-- | seen on display
+cMenuDisplay :: String -> Command
+cMenuDisplay s = CAddOption (menuDisplay s)
+
+newCatMenu :: CEnv -> [(Command, String)]
+newCatMenu env = [(CNewCat (prQIdent c), printname env initSState c) | 
+                                  (c,[]) <- allCatsOf (canCEnv env)]
+
+mkRefineMenu :: CEnv -> SState -> [(Command,String)]
+mkRefineMenu env sstate = [(c,s) | (c,(s,_)) <- mkRefineMenuAll env sstate]
+
+mkRefineMenuAll :: CEnv -> SState -> [(Command,(String,String))]
+mkRefineMenuAll env sstate = 
+  case (refinementsState cgr state, candsSState sstate, wrappingsState cgr state) of
+    ([],[],wraps) -> 
+       [(CWrapWithFun (prQIdent_ f, i), prWrap "w" "Wrap" fit)     
+         | fit@((f,i),_) <- wraps] ++
+       [(CChangeHead (prQIdent_ f),  prChangeHead f) 
+         | f <- headChangesState cgr state] ++
+       [(CPeelHead (prQIdent_ f, i), prPeel "ph" "PeelHead" fi)     
+         | fi@(f,i) <- peelingsState cgr state] ++
+       [(CDelete,      (ifShort "d"  "Delete",   "d"))] ++
+       [(CAddClip,     (ifShort "ac" "AddClip",  "ac"))]
+    (refs,[],_)   -> 
+       [(CRefineWithAtom (prRefinement f), prRef t) | t@(f,_) <- refs] ++
+       [(CRefineWithClip i, prClip i t) | (i,t) <- possClipsSState gr sstate] 
+    (_,cands,_)   -> 
+       [(CSelectCand i,   prCand (t,i))    | (t,i) <- zip cands [0..]]
+
+ where
+  prRef (f,(t,_)) = 
+    (ifShort "r" "Refine" +++ prOrLinRef f +++ ifTyped (":" +++ prt_ t),
+     "r" +++ prRefinement f)
+  prClip i t =
+    (ifShort "rc" "Paste" +++ prOrLinTree t,
+     "rc" +++ show i)
+  prChangeHead f = 
+    (ifShort "ch" "ChangeHead" +++ prOrLinFun f,
+     "ch" +++ prQIdent_ f)
+  prWrap sh lg ((f,i),t) = 
+    (ifShort sh lg   +++ prOrLinFun f +++ ifTyped (":" +++ prt t) +++
+     ifShort (show i) (prBracket (show i)),
+     sh +++ prQIdent_ f +++ show i)
+  prPeel sh lg (f,i) = 
+    (ifShort sh lg   +++ prOrLinFun f +++
+     ifShort (show i) (prBracket (show i)),
+     sh +++ prQIdent_ f +++ show i)
+  prCand (t,i) = 
+    (ifShort ("s" +++ prOrLinExp t) ("Select" +++ prOrLinExp t),"s" +++ show i)
+
+  gr = grammarCEnv env
+  cgr = canCEnv env
+  state = stateSState sstate
+  opts = addOptions (optsSState sstate) (globalOptions env)
+  ifOpt f v a b = case getOptVal opts f of 
+    Just s | s == v -> a 
+    _ -> b
+  ifShort = ifOpt sizeDisplay "short"
+  ifTyped t = ifOpt typeDisplay "typed" t ""
+  prOrLinExp t = err (const $ prt_ t) prOrLinTree $ annotateInState cgr t state
+  prOrLinRef t = case t of
+    G.Q m f  ->  printname env sstate (m,f) 
+    G.QC m f ->  printname env sstate (m,f) 
+    _ -> prt_ t
+  prOrLinFun = printname env sstate
+  prOrLinTree t = case getOptVal opts menuDisplay of
+    Just "Abs" -> prt_ $ tree2exp t ---- prTermOpt opts $ tree2exp t
+    Just lang  -> prQuotedString $ lin lang t
+    _ -> prTermOpt opts $ tree2exp t
+  lin lang t = optLinearizeTreeVal opts (stateGrammarOfLang env (language lang)) t
+
+-- there are three orthogonal parameters: Abs/[conc], short/long, typed/untyped
+-- the default is Abs, long, untyped; the Menus menu changes the parameter
+
+emptyMenuItem :: (Command, (String, String))
+emptyMenuItem = (CVoid,("",""))
+
+
+
+---- allStringCommands = snd $ customInfo customStringCommand
+termCommandMenu :: [(Command,String)]
+termCommandMenu = [(CTermCommand s, s) | s <- allTermCommands]
+
+allTermCommands :: [String]
+allTermCommands = snd $ customInfo customEditCommand
+
+stringCommandMenu :: [(Command,String)]
+stringCommandMenu = []
+
+displayCommandMenu :: CEnv -> [(Command,String)]
+displayCommandMenu env =
+  [(CAddOption (menuDisplay s), s) | s <- "Abs" : langs] ++
+  [(CAddOption (sizeDisplay s), s) | s <- ["short", "long"]] ++
+  [(fo nostripQualif, s) | (fo,s) <- [(CAddOption,"qualified"),
+                                      (CRemoveOption,"unqualified")]] ++
+  [(CAddOption (typeDisplay s), s) | s <- ["typed", "untyped"]]
+ where
+   langs = map prLanguage $ allLanguages env
+
+{- ----
+
+stringCommandMenu = 
+   (CAddOption showStruct,      "structured") :
+   (CRemoveOption showStruct,   "unstructured") :
+  [(CAddOption (filterString s), s) | s <- allStringCommands]
+-}
+
+changeMenuLanguage, changeMenuSize, changeMenuTyped :: String -> Command
+changeMenuLanguage s = CAddOption (menuDisplay s)
+changeMenuSize s     = CAddOption (sizeDisplay s)
+changeMenuTyped s    = CAddOption (typeDisplay s)
+
+menuState :: CEnv -> SState -> [String]
+menuState env = map snd . mkRefineMenu env
+
+prState :: State -> [String]
+prState s = prMarkedTree (loc2treeMarked s)
+
+displayJustStateIn :: CEnv -> SState -> String
+displayJustStateIn env state = case displaySStateIn env state of 
+   (t,msg,_) -> unlines (t ++ ["",""] ++ msg) --- ad hoc for CommandF
+
+displaySStateIn :: CEnv -> SState -> ([String],[String],[(String,String)])
+displaySStateIn env state = (tree',msg,menu) where
+  (tree,msg,menu) = displaySState env state
+  grs    = allStateGrammars env
+  lang   = (viewSState state) `mod` (length grs + 3)
+  tree'  = (tree : exp : linAll ++ separ (linAll ++ [tree])) !! lang
+  opts   = addOptions (optsSState state)   -- state opts override
+             (addOption (markLin markOptFocus) (globalOptions env))
+  lin g  = linearizeState fudWrap opts g zipper
+  exp    = return $ tree2string $ loc2tree zipper
+  zipper = stateSState state
+  linAll = map lin grs
+  separ  = singleton . map unlines . intersperse [replicate 72 '*']
+
+-- | the Boolean is a temporary hack to have two parallel GUIs
+displaySStateJavaX :: Bool -> CEnv -> SState -> String -> String
+displaySStateJavaX isNew env state m = encodeUTF8 $ mkUnicode $
+                                       unlines $ tagXML "gfedit" $ concat [
+  if null m then [] else tagXML "hmsg" [m],
+  tagXML "linearizations" (concat 
+    [tagAttrXML "lin" ("lang", prLanguage lang) ss | (lang,ss) <- lins]),
+  tagXML "tree"           tree,
+  tagXML "message"        msg,
+  tagXML "menu"           (tagsXML "item" menu')
+  ]
+ where
+  (tree,msg,menu) = displaySState env state
+  menu'  = [tagXML "show" [unicode s] ++ tagXML "send" [c] | (s,c) <- menu] 
+  (ls,grs) = unzip $ lgrs
+  lgrs   = allActiveStateGrammarsWithNames env
+  lins   = (langAbstract, exp) : linAll
+  opts   = addOptions (optsSState state)   -- state opts override 
+              (addOption (markLin mark) (globalOptions env))
+  lin (n,gr) = (n, map uni $ linearizeState noWrap opts gr zipper) where
+                  uni = optDecodeUTF8 gr
+  exp    = prprTree $ loc2tree zipper
+  zipper = stateSState state
+  linAll = map lin lgrs
+  gr     = firstStateGrammar env
+  mark   = markOptXML -- markOptJava   
+
+  unicode = case getOptVal opts menuDisplay of
+    Just lang -> optDecodeUTF8 (stateGrammarOfLang env (language lang)) 
+    _ -> id
+
+-- | the env is UTF8 if the display language is 
+--
+-- should be independent
+isCEnvUTF8 :: CEnv -> SState -> Bool
+isCEnvUTF8 env st = maybe False id $ do
+   lang <- getOptVal opts menuDisplay
+   co   <- getOptVal (stateOptions (stateGrammarOfLang env (language lang))) uniCoding
+   return $ co == "utf8"
+  where
+    opts = addOptions (optsSState st) (globalOptions env)
+
+langAbstract, langXML :: I.Ident
+langAbstract = language "Abstract"
+langXML      = language "XML"
+
+linearizeState :: (String -> [String]) -> Options -> GFGrammar -> State -> [String]
+linearizeState wrap opts gr = 
+ wrap . strop . unt . optLinearizeTreeVal opts gr . loc2treeFocus
+
+  where
+   unt   = customOrDefault (stateOptions gr) useUntokenizer customUntokenizer gr
+   strop = maybe id ($ gr) $ customAsOptVal opts filterString customStringCommand
+   br    = oElem showStruct opts
+
+noWrap, fudWrap :: String -> [String]
+noWrap = lines
+fudWrap = lines . wrapLines 0 ---
+
+displaySState :: CEnv -> SState -> ([String],[String],[(String,String)])
+displaySState env state = 
+  (prState (stateSState state), msgSState state, menuSState env state)
+
+menuSState :: CEnv -> SState -> [(String,String)]
+menuSState env state = if null cs then [("[NO ALTERNATIVE]","")] else cs 
+  where
+    cs = [(s,c) | (_,(s,c)) <- mkRefineMenuAll env state]
+
+printname :: CEnv -> SState -> G.Fun -> String
+printname env state f = case getOptVal opts menuDisplay of
+  Just "Abs" -> prQIdent_ f
+  Just lang  -> printn lang f
+  _ -> prQIdent_ f ---- prTermOpt opts (qq f)
+ where
+  opts = addOptions (optsSState state) (globalOptions env)
+  printn lang f = err id (ifNull (prQIdent_ f) (sstr . head)) $ do
+    t  <- lookupPrintname gr mf 
+    strsFromTerm t
+   where
+     sgr = stateGrammarOfLang env (language lang)
+     gr  = grammar sgr
+     mf  = ciq (cncId sgr) (snd f)
+
+-- * XML printing; does not belong here!
+
+tagsXML :: String -> [[String]] -> [String]
+tagsXML t = concatMap (tagXML t)
+
+tagAttrXML :: String -> (String, String) -> [String] -> [String]
+tagAttrXML t av ss = mkTagAttrXML t av : map (indent 2) ss ++ [mkEndTagXML t]
+
+tagXML :: String -> [String] -> [String]
+tagXML t ss = mkTagXML t : map (indent 2) ss ++ [mkEndTagXML t]
+
+mkTagXML :: String -> String
+mkTagXML t = '<':t ++ ">"
+
+mkEndTagXML :: String -> String
+mkEndTagXML t = mkTagXML ('/':t)
+
+mkTagAttrsXML :: String -> [(String, String)] -> String
+mkTagAttrsXML t avs = '<':t +++ unwords [a++"="++v | (a,v) <- avs] ++">"
+
+mkTagAttrXML :: String -> (String, String) -> String
+mkTagAttrXML t av  = mkTagAttrsXML t [av]
+
diff --git a/src-2.9/GF/Shell/HelpFile.hs b/src-2.9/GF/Shell/HelpFile.hs
new file mode 100644
index 000000000..43fae7c42
--- /dev/null
+++ b/src-2.9/GF/Shell/HelpFile.hs
@@ -0,0 +1,723 @@
+----------------------------------------------------------------------
+-- |
+-- 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.
+-----------------------------------------------------------------------------
+
+
+module GF.Shell.HelpFile where
+
+import GF.Data.Operations
+
+txtHelpFileSummary =
+  unlines $ map (concat . take 1 . lines) $ paragraphs txtHelpFile
+
+txtHelpCommand c =
+  case lookup c [(takeWhile (/=',') p,p) | p <- paragraphs txtHelpFile] of
+    Just s -> s
+    _ -> "Command not found."
+
+txtHelpFile =
+  "\n-- GF help file updated for GF 2.6, 17/6/2006." ++
+  "\n-- *: Commands and options marked with * are currently not implemented." ++
+  "\n--" ++
+  "\n-- Each command has a long and a short name, options, and zero or more" ++
+  "\n-- arguments. Commands are sorted by functionality. The short name is" ++
+  "\n-- given first." ++
+  "\n" ++
+  "\n-- Type \"h -all\" for full help file, \"h <CommandName>\" for full help on a command.  " ++
+  "\n" ++
+  "\n-- commands that change the state" ++
+  "\n" ++
+  "\ni,  import: i File" ++
+  "\n      Reads a grammar from File and compiles it into a GF runtime grammar." ++
+  "\n      Files \"include\"d in File are read recursively, nubbing repetitions." ++
+  "\n      If a grammar with the same language name is already in the state," ++
+  "\n      it is overwritten - but only if compilation succeeds. " ++
+  "\n      The grammar parser depends on the file name suffix:" ++
+  "\n        .gf    normal GF source" ++
+  "\n        .gfc   canonical GF" ++
+  "\n        .gfr   precompiled GF resource  " ++
+  "\n        .gfcm  multilingual canonical GF" ++
+  "\n        .gfe   example-based grammar files (only with the -ex option)" ++
+  "\n        .gfwl  multilingual word list (preprocessed to abs + cncs)" ++
+  "\n        .ebnf  Extended BNF format" ++
+  "\n        .cf    Context-free (BNF) format" ++
+  "\n        .trc   TransferCore format" ++
+  "\n  options:" ++
+  "\n      -old          old: parse in GF<2.0 format (not necessary)" ++
+  "\n      -v            verbose: give lots of messages " ++
+  "\n      -s            silent: don't give error messages" ++
+  "\n      -src          from source: ignore precompiled gfc and gfr files" ++
+  "\n      -gfc          from gfc: use compiled modules whenever they exist" ++
+  "\n      -retain       retain operations: read resource modules (needed in comm cc) " ++
+  "\n      -nocf         don't build old-style context-free grammar (default without HOAS)" ++
+  "\n      -docf         do build old-style context-free grammar (default with HOAS)" ++
+  "\n      -nocheckcirc  don't eliminate circular rules from CF " ++
+  "\n      -cflexer      build an optimized parser with separate lexer trie" ++
+  "\n      -noemit       do not emit code (default with old grammar format)" ++
+  "\n      -o            do emit code (default with new grammar format)" ++
+  "\n      -ex           preprocess .gfe files if needed" ++
+  "\n      -prob         read probabilities from top grammar file  (format --# prob Fun Double)" ++
+  "\n      -treebank     read a treebank file to memory (xml format)" ++
+  "\n  flags:" ++
+  "\n      -abs          set the name used for abstract syntax (with -old option)" ++
+  "\n      -cnc          set the name used for concrete syntax (with -old option)" ++
+  "\n      -res          set the name used for resource (with -old option)" ++
+  "\n      -path         use the (colon-separated) search path to find modules" ++
+  "\n      -optimize     select an optimization to override file-defined flags" ++
+  "\n      -conversion   select parsing method (values strict|nondet)" ++
+  "\n      -probs        read probabilities from file (format (--# prob) Fun Double)" ++
+  "\n      -preproc      use a preprocessor on each source file" ++
+  "\n      -noparse      read nonparsable functions from file (format --# noparse Funs) " ++
+  "\n  examples:" ++
+  "\n      i English.gf                      -- ordinary import of Concrete" ++
+  "\n      i -retain german/ParadigmsGer.gf  -- import of Resource to test" ++
+  "\n" ++
+  "\nr, reload: r" ++
+  "\n      Executes the previous import (i) command." ++
+  "\n      " ++
+  "\nrl, remove_language: rl Language" ++
+  "\n      Takes away the language from the state." ++
+  "\n" ++
+  "\ne,  empty: e" ++
+  "\n      Takes away all languages and resets all global flags." ++
+  "\n" ++
+  "\nsf, set_flags: sf Flag*" ++
+  "\n      The values of the Flags are set for Language. If no language" ++
+  "\n      is specified, the flags are set globally." ++
+  "\n  examples:" ++
+  "\n      sf -nocpu     -- stop showing CPU time" ++
+  "\n      sf -lang=Swe  -- make Swe the default concrete" ++
+  "\n" ++
+  "\ns,  strip: s" ++
+  "\n      Prune the state by removing source and resource modules." ++
+  "\n" ++
+  "\ndc, define_command Name Anything" ++
+  "\n      Add a new defined command. The Name must star with '%'. Later," ++
+  "\n      if 'Name X' is used, it is replaced by Anything where #1 is replaced" ++
+  "\n      by X. " ++
+  "\n      Restrictions: Currently at most one argument is possible, and a defined" ++
+  "\n      command cannot appear in a pipe.     " ++
+  "\n      To see what definitions are in scope, use help -defs." ++
+  "\n  examples:" ++
+  "\n      dc %tnp p -cat=NP -lang=Eng #1 | l -lang=Swe    -- translate NPs" ++
+  "\n      %tnp \"this man\"                                 -- translate and parse" ++
+  "\n" ++
+  "\ndt, define_term Name Tree" ++
+  "\n      Add a constant for a tree. The constant can later be called by" ++
+  "\n      prefixing it with '$'. " ++
+  "\n      Restriction: These terms are not yet usable as a subterm. " ++
+  "\n      To see what definitions are in scope, use help -defs." ++
+  "\n  examples:" ++
+  "\n      p -cat=NP \"this man\" | dt tm    -- define tm as parse result" ++
+  "\n      l -all $tm                      -- linearize tm in all forms" ++
+  "\n" ++
+  "\n-- commands that give information about the state" ++
+  "\n" ++
+  "\npg, print_grammar: pg" ++
+  "\n      Prints the actual grammar (overridden by the -lang=X flag)." ++
+  "\n      The -printer=X flag sets the format in which the grammar is" ++
+  "\n      written." ++
+  "\n      N.B. since grammars are compiled when imported, this command" ++
+  "\n      generally does not show the grammar in the same format as the" ++
+  "\n      source. In particular, the -printer=latex is not supported. " ++
+  "\n      Use the command tg -printer=latex File to print the source " ++
+  "\n      grammar in LaTeX." ++
+  "\n  options:" ++
+  "\n      -utf8  apply UTF8-encoding to the grammar" ++
+  "\n  flags: " ++
+  "\n      -printer" ++
+  "\n      -lang" ++
+  "\n      -startcat  -- The start category of the generated grammar." ++
+  "\n                    Only supported by some grammar printers." ++
+  "\n  examples:" ++
+  "\n      pg -printer=cf  -- show the context-free skeleton" ++
+  "\n" ++
+  "\npm, print_multigrammar: pm" ++
+  "\n      Prints the current multilingual grammar in .gfcm form." ++
+  "\n      (Automatically executes the strip command (s) before doing this.)" ++
+  "\n  options:" ++
+  "\n      -utf8  apply UTF8 encoding to the tokens in the grammar" ++
+  "\n      -utf8id apply UTF8 encoding to the identifiers in the grammar" ++
+  "\n  examples:" ++
+  "\n      pm | wf Letter.gfcm  -- print the grammar into the file Letter.gfcm" ++
+  "\n      pm -printer=graph | wf D.dot  -- then do 'dot -Tps D.dot > D.ps'" ++
+  "\n" ++
+  "\nvg, visualize_graph: vg" ++
+  "\n     Show the dependency graph of multilingual grammar via dot and gv." ++
+  "\n" ++
+  "\npo, print_options: po" ++
+  "\n      Print what modules there are in the state. Also" ++
+  "\n      prints those flag values in the current state that differ from defaults." ++
+  "\n" ++
+  "\npl, print_languages: pl" ++
+  "\n      Prints the names of currently available languages." ++
+  "\n" ++
+  "\npi, print_info: pi Ident" ++
+  "\n      Prints information on the identifier." ++
+  "\n" ++
+  "\n-- commands that execute and show the session history" ++
+  "\n" ++
+  "\neh, execute_history: eh File" ++
+  "\n      Executes commands in the file." ++
+  "\n" ++
+  "\nph, print_history; ph" ++
+  "\n      Prints the commands issued during the GF session." ++
+  "\n      The result is readable by the eh command." ++
+  "\n  examples:" ++
+  "\n      ph | wf foo.hist\"  -- save the history into a file" ++
+  "\n" ++
+  "\n-- linearization, parsing, translation, and computation" ++
+  "\n" ++
+  "\nl,  linearize: l PattList? Tree" ++
+  "\n      Shows all linearization forms of Tree by the actual grammar" ++
+  "\n      (which is overridden by the -lang flag). " ++
+  "\n      The pattern list has the form [P, ... ,Q] where P,...,Q follow GF " ++
+  "\n      syntax for patterns. All those forms are generated that match with the" ++
+  "\n      pattern list. Too short lists are filled with variables in the end." ++
+  "\n      Only the -table flag is available if a pattern list is specified." ++
+  "\n      HINT: see GF language specification for the syntax of Pattern and Term." ++
+  "\n      You can also copy and past parsing results." ++
+  "\n  options:  " ++
+  "\n      -struct  bracketed form" ++
+  "\n      -table   show parameters (not compatible with -record, -all)" ++
+  "\n      -record  record, i.e. explicit GF concrete syntax term (not compatible with -table, -all)" ++
+  "\n      -all     show all forms and variants (not compatible with -record, -table)" ++
+  "\n      -multi   linearize to all languages (can be combined with the other options)" ++
+  "\n  flags:" ++
+  "\n      -lang    linearize in this grammar" ++
+  "\n      -number  give this number of forms at most" ++
+  "\n      -unlexer filter output through unlexer" ++
+  "\n  examples:" ++
+  "\n      l -lang=Swe -table  -- show full inflection table in Swe" ++
+  "\n" ++
+  "\np,  parse: p String" ++
+  "\n      Shows all Trees returned for String by the actual" ++
+  "\n      grammar (overridden by the -lang flag), in the category S (overridden" ++
+  "\n      by the -cat flag)." ++
+  "\n  options for batch input:" ++
+  "\n      -lines     parse each line of input separately, ignoring empty lines" ++
+  "\n      -all       as -lines, but also parse empty lines" ++
+  "\n      -prob      rank results by probability" ++
+  "\n      -cut       stop after first lexing result leading to parser success" ++
+  "\n      -fail      show strings whose parse fails prefixed by #FAIL" ++
+  "\n      -ambiguous show strings that have more than one parse prefixed by #AMBIGUOUS" ++
+  "\n  options for selecting parsing method:" ++
+  "\n      -fcfg    parse using a fast variant of MCFG (default is no HOAS in grammar)" ++
+  "\n      -old     parse using an overgenerating CFG (default if HOAS in grammar)" ++
+  "\n      -cfg     parse using a much less overgenerating CFG" ++
+  "\n      -mcfg    parse using an even less overgenerating MCFG" ++
+  "\n      Note:    the first time parsing with -cfg, -mcfg, and -fcfg may take a long time" ++
+  "\n  options that only work for the -old default parsing method:" ++
+  "\n      -n       non-strict: tolerates morphological errors" ++
+  "\n      -ign     ignore unknown words when parsing" ++
+  "\n      -raw     return context-free terms in raw form" ++
+  "\n      -v       verbose: give more information if parsing fails" ++
+  "\n  flags:" ++
+  "\n      -cat     parse in this category" ++
+  "\n      -lang    parse in this grammar" ++
+  "\n      -lexer   filter input through this lexer" ++
+  "\n      -parser  use this parsing strategy" ++
+  "\n      -number  return this many results at most" ++
+  "\n  examples:" ++
+  "\n      p -cat=S -mcfg \"jag \228r gammal\"   -- parse an S with the MCFG" ++
+  "\n      rf examples.txt | p -lines      -- parse each non-empty line of the file" ++
+  "\n" ++
+  "\nat, apply_transfer: at (Module.Fun | Fun)" ++
+  "\n      Transfer a term using Fun from Module, or the topmost transfer" ++
+  "\n      module. Transfer modules are given in the .trc format. They are" ++
+  "\n      shown by the 'po' command." ++
+  "\n  flags:" ++
+  "\n     -lang     typecheck the result in this lang instead of default lang" ++
+  "\n  examples:" ++
+  "\n     p -lang=Cncdecimal \"123\" | at num2bin | l   -- convert dec to bin" ++
+  "\n" ++
+  "\ntb, tree_bank: tb" ++
+  "\n      Generate a multilingual treebank from a list of trees (default) or compare" ++
+  "\n      to an existing treebank." ++
+  "\n  options:" ++
+  "\n     -c        compare to existing xml-formatted treebank" ++
+  "\n     -trees    return the trees of the treebank" ++
+  "\n     -all      show all linearization alternatives (branches and variants)" ++
+  "\n     -table    show tables of linearizations with parameters" ++
+  "\n     -record   show linearization records" ++
+  "\n     -xml      wrap the treebank (or comparison results) with XML tags" ++
+  "\n     -mem      write the treebank in memory instead of a file TODO" ++
+  "\n  examples:" ++
+  "\n     gr -cat=S -number=100 | tb -xml | wf tb.xml -- random treebank into file" ++
+  "\n     rf tb.xml | tb -c                           -- compare-test treebank from file" ++
+  "\n     rf old.xml | tb -trees | tb -xml            -- create new treebank from old" ++
+  "\n" ++
+  "\nut, use_treebank: ut String" ++
+  "\n      Lookup a string in a treebank and return the resulting trees." ++
+  "\n      Use 'tb' to create a treebank and 'i -treebank' to read one from" ++
+  "\n      a file." ++
+  "\n   options:" ++
+  "\n     -assocs   show all string-trees associations in the treebank" ++
+  "\n     -strings  show all strings in the treebank" ++
+  "\n     -trees    show all trees in the treebank" ++
+  "\n     -raw      return the lookup result as string, without typechecking it" ++
+  "\n   flags:" ++
+  "\n     -treebank use this treebank (instead of the latest introduced one)" ++
+  "\n   examples:" ++
+  "\n     ut \"He adds this to that\" | l -multi        -- use treebank lookup as parser in translation" ++
+  "\n     ut -assocs | grep \"ComplV2\"                 -- show all associations with ComplV2" ++
+  "\n" ++
+  "\ntt, test_tokenizer: tt String" ++
+  "\n      Show the token list sent to the parser when String is parsed." ++
+  "\n      HINT: can be useful when debugging the parser." ++
+  "\n  flags: " ++
+  "\n     -lexer    use this lexer" ++
+  "\n  examples:" ++
+  "\n     tt -lexer=codelit \"2*(x + 3)\"  -- a favourite lexer for program code" ++
+  "\n" ++
+  "\ng, grep: g String1 String2" ++
+  "\n      Grep the String1 in the String2. String2 is read line by line," ++
+  "\n      and only those lines that contain String1 are returned." ++
+  "\n  flags:" ++
+  "\n     -v  return those lines that do not contain String1." ++
+  "\n  examples:" ++
+  "\n     pg -printer=cf | grep \"mother\"  -- show cf rules with word mother" ++
+  "\n" ++
+  "\ncc, compute_concrete: cc Term" ++
+  "\n      Compute a term by concrete syntax definitions. Uses the topmost" ++
+  "\n      resource module (the last in listing by command po) to resolve " ++
+  "\n      constant names. " ++
+  "\n      N.B. You need the flag -retain when importing the grammar, if you want " ++
+  "\n      the oper definitions to be retained after compilation; otherwise this" ++
+  "\n      command does not expand oper constants." ++
+  "\n      N.B.' The resulting Term is not a term in the sense of abstract syntax," ++
+  "\n      and hence not a valid input to a Tree-demanding command." ++
+  "\n  flags:" ++
+  "\n     -table    show output in a similar readable format as 'l -table'" ++
+  "\n     -res      use another module than the topmost one" ++
+  "\n  examples:" ++
+  "\n     cc -res=ParadigmsFin (nLukko \"hyppy\")   -- inflect \"hyppy\" with nLukko" ++
+  "\n" ++
+  "\nso, show_operations: so Type" ++
+  "\n      Show oper operations with the given value type. Uses the topmost " ++
+  "\n      resource module to resolve constant names. " ++
+  "\n      N.B. You need the flag -retain when importing the grammar, if you want " ++
+  "\n      the oper definitions to be retained after compilation; otherwise this" ++
+  "\n      command does not find any oper constants." ++
+  "\n      N.B.' The value type may not be defined in a supermodule of the" ++
+  "\n      topmost resource. In that case, use appropriate qualified name." ++
+  "\n  flags:" ++
+  "\n     -res      use another module than the topmost one" ++
+  "\n  examples:" ++
+  "\n     so -res=ParadigmsFin ResourceFin.N  -- show N-paradigms in ParadigmsFin" ++
+  "\n" ++
+  "\nt,  translate: t Lang Lang String" ++
+  "\n      Parses String in Lang1 and linearizes the resulting Trees in Lang2." ++
+  "\n  flags:" ++
+  "\n      -cat" ++
+  "\n      -lexer" ++
+  "\n      -parser" ++
+  "\n  examples:" ++
+  "\n      t Eng Swe -cat=S \"every number is even or odd\"" ++
+  "\n" ++
+  "\ngr, generate_random: gr Tree?" ++
+  "\n      Generates a random Tree of a given category. If a Tree" ++
+  "\n      argument is given, the command completes the Tree with values to" ++
+  "\n      the metavariables in the tree. " ++
+  "\n  options:" ++
+  "\n      -prob    use probabilities (works for nondep types only)" ++
+  "\n      -cf      use a very fast method (works for nondep types only)" ++
+  "\n  flags:" ++
+  "\n      -cat     generate in this category" ++
+  "\n      -lang    use the abstract syntax of this grammar" ++
+  "\n      -number  generate this number of trees (not impl. with Tree argument)" ++
+  "\n      -depth   use this number of search steps at most" ++
+  "\n  examples:" ++
+  "\n      gr -cat=Query            -- generate in category Query" ++
+  "\n      gr (PredVP ? (NegVG ?))  -- generate a random tree of this form" ++
+  "\n      gr -cat=S -tr | l        -- gererate and linearize" ++
+  "\n" ++
+  "\ngt, generate_trees: gt Tree?" ++
+  "\n      Generates all trees up to a given depth. If the depth is large," ++
+  "\n      a small -alts is recommended. If a Tree argument is given, the" ++
+  "\n      command completes the Tree with values to the metavariables in" ++
+  "\n      the tree." ++
+  "\n  options:" ++
+  "\n      -metas    also return trees that include metavariables" ++
+  "\n      -all      generate all (can be infinitely many, lazily)" ++
+  "\n      -lin      linearize result of -all (otherwise, use pipe to linearize)" ++
+  "\n  flags:" ++
+  "\n      -depth    generate to this depth (default 3)" ++
+  "\n      -atoms    take this number of atomic rules of each category (default unlimited)" ++
+  "\n      -alts     take this number of alternatives at each branch (default unlimited)" ++
+  "\n      -cat      generate in this category" ++
+  "\n      -nonub    don't remove duplicates (faster, not effective with -mem)" ++
+  "\n      -mem      use a memorizing algorithm (often faster, usually more memory-consuming)" ++
+  "\n      -lang     use the abstract syntax of this grammar" ++
+  "\n      -number   generate (at most) this number of trees (also works with -all)" ++
+  "\n      -noexpand don't expand these categories (comma-separated, e.g. -noexpand=V,CN)" ++
+  "\n      -doexpand only expand these categories (comma-separated, e.g. -doexpand=V,CN)" ++
+  "\n  examples:" ++
+  "\n      gt -depth=10 -cat=NP              -- generate all NP's to depth 10 " ++
+  "\n      gt (PredVP ? (NegVG ?))           -- generate all trees of this form" ++
+  "\n      gt -cat=S -tr | l                 -- generate and linearize" ++
+  "\n      gt -noexpand=NP | l -mark=metacat -- the only NP is meta, linearized \"?0 +NP\"" ++
+  "\n      gt | l | p -lines -ambiguous | grep \"#AMBIGUOUS\" -- show ambiguous strings" ++
+  "\n" ++
+  "\nma, morphologically_analyse: ma String" ++
+  "\n      Runs morphological analysis on each word in String and displays" ++
+  "\n      the results line by line." ++
+  "\n  options:" ++
+  "\n      -short   show analyses in bracketed words, instead of separate lines" ++
+  "\n      -status  show just the work at success, prefixed with \"*\" at failure" ++
+  "\n  flags:" ++
+  "\n      -lang" ++
+  "\n  examples:" ++
+  "\n      wf Bible.txt | ma -short | wf Bible.tagged  -- analyse the Bible" ++
+  "\n" ++
+  "\n" ++
+  "\n-- elementary generation of Strings and Trees" ++
+  "\n" ++
+  "\nps, put_string: ps String" ++
+  "\n      Returns its argument String, like Unix echo." ++
+  "\n      HINT. The strength of ps comes from the possibility to receive the " ++
+  "\n      argument from a pipeline, and altering it by the -filter flag." ++
+  "\n  flags:" ++
+  "\n      -filter  filter the result through this string processor " ++
+  "\n      -length  cut the string after this number of characters" ++
+  "\n  examples:" ++
+  "\n      gr -cat=Letter | l | ps -filter=text -- random letter as text" ++
+  "\n" ++
+  "\npt, put_tree: pt Tree" ++
+  "\n      Returns its argument Tree, like a specialized Unix echo." ++
+  "\n      HINT. The strength of pt comes from the possibility to receive " ++
+  "\n      the argument from a pipeline, and altering it by the -transform flag." ++
+  "\n  flags:" ++
+  "\n      -transform   transform the result by this term processor" ++
+  "\n      -number      generate this number of terms at most" ++
+  "\n  examples:" ++
+  "\n      p \"zero is even\" | pt -transform=solve  -- solve ?'s in parse result" ++
+  "\n" ++
+  "\n* st, show_tree: st Tree" ++
+  "\n      Prints the tree as a string. Unlike pt, this command cannot be" ++
+  "\n      used in a pipe to produce a tree, since its output is a string." ++
+  "\n  flags:" ++
+  "\n      -printer     show the tree in a special format (-printer=xml supported)" ++
+  "\n" ++
+  "\nwt, wrap_tree: wt Fun" ++
+  "\n      Wraps the tree as the sole argument of Fun." ++
+  "\n  flags:" ++
+  "\n      -c           compute the resulting new tree to normal form" ++
+  "\n" ++
+  "\nvt, visualize_tree: vt Tree" ++
+  "\n      Shows the abstract syntax tree via dot and gv (via temporary files" ++
+  "\n      grphtmp.dot, grphtmp.ps)." ++
+  "\n  flags:" ++
+  "\n      -c           show categories only (no functions)" ++
+  "\n      -f           show functions only (no categories)" ++
+  "\n      -g           show as graph (sharing uses of the same function)" ++
+  "\n      -o           just generate the .dot file" ++
+  "\n  examples:" ++
+  "\n    p \"hello world\" | vt -o | wf my.dot ;; ! open -a GraphViz my.dot" ++
+  "\n    -- This writes the parse tree into my.dot and opens the .dot file" ++
+  "\n    -- with another application without generating .ps." ++
+  "\n" ++
+  "\n-- subshells" ++
+  "\n" ++
+  "\nes, editing_session: es" ++
+  "\n      Opens an interactive editing session." ++
+  "\n      N.B. Exit from a Fudget session is to the Unix shell, not to GF. " ++
+  "\n  options:" ++
+  "\n      -f Fudget GUI (necessary for Unicode; only available in X Window System)" ++
+  "\n" ++
+  "\nts, translation_session: ts" ++
+  "\n      Translates input lines from any of the actual languages to all other ones." ++
+  "\n      To exit, type a full stop (.) alone on a line." ++
+  "\n      N.B. Exit from a Fudget session is to the Unix shell, not to GF. " ++
+  "\n      HINT: Set -parser and -lexer locally in each grammar." ++
+  "\n  options:" ++
+  "\n      -f    Fudget GUI (necessary for Unicode; only available in X Windows)" ++
+  "\n      -lang prepend translation results with language names" ++
+  "\n  flags:" ++
+  "\n      -cat    the parser category" ++
+  "\n  examples:" ++
+  "\n      ts -cat=Numeral -lang  -- translate numerals, show language names" ++
+  "\n" ++
+  "\ntq, translation_quiz: tq Lang Lang" ++
+  "\n      Random-generates translation exercises from Lang1 to Lang2," ++
+  "\n      keeping score of success." ++
+  "\n      To interrupt, type a full stop (.) alone on a line." ++
+  "\n      HINT: Set -parser and -lexer locally in each grammar." ++
+  "\n  flags:" ++
+  "\n      -cat" ++
+  "\n  examples:" ++
+  "\n      tq -cat=NP TestResourceEng TestResourceSwe  -- quiz for NPs" ++
+  "\n" ++
+  "\ntl, translation_list: tl Lang Lang" ++
+  "\n      Random-generates a list of ten translation exercises from Lang1" ++
+  "\n      to Lang2. The number can be changed by a flag." ++
+  "\n      HINT: use wf to save the exercises in a file." ++
+  "\n  flags:" ++
+  "\n      -cat" ++
+  "\n      -number" ++
+  "\n  examples:" ++
+  "\n      tl -cat=NP TestResourceEng TestResourceSwe  -- quiz list for NPs" ++
+  "\n" ++
+  "\nmq, morphology_quiz: mq" ++
+  "\n      Random-generates morphological exercises," ++
+  "\n      keeping score of success." ++
+  "\n      To interrupt, type a full stop (.) alone on a line." ++
+  "\n      HINT: use printname judgements in your grammar to" ++
+  "\n      produce nice expressions for desired forms." ++
+  "\n  flags:" ++
+  "\n      -cat" ++
+  "\n      -lang" ++
+  "\n  examples:" ++
+  "\n      mq -cat=N -lang=TestResourceSwe  -- quiz for Swedish nouns" ++
+  "\n" ++
+  "\nml, morphology_list: ml" ++
+  "\n      Random-generates a list of ten morphological exercises," ++
+  "\n      keeping score of success. The number can be changed with a flag." ++
+  "\n      HINT: use wf to save the exercises in a file." ++
+  "\n  flags:" ++
+  "\n      -cat" ++
+  "\n      -lang" ++
+  "\n      -number" ++
+  "\n  examples:" ++
+  "\n      ml -cat=N -lang=TestResourceSwe  -- quiz list for Swedish nouns" ++
+  "\n" ++
+  "\n" ++
+  "\n-- IO related commands" ++
+  "\n" ++
+  "\nrf, read_file: rf File" ++
+  "\n      Returns the contents of File as a String; error if File does not exist." ++
+  "\n" ++
+  "\nwf, write_file: wf File String" ++
+  "\n      Writes String into File; File is created if it does not exist." ++
+  "\n      N.B. the command overwrites File without a warning." ++
+  "\n" ++
+  "\naf, append_file: af File" ++
+  "\n      Writes String into the end of File; File is created if it does not exist." ++
+  "\n" ++
+  "\n* tg, transform_grammar: tg File" ++
+  "\n      Reads File, parses as a grammar, " ++
+  "\n      but instead of compiling further, prints it. " ++
+  "\n      The environment is not changed. When parsing the grammar, the same file" ++
+  "\n      name suffixes are supported as in the i command." ++
+  "\n      HINT: use this command to print the grammar in " ++
+  "\n      another format (the -printer flag); pipe it to wf to save this format." ++
+  "\n  flags:" ++
+  "\n      -printer  (only -printer=latex supported currently)" ++
+  "\n" ++
+  "\n* cl, convert_latex: cl File" ++
+  "\n      Reads File, which is expected to be in LaTeX form." ++
+  "\n      Three environments are treated in special ways:" ++
+  "\n        \\begGF    - \\end{verbatim}, which contains GF judgements," ++
+  "\n        \\begTGF   - \\end{verbatim}, which contains a GF expression (displayed)" ++
+  "\n        \\begInTGF - \\end{verbatim}, which contains a GF expressions (inlined)." ++
+  "\n      Moreover, certain macros should be included in the file; you can" ++
+  "\n      get those macros by applying 'tg -printer=latex foo.gf' to any grammar" ++
+  "\n      foo.gf. Notice that the same File can be imported as a GF grammar," ++
+  "\n      consisting of all the judgements in \\begGF environments." ++
+  "\n      HINT: pipe with 'wf Foo.tex' to generate a new Latex file." ++
+  "\n" ++
+  "\nsa, speak_aloud: sa String" ++
+  "\n      Uses the Flite speech generator to produce speech for String." ++
+  "\n      Works for American English spelling. " ++
+  "\n  examples:" ++
+  "\n    h | sa              -- listen to the list of commands" ++
+  "\n    gr -cat=S | l | sa  -- generate a random sentence and speak it aloud" ++
+  "\n" ++
+  "\nsi, speech_input: si" ++
+  "\n      Uses an ATK speech recognizer to get speech input. " ++
+  "\n  flags:" ++
+  "\n      -lang: The grammar to use with the speech recognizer." ++
+  "\n      -cat: The grammar category to get input in." ++
+  "\n      -language: Use acoustic model and dictionary for this language." ++
+  "\n      -number: The number of utterances to recognize." ++
+  "\n" ++
+  "\nh, help: h Command?" ++
+  "\n      Displays the paragraph concerning the command from this help file." ++
+  "\n      Without the argument, shows the first lines of all paragraphs." ++
+  "\n  options" ++
+  "\n       -all   show the whole help file" ++
+  "\n       -defs  show user-defined commands and terms" ++
+  "\n       -FLAG  show the values of FLAG (works for grammar-independent flags)" ++
+  "\n  examples:" ++
+  "\n       h print_grammar  -- show all information on the pg command" ++
+  "\n" ++
+  "\nq, quit: q" ++
+  "\n      Exits GF." ++
+  "\n      HINT: you can use 'ph | wf history' to save your session." ++
+  "\n" ++
+  "\n!, system_command: ! String" ++
+  "\n      Issues a system command. No value is returned to GF." ++
+  "\n   example:" ++
+  "\n      ! ls" ++
+  "\n" ++
+  "\n?, system_command: ? String" ++
+  "\n      Issues a system command that receives its arguments from GF pipe" ++
+  "\n      and returns a value to GF." ++
+  "\n   example:" ++
+  "\n      h | ? 'wc -l' | p -cat=Num" ++
+  "\n" ++
+  "\n" ++
+  "\n-- Flags. The availability of flags is defined separately for each command." ++
+  "\n" ++
+  "\n-cat, category in which parsing is performed." ++
+  "\n      The default is S." ++
+  "\n" ++
+  "\n-depth, the search depth in e.g. random generation." ++
+  "\n      The default depends on application." ++
+  "\n" ++
+  "\n-filter, operation performed on a string. The default is identity." ++
+  "\n    -filter=identity     no change" ++
+  "\n    -filter=erase        erase the text" ++
+  "\n    -filter=take100      show the first 100 characters" ++
+  "\n    -filter=length       show the length of the string" ++
+  "\n    -filter=text         format as text (punctuation, capitalization)" ++
+  "\n    -filter=code         format as code (spacing, indentation)" ++
+  "\n" ++
+  "\n-lang, grammar used when executing a grammar-dependent command." ++
+  "\n       The default is the last-imported grammar." ++
+  "\n" ++
+  "\n-language, voice used by Festival as its --language flag in the sa command. " ++
+  "\n       The default is system-dependent. " ++
+  "\n" ++
+  "\n-length, the maximum number of characters shown of a string. " ++
+  "\n       The default is unlimited." ++
+  "\n" ++
+  "\n-lexer, tokenization transforming a string into lexical units for a parser." ++
+  "\n       The default is words." ++
+  "\n    -lexer=words         tokens are separated by spaces or newlines" ++
+  "\n    -lexer=literals      like words, but GF integer and string literals recognized" ++
+  "\n    -lexer=vars          like words, but \"x\",\"x_...\",\"$...$\" as vars, \"?...\" as meta" ++
+  "\n    -lexer=chars         each character is a token" ++
+  "\n    -lexer=code          use Haskell's lex" ++
+  "\n    -lexer=codevars      like code, but treat unknown words as variables, ?? as meta " ++
+  "\n    -lexer=textvars      like text, but treat unknown words as variables, ?? as meta " ++
+  "\n    -lexer=text          with conventions on punctuation and capital letters" ++
+  "\n    -lexer=codelit       like code, but treat unknown words as string literals" ++
+  "\n    -lexer=textlit       like text, but treat unknown words as string literals" ++
+  "\n    -lexer=codeC         use a C-like lexer" ++
+  "\n    -lexer=ignore        like literals, but ignore unknown words" ++
+  "\n    -lexer=subseqs       like ignore, but then try all subsequences from longest" ++
+  "\n" ++
+  "\n-number, the maximum number of generated items in a list. " ++
+  "\n       The default is unlimited." ++
+  "\n" ++
+  "\n-optimize, optimization on generated code." ++
+  "\n       The default is share for concrete, none for resource modules." ++
+  "\n       Each of the flags can have the suffix _subs, which performs" ++
+  "\n       common subexpression elimination after the main optimization." ++
+  "\n       Thus, -optimize=all_subs is the most aggressive one. The _subs" ++
+  "\n       strategy only works in GFC, and applies therefore in concrete but" ++
+  "\n       not in resource modules." ++
+  "\n    -optimize=share        share common branches in tables" ++
+  "\n    -optimize=parametrize  first try parametrize then do share with the rest" ++
+  "\n    -optimize=values       represent tables as courses-of-values" ++
+  "\n    -optimize=all          first try parametrize then do values with the rest" ++
+  "\n    -optimize=none         no optimization" ++
+  "\n" ++
+  "\n-parser, parsing strategy. The default is chart. If -cfg or -mcfg are" ++
+  "\n       selected, only bottomup and topdown are recognized." ++
+  "\n    -parser=chart          bottom-up chart parsing" ++
+  "\n    -parser=bottomup       a more up to date bottom-up strategy" ++
+  "\n    -parser=topdown        top-down strategy" ++
+  "\n    -parser=old            an old bottom-up chart parser" ++
+  "\n" ++
+  "\n-printer, format in which the grammar is printed. The default is" ++
+  "\n       gfc. Those marked with M are (only) available for pm, the rest" ++
+  "\n       for pg." ++
+  "\n    -printer=gfc            GFC grammar" ++
+  "\n    -printer=gf             GF grammar" ++
+  "\n    -printer=old            old GF grammar" ++
+  "\n    -printer=cf             context-free grammar, with profiles" ++
+  "\n    -printer=bnf            context-free grammar, without profiles" ++
+  "\n    -printer=lbnf           labelled context-free grammar for BNF Converter" ++
+  "\n    -printer=plbnf          grammar for BNF Converter, with precedence levels" ++
+  "\n   *-printer=happy          source file for Happy parser generator (use lbnf!)" ++
+  "\n    -printer=haskell        abstract syntax in Haskell, with transl to/from GF" ++
+  "\n    -printer=haskell_gadt   abstract syntax GADT in Haskell, with transl to/from GF" ++
+  "\n    -printer=morpho         full-form lexicon, long format" ++
+  "\n   *-printer=latex          LaTeX file (for the tg command)" ++
+  "\n    -printer=fullform       full-form lexicon, short format" ++
+  "\n   *-printer=xml            XML: DTD for the pg command, object for st" ++
+  "\n    -printer=old            old GF: file readable by GF 1.2" ++
+  "\n    -printer=stat           show some statistics of generated GFC" ++
+  "\n    -printer=probs          show probabilities of all functions" ++
+  "\n    -printer=gsl            Nuance GSL speech recognition grammar" ++
+  "\n    -printer=jsgf           Java Speech Grammar Format" ++
+  "\n    -printer=jsgf_sisr_old   Java Speech Grammar Format with semantic tags in " ++
+  "\n                                         SISR  WD 20030401 format" ++
+  "\n    -printer=srgs_abnf       SRGS ABNF format" ++
+  "\n    -printer=srgs_abnf_non_rec  SRGS ABNF format, without any recursion." ++
+  "\n    -printer=srgs_abnf_sisr_old SRGS ABNF format, with semantic tags in" ++
+  "\n                                         SISR  WD 20030401 format" ++
+  "\n    -printer=srgs_xml       SRGS XML format" ++
+  "\n    -printer=srgs_xml_non_rec     SRGS XML format, without any recursion." ++
+  "\n    -printer=srgs_xml_prob  SRGS XML format, with weights" ++
+  "\n    -printer=srgs_xml_sisr_old SRGS XML format, with semantic tags in" ++
+  "\n                                         SISR  WD 20030401 format" ++
+  "\n    -printer=vxml           Generate a dialogue system in VoiceXML." ++
+  "\n    -printer=slf            a finite automaton in the HTK SLF format" ++
+  "\n    -printer=slf_graphviz   the same automaton as slf, but in Graphviz format" ++
+  "\n    -printer=slf_sub        a finite automaton with sub-automata in the " ++
+  "\n                            HTK SLF format" ++
+  "\n    -printer=slf_sub_graphviz the same automaton as slf_sub, but in  " ++
+  "\n                              Graphviz format" ++
+  "\n    -printer=fa_graphviz    a finite automaton with labelled edges" ++
+  "\n    -printer=regular        a regular grammar in a simple BNF" ++
+  "\n    -printer=unpar          a gfc grammar with parameters eliminated" ++
+  "\n    -printer=functiongraph  abstract syntax functions in 'dot' format" ++
+  "\n    -printer=typegraph      abstract syntax categories in 'dot' format" ++
+  "\n    -printer=transfer       Transfer language datatype (.tr file format)" ++
+  "\n    -printer=cfg-prolog  M  cfg in prolog format (also pg)" ++
+  "\n    -printer=gfc-prolog  M  gfc in prolog format (also pg)" ++
+  "\n    -printer=gfcm        M  gfcm file (default for pm)" ++
+  "\n    -printer=graph       M  module dependency graph in 'dot' (graphviz) format" ++
+  "\n    -printer=header      M  gfcm file with header (for GF embedded in Java)" ++
+  "\n    -printer=js  M  JavaScript type annotator and linearizer" ++
+  "\n    -printer=mcfg-prolog M  mcfg in prolog format (also pg)" ++
+  "\n    -printer=missing     M  the missing linearizations of each concrete" ++
+  "\n" ++
+  "\n-startcat, like -cat, but used in grammars (to avoid clash with keyword cat)" ++
+  "\n" ++
+  "\n-transform, transformation performed on a syntax tree. The default is identity." ++
+  "\n    -transform=identity     no change" ++
+  "\n    -transform=compute      compute by using definitions in the grammar" ++
+  "\n    -transform=nodup        return the term only if it has no constants duplicated" ++
+  "\n    -transform=nodupatom    return the term only if it has no atomic constants duplicated" ++
+  "\n    -transform=typecheck    return the term only if it is type-correct" ++
+  "\n    -transform=solve        solve metavariables as derived refinements" ++
+  "\n    -transform=context      solve metavariables by unique refinements as variables" ++
+  "\n    -transform=delete       replace the term by metavariable" ++
+  "\n" ++
+  "\n-unlexer, untokenization transforming linearization output into a string." ++
+  "\n       The default is unwords." ++
+  "\n    -unlexer=unwords     space-separated token list (like unwords)" ++
+  "\n    -unlexer=text        format as text: punctuation, capitals, paragraph <p>" ++
+  "\n    -unlexer=code        format as code (spacing, indentation)" ++
+  "\n    -unlexer=textlit     like text, but remove string literal quotes" ++
+  "\n    -unlexer=codelit     like code, but remove string literal quotes" ++
+  "\n    -unlexer=concat      remove all spaces" ++
+  "\n    -unlexer=bind        like identity, but bind at \"&+\"" ++
+  "\n" ++
+  "\n-mark, marking of parts of tree in linearization. The default is none." ++
+  "\n    -mark=metacat        append \"+CAT\" to every metavariable, showing its category" ++
+  "\n    -mark=struct         show tree structure with brackets" ++
+  "\n    -mark=java           show tree structure with XML tags (used in gfeditor)" ++
+  "\n" ++
+  "\n-coding, Some grammars are in UTF-8, some in isolatin-1." ++
+  "\n    If the letters \228 (a-umlaut) and \246 (o-umlaut) look strange, either" ++
+  "\n    change your terminal to isolatin-1, or rewrite the grammar with" ++
+  "\n    'pg -utf8'. For Windows you also may have to change your font to TrueType." ++
+  "\n" ++
+  "\n-- *: Commands and options marked with * are not currently implemented." ++
+  []
diff --git a/src-2.9/GF/Shell/JGF.hs b/src-2.9/GF/Shell/JGF.hs
new file mode 100644
index 000000000..0ff678809
--- /dev/null
+++ b/src-2.9/GF/Shell/JGF.hs
@@ -0,0 +1,89 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : JGF
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/03 22:44:36 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.13 $
+--
+-- GF editing session controlled by e.g. a Java program. AR 16\/11\/2001
+-----------------------------------------------------------------------------
+
+module GF.Shell.JGF where
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.Text.Unicode
+
+import GF.API.IOGrammar
+import GF.Infra.Option
+import GF.Compile.ShellState
+import GF.UseGrammar.Session
+import GF.Shell.Commands
+import GF.Shell.CommandL
+import GF.Text.UTF8
+
+import Control.Monad (foldM)
+import System
+
+
+
+-- GF editing session controlled by e.g. a Java program. AR 16/11/2001
+
+-- | the Boolean is a temporary hack to have two parallel GUIs
+sessionLineJ :: Bool -> ShellState -> IO ()
+sessionLineJ isNew env = do
+  putStrLnFlush $ initEditMsgJavaX env
+  let env' = addGlobalOptions (options [sizeDisplay "short",beSilent]) env
+  editLoopJnewX isNew env' (initSState)
+
+-- | this is the real version, with XML
+--
+-- the Boolean is a temporary hack to have two parallel GUIs
+editLoopJnewX :: Bool -> CEnv -> SState -> IO ()
+editLoopJnewX isNew env state = do
+  mscs <- getCommandUTF (isCEnvUTF8 env state) ----
+  let (ms,cs) = unzip mscs
+      m = unlines ms --- ?
+  if null cs 
+    then editLoopJnewX isNew env state
+    else
+      case cs of
+        [CQuit] -> return ()
+        _ -> do
+          (env',state') <- foldM exec (env,state) cs
+          let inits = initAndEditMsgJavaX isNew env' state' m
+          let 
+            package = case last cs of
+              CCEnvImport _         -> inits
+              CCEnvEmptyAndImport _ -> inits
+              CCEnvOpenTerm _       -> inits
+              CCEnvOpenString _     -> inits
+              CCEnvEmpty            -> initEditMsgJavaX env'
+              _ -> displaySStateJavaX isNew env' state' m
+          putStrLnFlush package
+          editLoopJnewX isNew env' state'
+ where
+  exec (env,state) c = do
+    execCommand env c state
+
+welcome :: String
+welcome = 
+  "An experimental GF Editor for Java." ++ 
+  "(c) Kristofer Johannisson, Janna Khegai, and Aarne Ranta 2002 under CNU GPL."
+
+initEditMsgJavaX :: CEnv -> String
+initEditMsgJavaX env = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfinit" $ 
+  tagsXML "newcat"   [["n" +++ cat]     | (_,cat) <- newCatMenu env] ++
+  tagXML  "topic"    [abstractName env] ++
+  tagXML  "language" [prLanguage langAbstract] ++
+  concat [tagAttrXML "language" ("file",file) [prLanguage lang] |
+           (file,lang) <- zip (allGrammarFileNames env) (allLanguages env)]
+
+
+initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String -> String
+initAndEditMsgJavaX isNew env state m = 
+  initEditMsgJavaX env ++++ displaySStateJavaX isNew env state m
diff --git a/src-2.9/GF/Shell/PShell.hs b/src-2.9/GF/Shell/PShell.hs
new file mode 100644
index 000000000..68cb4d629
--- /dev/null
+++ b/src-2.9/GF/Shell/PShell.hs
@@ -0,0 +1,174 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PShell
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/06 14:21:34 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.28 $
+--
+-- parsing GF shell commands. AR 11\/11\/2001
+-----------------------------------------------------------------------------
+
+module GF.Shell.PShell where
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.Compile.ShellState
+import GF.Shell.ShellCommands
+import GF.Shell
+import GF.Infra.Option
+import GF.Compile.PGrammar (pzIdent, pTrm) --- (string2formsAndTerm)
+import GF.API
+import GF.System.Arch (fetchCommand)
+import GF.UseGrammar.Tokenize (wordsLits)
+
+import Data.Char (isDigit, isSpace)
+import System.IO.Error
+
+-- parsing GF shell commands. AR 11/11/2001
+
+-- | getting a sequence of command lines as input
+getCommandLines :: HState -> IO (String,[CommandLine])
+getCommandLines st = do
+  s <- fetchCommand "> "
+  return (s,pCommandLines st s)
+
+getCommandLinesBatch :: HState -> IO (String,[CommandLine])
+getCommandLinesBatch st = do
+  s <- catch getLine (\e -> if isEOFError e then return "q" else ioError e)
+  return $ (s,pCommandLines st s)
+
+pCommandLines :: HState -> String -> [CommandLine]
+pCommandLines st = 
+  map (pCommandLine st) . concatMap (chunks ";;" . wordsLits) . lines
+
+-- | Remove single or double quotes around a string
+unquote :: String -> String
+unquote (x:xs@(_:_)) | x `elem` "\"'" && x == last xs = init xs
+unquote s = s
+
+pCommandLine :: HState -> [String] -> CommandLine
+pCommandLine st (c@('%':_):args) = pCommandLine st $ resolveShMacro st c args 
+pCommandLine st (dc:c:def) | abbrevCommand dc == "dc" = ((CDefineCommand c def, noOptions),AUnit,[])
+pCommandLine st s = pFirst (chks s) where
+  pFirst cos = case cos of
+    (c,os,[a]) : cs -> ((c,os), a, pCont cs)
+    _               -> ((CVoid,noOptions), AError "no parse", [])
+  pCont cos = case cos of
+    (c,os,_)   : cs -> (c,os) : pCont cs
+    _               -> []
+  chks = map (pCommandOpt st) . chunks "|"
+
+pCommandOpt :: HState -> [String] -> (Command, Options, [CommandArg])
+pCommandOpt _ (w:ws) = let 
+  (os, co)     = getOptions "-" ws
+  (comm, args) = pCommand (abbrevCommand w:co)
+  in
+  (comm, os, args)
+pCommandOpt _ s = (CVoid, noOptions, [AError "no parse"])
+
+pInputString :: String -> [CommandArg]
+pInputString s = case s of
+  ('"':_:_) | last s == '"' -> [AString (read s)]
+  _         -> [AError "illegal string"]
+
+-- | command @rl@ can be written @remove_language@ etc.
+abbrevCommand :: String -> String
+abbrevCommand = hds . words . map u2sp where
+  u2sp c = if c=='_' then ' ' else c
+  hds s = case s of
+    [w@[_,_]] -> w
+    _ -> map head s
+
+pCommand :: [String] -> (Command, [CommandArg])
+pCommand ws = case ws of
+
+  "i"  : f : [] -> aUnit   (CImport (unquote f))
+  "rl" : l : [] -> aUnit   (CRemoveLanguage (language l))
+  "e"  : []     -> aUnit   CEmptyState
+  "cm" : a : [] -> aUnit   (CChangeMain (Just (pzIdent a)))
+  "cm" : []     -> aUnit   (CChangeMain Nothing)
+  "s"  : []     -> aUnit   CStripState
+  "tg" : f : [] -> aUnit   (CTransformGrammar f)
+  "cl" : f : [] -> aUnit   (CConvertLatex f)
+
+  "ph" : []     -> aUnit   CPrintHistory
+  "dt" : f : t  -> aTerm   (CDefineTerm (unquote f)) t
+
+  "l"  : s      -> aTermLi CLinearize s
+
+  "p"  : s      -> aString CParse s
+  "t"  : i:o: s -> aString (CTranslate (language i) (language o)) s
+  "gr" : []     -> aUnit   CGenerateRandom
+  "gr" : t      -> aTerm   CGenerateRandom t
+  "gt" : []     -> aUnit   CGenerateTrees
+  "gt" : t      -> aTerm   CGenerateTrees t
+  "pt" : s      -> aTerm   CPutTerm s
+  "wt" : f : s  -> aTerm   (CWrapTerm (pzIdent f)) s
+  "at" : f : s  -> aTerm   (CApplyTransfer (pmIdent f)) s
+  "ma" : s      -> aString CMorphoAnalyse s
+  "tt" : s      -> aString CTestTokenizer s
+  "cc" : s      -> aUnit   $ CComputeConcrete $ unwords s
+  "so" : s      -> aUnit   $ CShowOpers $ unwords s
+  "tb" : []     -> aUnit   CTreeBank
+  "ut" : s      -> aString CLookupTreebank s
+
+  "tq" : i:o:[] -> aUnit   (CTranslationQuiz (language i) (language o))
+  "tl":i:o:[]   -> aUnit   (CTranslationList (language i) (language o))
+  "mq" : []     -> aUnit   CMorphoQuiz
+  "ml" : []     -> aUnit   CMorphoList
+
+  "wf" : f : s  -> aString (CWriteFile (unquote f)) s
+  "af" : f : s  -> aString (CAppendFile (unquote f)) s
+  "rf" : f : [] -> aUnit   (CReadFile (unquote f))
+  "sa" : s      -> aString CSpeakAloud s
+  "si" : []     -> aUnit   CSpeechInput
+  "ps" : s      -> aString CPutString s
+  "st" : s      -> aTerm   CShowTerm s
+  "!"  : s      -> aUnit   (CSystemCommand (unwords s))
+  "?"  : s : x  -> aString (CSystemCommand (unquote s)) x
+  "sc" : s      -> aUnit   (CSystemCommand (unwords s))
+  "g"  : f : s  -> aString (CGrep (unquote f)) s
+  
+  "sf" : l : [] -> aUnit (CSetLocalFlag (language l))
+  "sf" : []     -> aUnit CSetFlag
+
+  "pg" : []     -> aUnit CPrintGrammar
+  "pi" : c : [] -> aUnit $ CPrintInformation (pzIdent c)
+
+  "pj"  : []     -> aUnit CPrintGramlet
+  "pxs" : []     -> aUnit CPrintCanonXMLStruct
+  "px"  : []     -> aUnit CPrintCanonXML
+  "pm"  : []     -> aUnit CPrintMultiGrammar
+  "vg"  : []     -> aUnit CShowGrammarGraph
+  "vt"  : s      -> aTerm CShowTreeGraph s
+  "sg"  : []     -> aUnit CPrintSourceGrammar
+  "po"  : []     -> aUnit CPrintGlobalOptions
+  "pl"  : []     -> aUnit CPrintLanguages
+  "h"   : c : [] -> aUnit $ CHelp (Just (abbrevCommand c))
+  "h"   : []     -> aUnit $ CHelp Nothing
+
+  "q"  : []     -> aImpure ICQuit
+  "eh" : f : [] -> aImpure (ICExecuteHistory f)
+  n    : [] | all isDigit n -> aImpure (ICEarlierCommand (readIntArg n))
+
+  "es" : []     -> aImpure ICEditSession
+  "ts" : []     -> aImpure ICTranslateSession
+  "r"  : []     -> aImpure ICReload
+  _             -> (CVoid, [])
+
+ where
+   aString c ss = (c, pInputString (unwords ss))
+   aTerm c ss   = (c, [ASTrm $ unwords ss]) ---- [ASTrms [s2t (unwords ss)]])
+   aUnit c      = (c, [AUnit])
+   aImpure      = aUnit . CImpure
+
+   aTermLi c ss = (c [], [ASTrm $ unwords ss])
+   ---- (c forms, [ASTrms [term]]) where
+   ----  (forms,term) = ([], s2t (unwords ss)) ----string2formsAndTerm(unwords ss)
+   pmIdent m = case span (/='.') m of
+     (k,_:f) -> (Just (pzIdent k), pzIdent f)
+     _ -> (Nothing,pzIdent m)
diff --git a/src-2.9/GF/Shell/ShellCommands.hs b/src-2.9/GF/Shell/ShellCommands.hs
new file mode 100644
index 000000000..70238817b
--- /dev/null
+++ b/src-2.9/GF/Shell/ShellCommands.hs
@@ -0,0 +1,246 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ShellCommands
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.46 $
+--
+-- The datatype of shell commands and the list of their options.
+-----------------------------------------------------------------------------
+
+module GF.Shell.ShellCommands where
+
+import qualified GF.Infra.Ident as I
+import GF.Compile.ShellState
+import GF.UseGrammar.Custom
+import GF.Grammar.PrGrammar
+
+import GF.Infra.Option
+import GF.Data.Operations
+import GF.Infra.Modules
+
+import Data.Char (isDigit)
+import Control.Monad (mplus)
+
+-- shell commands and their options
+-- moved to separate module and added option check: AR 27/5/2004
+--- TODO: single source for 
+---   (1) command interpreter (2) option check (3) help file
+
+data Command =
+   CImport FilePath
+ | CRemoveLanguage Language
+ | CEmptyState
+ | CChangeMain (Maybe I.Ident)
+ | CStripState
+ | CTransformGrammar FilePath
+ | CConvertLatex FilePath
+
+ | CDefineCommand String [String]
+ | CDefineTerm String
+
+ | CLinearize [()] ---- parameters
+ | CParse
+ | CTranslate Language Language
+ | CGenerateRandom
+ | CGenerateTrees
+ | CTreeBank
+ | CPutTerm
+ | CWrapTerm I.Ident
+ | CApplyTransfer (Maybe I.Ident, I.Ident)
+ | CMorphoAnalyse
+ | CTestTokenizer
+ | CComputeConcrete String
+ | CShowOpers String
+
+ | CLookupTreebank
+
+ | CTranslationQuiz Language Language
+ | CTranslationList Language Language
+ | CMorphoQuiz
+ | CMorphoList
+
+ | CReadFile   FilePath
+ | CWriteFile  FilePath
+ | CAppendFile FilePath
+ | CSpeakAloud
+ | CSpeechInput
+ | CPutString
+ | CShowTerm
+ | CSystemCommand String
+ | CGrep String
+
+ | CSetFlag
+ | CSetLocalFlag Language
+
+ | CPrintGrammar
+ | CPrintGlobalOptions
+ | CPrintLanguages
+ | CPrintInformation I.Ident
+ | CPrintMultiGrammar
+ | CPrintSourceGrammar
+ | CShowGrammarGraph
+ | CShowTreeGraph
+ | CPrintGramlet 
+ | CPrintCanonXML
+ | CPrintCanonXMLStruct 
+ | CPrintHistory
+ | CHelp (Maybe String)
+
+ | CImpure ImpureCommand
+
+ | CVoid
+
+-- to isolate the commands that are executed on top level
+data ImpureCommand = 
+    ICQuit 
+  | ICExecuteHistory FilePath 
+  | ICEarlierCommand Int
+  | ICEditSession 
+  | ICTranslateSession
+  | ICReload
+
+type CommandOpt = (Command, Options)
+
+-- the top-level option warning action
+
+checkOptions :: ShellState -> (Command,Options) -> IO ()
+checkOptions sh (co, Opts opts) = do
+  let (_,s) = errVal ([],"option check failed") $ mapErr check opts
+  if (null s) then return () 
+    else putStr "WARNING: " >> putStrLn s
+ where 
+   check = isValidOption sh co
+
+isValidOption :: ShellState -> Command -> Option -> Err ()
+isValidOption st co op = case op of
+     Opt (o,[])  -> 
+       testErr (elem o $ optsOf co) ("invalid option:" +++ prOpt op)
+     Opt (o,[x]) -> do
+       testErr (elem o (flagsOf co)) ("invalid flag:" +++ o) 
+       testValidFlag st co o x
+     _ -> Bad $ "impossible option" +++ prOpt op
+  where
+   optsOf  co = ("tr" :) $ fst $ optionsOfCommand co
+   flagsOf co = snd $ optionsOfCommand co
+
+testValidFlag :: ShellState -> Command -> OptFunId -> String -> Err ()
+testValidFlag st co f x = case f of
+  "cat"     -> testIn (map prQIdent_ (allCategories st))
+  "lang"    -> testIn (map prt (allLanguages st))
+  "transfer" -> testIn (map prt (allTransfers st))
+  "res"     -> testIn (map prt (allResources (srcModules st)))
+  "number"  -> testN
+  "printer" -> case co of
+		       CPrintGrammar -> testInc customGrammarPrinter
+		       CPrintMultiGrammar -> testInc customMultiGrammarPrinter
+		       CSetFlag -> testInc customGrammarPrinter `mplus` 
+				   testInc customMultiGrammarPrinter
+  "lexer"   -> testInc customTokenizer
+  "unlexer" -> testInc customUntokenizer
+  "depth"   -> testN
+  "rawtrees"-> testN
+  "parser"  -> testInc customParser 
+	       -- hack for the -newer parsers: (to be changed in the future)
+	       -- `mplus` testIn (words "mcfg mcfg-bottomup mcfg-topdown cfg cfg-bottomup cfg-topdown bottomup topdown")
+	       -- if not(null x) && head x `elem` "mc" then return () else Bad ""
+  "alts"    -> testN
+  "transform" -> testInc customTermCommand
+  "filter"  -> testInc customStringCommand
+  "length"  -> testN
+  "optimize"-> testIn $ words "parametrize values all share none"
+  "conversion" -> testIn $ words "strict nondet finite finite2 finite3 singletons finite-strict finite-singletons"
+  _ -> return ()
+ where
+   testInc ci = 
+     let vs = snd (customInfo ci) in testIn vs 
+   testIn vs =
+     if elem x vs
+        then return ()
+        else Bad ("flag:" +++ f +++ "invalid value:" +++ x ++++
+                  "possible values:" +++ unwords vs)
+   testN = 
+     if all isDigit x
+        then return ()
+        else Bad ("flag:" +++ f +++ "invalid value:" +++ x ++++
+                  "expected integer")
+
+
+optionsOfCommand :: Command -> ([String],[String])
+optionsOfCommand co = case co of
+  CSetFlag -> 
+    both "utf8 table struct record all multi"
+	 "cat lang lexer parser number depth rawtrees unlexer optimize path conversion printer"
+  CImport _ -> 
+    both "old v s src make gfc retain docf nocf nocheckcirc cflexer noemit o make ex prob treebank"
+         "abs cnc res path optimize conversion cat preproc probs noparse"
+  CRemoveLanguage _ -> none
+  CEmptyState -> none
+  CStripState -> none
+  CTransformGrammar _ -> flags "printer"
+  CConvertLatex _ -> none
+  CLinearize _ -> both "utf8 table struct record all multi" "lang number unlexer mark"
+  CParse -> 
+    both "ambiguous fail cut new newer old overload cfg mcfg fcfg n ign raw v lines all prob" 
+         "cat lang lexer parser number rawtrees"
+  CTranslate _ _ -> opts "cat lexer parser"
+  CGenerateRandom -> both "cf prob" "cat lang number depth atoms noexpand doexpand"
+  CGenerateTrees -> both "metas" "atoms depth alts cat lang number noexpand doexpand"
+  CPutTerm -> flags "transform number"
+  CTreeBank -> opts "c xml trees all table record"
+  CLookupTreebank -> both "assocs raw strings trees" "treebank"
+  CWrapTerm _ -> opts "c"
+  CApplyTransfer _ -> flags "lang transfer"
+  CMorphoAnalyse -> both "short status" "lang"
+  CTestTokenizer -> flags "lexer"
+  CComputeConcrete _ -> both "table" "res"
+  CShowOpers _ -> flags "res"
+
+  CTranslationQuiz _ _ -> flags "cat"
+  CTranslationList _ _ ->  flags "cat number"
+  CMorphoQuiz -> flags "cat lang"
+  CMorphoList -> flags "cat lang number"
+
+  CReadFile _  -> none
+  CWriteFile  _ -> none
+  CAppendFile _ -> none
+  CSpeakAloud -> flags "language"
+  CSpeechInput -> flags "lang cat language number"
+
+  CPutString -> both "utf8" "filter length"
+  CShowTerm -> flags "printer"
+  CShowTreeGraph -> opts "c f g o"
+  CSystemCommand _ -> none
+  CGrep _ -> opts "v"
+
+  CPrintGrammar -> both "utf8" "printer lang startcat"
+  CPrintMultiGrammar -> both "utf8 utf8id" "printer"
+  CPrintSourceGrammar -> both "utf8" "printer"
+
+  CHelp _ -> opts "all alts atoms coding defs filter length lexer unlexer printer probs transform depth number cat"
+
+  CImpure ICEditSession -> both "f" "file"
+  CImpure ICTranslateSession -> both "f langs" "cat"
+
+  _ -> none
+
+{-
+  CSetLocalFlag Language
+  CPrintGlobalOptions
+  CPrintLanguages
+  CPrintInformation I.Ident
+  CPrintGramlet 
+  CPrintCanonXML
+  CPrintCanonXMLStruct 
+  CPrintHistory
+  CVoid
+-}
+ where
+   flags fs = ([],words fs)
+   opts fs = (words fs,[])
+   both os fs = (words os,words fs)
+   none = ([],[])
diff --git a/src-2.9/GF/Shell/SubShell.hs b/src-2.9/GF/Shell/SubShell.hs
new file mode 100644
index 000000000..5ef0459e5
--- /dev/null
+++ b/src-2.9/GF/Shell/SubShell.hs
@@ -0,0 +1,66 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : SubShell
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:46:12 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.9 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Shell.SubShell where
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+import GF.Compile.ShellState
+import GF.Infra.Option
+import GF.API
+
+import GF.Shell.CommandL
+import GF.System.ArchEdit
+
+import Data.List
+
+-- AR 20/4/2000 -- 12/11/2001
+
+editSession :: Options -> ShellState -> IO ()
+editSession opts st
+  | oElem makeFudget opts = fudlogueEdit font st'
+  | otherwise             = initEditLoop st' (return ())
+ where
+   st'   = addGlobalOptions opts st
+   font  = maybe myUniFont mkOptFont $ getOptVal opts useFont
+
+myUniFont :: String
+myUniFont = "-mutt-clearlyu-medium-r-normal--0-0-100-100-p-0-iso10646-1"
+
+mkOptFont :: String -> String
+mkOptFont = id
+
+translateSession :: Options -> ShellState -> IO ()
+translateSession opts st = do
+  let grs   = allStateGrammars st
+      cat   = firstCatOpts opts (firstStateGrammar st)
+      trans s = unlines $ 
+                if oElem showLang opts then 
+                  sort $ [l +++ ":" +++ s | (l,s) <- zip (map (prIdent . cncId) grs) 
+                                                     (translateBetweenAll grs cat s)]
+                  else translateBetweenAll grs cat s
+  translateLoop opts trans
+
+translateLoop :: Options -> (String -> String) -> IO ()
+translateLoop opts trans = do
+  let fud  = oElem makeFudget opts
+      font = maybe myUniFont mkOptFont $ getOptVal opts useFont
+  if fud then fudlogueWrite font trans else loopLine
+ where
+   loopLine = do
+     putStrFlush "trans> "
+     s <- getLine
+     if s == "." then return () else do
+       putStrLnFlush $ trans s
+       loopLine
diff --git a/src-2.9/GF/Shell/TeachYourself.hs b/src-2.9/GF/Shell/TeachYourself.hs
new file mode 100644
index 000000000..7e5a8afe2
--- /dev/null
+++ b/src-2.9/GF/Shell/TeachYourself.hs
@@ -0,0 +1,87 @@
+----------------------------------------------------------------------
+-- |
+-- 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
+-----------------------------------------------------------------------------
+
+module GF.Shell.TeachYourself where
+
+import GF.Compile.ShellState
+import GF.API
+import GF.UseGrammar.Linear
+import GF.Grammar.PrGrammar
+
+import GF.Infra.Option
+import GF.System.Arch (myStdGen)
+import GF.Data.Operations
+import GF.Infra.UseIO
+
+import System.Random --- (randoms) --- bad import for hbc
+import System
+
+-- translation and morphology quiz. AR 10/5/2000 -- 12/4/2002
+
+teachTranslation :: Options -> GFGrammar -> GFGrammar -> IO ()
+teachTranslation opts ig og = do
+  tts <- transTrainList opts ig og infinity
+  let qas = [ (q, mkAnswer as) | (q,as) <- tts]
+  teachDialogue qas "Welcome to GF Translation Quiz."
+
+transTrainList :: 
+  Options -> GFGrammar -> GFGrammar -> Integer -> IO [(String,[String])]
+transTrainList opts ig og number = do
+  ts <- randomTreesIO (addOption beSilent opts) ig (fromInteger number)
+  return $ map mkOne $ ts
+ where
+   cat = firstCatOpts opts ig
+   mkOne t = (norml (linearize ig t),map (norml . linearize og) (homonyms ig cat t))
+
+
+teachMorpho :: Options -> GFGrammar -> IO ()
+teachMorpho opts ig = useIOE () $ do
+  tts <- morphoTrainList opts ig infinity
+  let qas = [ (q, mkAnswer as) | (q,as) <- tts]
+  ioeIO $ teachDialogue qas "Welcome to GF Morphology Quiz."
+
+morphoTrainList :: Options -> GFGrammar -> Integer -> IOE [(String,[String])]
+morphoTrainList opts ig number = do
+  ts   <- ioeIO $ randomTreesIO (addOption beSilent opts) ig (fromInteger number)
+  gen  <- ioeIO $ myStdGen (fromInteger number)
+  mkOnes gen ts
+ where
+   mkOnes gen (t:ts) = do
+     psss    <- ioeErr $ allLinTables True gr cnc t
+     let pss = concat $ map snd $ concat psss
+     let (i,gen') = randomR (0, length pss - 1) gen
+     (ps,ss) <- ioeErr $ pss !? i
+     (_,ss0) <- ioeErr $ pss !? 0
+     let bas = unwords ss0 --- concat $ take 1 ss0
+     more <- mkOnes gen' ts
+     return $ (bas +++ ":" +++ unwords (map prt_ ps), return (unwords ss)) : more
+   mkOnes gen [] = return []
+ 
+   gr = grammar ig
+   cnc = cncId ig
+
+-- | 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
+
+-- | the maximal number of precompiled quiz problems
+infinity :: Integer
+infinity = 123 
+
diff --git a/src-2.9/GF/Source/AbsGF.hs b/src-2.9/GF/Source/AbsGF.hs
new file mode 100644
index 000000000..63cc43006
--- /dev/null
+++ b/src-2.9/GF/Source/AbsGF.hs
@@ -0,0 +1,306 @@
+module GF.Source.AbsGF where
+
+-- Haskell module generated by the BNF converter
+
+newtype LString = LString String deriving (Eq,Ord,Show)
+newtype PIdent = PIdent ((Int,Int),String) 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-2.9/GF/Source/ErrM.hs b/src-2.9/GF/Source/ErrM.hs
new file mode 100644
index 000000000..63840758e
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Source/GF.cf b/src-2.9/GF/Source/GF.cf
new file mode 100644
index 000000000..364550e6f
--- /dev/null
+++ b/src-2.9/GF/Source/GF.cf
@@ -0,0 +1,370 @@
+-- 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, --%
+  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-2.9/GF/Source/GrammarToSource.hs b/src-2.9/GF/Source/GrammarToSource.hs
new file mode 100644
index 000000000..6d48e4ced
--- /dev/null
+++ b/src-2.9/GF/Source/GrammarToSource.hs
@@ -0,0 +1,259 @@
+----------------------------------------------------------------------
+-- |
+-- 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.Infra.Modules
+import GF.Infra.Option
+import qualified GF.Source.AbsGF as P
+import GF.Infra.Ident
+
+-- | 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)) ++ map trFlag (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 tysts -> 
+    [P.DefOper [P.DDef [mkName i'] (
+      P.EApp (P.EIdent $ tri $ identC "overload") 
+        (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 ---
+
+
+trFlag :: Option -> P.TopDef
+trFlag o = case o of
+  Opt (f,[x]) -> P.DefFlag [P.FlagDef (tri $ identC f) (tri $ identC x)]
+  _ -> P.DefFlag [] --- warning?
+
+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 $ case s of
+      "Type" -> P.Sort_Type
+      "PType" -> P.Sort_PType
+      "Tok" -> P.Sort_Tok
+      "Str" -> P.Sort_Str
+      "Strs" -> P.Sort_Strs
+      _ -> 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 $ trLabelIdent 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 $ trLabelIdent lab]
+
+trLabelling (lab,ty) = P.LDDecl [tri $ trLabelIdent 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 . prIdent 
+
+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
+
+trLabelIdent i = identC $ case i of
+  LIdent s -> s
+  LVar i -> "v" ++ show i --- should not happen
+
+mkName :: P.PIdent -> P.Name
+mkName = P.IdentName
diff --git a/src-2.9/GF/Source/LexGF.hs b/src-2.9/GF/Source/LexGF.hs
new file mode 100644
index 000000000..89067b6b6
--- /dev/null
+++ b/src-2.9/GF/Source/LexGF.hs
@@ -0,0 +1,345 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# LINE 3 "GF/Source/LexGF.x" #-}
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Source.LexGF where
+
+
+import qualified Data.ByteString.Char8 as BS
+
+#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\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 36 "GF/Source/LexGF.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_LString !String
+ | T_PIdent !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_LString s) -> s
+  PT _ (T_PIdent 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 "lincat" (b "def" (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 "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" 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
+               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.unpack (BS.take len str)) : (go inp')
+
+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
+alexGetChar (p,_,cs) | BS.null cs  = Nothing
+                     | otherwise = let c   = BS.head cs
+                                       cs' = BS.tail cs
+                                       p'  = alexMove p c
+                                    in p' `seq` cs' `seq` Just (c, (p', c, cs'))
+
+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_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 "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 -> 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-2.9/GF/Source/LexGF.x b/src-2.9/GF/Source/LexGF.x
new file mode 100644
index 000000000..7ea768e75
--- /dev/null
+++ b/src-2.9/GF/Source/LexGF.x
@@ -0,0 +1,137 @@
+-- -*- haskell -*-
+-- This Alex file was machine-generated by the BNF converter
+{
+module LexGF where
+
+import ErrM
+import SharedString
+}
+
+
+$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 =    -- reserved words consisting of special symbols
+   \; | \= | \{ | \} | \( | \) | \: | \- \> | \* \* | \, | \[ | \] | \- | \. | \| | \% | \? | \< | \> | \@ | \! | \* | \+ | \+ \+ | \\ | \= \> | \_ | \$ | \/
+
+:-
+"--" [.]* ; -- Toss single line comments
+"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; 
+
+$white+ ;
+@rsyms { tok (\p s -> PT p (TS $ share s)) }
+\' ($u # \')* \' { tok (\p s -> PT p (eitherResIdent (T_LString . 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 = shareString
+
+data Tok =
+   TS !String     -- reserved words
+ | TL !String     -- string literals
+ | TI !String     -- integer literals
+ | TV !String     -- identifiers
+ | TD !String     -- double precision float literals
+ | TC !String     -- character literals
+ | T_LString !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_LString 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 "lincat" (b "def" (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 "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" 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-2.9/GF/Source/ParGF.hs b/src-2.9/GF/Source/ParGF.hs
new file mode 100644
index 000000000..30f83eef6
--- /dev/null
+++ b/src-2.9/GF/Source/ParGF.hs
@@ -0,0 +1,7845 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
+ module GF.Source.ParGF (pGrammar, pModDef, pOldGrammar, pExp, pModHeader, myLexer) where --H
+import GF.Source.AbsGF       --H
+import GF.Source.LexGF       --H
+import GF.Infra.Ident        --H
+import GF.Data.ErrM          --H
+#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 (139#) = happyShift action_57
+action_1 (142#) = happyShift action_9
+action_1 (15#) = happyGoto action_55
+action_1 (30#) = happyGoto action_56
+action_1 x = happyTcHack x happyReduce_60
+
+action_2 (141#) = happyShift action_54
+action_2 (90#) = happyGoto action_52
+action_2 (91#) = happyGoto action_53
+action_2 x = happyTcHack x happyReduce_265
+
+action_3 (96#) = happyShift action_24
+action_3 (98#) = happyShift action_25
+action_3 (104#) = happyShift action_26
+action_3 (109#) = happyShift action_27
+action_3 (110#) = happyShift action_28
+action_3 (111#) = happyShift action_29
+action_3 (114#) = happyShift action_30
+action_3 (119#) = happyShift action_31
+action_3 (124#) = happyShift action_32
+action_3 (125#) = happyShift action_33
+action_3 (126#) = happyShift action_34
+action_3 (127#) = happyShift action_35
+action_3 (128#) = happyShift action_36
+action_3 (129#) = happyShift action_37
+action_3 (131#) = happyShift action_38
+action_3 (134#) = happyShift action_39
+action_3 (137#) = happyShift action_40
+action_3 (140#) = happyShift action_41
+action_3 (145#) = happyShift action_42
+action_3 (156#) = happyShift action_43
+action_3 (157#) = happyShift action_44
+action_3 (161#) = happyShift action_45
+action_3 (162#) = happyShift action_46
+action_3 (167#) = happyShift action_47
+action_3 (170#) = happyShift action_6
+action_3 (171#) = happyShift action_48
+action_3 (172#) = happyShift action_49
+action_3 (173#) = happyShift action_50
+action_3 (174#) = happyShift action_51
+action_3 (8#) = happyGoto action_10
+action_3 (9#) = happyGoto action_11
+action_3 (10#) = happyGoto action_12
+action_3 (11#) = happyGoto action_13
+action_3 (12#) = happyGoto action_14
+action_3 (58#) = happyGoto action_15
+action_3 (59#) = happyGoto action_16
+action_3 (60#) = happyGoto action_17
+action_3 (61#) = happyGoto action_18
+action_3 (62#) = happyGoto action_19
+action_3 (63#) = happyGoto action_20
+action_3 (64#) = happyGoto action_21
+action_3 (72#) = happyGoto action_22
+action_3 (77#) = happyGoto action_23
+action_3 x = happyTcHack x happyFail
+
+action_4 (142#) = happyShift action_9
+action_4 (21#) = happyGoto action_7
+action_4 (30#) = happyGoto action_8
+action_4 x = happyTcHack x happyReduce_60
+
+action_5 (170#) = happyShift action_6
+action_5 x = happyTcHack x happyFail
+
+action_6 x = happyTcHack x happyReduce_5
+
+action_7 (1#) = happyAccept
+action_7 x = happyTcHack x happyFail
+
+action_8 (130#) = happyShift action_63
+action_8 (133#) = happyShift action_64
+action_8 (143#) = happyShift action_65
+action_8 (144#) = happyShift action_66
+action_8 (159#) = happyShift action_67
+action_8 (164#) = happyShift action_68
+action_8 (23#) = happyGoto action_137
+action_8 x = happyTcHack x happyFail
+
+action_9 x = happyTcHack x happyReduce_61
+
+action_10 x = happyTcHack x happyReduce_145
+
+action_11 x = happyTcHack x happyReduce_144
+
+action_12 x = happyTcHack x happyReduce_146
+
+action_13 x = happyTcHack x happyReduce_157
+
+action_14 (113#) = happyShift action_136
+action_14 x = happyTcHack x happyReduce_140
+
+action_15 x = happyTcHack x happyReduce_161
+
+action_16 (107#) = happyShift action_135
+action_16 x = happyTcHack x happyReduce_173
+
+action_17 (96#) = happyShift action_24
+action_17 (98#) = happyShift action_82
+action_17 (101#) = happyReduce_240
+action_17 (104#) = happyShift action_26
+action_17 (109#) = happyShift action_27
+action_17 (110#) = happyShift action_28
+action_17 (111#) = happyShift action_29
+action_17 (125#) = happyShift action_33
+action_17 (126#) = happyShift action_34
+action_17 (127#) = happyShift action_35
+action_17 (128#) = happyShift action_36
+action_17 (129#) = happyShift action_37
+action_17 (134#) = happyShift action_39
+action_17 (170#) = happyShift action_6
+action_17 (171#) = happyShift action_48
+action_17 (172#) = happyShift action_49
+action_17 (173#) = happyShift action_50
+action_17 (174#) = happyShift action_51
+action_17 (8#) = happyGoto action_10
+action_17 (9#) = happyGoto action_11
+action_17 (10#) = happyGoto action_12
+action_17 (11#) = happyGoto action_13
+action_17 (12#) = happyGoto action_79
+action_17 (58#) = happyGoto action_15
+action_17 (59#) = happyGoto action_134
+action_17 (72#) = happyGoto action_22
+action_17 x = happyTcHack x happyReduce_178
+
+action_18 (102#) = happyShift action_129
+action_18 (115#) = happyShift action_130
+action_18 (116#) = happyShift action_131
+action_18 (120#) = happyShift action_132
+action_18 (168#) = happyShift action_133
+action_18 x = happyTcHack x happyReduce_192
+
+action_19 (118#) = happyShift action_128
+action_19 x = happyTcHack x happyReduce_191
+
+action_20 (176#) = happyAccept
+action_20 x = happyTcHack x happyFail
+
+action_21 (117#) = happyShift action_127
+action_21 x = happyTcHack x happyReduce_180
+
+action_22 x = happyTcHack x happyReduce_143
+
+action_23 (101#) = happyShift action_126
+action_23 x = happyTcHack x happyFail
+
+action_24 (174#) = happyShift action_51
+action_24 (12#) = happyGoto action_124
+action_24 (53#) = happyGoto action_88
+action_24 (56#) = happyGoto action_89
+action_24 (57#) = happyGoto action_125
+action_24 x = happyTcHack x happyReduce_137
+
+action_25 (96#) = happyShift action_24
+action_25 (98#) = happyShift action_25
+action_25 (104#) = happyShift action_26
+action_25 (109#) = happyShift action_27
+action_25 (110#) = happyShift action_28
+action_25 (111#) = happyShift action_29
+action_25 (114#) = happyShift action_30
+action_25 (119#) = happyShift action_31
+action_25 (121#) = happyShift action_100
+action_25 (124#) = happyShift action_32
+action_25 (125#) = happyShift action_33
+action_25 (126#) = happyShift action_34
+action_25 (127#) = happyShift action_35
+action_25 (128#) = happyShift action_36
+action_25 (129#) = happyShift action_37
+action_25 (131#) = happyShift action_38
+action_25 (134#) = happyShift action_39
+action_25 (137#) = happyShift action_40
+action_25 (140#) = happyShift action_123
+action_25 (145#) = happyShift action_42
+action_25 (156#) = happyShift action_43
+action_25 (157#) = happyShift action_44
+action_25 (161#) = happyShift action_45
+action_25 (162#) = happyShift action_46
+action_25 (167#) = happyShift action_47
+action_25 (170#) = happyShift action_6
+action_25 (171#) = happyShift action_48
+action_25 (172#) = happyShift action_49
+action_25 (173#) = happyShift action_50
+action_25 (174#) = happyShift action_51
+action_25 (8#) = happyGoto action_10
+action_25 (9#) = happyGoto action_11
+action_25 (10#) = happyGoto action_12
+action_25 (11#) = happyGoto action_13
+action_25 (12#) = happyGoto action_120
+action_25 (58#) = happyGoto action_15
+action_25 (59#) = happyGoto action_16
+action_25 (60#) = happyGoto action_17
+action_25 (61#) = happyGoto action_18
+action_25 (62#) = happyGoto action_19
+action_25 (63#) = happyGoto action_121
+action_25 (64#) = happyGoto action_21
+action_25 (72#) = happyGoto action_22
+action_25 (75#) = happyGoto action_97
+action_25 (76#) = happyGoto action_122
+action_25 (77#) = happyGoto action_23
+action_25 x = happyTcHack x happyReduce_236
+
+action_26 (105#) = happyShift action_119
+action_26 (171#) = happyShift action_48
+action_26 (174#) = happyShift action_51
+action_26 (9#) = happyGoto action_117
+action_26 (12#) = happyGoto action_118
+action_26 x = happyTcHack x happyFail
+
+action_27 (174#) = happyShift action_51
+action_27 (12#) = happyGoto action_116
+action_27 x = happyTcHack x happyFail
+
+action_28 x = happyTcHack x happyReduce_147
+
+action_29 (96#) = happyShift action_24
+action_29 (98#) = happyShift action_25
+action_29 (104#) = happyShift action_26
+action_29 (109#) = happyShift action_27
+action_29 (110#) = happyShift action_28
+action_29 (111#) = happyShift action_29
+action_29 (114#) = happyShift action_30
+action_29 (119#) = happyShift action_31
+action_29 (124#) = happyShift action_32
+action_29 (125#) = happyShift action_33
+action_29 (126#) = happyShift action_34
+action_29 (127#) = happyShift action_35
+action_29 (128#) = happyShift action_36
+action_29 (129#) = happyShift action_37
+action_29 (131#) = happyShift action_38
+action_29 (134#) = happyShift action_39
+action_29 (137#) = happyShift action_40
+action_29 (140#) = happyShift action_41
+action_29 (145#) = happyShift action_42
+action_29 (156#) = happyShift action_43
+action_29 (157#) = happyShift action_44
+action_29 (161#) = happyShift action_45
+action_29 (162#) = happyShift action_46
+action_29 (167#) = happyShift action_47
+action_29 (170#) = happyShift action_6
+action_29 (171#) = happyShift action_48
+action_29 (172#) = happyShift action_49
+action_29 (173#) = happyShift action_50
+action_29 (174#) = happyShift action_51
+action_29 (8#) = happyGoto action_10
+action_29 (9#) = happyGoto action_11
+action_29 (10#) = happyGoto action_12
+action_29 (11#) = happyGoto action_13
+action_29 (12#) = happyGoto action_14
+action_29 (58#) = happyGoto action_15
+action_29 (59#) = happyGoto action_16
+action_29 (60#) = happyGoto action_17
+action_29 (61#) = happyGoto action_18
+action_29 (62#) = happyGoto action_19
+action_29 (63#) = happyGoto action_113
+action_29 (64#) = happyGoto action_21
+action_29 (72#) = happyGoto action_22
+action_29 (77#) = happyGoto action_23
+action_29 (78#) = happyGoto action_114
+action_29 (80#) = happyGoto action_115
+action_29 x = happyTcHack x happyReduce_243
+
+action_30 (96#) = happyShift action_106
+action_30 (98#) = happyShift action_107
+action_30 (104#) = happyShift action_108
+action_30 (110#) = happyShift action_109
+action_30 (111#) = happyShift action_110
+action_30 (114#) = happyShift action_111
+action_30 (121#) = happyShift action_112
+action_30 (170#) = happyShift action_6
+action_30 (171#) = happyShift action_48
+action_30 (172#) = happyShift action_49
+action_30 (174#) = happyShift action_51
+action_30 (8#) = happyGoto action_101
+action_30 (9#) = happyGoto action_102
+action_30 (10#) = happyGoto action_103
+action_30 (12#) = happyGoto action_104
+action_30 (67#) = happyGoto action_105
+action_30 x = happyTcHack x happyFail
+
+action_31 (119#) = happyShift action_99
+action_31 (121#) = happyShift action_100
+action_31 (174#) = happyShift action_51
+action_31 (12#) = happyGoto action_96
+action_31 (75#) = happyGoto action_97
+action_31 (76#) = happyGoto action_98
+action_31 x = happyTcHack x happyReduce_236
+
+action_32 (174#) = happyShift action_51
+action_32 (12#) = happyGoto action_95
+action_32 x = happyTcHack x happyFail
+
+action_33 x = happyTcHack x happyReduce_225
+
+action_34 x = happyTcHack x happyReduce_227
+
+action_35 x = happyTcHack x happyReduce_228
+
+action_36 x = happyTcHack x happyReduce_226
+
+action_37 x = happyTcHack x happyReduce_224
+
+action_38 (96#) = happyShift action_24
+action_38 (98#) = happyShift action_25
+action_38 (104#) = happyShift action_26
+action_38 (109#) = happyShift action_27
+action_38 (110#) = happyShift action_28
+action_38 (111#) = happyShift action_29
+action_38 (114#) = happyShift action_30
+action_38 (119#) = happyShift action_31
+action_38 (124#) = happyShift action_32
+action_38 (125#) = happyShift action_33
+action_38 (126#) = happyShift action_34
+action_38 (127#) = happyShift action_35
+action_38 (128#) = happyShift action_36
+action_38 (129#) = happyShift action_37
+action_38 (131#) = happyShift action_38
+action_38 (134#) = happyShift action_39
+action_38 (137#) = happyShift action_40
+action_38 (140#) = happyShift action_41
+action_38 (145#) = happyShift action_42
+action_38 (156#) = happyShift action_43
+action_38 (157#) = happyShift action_44
+action_38 (161#) = happyShift action_45
+action_38 (162#) = happyShift action_46
+action_38 (167#) = happyShift action_47
+action_38 (170#) = happyShift action_6
+action_38 (171#) = happyShift action_48
+action_38 (172#) = happyShift action_49
+action_38 (173#) = happyShift action_50
+action_38 (174#) = happyShift action_51
+action_38 (8#) = happyGoto action_10
+action_38 (9#) = happyGoto action_11
+action_38 (10#) = happyGoto action_12
+action_38 (11#) = happyGoto action_13
+action_38 (12#) = happyGoto action_14
+action_38 (58#) = happyGoto action_15
+action_38 (59#) = happyGoto action_16
+action_38 (60#) = happyGoto action_17
+action_38 (61#) = happyGoto action_18
+action_38 (62#) = happyGoto action_19
+action_38 (63#) = happyGoto action_94
+action_38 (64#) = happyGoto action_21
+action_38 (72#) = happyGoto action_22
+action_38 (77#) = happyGoto action_23
+action_38 x = happyTcHack x happyFail
+
+action_39 x = happyTcHack x happyReduce_149
+
+action_40 (96#) = happyShift action_93
+action_40 x = happyTcHack x happyFail
+
+action_41 (96#) = happyShift action_24
+action_41 (98#) = happyShift action_82
+action_41 (104#) = happyShift action_26
+action_41 (109#) = happyShift action_27
+action_41 (110#) = happyShift action_28
+action_41 (111#) = happyShift action_29
+action_41 (125#) = happyShift action_33
+action_41 (126#) = happyShift action_34
+action_41 (127#) = happyShift action_35
+action_41 (128#) = happyShift action_36
+action_41 (129#) = happyShift action_37
+action_41 (134#) = happyShift action_39
+action_41 (170#) = happyShift action_6
+action_41 (171#) = happyShift action_48
+action_41 (172#) = happyShift action_49
+action_41 (173#) = happyShift action_50
+action_41 (174#) = happyShift action_51
+action_41 (8#) = happyGoto action_10
+action_41 (9#) = happyGoto action_11
+action_41 (10#) = happyGoto action_12
+action_41 (11#) = happyGoto action_13
+action_41 (12#) = happyGoto action_79
+action_41 (58#) = happyGoto action_15
+action_41 (59#) = happyGoto action_92
+action_41 (72#) = happyGoto action_22
+action_41 x = happyTcHack x happyFail
+
+action_42 (96#) = happyShift action_91
+action_42 (174#) = happyShift action_51
+action_42 (12#) = happyGoto action_87
+action_42 (53#) = happyGoto action_88
+action_42 (56#) = happyGoto action_89
+action_42 (57#) = happyGoto action_90
+action_42 x = happyTcHack x happyReduce_137
+
+action_43 (96#) = happyShift action_24
+action_43 (98#) = happyShift action_82
+action_43 (104#) = happyShift action_26
+action_43 (109#) = happyShift action_27
+action_43 (110#) = happyShift action_28
+action_43 (111#) = happyShift action_29
+action_43 (125#) = happyShift action_33
+action_43 (126#) = happyShift action_34
+action_43 (127#) = happyShift action_35
+action_43 (128#) = happyShift action_36
+action_43 (129#) = happyShift action_37
+action_43 (134#) = happyShift action_39
+action_43 (170#) = happyShift action_6
+action_43 (171#) = happyShift action_48
+action_43 (172#) = happyShift action_49
+action_43 (173#) = happyShift action_50
+action_43 (174#) = happyShift action_51
+action_43 (8#) = happyGoto action_10
+action_43 (9#) = happyGoto action_11
+action_43 (10#) = happyGoto action_12
+action_43 (11#) = happyGoto action_13
+action_43 (12#) = happyGoto action_79
+action_43 (58#) = happyGoto action_15
+action_43 (59#) = happyGoto action_86
+action_43 (72#) = happyGoto action_22
+action_43 x = happyTcHack x happyFail
+
+action_44 (96#) = happyShift action_85
+action_44 x = happyTcHack x happyFail
+
+action_45 (96#) = happyShift action_84
+action_45 x = happyTcHack x happyFail
+
+action_46 (96#) = happyShift action_81
+action_46 (98#) = happyShift action_82
+action_46 (104#) = happyShift action_26
+action_46 (109#) = happyShift action_83
+action_46 (110#) = happyShift action_28
+action_46 (111#) = happyShift action_29
+action_46 (125#) = happyShift action_33
+action_46 (126#) = happyShift action_34
+action_46 (127#) = happyShift action_35
+action_46 (128#) = happyShift action_36
+action_46 (129#) = happyShift action_37
+action_46 (134#) = happyShift action_39
+action_46 (170#) = happyShift action_6
+action_46 (171#) = happyShift action_48
+action_46 (172#) = happyShift action_49
+action_46 (173#) = happyShift action_50
+action_46 (174#) = happyShift action_51
+action_46 (8#) = happyGoto action_10
+action_46 (9#) = happyGoto action_11
+action_46 (10#) = happyGoto action_12
+action_46 (11#) = happyGoto action_13
+action_46 (12#) = happyGoto action_79
+action_46 (58#) = happyGoto action_80
+action_46 (72#) = happyGoto action_22
+action_46 x = happyTcHack x happyFail
+
+action_47 (96#) = happyShift action_78
+action_47 x = happyTcHack x happyFail
+
+action_48 x = happyTcHack x happyReduce_6
+
+action_49 x = happyTcHack x happyReduce_7
+
+action_50 x = happyTcHack x happyReduce_8
+
+action_51 x = happyTcHack x happyReduce_9
+
+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 (106#) = happyShift action_74
+action_54 (107#) = happyShift action_75
+action_54 (123#) = happyShift action_76
+action_54 (171#) = happyShift action_48
+action_54 (174#) = happyShift action_51
+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 (94#) = happyShift action_69
+action_55 (176#) = happyAccept
+action_55 x = happyTcHack x happyFail
+
+action_56 (130#) = happyShift action_63
+action_56 (133#) = happyShift action_64
+action_56 (143#) = happyShift action_65
+action_56 (144#) = happyShift action_66
+action_56 (159#) = happyShift action_67
+action_56 (164#) = happyShift action_68
+action_56 (23#) = happyGoto action_62
+action_56 x = happyTcHack x happyFail
+
+action_57 (174#) = happyShift action_51
+action_57 (12#) = happyGoto action_61
+action_57 x = happyTcHack x happyFail
+
+action_58 (176#) = happyAccept
+action_58 x = happyTcHack x happyFail
+
+action_59 (139#) = happyShift action_57
+action_59 (142#) = happyShift action_9
+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 (94#) = happyShift action_69
+action_60 x = happyTcHack x happyReduce_12
+
+action_61 (95#) = happyShift action_239
+action_61 x = happyTcHack x happyFail
+
+action_62 (95#) = happyShift action_238
+action_62 x = happyTcHack x happyFail
+
+action_63 (174#) = happyShift action_51
+action_63 (12#) = happyGoto action_237
+action_63 x = happyTcHack x happyFail
+
+action_64 (174#) = happyShift action_51
+action_64 (12#) = happyGoto action_236
+action_64 x = happyTcHack x happyFail
+
+action_65 (174#) = happyShift action_51
+action_65 (12#) = happyGoto action_235
+action_65 x = happyTcHack x happyFail
+
+action_66 (174#) = happyShift action_51
+action_66 (12#) = happyGoto action_234
+action_66 x = happyTcHack x happyFail
+
+action_67 (174#) = happyShift action_51
+action_67 (12#) = happyGoto action_233
+action_67 x = happyTcHack x happyFail
+
+action_68 (174#) = happyShift action_51
+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 (106#) = happyShift action_74
+action_71 (107#) = happyShift action_75
+action_71 (123#) = happyShift action_76
+action_71 (171#) = happyShift action_48
+action_71 (174#) = happyShift action_51
+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 (94#) = happyShift action_230
+action_72 x = happyTcHack x happyFail
+
+action_73 x = happyTcHack x happyReduce_266
+
+action_74 (106#) = happyShift action_74
+action_74 (107#) = happyShift action_75
+action_74 (123#) = happyShift action_76
+action_74 (171#) = happyShift action_48
+action_74 (174#) = happyShift action_51
+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 (106#) = happyShift action_74
+action_75 (107#) = happyShift action_75
+action_75 (123#) = happyShift action_76
+action_75 (171#) = happyShift action_48
+action_75 (174#) = happyShift action_51
+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 (106#) = happyShift action_74
+action_76 (107#) = happyShift action_75
+action_76 (123#) = happyShift action_76
+action_76 (171#) = happyShift action_48
+action_76 (174#) = happyShift action_51
+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 (132#) = happyShift action_210
+action_77 (134#) = happyShift action_211
+action_77 (135#) = happyShift action_212
+action_77 (136#) = happyShift action_213
+action_77 (138#) = happyShift action_214
+action_77 (146#) = happyShift action_215
+action_77 (147#) = happyShift action_216
+action_77 (148#) = happyShift action_217
+action_77 (149#) = happyShift action_218
+action_77 (152#) = happyShift action_219
+action_77 (154#) = happyShift action_220
+action_77 (155#) = happyShift action_221
+action_77 (156#) = happyShift action_222
+action_77 (158#) = happyShift action_223
+action_77 (163#) = happyShift action_224
+action_77 (164#) = happyShift action_225
+action_77 (166#) = happyShift action_226
+action_77 (35#) = happyGoto action_209
+action_77 x = happyTcHack x happyReduce_264
+
+action_78 (96#) = happyShift action_24
+action_78 (98#) = happyShift action_25
+action_78 (104#) = happyShift action_26
+action_78 (109#) = happyShift action_27
+action_78 (110#) = happyShift action_28
+action_78 (111#) = happyShift action_29
+action_78 (114#) = happyShift action_30
+action_78 (119#) = happyShift action_31
+action_78 (124#) = happyShift action_32
+action_78 (125#) = happyShift action_33
+action_78 (126#) = happyShift action_34
+action_78 (127#) = happyShift action_35
+action_78 (128#) = happyShift action_36
+action_78 (129#) = happyShift action_37
+action_78 (131#) = happyShift action_38
+action_78 (134#) = happyShift action_39
+action_78 (137#) = happyShift action_40
+action_78 (140#) = happyShift action_41
+action_78 (145#) = happyShift action_42
+action_78 (156#) = happyShift action_43
+action_78 (157#) = happyShift action_44
+action_78 (161#) = happyShift action_45
+action_78 (162#) = happyShift action_46
+action_78 (167#) = happyShift action_47
+action_78 (170#) = happyShift action_6
+action_78 (171#) = happyShift action_48
+action_78 (172#) = happyShift action_49
+action_78 (173#) = happyShift action_50
+action_78 (174#) = happyShift action_51
+action_78 (8#) = happyGoto action_10
+action_78 (9#) = happyGoto action_11
+action_78 (10#) = happyGoto action_12
+action_78 (11#) = happyGoto action_13
+action_78 (12#) = happyGoto action_14
+action_78 (58#) = happyGoto action_15
+action_78 (59#) = happyGoto action_16
+action_78 (60#) = happyGoto action_17
+action_78 (61#) = happyGoto action_18
+action_78 (62#) = happyGoto action_19
+action_78 (63#) = happyGoto action_199
+action_78 (64#) = happyGoto action_21
+action_78 (65#) = happyGoto action_208
+action_78 (72#) = happyGoto action_22
+action_78 (77#) = happyGoto action_23
+action_78 x = happyTcHack x happyReduce_193
+
+action_79 x = happyTcHack x happyReduce_140
+
+action_80 (96#) = happyShift action_206
+action_80 (104#) = happyShift action_207
+action_80 x = happyTcHack x happyFail
+
+action_81 (96#) = happyShift action_106
+action_81 (98#) = happyShift action_107
+action_81 (104#) = happyShift action_108
+action_81 (106#) = happyShift action_176
+action_81 (110#) = happyShift action_109
+action_81 (111#) = happyShift action_110
+action_81 (114#) = happyShift action_111
+action_81 (121#) = happyShift action_112
+action_81 (170#) = happyShift action_6
+action_81 (171#) = happyShift action_48
+action_81 (172#) = happyShift action_49
+action_81 (174#) = happyShift action_51
+action_81 (8#) = happyGoto action_101
+action_81 (9#) = happyGoto action_102
+action_81 (10#) = happyGoto action_103
+action_81 (12#) = happyGoto action_202
+action_81 (53#) = happyGoto action_88
+action_81 (56#) = happyGoto action_89
+action_81 (57#) = happyGoto action_125
+action_81 (67#) = happyGoto action_171
+action_81 (68#) = happyGoto action_172
+action_81 (69#) = happyGoto action_203
+action_81 (82#) = happyGoto action_204
+action_81 (83#) = happyGoto action_205
+action_81 x = happyTcHack x happyReduce_137
+
+action_82 (96#) = happyShift action_24
+action_82 (98#) = happyShift action_25
+action_82 (104#) = happyShift action_26
+action_82 (109#) = happyShift action_27
+action_82 (110#) = happyShift action_28
+action_82 (111#) = happyShift action_29
+action_82 (114#) = happyShift action_30
+action_82 (119#) = happyShift action_31
+action_82 (124#) = happyShift action_32
+action_82 (125#) = happyShift action_33
+action_82 (126#) = happyShift action_34
+action_82 (127#) = happyShift action_35
+action_82 (128#) = happyShift action_36
+action_82 (129#) = happyShift action_37
+action_82 (131#) = happyShift action_38
+action_82 (134#) = happyShift action_39
+action_82 (137#) = happyShift action_40
+action_82 (140#) = happyShift action_123
+action_82 (145#) = happyShift action_42
+action_82 (156#) = happyShift action_43
+action_82 (157#) = happyShift action_44
+action_82 (161#) = happyShift action_45
+action_82 (162#) = happyShift action_46
+action_82 (167#) = happyShift action_47
+action_82 (170#) = happyShift action_6
+action_82 (171#) = happyShift action_48
+action_82 (172#) = happyShift action_49
+action_82 (173#) = happyShift action_50
+action_82 (174#) = happyShift action_51
+action_82 (8#) = happyGoto action_10
+action_82 (9#) = happyGoto action_11
+action_82 (10#) = happyGoto action_12
+action_82 (11#) = happyGoto action_13
+action_82 (12#) = happyGoto action_14
+action_82 (58#) = happyGoto action_15
+action_82 (59#) = happyGoto action_16
+action_82 (60#) = happyGoto action_17
+action_82 (61#) = happyGoto action_18
+action_82 (62#) = happyGoto action_19
+action_82 (63#) = happyGoto action_121
+action_82 (64#) = happyGoto action_21
+action_82 (72#) = happyGoto action_22
+action_82 (77#) = happyGoto action_23
+action_82 x = happyTcHack x happyFail
+
+action_83 (174#) = happyShift action_51
+action_83 (12#) = happyGoto action_201
+action_83 x = happyTcHack x happyFail
+
+action_84 (96#) = happyShift action_24
+action_84 (98#) = happyShift action_25
+action_84 (104#) = happyShift action_26
+action_84 (109#) = happyShift action_27
+action_84 (110#) = happyShift action_28
+action_84 (111#) = happyShift action_29
+action_84 (114#) = happyShift action_30
+action_84 (119#) = happyShift action_31
+action_84 (124#) = happyShift action_32
+action_84 (125#) = happyShift action_33
+action_84 (126#) = happyShift action_34
+action_84 (127#) = happyShift action_35
+action_84 (128#) = happyShift action_36
+action_84 (129#) = happyShift action_37
+action_84 (131#) = happyShift action_38
+action_84 (134#) = happyShift action_39
+action_84 (137#) = happyShift action_40
+action_84 (140#) = happyShift action_41
+action_84 (145#) = happyShift action_42
+action_84 (156#) = happyShift action_43
+action_84 (157#) = happyShift action_44
+action_84 (161#) = happyShift action_45
+action_84 (162#) = happyShift action_46
+action_84 (167#) = happyShift action_47
+action_84 (170#) = happyShift action_6
+action_84 (171#) = happyShift action_48
+action_84 (172#) = happyShift action_49
+action_84 (173#) = happyShift action_50
+action_84 (174#) = happyShift action_51
+action_84 (8#) = happyGoto action_10
+action_84 (9#) = happyGoto action_11
+action_84 (10#) = happyGoto action_12
+action_84 (11#) = happyGoto action_13
+action_84 (12#) = happyGoto action_14
+action_84 (58#) = happyGoto action_15
+action_84 (59#) = happyGoto action_16
+action_84 (60#) = happyGoto action_17
+action_84 (61#) = happyGoto action_18
+action_84 (62#) = happyGoto action_19
+action_84 (63#) = happyGoto action_199
+action_84 (64#) = happyGoto action_21
+action_84 (65#) = happyGoto action_200
+action_84 (72#) = happyGoto action_22
+action_84 (77#) = happyGoto action_23
+action_84 x = happyTcHack x happyReduce_193
+
+action_85 (96#) = happyShift action_24
+action_85 (98#) = happyShift action_25
+action_85 (104#) = happyShift action_26
+action_85 (109#) = happyShift action_27
+action_85 (110#) = happyShift action_28
+action_85 (111#) = happyShift action_29
+action_85 (114#) = happyShift action_30
+action_85 (119#) = happyShift action_31
+action_85 (124#) = happyShift action_32
+action_85 (125#) = happyShift action_33
+action_85 (126#) = happyShift action_34
+action_85 (127#) = happyShift action_35
+action_85 (128#) = happyShift action_36
+action_85 (129#) = happyShift action_37
+action_85 (131#) = happyShift action_38
+action_85 (134#) = happyShift action_39
+action_85 (137#) = happyShift action_40
+action_85 (140#) = happyShift action_41
+action_85 (145#) = happyShift action_42
+action_85 (156#) = happyShift action_43
+action_85 (157#) = happyShift action_44
+action_85 (161#) = happyShift action_45
+action_85 (162#) = happyShift action_46
+action_85 (167#) = happyShift action_47
+action_85 (170#) = happyShift action_6
+action_85 (171#) = happyShift action_48
+action_85 (172#) = happyShift action_49
+action_85 (173#) = happyShift action_50
+action_85 (174#) = happyShift action_51
+action_85 (8#) = happyGoto action_10
+action_85 (9#) = happyGoto action_11
+action_85 (10#) = happyGoto action_12
+action_85 (11#) = happyGoto action_13
+action_85 (12#) = happyGoto action_14
+action_85 (58#) = happyGoto action_15
+action_85 (59#) = happyGoto action_16
+action_85 (60#) = happyGoto action_17
+action_85 (61#) = happyGoto action_18
+action_85 (62#) = happyGoto action_19
+action_85 (63#) = happyGoto action_198
+action_85 (64#) = happyGoto action_21
+action_85 (72#) = happyGoto action_22
+action_85 (77#) = happyGoto action_23
+action_85 x = happyTcHack x happyFail
+
+action_86 (107#) = happyShift action_135
+action_86 x = happyTcHack x happyReduce_172
+
+action_87 (103#) = happyShift action_156
+action_87 x = happyTcHack x happyReduce_128
+
+action_88 (95#) = happyShift action_196
+action_88 (100#) = happyShift action_197
+action_88 x = happyTcHack x happyFail
+
+action_89 (94#) = happyShift action_195
+action_89 x = happyTcHack x happyReduce_138
+
+action_90 (140#) = happyShift action_194
+action_90 x = happyTcHack x happyFail
+
+action_91 (174#) = happyShift action_51
+action_91 (12#) = happyGoto action_87
+action_91 (53#) = happyGoto action_88
+action_91 (56#) = happyGoto action_89
+action_91 (57#) = happyGoto action_193
+action_91 x = happyTcHack x happyReduce_137
+
+action_92 (107#) = happyShift action_135
+action_92 (171#) = happyShift action_48
+action_92 (9#) = happyGoto action_192
+action_92 x = happyTcHack x happyFail
+
+action_93 (96#) = happyShift action_106
+action_93 (98#) = happyShift action_107
+action_93 (104#) = happyShift action_108
+action_93 (110#) = happyShift action_109
+action_93 (111#) = happyShift action_110
+action_93 (114#) = happyShift action_111
+action_93 (121#) = happyShift action_112
+action_93 (170#) = happyShift action_6
+action_93 (171#) = happyShift action_48
+action_93 (172#) = happyShift action_49
+action_93 (174#) = happyShift action_51
+action_93 (8#) = happyGoto action_101
+action_93 (9#) = happyGoto action_102
+action_93 (10#) = happyGoto action_103
+action_93 (12#) = happyGoto action_104
+action_93 (67#) = happyGoto action_188
+action_93 (74#) = happyGoto action_189
+action_93 (84#) = happyGoto action_190
+action_93 (85#) = happyGoto action_191
+action_93 x = happyTcHack x happyReduce_253
+
+action_94 (150#) = happyShift action_187
+action_94 x = happyTcHack x happyFail
+
+action_95 x = happyTcHack x happyReduce_174
+
+action_96 x = happyTcHack x happyReduce_234
+
+action_97 (103#) = happyShift action_186
+action_97 x = happyTcHack x happyReduce_237
+
+action_98 (101#) = happyShift action_185
+action_98 x = happyTcHack x happyFail
+
+action_99 (121#) = happyShift action_100
+action_99 (174#) = happyShift action_51
+action_99 (12#) = happyGoto action_96
+action_99 (75#) = happyGoto action_97
+action_99 (76#) = happyGoto action_184
+action_99 x = happyTcHack x happyReduce_236
+
+action_100 x = happyTcHack x happyReduce_235
+
+action_101 x = happyTcHack x happyReduce_206
+
+action_102 x = happyTcHack x happyReduce_208
+
+action_103 x = happyTcHack x happyReduce_207
+
+action_104 (107#) = happyShift action_183
+action_104 x = happyTcHack x happyReduce_203
+
+action_105 x = happyTcHack x happyReduce_171
+
+action_106 (174#) = happyShift action_51
+action_106 (12#) = happyGoto action_179
+action_106 (53#) = happyGoto action_180
+action_106 (70#) = happyGoto action_181
+action_106 (73#) = happyGoto action_182
+action_106 x = happyTcHack x happyReduce_229
+
+action_107 (96#) = happyShift action_106
+action_107 (98#) = happyShift action_107
+action_107 (104#) = happyShift action_108
+action_107 (106#) = happyShift action_176
+action_107 (110#) = happyShift action_109
+action_107 (111#) = happyShift action_110
+action_107 (114#) = happyShift action_111
+action_107 (121#) = happyShift action_112
+action_107 (170#) = happyShift action_6
+action_107 (171#) = happyShift action_48
+action_107 (172#) = happyShift action_49
+action_107 (174#) = happyShift action_51
+action_107 (8#) = happyGoto action_101
+action_107 (9#) = happyGoto action_102
+action_107 (10#) = happyGoto action_103
+action_107 (12#) = happyGoto action_170
+action_107 (67#) = happyGoto action_171
+action_107 (68#) = happyGoto action_172
+action_107 (69#) = happyGoto action_178
+action_107 x = happyTcHack x happyFail
+
+action_108 (171#) = happyShift action_48
+action_108 (9#) = happyGoto action_177
+action_108 x = happyTcHack x happyFail
+
+action_109 x = happyTcHack x happyReduce_198
+
+action_110 (96#) = happyShift action_106
+action_110 (98#) = happyShift action_107
+action_110 (104#) = happyShift action_108
+action_110 (106#) = happyShift action_176
+action_110 (110#) = happyShift action_109
+action_110 (111#) = happyShift action_110
+action_110 (114#) = happyShift action_111
+action_110 (121#) = happyShift action_112
+action_110 (170#) = happyShift action_6
+action_110 (171#) = happyShift action_48
+action_110 (172#) = happyShift action_49
+action_110 (174#) = happyShift action_51
+action_110 (8#) = happyGoto action_101
+action_110 (9#) = happyGoto action_102
+action_110 (10#) = happyGoto action_103
+action_110 (12#) = happyGoto action_170
+action_110 (67#) = happyGoto action_171
+action_110 (68#) = happyGoto action_172
+action_110 (69#) = happyGoto action_173
+action_110 (79#) = happyGoto action_174
+action_110 (81#) = happyGoto action_175
+action_110 x = happyTcHack x happyReduce_246
+
+action_111 (174#) = happyShift action_51
+action_111 (12#) = happyGoto action_169
+action_111 x = happyTcHack x happyFail
+
+action_112 x = happyTcHack x happyReduce_202
+
+action_113 (100#) = happyShift action_168
+action_113 x = happyTcHack x happyReduce_241
+
+action_114 (103#) = happyShift action_167
+action_114 x = happyTcHack x happyReduce_244
+
+action_115 (112#) = happyShift action_166
+action_115 x = happyTcHack x happyFail
+
+action_116 (107#) = happyShift action_164
+action_116 (109#) = happyShift action_165
+action_116 x = happyTcHack x happyFail
+
+action_117 (105#) = happyShift action_163
+action_117 x = happyTcHack x happyFail
+
+action_118 (96#) = happyShift action_140
+action_118 (98#) = happyShift action_82
+action_118 (104#) = happyShift action_26
+action_118 (109#) = happyShift action_83
+action_118 (110#) = happyShift action_28
+action_118 (111#) = happyShift action_29
+action_118 (125#) = happyShift action_33
+action_118 (126#) = happyShift action_34
+action_118 (127#) = happyShift action_35
+action_118 (128#) = happyShift action_36
+action_118 (129#) = happyShift action_37
+action_118 (134#) = happyShift action_39
+action_118 (170#) = happyShift action_6
+action_118 (171#) = happyShift action_48
+action_118 (172#) = happyShift action_49
+action_118 (173#) = happyShift action_50
+action_118 (174#) = happyShift action_51
+action_118 (8#) = happyGoto action_10
+action_118 (9#) = happyGoto action_11
+action_118 (10#) = happyGoto action_12
+action_118 (11#) = happyGoto action_13
+action_118 (12#) = happyGoto action_79
+action_118 (58#) = happyGoto action_161
+action_118 (66#) = happyGoto action_162
+action_118 (72#) = happyGoto action_22
+action_118 x = happyTcHack x happyReduce_196
+
+action_119 x = happyTcHack x happyReduce_148
+
+action_120 (100#) = happyReduce_234
+action_120 (103#) = happyReduce_234
+action_120 (113#) = happyShift action_136
+action_120 x = happyTcHack x happyReduce_140
+
+action_121 (99#) = happyShift action_160
+action_121 x = happyTcHack x happyFail
+
+action_122 (100#) = happyShift action_159
+action_122 x = happyTcHack x happyFail
+
+action_123 (96#) = happyShift action_24
+action_123 (98#) = happyShift action_82
+action_123 (104#) = happyShift action_26
+action_123 (109#) = happyShift action_27
+action_123 (110#) = happyShift action_28
+action_123 (111#) = happyShift action_29
+action_123 (125#) = happyShift action_33
+action_123 (126#) = happyShift action_34
+action_123 (127#) = happyShift action_35
+action_123 (128#) = happyShift action_36
+action_123 (129#) = happyShift action_37
+action_123 (134#) = happyShift action_39
+action_123 (170#) = happyShift action_6
+action_123 (171#) = happyShift action_48
+action_123 (172#) = happyShift action_49
+action_123 (173#) = happyShift action_50
+action_123 (174#) = happyShift action_51
+action_123 (8#) = happyGoto action_10
+action_123 (9#) = happyGoto action_11
+action_123 (10#) = happyGoto action_12
+action_123 (11#) = happyGoto action_13
+action_123 (12#) = happyGoto action_158
+action_123 (58#) = happyGoto action_15
+action_123 (59#) = happyGoto action_92
+action_123 (72#) = happyGoto action_22
+action_123 x = happyTcHack x happyFail
+
+action_124 (97#) = happyShift action_155
+action_124 (103#) = happyShift action_156
+action_124 (107#) = happyShift action_157
+action_124 x = happyTcHack x happyReduce_128
+
+action_125 (97#) = happyShift action_154
+action_125 x = happyTcHack x happyFail
+
+action_126 (96#) = happyShift action_24
+action_126 (98#) = happyShift action_25
+action_126 (104#) = happyShift action_26
+action_126 (109#) = happyShift action_27
+action_126 (110#) = happyShift action_28
+action_126 (111#) = happyShift action_29
+action_126 (114#) = happyShift action_30
+action_126 (119#) = happyShift action_31
+action_126 (124#) = happyShift action_32
+action_126 (125#) = happyShift action_33
+action_126 (126#) = happyShift action_34
+action_126 (127#) = happyShift action_35
+action_126 (128#) = happyShift action_36
+action_126 (129#) = happyShift action_37
+action_126 (131#) = happyShift action_38
+action_126 (134#) = happyShift action_39
+action_126 (137#) = happyShift action_40
+action_126 (140#) = happyShift action_41
+action_126 (145#) = happyShift action_42
+action_126 (156#) = happyShift action_43
+action_126 (157#) = happyShift action_44
+action_126 (161#) = happyShift action_45
+action_126 (162#) = happyShift action_46
+action_126 (167#) = happyShift action_47
+action_126 (170#) = happyShift action_6
+action_126 (171#) = happyShift action_48
+action_126 (172#) = happyShift action_49
+action_126 (173#) = happyShift action_50
+action_126 (174#) = happyShift action_51
+action_126 (8#) = happyGoto action_10
+action_126 (9#) = happyGoto action_11
+action_126 (10#) = happyGoto action_12
+action_126 (11#) = happyGoto action_13
+action_126 (12#) = happyGoto action_14
+action_126 (58#) = happyGoto action_15
+action_126 (59#) = happyGoto action_16
+action_126 (60#) = happyGoto action_17
+action_126 (61#) = happyGoto action_18
+action_126 (62#) = happyGoto action_19
+action_126 (63#) = happyGoto action_153
+action_126 (64#) = happyGoto action_21
+action_126 (72#) = happyGoto action_22
+action_126 (77#) = happyGoto action_23
+action_126 x = happyTcHack x happyFail
+
+action_127 (96#) = happyShift action_24
+action_127 (98#) = happyShift action_82
+action_127 (104#) = happyShift action_26
+action_127 (109#) = happyShift action_27
+action_127 (110#) = happyShift action_28
+action_127 (111#) = happyShift action_29
+action_127 (114#) = happyShift action_30
+action_127 (124#) = happyShift action_32
+action_127 (125#) = happyShift action_33
+action_127 (126#) = happyShift action_34
+action_127 (127#) = happyShift action_35
+action_127 (128#) = happyShift action_36
+action_127 (129#) = happyShift action_37
+action_127 (131#) = happyShift action_38
+action_127 (134#) = happyShift action_39
+action_127 (156#) = happyShift action_43
+action_127 (157#) = happyShift action_44
+action_127 (161#) = happyShift action_45
+action_127 (162#) = happyShift action_46
+action_127 (167#) = happyShift action_47
+action_127 (170#) = happyShift action_6
+action_127 (171#) = happyShift action_48
+action_127 (172#) = happyShift action_49
+action_127 (173#) = happyShift action_50
+action_127 (174#) = happyShift action_51
+action_127 (8#) = happyGoto action_10
+action_127 (9#) = happyGoto action_11
+action_127 (10#) = happyGoto action_12
+action_127 (11#) = happyGoto action_13
+action_127 (12#) = happyGoto action_14
+action_127 (58#) = happyGoto action_15
+action_127 (59#) = happyGoto action_16
+action_127 (60#) = happyGoto action_150
+action_127 (61#) = happyGoto action_151
+action_127 (62#) = happyGoto action_152
+action_127 (64#) = happyGoto action_21
+action_127 (72#) = happyGoto action_22
+action_127 x = happyTcHack x happyFail
+
+action_128 (96#) = happyShift action_24
+action_128 (98#) = happyShift action_25
+action_128 (104#) = happyShift action_26
+action_128 (109#) = happyShift action_27
+action_128 (110#) = happyShift action_28
+action_128 (111#) = happyShift action_29
+action_128 (114#) = happyShift action_30
+action_128 (119#) = happyShift action_31
+action_128 (124#) = happyShift action_32
+action_128 (125#) = happyShift action_33
+action_128 (126#) = happyShift action_34
+action_128 (127#) = happyShift action_35
+action_128 (128#) = happyShift action_36
+action_128 (129#) = happyShift action_37
+action_128 (131#) = happyShift action_38
+action_128 (134#) = happyShift action_39
+action_128 (137#) = happyShift action_40
+action_128 (140#) = happyShift action_41
+action_128 (145#) = happyShift action_42
+action_128 (156#) = happyShift action_43
+action_128 (157#) = happyShift action_44
+action_128 (161#) = happyShift action_45
+action_128 (162#) = happyShift action_46
+action_128 (167#) = happyShift action_47
+action_128 (170#) = happyShift action_6
+action_128 (171#) = happyShift action_48
+action_128 (172#) = happyShift action_49
+action_128 (173#) = happyShift action_50
+action_128 (174#) = happyShift action_51
+action_128 (8#) = happyGoto action_10
+action_128 (9#) = happyGoto action_11
+action_128 (10#) = happyGoto action_12
+action_128 (11#) = happyGoto action_13
+action_128 (12#) = happyGoto action_14
+action_128 (58#) = happyGoto action_15
+action_128 (59#) = happyGoto action_16
+action_128 (60#) = happyGoto action_17
+action_128 (61#) = happyGoto action_18
+action_128 (62#) = happyGoto action_19
+action_128 (63#) = happyGoto action_149
+action_128 (64#) = happyGoto action_21
+action_128 (72#) = happyGoto action_22
+action_128 (77#) = happyGoto action_23
+action_128 x = happyTcHack x happyFail
+
+action_129 (96#) = happyShift action_24
+action_129 (98#) = happyShift action_82
+action_129 (104#) = happyShift action_26
+action_129 (109#) = happyShift action_27
+action_129 (110#) = happyShift action_28
+action_129 (111#) = happyShift action_29
+action_129 (114#) = happyShift action_30
+action_129 (124#) = happyShift action_32
+action_129 (125#) = happyShift action_33
+action_129 (126#) = happyShift action_34
+action_129 (127#) = happyShift action_35
+action_129 (128#) = happyShift action_36
+action_129 (129#) = happyShift action_37
+action_129 (131#) = happyShift action_38
+action_129 (134#) = happyShift action_39
+action_129 (156#) = happyShift action_43
+action_129 (157#) = happyShift action_44
+action_129 (161#) = happyShift action_45
+action_129 (162#) = happyShift action_46
+action_129 (167#) = happyShift action_47
+action_129 (170#) = happyShift action_6
+action_129 (171#) = happyShift action_48
+action_129 (172#) = happyShift action_49
+action_129 (173#) = happyShift action_50
+action_129 (174#) = happyShift action_51
+action_129 (8#) = happyGoto action_10
+action_129 (9#) = happyGoto action_11
+action_129 (10#) = happyGoto action_12
+action_129 (11#) = happyGoto action_13
+action_129 (12#) = happyGoto action_14
+action_129 (58#) = happyGoto action_15
+action_129 (59#) = happyGoto action_16
+action_129 (60#) = happyGoto action_148
+action_129 (72#) = happyGoto action_22
+action_129 x = happyTcHack x happyFail
+
+action_130 (96#) = happyShift action_24
+action_130 (98#) = happyShift action_82
+action_130 (104#) = happyShift action_26
+action_130 (109#) = happyShift action_27
+action_130 (110#) = happyShift action_28
+action_130 (111#) = happyShift action_29
+action_130 (114#) = happyShift action_30
+action_130 (124#) = happyShift action_32
+action_130 (125#) = happyShift action_33
+action_130 (126#) = happyShift action_34
+action_130 (127#) = happyShift action_35
+action_130 (128#) = happyShift action_36
+action_130 (129#) = happyShift action_37
+action_130 (131#) = happyShift action_38
+action_130 (134#) = happyShift action_39
+action_130 (156#) = happyShift action_43
+action_130 (157#) = happyShift action_44
+action_130 (161#) = happyShift action_45
+action_130 (162#) = happyShift action_46
+action_130 (167#) = happyShift action_47
+action_130 (170#) = happyShift action_6
+action_130 (171#) = happyShift action_48
+action_130 (172#) = happyShift action_49
+action_130 (173#) = happyShift action_50
+action_130 (174#) = happyShift action_51
+action_130 (8#) = happyGoto action_10
+action_130 (9#) = happyGoto action_11
+action_130 (10#) = happyGoto action_12
+action_130 (11#) = happyGoto action_13
+action_130 (12#) = happyGoto action_14
+action_130 (58#) = happyGoto action_15
+action_130 (59#) = happyGoto action_16
+action_130 (60#) = happyGoto action_147
+action_130 (72#) = happyGoto action_22
+action_130 x = happyTcHack x happyFail
+
+action_131 (96#) = happyShift action_24
+action_131 (98#) = happyShift action_82
+action_131 (104#) = happyShift action_26
+action_131 (109#) = happyShift action_27
+action_131 (110#) = happyShift action_28
+action_131 (111#) = happyShift action_29
+action_131 (114#) = happyShift action_30
+action_131 (124#) = happyShift action_32
+action_131 (125#) = happyShift action_33
+action_131 (126#) = happyShift action_34
+action_131 (127#) = happyShift action_35
+action_131 (128#) = happyShift action_36
+action_131 (129#) = happyShift action_37
+action_131 (131#) = happyShift action_38
+action_131 (134#) = happyShift action_39
+action_131 (156#) = happyShift action_43
+action_131 (157#) = happyShift action_44
+action_131 (161#) = happyShift action_45
+action_131 (162#) = happyShift action_46
+action_131 (167#) = happyShift action_47
+action_131 (170#) = happyShift action_6
+action_131 (171#) = happyShift action_48
+action_131 (172#) = happyShift action_49
+action_131 (173#) = happyShift action_50
+action_131 (174#) = happyShift action_51
+action_131 (8#) = happyGoto action_10
+action_131 (9#) = happyGoto action_11
+action_131 (10#) = happyGoto action_12
+action_131 (11#) = happyGoto action_13
+action_131 (12#) = happyGoto action_14
+action_131 (58#) = happyGoto action_15
+action_131 (59#) = happyGoto action_16
+action_131 (60#) = happyGoto action_146
+action_131 (72#) = happyGoto action_22
+action_131 x = happyTcHack x happyFail
+
+action_132 (96#) = happyShift action_24
+action_132 (98#) = happyShift action_25
+action_132 (104#) = happyShift action_26
+action_132 (109#) = happyShift action_27
+action_132 (110#) = happyShift action_28
+action_132 (111#) = happyShift action_29
+action_132 (114#) = happyShift action_30
+action_132 (119#) = happyShift action_31
+action_132 (124#) = happyShift action_32
+action_132 (125#) = happyShift action_33
+action_132 (126#) = happyShift action_34
+action_132 (127#) = happyShift action_35
+action_132 (128#) = happyShift action_36
+action_132 (129#) = happyShift action_37
+action_132 (131#) = happyShift action_38
+action_132 (134#) = happyShift action_39
+action_132 (137#) = happyShift action_40
+action_132 (140#) = happyShift action_41
+action_132 (145#) = happyShift action_42
+action_132 (156#) = happyShift action_43
+action_132 (157#) = happyShift action_44
+action_132 (161#) = happyShift action_45
+action_132 (162#) = happyShift action_46
+action_132 (167#) = happyShift action_47
+action_132 (170#) = happyShift action_6
+action_132 (171#) = happyShift action_48
+action_132 (172#) = happyShift action_49
+action_132 (173#) = happyShift action_50
+action_132 (174#) = happyShift action_51
+action_132 (8#) = happyGoto action_10
+action_132 (9#) = happyGoto action_11
+action_132 (10#) = happyGoto action_12
+action_132 (11#) = happyGoto action_13
+action_132 (12#) = happyGoto action_14
+action_132 (58#) = happyGoto action_15
+action_132 (59#) = happyGoto action_16
+action_132 (60#) = happyGoto action_17
+action_132 (61#) = happyGoto action_18
+action_132 (62#) = happyGoto action_19
+action_132 (63#) = happyGoto action_145
+action_132 (64#) = happyGoto action_21
+action_132 (72#) = happyGoto action_22
+action_132 (77#) = happyGoto action_23
+action_132 x = happyTcHack x happyFail
+
+action_133 (96#) = happyShift action_144
+action_133 x = happyTcHack x happyFail
+
+action_134 (107#) = happyShift action_135
+action_134 x = happyTcHack x happyReduce_162
+
+action_135 (122#) = happyShift action_143
+action_135 (174#) = happyShift action_51
+action_135 (12#) = happyGoto action_141
+action_135 (71#) = happyGoto action_142
+action_135 x = happyTcHack x happyFail
+
+action_136 (96#) = happyShift action_140
+action_136 (98#) = happyShift action_82
+action_136 (104#) = happyShift action_26
+action_136 (109#) = happyShift action_83
+action_136 (110#) = happyShift action_28
+action_136 (111#) = happyShift action_29
+action_136 (125#) = happyShift action_33
+action_136 (126#) = happyShift action_34
+action_136 (127#) = happyShift action_35
+action_136 (128#) = happyShift action_36
+action_136 (129#) = happyShift action_37
+action_136 (134#) = happyShift action_39
+action_136 (170#) = happyShift action_6
+action_136 (171#) = happyShift action_48
+action_136 (172#) = happyShift action_49
+action_136 (173#) = happyShift action_50
+action_136 (174#) = happyShift action_51
+action_136 (8#) = happyGoto action_10
+action_136 (9#) = happyGoto action_11
+action_136 (10#) = happyGoto action_12
+action_136 (11#) = happyGoto action_13
+action_136 (12#) = happyGoto action_79
+action_136 (58#) = happyGoto action_139
+action_136 (72#) = happyGoto action_22
+action_136 x = happyTcHack x happyFail
+
+action_137 (95#) = happyShift action_138
+action_137 x = happyTcHack x happyFail
+
+action_138 (1#) = happyReduce_65
+action_138 (102#) = happyReduce_65
+action_138 (151#) = happyReduce_51
+action_138 (160#) = happyShift action_347
+action_138 (165#) = happyShift action_348
+action_138 (174#) = happyShift action_51
+action_138 (12#) = happyGoto action_241
+action_138 (22#) = happyGoto action_343
+action_138 (26#) = happyGoto action_344
+action_138 (32#) = happyGoto action_345
+action_138 (33#) = happyGoto action_346
+action_138 x = happyTcHack x happyReduce_65
+
+action_139 x = happyTcHack x happyReduce_170
+
+action_140 (174#) = happyShift action_51
+action_140 (12#) = happyGoto action_342
+action_140 (53#) = happyGoto action_88
+action_140 (56#) = happyGoto action_89
+action_140 (57#) = happyGoto action_125
+action_140 x = happyTcHack x happyReduce_137
+
+action_141 x = happyTcHack x happyReduce_222
+
+action_142 x = happyTcHack x happyReduce_158
+
+action_143 (170#) = happyShift action_6
+action_143 (8#) = happyGoto action_341
+action_143 x = happyTcHack x happyFail
+
+action_144 (174#) = happyShift action_51
+action_144 (12#) = happyGoto action_87
+action_144 (53#) = happyGoto action_88
+action_144 (56#) = happyGoto action_89
+action_144 (57#) = happyGoto action_340
+action_144 x = happyTcHack x happyReduce_137
+
+action_145 x = happyTcHack x happyReduce_185
+
+action_146 (96#) = happyShift action_24
+action_146 (98#) = happyShift action_82
+action_146 (104#) = happyShift action_26
+action_146 (109#) = happyShift action_27
+action_146 (110#) = happyShift action_28
+action_146 (111#) = happyShift action_29
+action_146 (125#) = happyShift action_33
+action_146 (126#) = happyShift action_34
+action_146 (127#) = happyShift action_35
+action_146 (128#) = happyShift action_36
+action_146 (129#) = happyShift action_37
+action_146 (134#) = happyShift action_39
+action_146 (170#) = happyShift action_6
+action_146 (171#) = happyShift action_48
+action_146 (172#) = happyShift action_49
+action_146 (173#) = happyShift action_50
+action_146 (174#) = happyShift action_51
+action_146 (8#) = happyGoto action_10
+action_146 (9#) = happyGoto action_11
+action_146 (10#) = happyGoto action_12
+action_146 (11#) = happyGoto action_13
+action_146 (12#) = happyGoto action_79
+action_146 (58#) = happyGoto action_15
+action_146 (59#) = happyGoto action_134
+action_146 (72#) = happyGoto action_22
+action_146 x = happyTcHack x happyReduce_176
+
+action_147 (96#) = happyShift action_24
+action_147 (98#) = happyShift action_82
+action_147 (104#) = happyShift action_26
+action_147 (109#) = happyShift action_27
+action_147 (110#) = happyShift action_28
+action_147 (111#) = happyShift action_29
+action_147 (125#) = happyShift action_33
+action_147 (126#) = happyShift action_34
+action_147 (127#) = happyShift action_35
+action_147 (128#) = happyShift action_36
+action_147 (129#) = happyShift action_37
+action_147 (134#) = happyShift action_39
+action_147 (170#) = happyShift action_6
+action_147 (171#) = happyShift action_48
+action_147 (172#) = happyShift action_49
+action_147 (173#) = happyShift action_50
+action_147 (174#) = happyShift action_51
+action_147 (8#) = happyGoto action_10
+action_147 (9#) = happyGoto action_11
+action_147 (10#) = happyGoto action_12
+action_147 (11#) = happyGoto action_13
+action_147 (12#) = happyGoto action_79
+action_147 (58#) = happyGoto action_15
+action_147 (59#) = happyGoto action_134
+action_147 (72#) = happyGoto action_22
+action_147 x = happyTcHack x happyReduce_175
+
+action_148 (96#) = happyShift action_24
+action_148 (98#) = happyShift action_82
+action_148 (104#) = happyShift action_26
+action_148 (109#) = happyShift action_27
+action_148 (110#) = happyShift action_28
+action_148 (111#) = happyShift action_29
+action_148 (125#) = happyShift action_33
+action_148 (126#) = happyShift action_34
+action_148 (127#) = happyShift action_35
+action_148 (128#) = happyShift action_36
+action_148 (129#) = happyShift action_37
+action_148 (134#) = happyShift action_39
+action_148 (170#) = happyShift action_6
+action_148 (171#) = happyShift action_48
+action_148 (172#) = happyShift action_49
+action_148 (173#) = happyShift action_50
+action_148 (174#) = happyShift action_51
+action_148 (8#) = happyGoto action_10
+action_148 (9#) = happyGoto action_11
+action_148 (10#) = happyGoto action_12
+action_148 (11#) = happyGoto action_13
+action_148 (12#) = happyGoto action_79
+action_148 (58#) = happyGoto action_15
+action_148 (59#) = happyGoto action_134
+action_148 (72#) = happyGoto action_22
+action_148 x = happyTcHack x happyReduce_177
+
+action_149 x = happyTcHack x happyReduce_181
+
+action_150 (96#) = happyShift action_24
+action_150 (98#) = happyShift action_82
+action_150 (104#) = happyShift action_26
+action_150 (109#) = happyShift action_27
+action_150 (110#) = happyShift action_28
+action_150 (111#) = happyShift action_29
+action_150 (125#) = happyShift action_33
+action_150 (126#) = happyShift action_34
+action_150 (127#) = happyShift action_35
+action_150 (128#) = happyShift action_36
+action_150 (129#) = happyShift action_37
+action_150 (134#) = happyShift action_39
+action_150 (170#) = happyShift action_6
+action_150 (171#) = happyShift action_48
+action_150 (172#) = happyShift action_49
+action_150 (173#) = happyShift action_50
+action_150 (174#) = happyShift action_51
+action_150 (8#) = happyGoto action_10
+action_150 (9#) = happyGoto action_11
+action_150 (10#) = happyGoto action_12
+action_150 (11#) = happyGoto action_13
+action_150 (12#) = happyGoto action_79
+action_150 (58#) = happyGoto action_15
+action_150 (59#) = happyGoto action_134
+action_150 (72#) = happyGoto action_22
+action_150 x = happyTcHack x happyReduce_178
+
+action_151 (102#) = happyShift action_129
+action_151 (115#) = happyShift action_130
+action_151 (116#) = happyShift action_131
+action_151 x = happyTcHack x happyReduce_192
+
+action_152 x = happyTcHack x happyReduce_179
+
+action_153 x = happyTcHack x happyReduce_184
+
+action_154 x = happyTcHack x happyReduce_152
+
+action_155 x = happyTcHack x happyReduce_141
+
+action_156 (174#) = happyShift action_51
+action_156 (12#) = happyGoto action_87
+action_156 (53#) = happyGoto action_339
+action_156 x = happyTcHack x happyFail
+
+action_157 (174#) = happyShift action_51
+action_157 (12#) = happyGoto action_338
+action_157 x = happyTcHack x happyFail
+
+action_158 (99#) = happyShift action_337
+action_158 x = happyTcHack x happyReduce_140
+
+action_159 (96#) = happyShift action_24
+action_159 (98#) = happyShift action_25
+action_159 (104#) = happyShift action_26
+action_159 (109#) = happyShift action_27
+action_159 (110#) = happyShift action_28
+action_159 (111#) = happyShift action_29
+action_159 (114#) = happyShift action_30
+action_159 (119#) = happyShift action_31
+action_159 (124#) = happyShift action_32
+action_159 (125#) = happyShift action_33
+action_159 (126#) = happyShift action_34
+action_159 (127#) = happyShift action_35
+action_159 (128#) = happyShift action_36
+action_159 (129#) = happyShift action_37
+action_159 (131#) = happyShift action_38
+action_159 (134#) = happyShift action_39
+action_159 (137#) = happyShift action_40
+action_159 (140#) = happyShift action_41
+action_159 (145#) = happyShift action_42
+action_159 (156#) = happyShift action_43
+action_159 (157#) = happyShift action_44
+action_159 (161#) = happyShift action_45
+action_159 (162#) = happyShift action_46
+action_159 (167#) = happyShift action_47
+action_159 (170#) = happyShift action_6
+action_159 (171#) = happyShift action_48
+action_159 (172#) = happyShift action_49
+action_159 (173#) = happyShift action_50
+action_159 (174#) = happyShift action_51
+action_159 (8#) = happyGoto action_10
+action_159 (9#) = happyGoto action_11
+action_159 (10#) = happyGoto action_12
+action_159 (11#) = happyGoto action_13
+action_159 (12#) = happyGoto action_14
+action_159 (58#) = happyGoto action_15
+action_159 (59#) = happyGoto action_16
+action_159 (60#) = happyGoto action_17
+action_159 (61#) = happyGoto action_18
+action_159 (62#) = happyGoto action_19
+action_159 (63#) = happyGoto action_336
+action_159 (64#) = happyGoto action_21
+action_159 (72#) = happyGoto action_22
+action_159 (77#) = happyGoto action_23
+action_159 x = happyTcHack x happyFail
+
+action_160 x = happyTcHack x happyReduce_156
+
+action_161 (96#) = happyShift action_140
+action_161 (98#) = happyShift action_82
+action_161 (104#) = happyShift action_26
+action_161 (109#) = happyShift action_83
+action_161 (110#) = happyShift action_28
+action_161 (111#) = happyShift action_29
+action_161 (125#) = happyShift action_33
+action_161 (126#) = happyShift action_34
+action_161 (127#) = happyShift action_35
+action_161 (128#) = happyShift action_36
+action_161 (129#) = happyShift action_37
+action_161 (134#) = happyShift action_39
+action_161 (170#) = happyShift action_6
+action_161 (171#) = happyShift action_48
+action_161 (172#) = happyShift action_49
+action_161 (173#) = happyShift action_50
+action_161 (174#) = happyShift action_51
+action_161 (8#) = happyGoto action_10
+action_161 (9#) = happyGoto action_11
+action_161 (10#) = happyGoto action_12
+action_161 (11#) = happyGoto action_13
+action_161 (12#) = happyGoto action_79
+action_161 (58#) = happyGoto action_161
+action_161 (66#) = happyGoto action_335
+action_161 (72#) = happyGoto action_22
+action_161 x = happyTcHack x happyReduce_196
+
+action_162 (105#) = happyShift action_334
+action_162 x = happyTcHack x happyFail
+
+action_163 x = happyTcHack x happyReduce_151
+
+action_164 (174#) = happyShift action_51
+action_164 (12#) = happyGoto action_333
+action_164 x = happyTcHack x happyFail
+
+action_165 x = happyTcHack x happyReduce_142
+
+action_166 x = happyTcHack x happyReduce_153
+
+action_167 (96#) = happyShift action_24
+action_167 (98#) = happyShift action_25
+action_167 (104#) = happyShift action_26
+action_167 (109#) = happyShift action_27
+action_167 (110#) = happyShift action_28
+action_167 (111#) = happyShift action_29
+action_167 (114#) = happyShift action_30
+action_167 (119#) = happyShift action_31
+action_167 (124#) = happyShift action_32
+action_167 (125#) = happyShift action_33
+action_167 (126#) = happyShift action_34
+action_167 (127#) = happyShift action_35
+action_167 (128#) = happyShift action_36
+action_167 (129#) = happyShift action_37
+action_167 (131#) = happyShift action_38
+action_167 (134#) = happyShift action_39
+action_167 (137#) = happyShift action_40
+action_167 (140#) = happyShift action_41
+action_167 (145#) = happyShift action_42
+action_167 (156#) = happyShift action_43
+action_167 (157#) = happyShift action_44
+action_167 (161#) = happyShift action_45
+action_167 (162#) = happyShift action_46
+action_167 (167#) = happyShift action_47
+action_167 (170#) = happyShift action_6
+action_167 (171#) = happyShift action_48
+action_167 (172#) = happyShift action_49
+action_167 (173#) = happyShift action_50
+action_167 (174#) = happyShift action_51
+action_167 (8#) = happyGoto action_10
+action_167 (9#) = happyGoto action_11
+action_167 (10#) = happyGoto action_12
+action_167 (11#) = happyGoto action_13
+action_167 (12#) = happyGoto action_14
+action_167 (58#) = happyGoto action_15
+action_167 (59#) = happyGoto action_16
+action_167 (60#) = happyGoto action_17
+action_167 (61#) = happyGoto action_18
+action_167 (62#) = happyGoto action_19
+action_167 (63#) = happyGoto action_331
+action_167 (64#) = happyGoto action_21
+action_167 (72#) = happyGoto action_22
+action_167 (77#) = happyGoto action_23
+action_167 (78#) = happyGoto action_114
+action_167 (80#) = happyGoto action_332
+action_167 x = happyTcHack x happyReduce_243
+
+action_168 (96#) = happyShift action_24
+action_168 (98#) = happyShift action_25
+action_168 (104#) = happyShift action_26
+action_168 (109#) = happyShift action_27
+action_168 (110#) = happyShift action_28
+action_168 (111#) = happyShift action_29
+action_168 (114#) = happyShift action_30
+action_168 (119#) = happyShift action_31
+action_168 (124#) = happyShift action_32
+action_168 (125#) = happyShift action_33
+action_168 (126#) = happyShift action_34
+action_168 (127#) = happyShift action_35
+action_168 (128#) = happyShift action_36
+action_168 (129#) = happyShift action_37
+action_168 (131#) = happyShift action_38
+action_168 (134#) = happyShift action_39
+action_168 (137#) = happyShift action_40
+action_168 (140#) = happyShift action_41
+action_168 (145#) = happyShift action_42
+action_168 (156#) = happyShift action_43
+action_168 (157#) = happyShift action_44
+action_168 (161#) = happyShift action_45
+action_168 (162#) = happyShift action_46
+action_168 (167#) = happyShift action_47
+action_168 (170#) = happyShift action_6
+action_168 (171#) = happyShift action_48
+action_168 (172#) = happyShift action_49
+action_168 (173#) = happyShift action_50
+action_168 (174#) = happyShift action_51
+action_168 (8#) = happyGoto action_10
+action_168 (9#) = happyGoto action_11
+action_168 (10#) = happyGoto action_12
+action_168 (11#) = happyGoto action_13
+action_168 (12#) = happyGoto action_14
+action_168 (58#) = happyGoto action_15
+action_168 (59#) = happyGoto action_16
+action_168 (60#) = happyGoto action_17
+action_168 (61#) = happyGoto action_18
+action_168 (62#) = happyGoto action_19
+action_168 (63#) = happyGoto action_330
+action_168 (64#) = happyGoto action_21
+action_168 (72#) = happyGoto action_22
+action_168 (77#) = happyGoto action_23
+action_168 x = happyTcHack x happyFail
+
+action_169 (107#) = happyShift action_329
+action_169 x = happyTcHack x happyReduce_200
+
+action_170 (96#) = happyShift action_106
+action_170 (98#) = happyShift action_107
+action_170 (104#) = happyShift action_108
+action_170 (107#) = happyShift action_300
+action_170 (110#) = happyShift action_109
+action_170 (111#) = happyShift action_110
+action_170 (113#) = happyShift action_301
+action_170 (114#) = happyShift action_111
+action_170 (121#) = happyShift action_112
+action_170 (170#) = happyShift action_6
+action_170 (171#) = happyShift action_48
+action_170 (172#) = happyShift action_49
+action_170 (174#) = happyShift action_51
+action_170 (8#) = happyGoto action_101
+action_170 (9#) = happyGoto action_102
+action_170 (10#) = happyGoto action_103
+action_170 (12#) = happyGoto action_104
+action_170 (67#) = happyGoto action_188
+action_170 (74#) = happyGoto action_299
+action_170 x = happyTcHack x happyReduce_203
+
+action_171 (116#) = happyShift action_328
+action_171 x = happyTcHack x happyReduce_217
+
+action_172 x = happyTcHack x happyReduce_220
+
+action_173 (108#) = happyShift action_296
+action_173 (117#) = happyShift action_297
+action_173 x = happyTcHack x happyReduce_242
+
+action_174 (103#) = happyShift action_327
+action_174 x = happyTcHack x happyReduce_247
+
+action_175 (112#) = happyShift action_326
+action_175 x = happyTcHack x happyFail
+
+action_176 (96#) = happyShift action_106
+action_176 (98#) = happyShift action_107
+action_176 (104#) = happyShift action_108
+action_176 (110#) = happyShift action_109
+action_176 (111#) = happyShift action_110
+action_176 (114#) = happyShift action_111
+action_176 (121#) = happyShift action_112
+action_176 (170#) = happyShift action_6
+action_176 (171#) = happyShift action_48
+action_176 (172#) = happyShift action_49
+action_176 (174#) = happyShift action_51
+action_176 (8#) = happyGoto action_101
+action_176 (9#) = happyGoto action_102
+action_176 (10#) = happyGoto action_103
+action_176 (12#) = happyGoto action_104
+action_176 (67#) = happyGoto action_325
+action_176 x = happyTcHack x happyFail
+
+action_177 (105#) = happyShift action_324
+action_177 x = happyTcHack x happyFail
+
+action_178 (99#) = happyShift action_323
+action_178 (108#) = happyShift action_296
+action_178 (117#) = happyShift action_297
+action_178 x = happyTcHack x happyFail
+
+action_179 (97#) = happyShift action_322
+action_179 (103#) = happyShift action_156
+action_179 x = happyTcHack x happyReduce_128
+
+action_180 (95#) = happyShift action_321
+action_180 x = happyTcHack x happyFail
+
+action_181 (94#) = happyShift action_320
+action_181 x = happyTcHack x happyReduce_230
+
+action_182 (97#) = happyShift action_319
+action_182 x = happyTcHack x happyFail
+
+action_183 (174#) = happyShift action_51
+action_183 (12#) = happyGoto action_318
+action_183 x = happyTcHack x happyFail
+
+action_184 (120#) = happyShift action_317
+action_184 x = happyTcHack x happyFail
+
+action_185 (96#) = happyShift action_24
+action_185 (98#) = happyShift action_25
+action_185 (104#) = happyShift action_26
+action_185 (109#) = happyShift action_27
+action_185 (110#) = happyShift action_28
+action_185 (111#) = happyShift action_29
+action_185 (114#) = happyShift action_30
+action_185 (119#) = happyShift action_31
+action_185 (124#) = happyShift action_32
+action_185 (125#) = happyShift action_33
+action_185 (126#) = happyShift action_34
+action_185 (127#) = happyShift action_35
+action_185 (128#) = happyShift action_36
+action_185 (129#) = happyShift action_37
+action_185 (131#) = happyShift action_38
+action_185 (134#) = happyShift action_39
+action_185 (137#) = happyShift action_40
+action_185 (140#) = happyShift action_41
+action_185 (145#) = happyShift action_42
+action_185 (156#) = happyShift action_43
+action_185 (157#) = happyShift action_44
+action_185 (161#) = happyShift action_45
+action_185 (162#) = happyShift action_46
+action_185 (167#) = happyShift action_47
+action_185 (170#) = happyShift action_6
+action_185 (171#) = happyShift action_48
+action_185 (172#) = happyShift action_49
+action_185 (173#) = happyShift action_50
+action_185 (174#) = happyShift action_51
+action_185 (8#) = happyGoto action_10
+action_185 (9#) = happyGoto action_11
+action_185 (10#) = happyGoto action_12
+action_185 (11#) = happyGoto action_13
+action_185 (12#) = happyGoto action_14
+action_185 (58#) = happyGoto action_15
+action_185 (59#) = happyGoto action_16
+action_185 (60#) = happyGoto action_17
+action_185 (61#) = happyGoto action_18
+action_185 (62#) = happyGoto action_19
+action_185 (63#) = happyGoto action_316
+action_185 (64#) = happyGoto action_21
+action_185 (72#) = happyGoto action_22
+action_185 (77#) = happyGoto action_23
+action_185 x = happyTcHack x happyFail
+
+action_186 (121#) = happyShift action_100
+action_186 (174#) = happyShift action_51
+action_186 (12#) = happyGoto action_96
+action_186 (75#) = happyGoto action_97
+action_186 (76#) = happyGoto action_315
+action_186 x = happyTcHack x happyReduce_236
+
+action_187 (96#) = happyShift action_314
+action_187 x = happyTcHack x happyFail
+
+action_188 (96#) = happyShift action_106
+action_188 (98#) = happyShift action_107
+action_188 (104#) = happyShift action_108
+action_188 (110#) = happyShift action_109
+action_188 (111#) = happyShift action_110
+action_188 (114#) = happyShift action_111
+action_188 (121#) = happyShift action_112
+action_188 (170#) = happyShift action_6
+action_188 (171#) = happyShift action_48
+action_188 (172#) = happyShift action_49
+action_188 (174#) = happyShift action_51
+action_188 (8#) = happyGoto action_101
+action_188 (9#) = happyGoto action_102
+action_188 (10#) = happyGoto action_103
+action_188 (12#) = happyGoto action_104
+action_188 (67#) = happyGoto action_188
+action_188 (74#) = happyGoto action_313
+action_188 x = happyTcHack x happyReduce_232
+
+action_189 (101#) = happyShift action_312
+action_189 x = happyTcHack x happyFail
+
+action_190 (94#) = happyShift action_311
+action_190 x = happyTcHack x happyReduce_254
+
+action_191 (97#) = happyShift action_310
+action_191 x = happyTcHack x happyFail
+
+action_192 x = happyTcHack x happyReduce_190
+
+action_193 (97#) = happyShift action_309
+action_193 x = happyTcHack x happyFail
+
+action_194 (96#) = happyShift action_24
+action_194 (98#) = happyShift action_25
+action_194 (104#) = happyShift action_26
+action_194 (109#) = happyShift action_27
+action_194 (110#) = happyShift action_28
+action_194 (111#) = happyShift action_29
+action_194 (114#) = happyShift action_30
+action_194 (119#) = happyShift action_31
+action_194 (124#) = happyShift action_32
+action_194 (125#) = happyShift action_33
+action_194 (126#) = happyShift action_34
+action_194 (127#) = happyShift action_35
+action_194 (128#) = happyShift action_36
+action_194 (129#) = happyShift action_37
+action_194 (131#) = happyShift action_38
+action_194 (134#) = happyShift action_39
+action_194 (137#) = happyShift action_40
+action_194 (140#) = happyShift action_41
+action_194 (145#) = happyShift action_42
+action_194 (156#) = happyShift action_43
+action_194 (157#) = happyShift action_44
+action_194 (161#) = happyShift action_45
+action_194 (162#) = happyShift action_46
+action_194 (167#) = happyShift action_47
+action_194 (170#) = happyShift action_6
+action_194 (171#) = happyShift action_48
+action_194 (172#) = happyShift action_49
+action_194 (173#) = happyShift action_50
+action_194 (174#) = happyShift action_51
+action_194 (8#) = happyGoto action_10
+action_194 (9#) = happyGoto action_11
+action_194 (10#) = happyGoto action_12
+action_194 (11#) = happyGoto action_13
+action_194 (12#) = happyGoto action_14
+action_194 (58#) = happyGoto action_15
+action_194 (59#) = happyGoto action_16
+action_194 (60#) = happyGoto action_17
+action_194 (61#) = happyGoto action_18
+action_194 (62#) = happyGoto action_19
+action_194 (63#) = happyGoto action_308
+action_194 (64#) = happyGoto action_21
+action_194 (72#) = happyGoto action_22
+action_194 (77#) = happyGoto action_23
+action_194 x = happyTcHack x happyFail
+
+action_195 (174#) = happyShift action_51
+action_195 (12#) = happyGoto action_87
+action_195 (53#) = happyGoto action_88
+action_195 (56#) = happyGoto action_89
+action_195 (57#) = happyGoto action_307
+action_195 x = happyTcHack x happyReduce_137
+
+action_196 (96#) = happyShift action_24
+action_196 (98#) = happyShift action_25
+action_196 (104#) = happyShift action_26
+action_196 (109#) = happyShift action_27
+action_196 (110#) = happyShift action_28
+action_196 (111#) = happyShift action_29
+action_196 (114#) = happyShift action_30
+action_196 (119#) = happyShift action_31
+action_196 (124#) = happyShift action_32
+action_196 (125#) = happyShift action_33
+action_196 (126#) = happyShift action_34
+action_196 (127#) = happyShift action_35
+action_196 (128#) = happyShift action_36
+action_196 (129#) = happyShift action_37
+action_196 (131#) = happyShift action_38
+action_196 (134#) = happyShift action_39
+action_196 (137#) = happyShift action_40
+action_196 (140#) = happyShift action_41
+action_196 (145#) = happyShift action_42
+action_196 (156#) = happyShift action_43
+action_196 (157#) = happyShift action_44
+action_196 (161#) = happyShift action_45
+action_196 (162#) = happyShift action_46
+action_196 (167#) = happyShift action_47
+action_196 (170#) = happyShift action_6
+action_196 (171#) = happyShift action_48
+action_196 (172#) = happyShift action_49
+action_196 (173#) = happyShift action_50
+action_196 (174#) = happyShift action_51
+action_196 (8#) = happyGoto action_10
+action_196 (9#) = happyGoto action_11
+action_196 (10#) = happyGoto action_12
+action_196 (11#) = happyGoto action_13
+action_196 (12#) = happyGoto action_14
+action_196 (58#) = happyGoto action_15
+action_196 (59#) = happyGoto action_16
+action_196 (60#) = happyGoto action_17
+action_196 (61#) = happyGoto action_18
+action_196 (62#) = happyGoto action_19
+action_196 (63#) = happyGoto action_306
+action_196 (64#) = happyGoto action_21
+action_196 (72#) = happyGoto action_22
+action_196 (77#) = happyGoto action_23
+action_196 x = happyTcHack x happyFail
+
+action_197 (96#) = happyShift action_24
+action_197 (98#) = happyShift action_25
+action_197 (104#) = happyShift action_26
+action_197 (109#) = happyShift action_27
+action_197 (110#) = happyShift action_28
+action_197 (111#) = happyShift action_29
+action_197 (114#) = happyShift action_30
+action_197 (119#) = happyShift action_31
+action_197 (124#) = happyShift action_32
+action_197 (125#) = happyShift action_33
+action_197 (126#) = happyShift action_34
+action_197 (127#) = happyShift action_35
+action_197 (128#) = happyShift action_36
+action_197 (129#) = happyShift action_37
+action_197 (131#) = happyShift action_38
+action_197 (134#) = happyShift action_39
+action_197 (137#) = happyShift action_40
+action_197 (140#) = happyShift action_41
+action_197 (145#) = happyShift action_42
+action_197 (156#) = happyShift action_43
+action_197 (157#) = happyShift action_44
+action_197 (161#) = happyShift action_45
+action_197 (162#) = happyShift action_46
+action_197 (167#) = happyShift action_47
+action_197 (170#) = happyShift action_6
+action_197 (171#) = happyShift action_48
+action_197 (172#) = happyShift action_49
+action_197 (173#) = happyShift action_50
+action_197 (174#) = happyShift action_51
+action_197 (8#) = happyGoto action_10
+action_197 (9#) = happyGoto action_11
+action_197 (10#) = happyGoto action_12
+action_197 (11#) = happyGoto action_13
+action_197 (12#) = happyGoto action_14
+action_197 (58#) = happyGoto action_15
+action_197 (59#) = happyGoto action_16
+action_197 (60#) = happyGoto action_17
+action_197 (61#) = happyGoto action_18
+action_197 (62#) = happyGoto action_19
+action_197 (63#) = happyGoto action_305
+action_197 (64#) = happyGoto action_21
+action_197 (72#) = happyGoto action_22
+action_197 (77#) = happyGoto action_23
+action_197 x = happyTcHack x happyFail
+
+action_198 (94#) = happyShift action_304
+action_198 x = happyTcHack x happyFail
+
+action_199 (94#) = happyShift action_303
+action_199 x = happyTcHack x happyReduce_194
+
+action_200 (97#) = happyShift action_302
+action_200 x = happyTcHack x happyFail
+
+action_201 (109#) = happyShift action_165
+action_201 x = happyTcHack x happyFail
+
+action_202 (96#) = happyShift action_106
+action_202 (97#) = happyShift action_155
+action_202 (98#) = happyShift action_107
+action_202 (103#) = happyShift action_156
+action_202 (104#) = happyShift action_108
+action_202 (107#) = happyShift action_300
+action_202 (108#) = happyReduce_203
+action_202 (110#) = happyShift action_109
+action_202 (111#) = happyShift action_110
+action_202 (113#) = happyShift action_301
+action_202 (114#) = happyShift action_111
+action_202 (116#) = happyReduce_203
+action_202 (117#) = happyReduce_203
+action_202 (120#) = happyReduce_203
+action_202 (121#) = happyShift action_112
+action_202 (170#) = happyShift action_6
+action_202 (171#) = happyShift action_48
+action_202 (172#) = happyShift action_49
+action_202 (174#) = happyShift action_51
+action_202 (8#) = happyGoto action_101
+action_202 (9#) = happyGoto action_102
+action_202 (10#) = happyGoto action_103
+action_202 (12#) = happyGoto action_104
+action_202 (67#) = happyGoto action_188
+action_202 (74#) = happyGoto action_299
+action_202 x = happyTcHack x happyReduce_128
+
+action_203 (108#) = happyShift action_296
+action_203 (117#) = happyShift action_297
+action_203 (120#) = happyShift action_298
+action_203 x = happyTcHack x happyFail
+
+action_204 (94#) = happyShift action_295
+action_204 x = happyTcHack x happyReduce_250
+
+action_205 (97#) = happyShift action_294
+action_205 x = happyTcHack x happyFail
+
+action_206 (96#) = happyShift action_106
+action_206 (98#) = happyShift action_107
+action_206 (104#) = happyShift action_108
+action_206 (106#) = happyShift action_176
+action_206 (110#) = happyShift action_109
+action_206 (111#) = happyShift action_110
+action_206 (114#) = happyShift action_111
+action_206 (121#) = happyShift action_112
+action_206 (170#) = happyShift action_6
+action_206 (171#) = happyShift action_48
+action_206 (172#) = happyShift action_49
+action_206 (174#) = happyShift action_51
+action_206 (8#) = happyGoto action_101
+action_206 (9#) = happyGoto action_102
+action_206 (10#) = happyGoto action_103
+action_206 (12#) = happyGoto action_170
+action_206 (67#) = happyGoto action_171
+action_206 (68#) = happyGoto action_172
+action_206 (69#) = happyGoto action_203
+action_206 (82#) = happyGoto action_204
+action_206 (83#) = happyGoto action_293
+action_206 x = happyTcHack x happyFail
+
+action_207 (96#) = happyShift action_24
+action_207 (98#) = happyShift action_25
+action_207 (104#) = happyShift action_26
+action_207 (109#) = happyShift action_27
+action_207 (110#) = happyShift action_28
+action_207 (111#) = happyShift action_29
+action_207 (114#) = happyShift action_30
+action_207 (119#) = happyShift action_31
+action_207 (124#) = happyShift action_32
+action_207 (125#) = happyShift action_33
+action_207 (126#) = happyShift action_34
+action_207 (127#) = happyShift action_35
+action_207 (128#) = happyShift action_36
+action_207 (129#) = happyShift action_37
+action_207 (131#) = happyShift action_38
+action_207 (134#) = happyShift action_39
+action_207 (137#) = happyShift action_40
+action_207 (140#) = happyShift action_41
+action_207 (145#) = happyShift action_42
+action_207 (156#) = happyShift action_43
+action_207 (157#) = happyShift action_44
+action_207 (161#) = happyShift action_45
+action_207 (162#) = happyShift action_46
+action_207 (167#) = happyShift action_47
+action_207 (170#) = happyShift action_6
+action_207 (171#) = happyShift action_48
+action_207 (172#) = happyShift action_49
+action_207 (173#) = happyShift action_50
+action_207 (174#) = happyShift action_51
+action_207 (8#) = happyGoto action_10
+action_207 (9#) = happyGoto action_11
+action_207 (10#) = happyGoto action_12
+action_207 (11#) = happyGoto action_13
+action_207 (12#) = happyGoto action_14
+action_207 (58#) = happyGoto action_15
+action_207 (59#) = happyGoto action_16
+action_207 (60#) = happyGoto action_17
+action_207 (61#) = happyGoto action_18
+action_207 (62#) = happyGoto action_19
+action_207 (63#) = happyGoto action_199
+action_207 (64#) = happyGoto action_21
+action_207 (65#) = happyGoto action_292
+action_207 (72#) = happyGoto action_22
+action_207 (77#) = happyGoto action_23
+action_207 x = happyTcHack x happyReduce_193
+
+action_208 (97#) = happyShift action_291
+action_208 x = happyTcHack x happyFail
+
+action_209 x = happyTcHack x happyReduce_49
+
+action_210 (104#) = happyShift action_290
+action_210 (174#) = happyShift action_51
+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_51
+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 (104#) = happyShift action_257
+action_212 (174#) = happyShift action_51
+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_51
+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_51
+action_214 (12#) = happyGoto action_87
+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 (104#) = happyShift action_257
+action_215 (174#) = happyShift action_51
+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 (104#) = happyShift action_257
+action_216 (174#) = happyShift action_51
+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 (104#) = happyShift action_257
+action_217 (174#) = happyShift action_51
+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 (104#) = happyShift action_257
+action_218 (174#) = happyShift action_51
+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 (104#) = happyShift action_257
+action_219 (174#) = happyShift action_51
+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_51
+action_220 (12#) = happyGoto action_270
+action_220 x = happyTcHack x happyFail
+
+action_221 (174#) = happyShift action_51
+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 (104#) = happyShift action_257
+action_222 (174#) = happyShift action_51
+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 (104#) = happyShift action_257
+action_223 (132#) = happyShift action_264
+action_223 (138#) = happyShift action_265
+action_223 (174#) = happyShift action_51
+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_51
+action_224 (12#) = happyGoto action_259
+action_224 x = happyTcHack x happyFail
+
+action_225 (104#) = happyShift action_257
+action_225 (174#) = happyShift action_51
+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 (104#) = happyShift action_257
+action_226 (174#) = happyShift action_51
+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 (106#) = happyShift action_74
+action_230 (107#) = happyShift action_75
+action_230 (123#) = happyShift action_76
+action_230 (171#) = happyShift action_48
+action_230 (174#) = happyShift action_51
+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 (100#) = 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 (150#) = happyShift action_249
+action_235 x = happyTcHack x happyFail
+
+action_236 (150#) = happyShift action_248
+action_236 x = happyTcHack x happyFail
+
+action_237 x = happyTcHack x happyReduce_34
+
+action_238 (96#) = happyReduce_51
+action_238 (151#) = happyReduce_51
+action_238 (160#) = happyShift action_246
+action_238 (165#) = happyShift action_247
+action_238 (174#) = happyShift action_51
+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 (96#) = happyShift action_240
+action_239 x = happyTcHack x happyFail
+
+action_240 (130#) = happyShift action_418
+action_240 x = happyTcHack x happyFail
+
+action_241 (104#) = happyShift action_416
+action_241 (106#) = happyShift action_417
+action_241 x = happyTcHack x happyReduce_68
+
+action_242 x = happyTcHack x happyReduce_15
+
+action_243 (151#) = happyShift action_356
+action_243 (28#) = happyGoto action_415
+action_243 x = happyTcHack x happyReduce_55
+
+action_244 (102#) = happyShift action_414
+action_244 x = happyTcHack x happyReduce_41
+
+action_245 (103#) = happyShift action_352
+action_245 (169#) = happyShift action_413
+action_245 x = happyTcHack x happyReduce_66
+
+action_246 (174#) = happyShift action_51
+action_246 (12#) = happyGoto action_412
+action_246 x = happyTcHack x happyFail
+
+action_247 (174#) = happyShift action_51
+action_247 (12#) = happyGoto action_241
+action_247 (32#) = happyGoto action_411
+action_247 (33#) = happyGoto action_350
+action_247 x = happyTcHack x happyReduce_65
+
+action_248 (174#) = happyShift action_51
+action_248 (12#) = happyGoto action_410
+action_248 x = happyTcHack x happyFail
+
+action_249 (174#) = happyShift action_51
+action_249 (12#) = happyGoto action_409
+action_249 x = happyTcHack x happyFail
+
+action_250 (98#) = happyShift action_408
+action_250 (174#) = happyShift action_51
+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 (94#) = happyShift action_405
+action_253 x = happyTcHack x happyFail
+
+action_254 x = happyTcHack x happyReduce_93
+
+action_255 (96#) = happyShift action_106
+action_255 (98#) = happyShift action_107
+action_255 (103#) = happyShift action_398
+action_255 (104#) = happyShift action_108
+action_255 (110#) = happyShift action_109
+action_255 (111#) = happyShift action_110
+action_255 (114#) = happyShift action_111
+action_255 (121#) = happyShift action_112
+action_255 (170#) = happyShift action_6
+action_255 (171#) = happyShift action_48
+action_255 (172#) = happyShift action_49
+action_255 (174#) = happyShift action_51
+action_255 (8#) = happyGoto action_101
+action_255 (9#) = happyGoto action_102
+action_255 (10#) = happyGoto action_103
+action_255 (12#) = happyGoto action_104
+action_255 (67#) = happyGoto action_188
+action_255 (74#) = happyGoto action_404
+action_255 x = happyTcHack x happyReduce_132
+
+action_256 (95#) = happyShift action_402
+action_256 (100#) = happyShift action_403
+action_256 x = happyTcHack x happyFail
+
+action_257 (174#) = happyShift action_51
+action_257 (12#) = happyGoto action_401
+action_257 x = happyTcHack x happyFail
+
+action_258 x = happyTcHack x happyReduce_80
+
+action_259 (94#) = happyShift action_400
+action_259 x = happyTcHack x happyFail
+
+action_260 (94#) = happyShift action_399
+action_260 x = happyTcHack x happyFail
+
+action_261 x = happyTcHack x happyReduce_89
+
+action_262 (103#) = happyShift action_398
+action_262 x = happyTcHack x happyReduce_132
+
+action_263 (95#) = happyShift action_397
+action_263 x = happyTcHack x happyFail
+
+action_264 (104#) = happyShift action_257
+action_264 (174#) = happyShift action_51
+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 (104#) = happyShift action_257
+action_265 (174#) = happyShift action_51
+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 (95#) = happyShift action_394
+action_267 x = happyTcHack x happyReduce_107
+
+action_268 (94#) = happyShift action_393
+action_268 x = happyTcHack x happyFail
+
+action_269 x = happyTcHack x happyReduce_81
+
+action_270 (95#) = 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 (94#) = happyShift action_391
+action_276 x = happyTcHack x happyFail
+
+action_277 x = happyTcHack x happyReduce_76
+
+action_278 (100#) = happyShift action_390
+action_278 x = happyTcHack x happyFail
+
+action_279 (95#) = happyShift action_389
+action_279 x = happyTcHack x happyFail
+
+action_280 (94#) = 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 (95#) = happyShift action_387
+action_283 (103#) = happyShift action_156
+action_283 x = happyTcHack x happyReduce_128
+
+action_284 (94#) = 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 (94#) = happyShift action_384
+action_288 x = happyTcHack x happyFail
+
+action_289 x = happyTcHack x happyReduce_75
+
+action_290 (174#) = happyShift action_51
+action_290 (12#) = happyGoto action_383
+action_290 x = happyTcHack x happyFail
+
+action_291 x = happyTcHack x happyReduce_167
+
+action_292 (105#) = happyShift action_382
+action_292 x = happyTcHack x happyFail
+
+action_293 (97#) = happyShift action_381
+action_293 x = happyTcHack x happyFail
+
+action_294 x = happyTcHack x happyReduce_163
+
+action_295 (96#) = happyShift action_106
+action_295 (98#) = happyShift action_107
+action_295 (104#) = happyShift action_108
+action_295 (106#) = happyShift action_176
+action_295 (110#) = happyShift action_109
+action_295 (111#) = happyShift action_110
+action_295 (114#) = happyShift action_111
+action_295 (121#) = happyShift action_112
+action_295 (170#) = happyShift action_6
+action_295 (171#) = happyShift action_48
+action_295 (172#) = happyShift action_49
+action_295 (174#) = happyShift action_51
+action_295 (8#) = happyGoto action_101
+action_295 (9#) = happyGoto action_102
+action_295 (10#) = happyGoto action_103
+action_295 (12#) = happyGoto action_170
+action_295 (67#) = happyGoto action_171
+action_295 (68#) = happyGoto action_172
+action_295 (69#) = happyGoto action_203
+action_295 (82#) = happyGoto action_204
+action_295 (83#) = happyGoto action_380
+action_295 x = happyTcHack x happyFail
+
+action_296 (96#) = happyShift action_106
+action_296 (98#) = happyShift action_107
+action_296 (104#) = happyShift action_108
+action_296 (106#) = happyShift action_176
+action_296 (110#) = happyShift action_109
+action_296 (111#) = happyShift action_110
+action_296 (114#) = happyShift action_111
+action_296 (121#) = happyShift action_112
+action_296 (170#) = happyShift action_6
+action_296 (171#) = happyShift action_48
+action_296 (172#) = happyShift action_49
+action_296 (174#) = happyShift action_51
+action_296 (8#) = happyGoto action_101
+action_296 (9#) = happyGoto action_102
+action_296 (10#) = happyGoto action_103
+action_296 (12#) = happyGoto action_170
+action_296 (67#) = happyGoto action_171
+action_296 (68#) = happyGoto action_379
+action_296 x = happyTcHack x happyFail
+
+action_297 (96#) = happyShift action_106
+action_297 (98#) = happyShift action_107
+action_297 (104#) = happyShift action_108
+action_297 (106#) = happyShift action_176
+action_297 (110#) = happyShift action_109
+action_297 (111#) = happyShift action_110
+action_297 (114#) = happyShift action_111
+action_297 (121#) = happyShift action_112
+action_297 (170#) = happyShift action_6
+action_297 (171#) = happyShift action_48
+action_297 (172#) = happyShift action_49
+action_297 (174#) = happyShift action_51
+action_297 (8#) = happyGoto action_101
+action_297 (9#) = happyGoto action_102
+action_297 (10#) = happyGoto action_103
+action_297 (12#) = happyGoto action_170
+action_297 (67#) = happyGoto action_171
+action_297 (68#) = happyGoto action_378
+action_297 x = happyTcHack x happyFail
+
+action_298 (96#) = happyShift action_24
+action_298 (98#) = happyShift action_25
+action_298 (104#) = happyShift action_26
+action_298 (109#) = happyShift action_27
+action_298 (110#) = happyShift action_28
+action_298 (111#) = happyShift action_29
+action_298 (114#) = happyShift action_30
+action_298 (119#) = happyShift action_31
+action_298 (124#) = happyShift action_32
+action_298 (125#) = happyShift action_33
+action_298 (126#) = happyShift action_34
+action_298 (127#) = happyShift action_35
+action_298 (128#) = happyShift action_36
+action_298 (129#) = happyShift action_37
+action_298 (131#) = happyShift action_38
+action_298 (134#) = happyShift action_39
+action_298 (137#) = happyShift action_40
+action_298 (140#) = happyShift action_41
+action_298 (145#) = happyShift action_42
+action_298 (156#) = happyShift action_43
+action_298 (157#) = happyShift action_44
+action_298 (161#) = happyShift action_45
+action_298 (162#) = happyShift action_46
+action_298 (167#) = happyShift action_47
+action_298 (170#) = happyShift action_6
+action_298 (171#) = happyShift action_48
+action_298 (172#) = happyShift action_49
+action_298 (173#) = happyShift action_50
+action_298 (174#) = happyShift action_51
+action_298 (8#) = happyGoto action_10
+action_298 (9#) = happyGoto action_11
+action_298 (10#) = happyGoto action_12
+action_298 (11#) = happyGoto action_13
+action_298 (12#) = happyGoto action_14
+action_298 (58#) = happyGoto action_15
+action_298 (59#) = happyGoto action_16
+action_298 (60#) = happyGoto action_17
+action_298 (61#) = happyGoto action_18
+action_298 (62#) = happyGoto action_19
+action_298 (63#) = happyGoto action_377
+action_298 (64#) = happyGoto action_21
+action_298 (72#) = happyGoto action_22
+action_298 (77#) = happyGoto action_23
+action_298 x = happyTcHack x happyFail
+
+action_299 x = happyTcHack x happyReduce_212
+
+action_300 (174#) = happyShift action_51
+action_300 (12#) = happyGoto action_376
+action_300 x = happyTcHack x happyFail
+
+action_301 (96#) = happyShift action_106
+action_301 (98#) = happyShift action_107
+action_301 (104#) = happyShift action_108
+action_301 (110#) = happyShift action_109
+action_301 (111#) = happyShift action_110
+action_301 (114#) = happyShift action_111
+action_301 (121#) = happyShift action_112
+action_301 (170#) = happyShift action_6
+action_301 (171#) = happyShift action_48
+action_301 (172#) = happyShift action_49
+action_301 (174#) = happyShift action_51
+action_301 (8#) = happyGoto action_101
+action_301 (9#) = happyGoto action_102
+action_301 (10#) = happyGoto action_103
+action_301 (12#) = happyGoto action_104
+action_301 (67#) = happyGoto action_375
+action_301 x = happyTcHack x happyFail
+
+action_302 x = happyTcHack x happyReduce_169
+
+action_303 (96#) = happyShift action_24
+action_303 (98#) = happyShift action_25
+action_303 (104#) = happyShift action_26
+action_303 (109#) = happyShift action_27
+action_303 (110#) = happyShift action_28
+action_303 (111#) = happyShift action_29
+action_303 (114#) = happyShift action_30
+action_303 (119#) = happyShift action_31
+action_303 (124#) = happyShift action_32
+action_303 (125#) = happyShift action_33
+action_303 (126#) = happyShift action_34
+action_303 (127#) = happyShift action_35
+action_303 (128#) = happyShift action_36
+action_303 (129#) = happyShift action_37
+action_303 (131#) = happyShift action_38
+action_303 (134#) = happyShift action_39
+action_303 (137#) = happyShift action_40
+action_303 (140#) = happyShift action_41
+action_303 (145#) = happyShift action_42
+action_303 (156#) = happyShift action_43
+action_303 (157#) = happyShift action_44
+action_303 (161#) = happyShift action_45
+action_303 (162#) = happyShift action_46
+action_303 (167#) = happyShift action_47
+action_303 (170#) = happyShift action_6
+action_303 (171#) = happyShift action_48
+action_303 (172#) = happyShift action_49
+action_303 (173#) = happyShift action_50
+action_303 (174#) = happyShift action_51
+action_303 (8#) = happyGoto action_10
+action_303 (9#) = happyGoto action_11
+action_303 (10#) = happyGoto action_12
+action_303 (11#) = happyGoto action_13
+action_303 (12#) = happyGoto action_14
+action_303 (58#) = happyGoto action_15
+action_303 (59#) = happyGoto action_16
+action_303 (60#) = happyGoto action_17
+action_303 (61#) = happyGoto action_18
+action_303 (62#) = happyGoto action_19
+action_303 (63#) = happyGoto action_199
+action_303 (64#) = happyGoto action_21
+action_303 (65#) = happyGoto action_374
+action_303 (72#) = happyGoto action_22
+action_303 (77#) = happyGoto action_23
+action_303 x = happyTcHack x happyReduce_193
+
+action_304 (96#) = happyShift action_24
+action_304 (98#) = happyShift action_25
+action_304 (104#) = happyShift action_26
+action_304 (109#) = happyShift action_27
+action_304 (110#) = happyShift action_28
+action_304 (111#) = happyShift action_29
+action_304 (114#) = happyShift action_30
+action_304 (119#) = happyShift action_31
+action_304 (124#) = happyShift action_32
+action_304 (125#) = happyShift action_33
+action_304 (126#) = happyShift action_34
+action_304 (127#) = happyShift action_35
+action_304 (128#) = happyShift action_36
+action_304 (129#) = happyShift action_37
+action_304 (131#) = happyShift action_38
+action_304 (134#) = happyShift action_39
+action_304 (137#) = happyShift action_40
+action_304 (140#) = happyShift action_41
+action_304 (145#) = happyShift action_42
+action_304 (156#) = happyShift action_43
+action_304 (157#) = happyShift action_44
+action_304 (161#) = happyShift action_45
+action_304 (162#) = happyShift action_46
+action_304 (167#) = happyShift action_47
+action_304 (170#) = happyShift action_6
+action_304 (171#) = happyShift action_48
+action_304 (172#) = happyShift action_49
+action_304 (173#) = happyShift action_50
+action_304 (174#) = happyShift action_51
+action_304 (8#) = happyGoto action_10
+action_304 (9#) = happyGoto action_11
+action_304 (10#) = happyGoto action_12
+action_304 (11#) = happyGoto action_13
+action_304 (12#) = happyGoto action_14
+action_304 (58#) = happyGoto action_15
+action_304 (59#) = happyGoto action_16
+action_304 (60#) = happyGoto action_17
+action_304 (61#) = happyGoto action_18
+action_304 (62#) = happyGoto action_19
+action_304 (63#) = happyGoto action_371
+action_304 (64#) = happyGoto action_21
+action_304 (72#) = happyGoto action_22
+action_304 (77#) = happyGoto action_23
+action_304 (86#) = happyGoto action_372
+action_304 (87#) = happyGoto action_373
+action_304 x = happyTcHack x happyReduce_257
+
+action_305 (95#) = happyShift action_370
+action_305 x = happyTcHack x happyReduce_134
+
+action_306 x = happyTcHack x happyReduce_135
+
+action_307 x = happyTcHack x happyReduce_139
+
+action_308 x = happyTcHack x happyReduce_187
+
+action_309 (140#) = happyShift action_369
+action_309 x = happyTcHack x happyFail
+
+action_310 x = happyTcHack x happyReduce_189
+
+action_311 (96#) = happyShift action_106
+action_311 (98#) = happyShift action_107
+action_311 (104#) = happyShift action_108
+action_311 (110#) = happyShift action_109
+action_311 (111#) = happyShift action_110
+action_311 (114#) = happyShift action_111
+action_311 (121#) = happyShift action_112
+action_311 (170#) = happyShift action_6
+action_311 (171#) = happyShift action_48
+action_311 (172#) = happyShift action_49
+action_311 (174#) = happyShift action_51
+action_311 (8#) = happyGoto action_101
+action_311 (9#) = happyGoto action_102
+action_311 (10#) = happyGoto action_103
+action_311 (12#) = happyGoto action_104
+action_311 (67#) = happyGoto action_188
+action_311 (74#) = happyGoto action_189
+action_311 (84#) = happyGoto action_190
+action_311 (85#) = happyGoto action_368
+action_311 x = happyTcHack x happyReduce_253
+
+action_312 (96#) = happyShift action_24
+action_312 (98#) = happyShift action_25
+action_312 (104#) = happyShift action_26
+action_312 (109#) = happyShift action_27
+action_312 (110#) = happyShift action_28
+action_312 (111#) = happyShift action_29
+action_312 (114#) = happyShift action_30
+action_312 (119#) = happyShift action_31
+action_312 (124#) = happyShift action_32
+action_312 (125#) = happyShift action_33
+action_312 (126#) = happyShift action_34
+action_312 (127#) = happyShift action_35
+action_312 (128#) = happyShift action_36
+action_312 (129#) = happyShift action_37
+action_312 (131#) = happyShift action_38
+action_312 (134#) = happyShift action_39
+action_312 (137#) = happyShift action_40
+action_312 (140#) = happyShift action_41
+action_312 (145#) = happyShift action_42
+action_312 (156#) = happyShift action_43
+action_312 (157#) = happyShift action_44
+action_312 (161#) = happyShift action_45
+action_312 (162#) = happyShift action_46
+action_312 (167#) = happyShift action_47
+action_312 (170#) = happyShift action_6
+action_312 (171#) = happyShift action_48
+action_312 (172#) = happyShift action_49
+action_312 (173#) = happyShift action_50
+action_312 (174#) = happyShift action_51
+action_312 (8#) = happyGoto action_10
+action_312 (9#) = happyGoto action_11
+action_312 (10#) = happyGoto action_12
+action_312 (11#) = happyGoto action_13
+action_312 (12#) = happyGoto action_14
+action_312 (58#) = happyGoto action_15
+action_312 (59#) = happyGoto action_16
+action_312 (60#) = happyGoto action_17
+action_312 (61#) = happyGoto action_18
+action_312 (62#) = happyGoto action_19
+action_312 (63#) = happyGoto action_367
+action_312 (64#) = happyGoto action_21
+action_312 (72#) = happyGoto action_22
+action_312 (77#) = happyGoto action_23
+action_312 x = happyTcHack x happyFail
+
+action_313 x = happyTcHack x happyReduce_233
+
+action_314 (96#) = happyShift action_106
+action_314 (98#) = happyShift action_107
+action_314 (104#) = happyShift action_108
+action_314 (106#) = happyShift action_176
+action_314 (110#) = happyShift action_109
+action_314 (111#) = happyShift action_110
+action_314 (114#) = happyShift action_111
+action_314 (121#) = happyShift action_112
+action_314 (170#) = happyShift action_6
+action_314 (171#) = happyShift action_48
+action_314 (172#) = happyShift action_49
+action_314 (174#) = happyShift action_51
+action_314 (8#) = happyGoto action_101
+action_314 (9#) = happyGoto action_102
+action_314 (10#) = happyGoto action_103
+action_314 (12#) = happyGoto action_170
+action_314 (67#) = happyGoto action_171
+action_314 (68#) = happyGoto action_172
+action_314 (69#) = happyGoto action_203
+action_314 (82#) = happyGoto action_204
+action_314 (83#) = happyGoto action_366
+action_314 x = happyTcHack x happyFail
+
+action_315 x = happyTcHack x happyReduce_238
+
+action_316 x = happyTcHack x happyReduce_182
+
+action_317 (96#) = happyShift action_24
+action_317 (98#) = happyShift action_25
+action_317 (104#) = happyShift action_26
+action_317 (109#) = happyShift action_27
+action_317 (110#) = happyShift action_28
+action_317 (111#) = happyShift action_29
+action_317 (114#) = happyShift action_30
+action_317 (119#) = happyShift action_31
+action_317 (124#) = happyShift action_32
+action_317 (125#) = happyShift action_33
+action_317 (126#) = happyShift action_34
+action_317 (127#) = happyShift action_35
+action_317 (128#) = happyShift action_36
+action_317 (129#) = happyShift action_37
+action_317 (131#) = happyShift action_38
+action_317 (134#) = happyShift action_39
+action_317 (137#) = happyShift action_40
+action_317 (140#) = happyShift action_41
+action_317 (145#) = happyShift action_42
+action_317 (156#) = happyShift action_43
+action_317 (157#) = happyShift action_44
+action_317 (161#) = happyShift action_45
+action_317 (162#) = happyShift action_46
+action_317 (167#) = happyShift action_47
+action_317 (170#) = happyShift action_6
+action_317 (171#) = happyShift action_48
+action_317 (172#) = happyShift action_49
+action_317 (173#) = happyShift action_50
+action_317 (174#) = happyShift action_51
+action_317 (8#) = happyGoto action_10
+action_317 (9#) = happyGoto action_11
+action_317 (10#) = happyGoto action_12
+action_317 (11#) = happyGoto action_13
+action_317 (12#) = happyGoto action_14
+action_317 (58#) = happyGoto action_15
+action_317 (59#) = happyGoto action_16
+action_317 (60#) = happyGoto action_17
+action_317 (61#) = happyGoto action_18
+action_317 (62#) = happyGoto action_19
+action_317 (63#) = happyGoto action_365
+action_317 (64#) = happyGoto action_21
+action_317 (72#) = happyGoto action_22
+action_317 (77#) = happyGoto action_23
+action_317 x = happyTcHack x happyFail
+
+action_318 x = happyTcHack x happyReduce_205
+
+action_319 x = happyTcHack x happyReduce_209
+
+action_320 (174#) = happyShift action_51
+action_320 (12#) = happyGoto action_87
+action_320 (53#) = happyGoto action_180
+action_320 (70#) = happyGoto action_181
+action_320 (73#) = happyGoto action_364
+action_320 x = happyTcHack x happyReduce_229
+
+action_321 (96#) = happyShift action_106
+action_321 (98#) = happyShift action_107
+action_321 (104#) = happyShift action_108
+action_321 (106#) = happyShift action_176
+action_321 (110#) = happyShift action_109
+action_321 (111#) = happyShift action_110
+action_321 (114#) = happyShift action_111
+action_321 (121#) = happyShift action_112
+action_321 (170#) = happyShift action_6
+action_321 (171#) = happyShift action_48
+action_321 (172#) = happyShift action_49
+action_321 (174#) = happyShift action_51
+action_321 (8#) = happyGoto action_101
+action_321 (9#) = happyGoto action_102
+action_321 (10#) = happyGoto action_103
+action_321 (12#) = happyGoto action_170
+action_321 (67#) = happyGoto action_171
+action_321 (68#) = happyGoto action_172
+action_321 (69#) = happyGoto action_363
+action_321 x = happyTcHack x happyFail
+
+action_322 x = happyTcHack x happyReduce_204
+
+action_323 x = happyTcHack x happyReduce_211
+
+action_324 x = happyTcHack x happyReduce_199
+
+action_325 x = happyTcHack x happyReduce_216
+
+action_326 x = happyTcHack x happyReduce_210
+
+action_327 (96#) = happyShift action_106
+action_327 (98#) = happyShift action_107
+action_327 (104#) = happyShift action_108
+action_327 (106#) = happyShift action_176
+action_327 (110#) = happyShift action_109
+action_327 (111#) = happyShift action_110
+action_327 (114#) = happyShift action_111
+action_327 (121#) = happyShift action_112
+action_327 (170#) = happyShift action_6
+action_327 (171#) = happyShift action_48
+action_327 (172#) = happyShift action_49
+action_327 (174#) = happyShift action_51
+action_327 (8#) = happyGoto action_101
+action_327 (9#) = happyGoto action_102
+action_327 (10#) = happyGoto action_103
+action_327 (12#) = happyGoto action_170
+action_327 (67#) = happyGoto action_171
+action_327 (68#) = happyGoto action_172
+action_327 (69#) = happyGoto action_173
+action_327 (79#) = happyGoto action_174
+action_327 (81#) = happyGoto action_362
+action_327 x = happyTcHack x happyReduce_246
+
+action_328 x = happyTcHack x happyReduce_214
+
+action_329 (174#) = happyShift action_51
+action_329 (12#) = happyGoto action_361
+action_329 x = happyTcHack x happyFail
+
+action_330 (112#) = happyShift action_360
+action_330 x = happyTcHack x happyFail
+
+action_331 x = happyTcHack x happyReduce_241
+
+action_332 x = happyTcHack x happyReduce_245
+
+action_333 x = happyTcHack x happyReduce_160
+
+action_334 x = happyTcHack x happyReduce_150
+
+action_335 x = happyTcHack x happyReduce_197
+
+action_336 (99#) = happyShift action_359
+action_336 x = happyTcHack x happyFail
+
+action_337 x = happyTcHack x happyReduce_154
+
+action_338 (97#) = happyShift action_358
+action_338 x = happyTcHack x happyFail
+
+action_339 x = happyTcHack x happyReduce_129
+
+action_340 (97#) = happyShift action_357
+action_340 x = happyTcHack x happyFail
+
+action_341 x = happyTcHack x happyReduce_223
+
+action_342 (97#) = happyShift action_155
+action_342 (103#) = happyShift action_156
+action_342 x = happyTcHack x happyReduce_128
+
+action_343 x = happyTcHack x happyReduce_25
+
+action_344 (151#) = happyShift action_356
+action_344 (28#) = happyGoto action_355
+action_344 x = happyTcHack x happyReduce_55
+
+action_345 (102#) = happyShift action_354
+action_345 x = happyTcHack x happyReduce_27
+
+action_346 (103#) = happyShift action_352
+action_346 (169#) = happyShift action_353
+action_346 x = happyTcHack x happyReduce_66
+
+action_347 (174#) = happyShift action_51
+action_347 (12#) = happyGoto action_351
+action_347 x = happyTcHack x happyFail
+
+action_348 (174#) = happyShift action_51
+action_348 (12#) = happyGoto action_241
+action_348 (32#) = happyGoto action_349
+action_348 (33#) = happyGoto action_350
+action_348 x = happyTcHack x happyReduce_65
+
+action_349 x = happyTcHack x happyReduce_33
+
+action_350 (103#) = happyShift action_352
+action_350 x = happyTcHack x happyReduce_66
+
+action_351 x = happyTcHack x happyReduce_32
+
+action_352 (174#) = happyShift action_51
+action_352 (12#) = happyGoto action_241
+action_352 (32#) = happyGoto action_468
+action_352 (33#) = happyGoto action_350
+action_352 x = happyTcHack x happyReduce_65
+
+action_353 (98#) = happyShift action_408
+action_353 (174#) = happyShift action_51
+action_353 (12#) = happyGoto action_406
+action_353 (27#) = happyGoto action_467
+action_353 (29#) = happyGoto action_425
+action_353 x = happyTcHack x happyReduce_52
+
+action_354 (174#) = happyShift action_51
+action_354 (12#) = happyGoto action_241
+action_354 (33#) = happyGoto action_466
+action_354 x = happyTcHack x happyReduce_50
+
+action_355 x = happyTcHack x happyReduce_26
+
+action_356 (98#) = happyShift action_408
+action_356 (174#) = happyShift action_51
+action_356 (12#) = happyGoto action_406
+action_356 (27#) = happyGoto action_465
+action_356 (29#) = happyGoto action_425
+action_356 x = happyTcHack x happyReduce_52
+
+action_357 x = happyTcHack x happyReduce_188
+
+action_358 x = happyTcHack x happyReduce_159
+
+action_359 x = happyTcHack x happyReduce_239
+
+action_360 x = happyTcHack x happyReduce_155
+
+action_361 x = happyTcHack x happyReduce_201
+
+action_362 x = happyTcHack x happyReduce_248
+
+action_363 (108#) = happyShift action_296
+action_363 (117#) = happyShift action_297
+action_363 x = happyTcHack x happyReduce_221
+
+action_364 x = happyTcHack x happyReduce_231
+
+action_365 x = happyTcHack x happyReduce_183
+
+action_366 (97#) = happyShift action_464
+action_366 x = happyTcHack x happyFail
+
+action_367 x = happyTcHack x happyReduce_252
+
+action_368 x = happyTcHack x happyReduce_255
+
+action_369 (96#) = happyShift action_24
+action_369 (98#) = happyShift action_25
+action_369 (104#) = happyShift action_26
+action_369 (109#) = happyShift action_27
+action_369 (110#) = happyShift action_28
+action_369 (111#) = happyShift action_29
+action_369 (114#) = happyShift action_30
+action_369 (119#) = happyShift action_31
+action_369 (124#) = happyShift action_32
+action_369 (125#) = happyShift action_33
+action_369 (126#) = happyShift action_34
+action_369 (127#) = happyShift action_35
+action_369 (128#) = happyShift action_36
+action_369 (129#) = happyShift action_37
+action_369 (131#) = happyShift action_38
+action_369 (134#) = happyShift action_39
+action_369 (137#) = happyShift action_40
+action_369 (140#) = happyShift action_41
+action_369 (145#) = happyShift action_42
+action_369 (156#) = happyShift action_43
+action_369 (157#) = happyShift action_44
+action_369 (161#) = happyShift action_45
+action_369 (162#) = happyShift action_46
+action_369 (167#) = happyShift action_47
+action_369 (170#) = happyShift action_6
+action_369 (171#) = happyShift action_48
+action_369 (172#) = happyShift action_49
+action_369 (173#) = happyShift action_50
+action_369 (174#) = happyShift action_51
+action_369 (8#) = happyGoto action_10
+action_369 (9#) = happyGoto action_11
+action_369 (10#) = happyGoto action_12
+action_369 (11#) = happyGoto action_13
+action_369 (12#) = happyGoto action_14
+action_369 (58#) = happyGoto action_15
+action_369 (59#) = happyGoto action_16
+action_369 (60#) = happyGoto action_17
+action_369 (61#) = happyGoto action_18
+action_369 (62#) = happyGoto action_19
+action_369 (63#) = happyGoto action_463
+action_369 (64#) = happyGoto action_21
+action_369 (72#) = happyGoto action_22
+action_369 (77#) = happyGoto action_23
+action_369 x = happyTcHack x happyFail
+
+action_370 (96#) = happyShift action_24
+action_370 (98#) = happyShift action_25
+action_370 (104#) = happyShift action_26
+action_370 (109#) = happyShift action_27
+action_370 (110#) = happyShift action_28
+action_370 (111#) = happyShift action_29
+action_370 (114#) = happyShift action_30
+action_370 (119#) = happyShift action_31
+action_370 (124#) = happyShift action_32
+action_370 (125#) = happyShift action_33
+action_370 (126#) = happyShift action_34
+action_370 (127#) = happyShift action_35
+action_370 (128#) = happyShift action_36
+action_370 (129#) = happyShift action_37
+action_370 (131#) = happyShift action_38
+action_370 (134#) = happyShift action_39
+action_370 (137#) = happyShift action_40
+action_370 (140#) = happyShift action_41
+action_370 (145#) = happyShift action_42
+action_370 (156#) = happyShift action_43
+action_370 (157#) = happyShift action_44
+action_370 (161#) = happyShift action_45
+action_370 (162#) = happyShift action_46
+action_370 (167#) = happyShift action_47
+action_370 (170#) = happyShift action_6
+action_370 (171#) = happyShift action_48
+action_370 (172#) = happyShift action_49
+action_370 (173#) = happyShift action_50
+action_370 (174#) = happyShift action_51
+action_370 (8#) = happyGoto action_10
+action_370 (9#) = happyGoto action_11
+action_370 (10#) = happyGoto action_12
+action_370 (11#) = happyGoto action_13
+action_370 (12#) = happyGoto action_14
+action_370 (58#) = happyGoto action_15
+action_370 (59#) = happyGoto action_16
+action_370 (60#) = happyGoto action_17
+action_370 (61#) = happyGoto action_18
+action_370 (62#) = happyGoto action_19
+action_370 (63#) = happyGoto action_462
+action_370 (64#) = happyGoto action_21
+action_370 (72#) = happyGoto action_22
+action_370 (77#) = happyGoto action_23
+action_370 x = happyTcHack x happyFail
+
+action_371 (123#) = happyShift action_461
+action_371 x = happyTcHack x happyFail
+
+action_372 (94#) = happyShift action_460
+action_372 x = happyTcHack x happyReduce_258
+
+action_373 (97#) = happyShift action_459
+action_373 x = happyTcHack x happyFail
+
+action_374 x = happyTcHack x happyReduce_195
+
+action_375 x = happyTcHack x happyReduce_215
+
+action_376 (96#) = happyShift action_106
+action_376 (98#) = happyShift action_107
+action_376 (104#) = happyShift action_108
+action_376 (110#) = happyShift action_109
+action_376 (111#) = happyShift action_110
+action_376 (114#) = happyShift action_111
+action_376 (121#) = happyShift action_112
+action_376 (170#) = happyShift action_6
+action_376 (171#) = happyShift action_48
+action_376 (172#) = happyShift action_49
+action_376 (174#) = happyShift action_51
+action_376 (8#) = happyGoto action_101
+action_376 (9#) = happyGoto action_102
+action_376 (10#) = happyGoto action_103
+action_376 (12#) = happyGoto action_104
+action_376 (67#) = happyGoto action_188
+action_376 (74#) = happyGoto action_458
+action_376 x = happyTcHack x happyReduce_205
+
+action_377 x = happyTcHack x happyReduce_249
+
+action_378 x = happyTcHack x happyReduce_219
+
+action_379 x = happyTcHack x happyReduce_218
+
+action_380 x = happyTcHack x happyReduce_251
+
+action_381 x = happyTcHack x happyReduce_164
+
+action_382 x = happyTcHack x happyReduce_165
+
+action_383 (89#) = happyGoto action_457
+action_383 x = happyTcHack x happyReduce_262
+
+action_384 (104#) = happyShift action_290
+action_384 (174#) = happyShift action_51
+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 (96#) = happyShift action_140
+action_385 (98#) = happyShift action_455
+action_385 (104#) = happyShift action_26
+action_385 (109#) = happyShift action_83
+action_385 (110#) = happyShift action_28
+action_385 (111#) = happyShift action_29
+action_385 (125#) = happyShift action_33
+action_385 (126#) = happyShift action_34
+action_385 (127#) = happyShift action_35
+action_385 (128#) = happyShift action_36
+action_385 (129#) = happyShift action_37
+action_385 (134#) = happyShift action_39
+action_385 (170#) = happyShift action_6
+action_385 (171#) = happyShift action_48
+action_385 (172#) = happyShift action_49
+action_385 (173#) = happyShift action_50
+action_385 (174#) = happyShift action_51
+action_385 (8#) = happyGoto action_10
+action_385 (9#) = happyGoto action_11
+action_385 (10#) = happyGoto action_12
+action_385 (11#) = happyGoto action_13
+action_385 (12#) = happyGoto action_79
+action_385 (58#) = happyGoto action_453
+action_385 (72#) = happyGoto action_22
+action_385 (88#) = happyGoto action_454
+action_385 x = happyTcHack x happyReduce_95
+
+action_386 (174#) = happyShift action_51
+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_51
+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_51
+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_51
+action_389 (12#) = happyGoto action_446
+action_389 x = happyTcHack x happyFail
+
+action_390 (96#) = happyShift action_24
+action_390 (98#) = happyShift action_25
+action_390 (104#) = happyShift action_26
+action_390 (109#) = happyShift action_27
+action_390 (110#) = happyShift action_28
+action_390 (111#) = happyShift action_29
+action_390 (114#) = happyShift action_30
+action_390 (119#) = happyShift action_31
+action_390 (124#) = happyShift action_32
+action_390 (125#) = happyShift action_33
+action_390 (126#) = happyShift action_34
+action_390 (127#) = happyShift action_35
+action_390 (128#) = happyShift action_36
+action_390 (129#) = happyShift action_37
+action_390 (131#) = happyShift action_38
+action_390 (134#) = happyShift action_39
+action_390 (137#) = happyShift action_40
+action_390 (140#) = happyShift action_41
+action_390 (145#) = happyShift action_42
+action_390 (156#) = happyShift action_43
+action_390 (157#) = happyShift action_44
+action_390 (161#) = happyShift action_45
+action_390 (162#) = happyShift action_46
+action_390 (167#) = happyShift action_47
+action_390 (170#) = happyShift action_6
+action_390 (171#) = happyShift action_48
+action_390 (172#) = happyShift action_49
+action_390 (173#) = happyShift action_50
+action_390 (174#) = happyShift action_51
+action_390 (8#) = happyGoto action_10
+action_390 (9#) = happyGoto action_11
+action_390 (10#) = happyGoto action_12
+action_390 (11#) = happyGoto action_13
+action_390 (12#) = happyGoto action_14
+action_390 (58#) = happyGoto action_15
+action_390 (59#) = happyGoto action_16
+action_390 (60#) = happyGoto action_17
+action_390 (61#) = happyGoto action_18
+action_390 (62#) = happyGoto action_19
+action_390 (63#) = happyGoto action_445
+action_390 (64#) = happyGoto action_21
+action_390 (72#) = happyGoto action_22
+action_390 (77#) = happyGoto action_23
+action_390 x = happyTcHack x happyFail
+
+action_391 (174#) = happyShift action_51
+action_391 (12#) = happyGoto action_87
+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 (96#) = happyShift action_443
+action_392 x = happyTcHack x happyFail
+
+action_393 (174#) = happyShift action_51
+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_51
+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 (96#) = happyShift action_24
+action_397 (98#) = happyShift action_25
+action_397 (104#) = happyShift action_26
+action_397 (109#) = happyShift action_27
+action_397 (110#) = happyShift action_28
+action_397 (111#) = happyShift action_29
+action_397 (114#) = happyShift action_30
+action_397 (119#) = happyShift action_31
+action_397 (124#) = happyShift action_32
+action_397 (125#) = happyShift action_33
+action_397 (126#) = happyShift action_34
+action_397 (127#) = happyShift action_35
+action_397 (128#) = happyShift action_36
+action_397 (129#) = happyShift action_37
+action_397 (131#) = happyShift action_38
+action_397 (134#) = happyShift action_39
+action_397 (137#) = happyShift action_40
+action_397 (140#) = happyShift action_41
+action_397 (145#) = happyShift action_42
+action_397 (156#) = happyShift action_43
+action_397 (157#) = happyShift action_44
+action_397 (161#) = happyShift action_45
+action_397 (162#) = happyShift action_46
+action_397 (167#) = happyShift action_47
+action_397 (170#) = happyShift action_6
+action_397 (171#) = happyShift action_48
+action_397 (172#) = happyShift action_49
+action_397 (173#) = happyShift action_50
+action_397 (174#) = happyShift action_51
+action_397 (8#) = happyGoto action_10
+action_397 (9#) = happyGoto action_11
+action_397 (10#) = happyGoto action_12
+action_397 (11#) = happyGoto action_13
+action_397 (12#) = happyGoto action_14
+action_397 (58#) = happyGoto action_15
+action_397 (59#) = happyGoto action_16
+action_397 (60#) = happyGoto action_17
+action_397 (61#) = happyGoto action_18
+action_397 (62#) = happyGoto action_19
+action_397 (63#) = happyGoto action_437
+action_397 (64#) = happyGoto action_21
+action_397 (72#) = happyGoto action_22
+action_397 (77#) = happyGoto action_23
+action_397 x = happyTcHack x happyFail
+
+action_398 (104#) = happyShift action_257
+action_398 (174#) = happyShift action_51
+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 (104#) = happyShift action_257
+action_399 (174#) = happyShift action_51
+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 (105#) = happyShift action_434
+action_401 x = happyTcHack x happyFail
+
+action_402 (96#) = happyShift action_24
+action_402 (98#) = happyShift action_25
+action_402 (104#) = happyShift action_26
+action_402 (109#) = happyShift action_27
+action_402 (110#) = happyShift action_28
+action_402 (111#) = happyShift action_29
+action_402 (114#) = happyShift action_30
+action_402 (119#) = happyShift action_31
+action_402 (124#) = happyShift action_32
+action_402 (125#) = happyShift action_33
+action_402 (126#) = happyShift action_34
+action_402 (127#) = happyShift action_35
+action_402 (128#) = happyShift action_36
+action_402 (129#) = happyShift action_37
+action_402 (131#) = happyShift action_38
+action_402 (134#) = happyShift action_39
+action_402 (137#) = happyShift action_40
+action_402 (140#) = happyShift action_41
+action_402 (145#) = happyShift action_42
+action_402 (156#) = happyShift action_43
+action_402 (157#) = happyShift action_44
+action_402 (161#) = happyShift action_45
+action_402 (162#) = happyShift action_46
+action_402 (167#) = happyShift action_47
+action_402 (170#) = happyShift action_6
+action_402 (171#) = happyShift action_48
+action_402 (172#) = happyShift action_49
+action_402 (173#) = happyShift action_50
+action_402 (174#) = happyShift action_51
+action_402 (8#) = happyGoto action_10
+action_402 (9#) = happyGoto action_11
+action_402 (10#) = happyGoto action_12
+action_402 (11#) = happyGoto action_13
+action_402 (12#) = happyGoto action_14
+action_402 (58#) = happyGoto action_15
+action_402 (59#) = happyGoto action_16
+action_402 (60#) = happyGoto action_17
+action_402 (61#) = happyGoto action_18
+action_402 (62#) = happyGoto action_19
+action_402 (63#) = happyGoto action_433
+action_402 (64#) = happyGoto action_21
+action_402 (72#) = happyGoto action_22
+action_402 (77#) = happyGoto action_23
+action_402 x = happyTcHack x happyFail
+
+action_403 (96#) = happyShift action_24
+action_403 (98#) = happyShift action_25
+action_403 (104#) = happyShift action_26
+action_403 (109#) = happyShift action_27
+action_403 (110#) = happyShift action_28
+action_403 (111#) = happyShift action_29
+action_403 (114#) = happyShift action_30
+action_403 (119#) = happyShift action_31
+action_403 (124#) = happyShift action_32
+action_403 (125#) = happyShift action_33
+action_403 (126#) = happyShift action_34
+action_403 (127#) = happyShift action_35
+action_403 (128#) = happyShift action_36
+action_403 (129#) = happyShift action_37
+action_403 (131#) = happyShift action_38
+action_403 (134#) = happyShift action_39
+action_403 (137#) = happyShift action_40
+action_403 (140#) = happyShift action_41
+action_403 (145#) = happyShift action_42
+action_403 (156#) = happyShift action_43
+action_403 (157#) = happyShift action_44
+action_403 (161#) = happyShift action_45
+action_403 (162#) = happyShift action_46
+action_403 (167#) = happyShift action_47
+action_403 (170#) = happyShift action_6
+action_403 (171#) = happyShift action_48
+action_403 (172#) = happyShift action_49
+action_403 (173#) = happyShift action_50
+action_403 (174#) = happyShift action_51
+action_403 (8#) = happyGoto action_10
+action_403 (9#) = happyGoto action_11
+action_403 (10#) = happyGoto action_12
+action_403 (11#) = happyGoto action_13
+action_403 (12#) = happyGoto action_14
+action_403 (58#) = happyGoto action_15
+action_403 (59#) = happyGoto action_16
+action_403 (60#) = happyGoto action_17
+action_403 (61#) = happyGoto action_18
+action_403 (62#) = happyGoto action_19
+action_403 (63#) = happyGoto action_432
+action_403 (64#) = happyGoto action_21
+action_403 (72#) = happyGoto action_22
+action_403 (77#) = happyGoto action_23
+action_403 x = happyTcHack x happyFail
+
+action_404 (95#) = happyShift action_431
+action_404 x = happyTcHack x happyFail
+
+action_405 (104#) = happyShift action_257
+action_405 (174#) = happyShift action_51
+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 (101#) = happyShift action_429
+action_407 x = happyTcHack x happyFail
+
+action_408 (142#) = happyShift action_427
+action_408 (144#) = 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_51
+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_51
+action_414 (12#) = happyGoto action_241
+action_414 (33#) = happyGoto action_423
+action_414 x = happyTcHack x happyReduce_50
+
+action_415 (96#) = happyShift action_422
+action_415 x = happyTcHack x happyFail
+
+action_416 (174#) = happyShift action_51
+action_416 (12#) = happyGoto action_87
+action_416 (53#) = happyGoto action_421
+action_416 x = happyTcHack x happyFail
+
+action_417 (104#) = happyShift action_420
+action_417 x = happyTcHack x happyFail
+
+action_418 (95#) = happyShift action_419
+action_418 x = happyTcHack x happyFail
+
+action_419 (174#) = happyShift action_51
+action_419 (12#) = happyGoto action_492
+action_419 x = happyTcHack x happyFail
+
+action_420 (174#) = happyShift action_51
+action_420 (12#) = happyGoto action_87
+action_420 (53#) = happyGoto action_491
+action_420 x = happyTcHack x happyFail
+
+action_421 (105#) = happyShift action_490
+action_421 x = happyTcHack x happyFail
+
+action_422 (25#) = happyGoto action_489
+action_422 x = happyTcHack x happyReduce_48
+
+action_423 (169#) = happyShift action_488
+action_423 x = happyTcHack x happyFail
+
+action_424 (102#) = happyShift action_487
+action_424 x = happyTcHack x happyReduce_42
+
+action_425 (103#) = happyShift action_486
+action_425 x = happyTcHack x happyReduce_53
+
+action_426 (174#) = happyShift action_51
+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_51
+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 (96#) = happyShift action_24
+action_431 (98#) = happyShift action_25
+action_431 (104#) = happyShift action_26
+action_431 (109#) = happyShift action_27
+action_431 (110#) = happyShift action_28
+action_431 (111#) = happyShift action_29
+action_431 (114#) = happyShift action_30
+action_431 (119#) = happyShift action_31
+action_431 (124#) = happyShift action_32
+action_431 (125#) = happyShift action_33
+action_431 (126#) = happyShift action_34
+action_431 (127#) = happyShift action_35
+action_431 (128#) = happyShift action_36
+action_431 (129#) = happyShift action_37
+action_431 (131#) = happyShift action_38
+action_431 (134#) = happyShift action_39
+action_431 (137#) = happyShift action_40
+action_431 (140#) = happyShift action_41
+action_431 (145#) = happyShift action_42
+action_431 (156#) = happyShift action_43
+action_431 (157#) = happyShift action_44
+action_431 (161#) = happyShift action_45
+action_431 (162#) = happyShift action_46
+action_431 (167#) = happyShift action_47
+action_431 (170#) = happyShift action_6
+action_431 (171#) = happyShift action_48
+action_431 (172#) = happyShift action_49
+action_431 (173#) = happyShift action_50
+action_431 (174#) = happyShift action_51
+action_431 (8#) = happyGoto action_10
+action_431 (9#) = happyGoto action_11
+action_431 (10#) = happyGoto action_12
+action_431 (11#) = happyGoto action_13
+action_431 (12#) = happyGoto action_14
+action_431 (58#) = happyGoto action_15
+action_431 (59#) = happyGoto action_16
+action_431 (60#) = happyGoto action_17
+action_431 (61#) = happyGoto action_18
+action_431 (62#) = happyGoto action_19
+action_431 (63#) = happyGoto action_483
+action_431 (64#) = happyGoto action_21
+action_431 (72#) = happyGoto action_22
+action_431 (77#) = happyGoto action_23
+action_431 x = happyTcHack x happyFail
+
+action_432 (95#) = happyShift action_482
+action_432 x = happyTcHack x happyReduce_71
+
+action_433 x = happyTcHack x happyReduce_72
+
+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 (108#) = happyShift action_480
+action_439 x = happyTcHack x happyReduce_126
+
+action_440 x = happyTcHack x happyReduce_105
+
+action_441 (140#) = 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 (108#) = happyShift action_476
+action_449 x = happyTcHack x happyReduce_103
+
+action_450 x = happyTcHack x happyReduce_99
+
+action_451 (95#) = 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 (96#) = happyShift action_24
+action_455 (98#) = happyShift action_25
+action_455 (104#) = happyShift action_26
+action_455 (109#) = happyShift action_27
+action_455 (110#) = happyShift action_28
+action_455 (111#) = happyShift action_29
+action_455 (114#) = happyShift action_30
+action_455 (119#) = happyShift action_31
+action_455 (121#) = happyShift action_100
+action_455 (124#) = happyShift action_32
+action_455 (125#) = happyShift action_33
+action_455 (126#) = happyShift action_34
+action_455 (127#) = happyShift action_35
+action_455 (128#) = happyShift action_36
+action_455 (129#) = happyShift action_37
+action_455 (131#) = happyShift action_38
+action_455 (134#) = happyShift action_39
+action_455 (137#) = happyShift action_40
+action_455 (140#) = happyShift action_123
+action_455 (145#) = happyShift action_42
+action_455 (156#) = happyShift action_43
+action_455 (157#) = happyShift action_44
+action_455 (161#) = happyShift action_45
+action_455 (162#) = happyShift action_46
+action_455 (167#) = happyShift action_47
+action_455 (170#) = happyShift action_6
+action_455 (171#) = happyShift action_48
+action_455 (172#) = happyShift action_49
+action_455 (173#) = happyShift action_50
+action_455 (174#) = happyShift action_51
+action_455 (8#) = happyGoto action_10
+action_455 (9#) = happyGoto action_11
+action_455 (10#) = happyGoto action_12
+action_455 (11#) = happyGoto action_13
+action_455 (12#) = happyGoto action_120
+action_455 (58#) = happyGoto action_15
+action_455 (59#) = happyGoto action_16
+action_455 (60#) = happyGoto action_17
+action_455 (61#) = happyGoto action_18
+action_455 (62#) = happyGoto action_19
+action_455 (63#) = happyGoto action_121
+action_455 (64#) = happyGoto action_21
+action_455 (72#) = happyGoto action_22
+action_455 (75#) = happyGoto action_97
+action_455 (76#) = happyGoto action_475
+action_455 (77#) = happyGoto action_23
+action_455 x = happyTcHack x happyReduce_236
+
+action_456 x = happyTcHack x happyReduce_114
+
+action_457 (96#) = happyShift action_140
+action_457 (98#) = happyShift action_455
+action_457 (104#) = happyShift action_26
+action_457 (105#) = happyShift action_474
+action_457 (109#) = happyShift action_83
+action_457 (110#) = happyShift action_28
+action_457 (111#) = happyShift action_29
+action_457 (125#) = happyShift action_33
+action_457 (126#) = happyShift action_34
+action_457 (127#) = happyShift action_35
+action_457 (128#) = happyShift action_36
+action_457 (129#) = happyShift action_37
+action_457 (134#) = happyShift action_39
+action_457 (170#) = happyShift action_6
+action_457 (171#) = happyShift action_48
+action_457 (172#) = happyShift action_49
+action_457 (173#) = happyShift action_50
+action_457 (174#) = happyShift action_51
+action_457 (8#) = happyGoto action_10
+action_457 (9#) = happyGoto action_11
+action_457 (10#) = happyGoto action_12
+action_457 (11#) = happyGoto action_13
+action_457 (12#) = happyGoto action_79
+action_457 (58#) = happyGoto action_453
+action_457 (72#) = happyGoto action_22
+action_457 (88#) = happyGoto action_454
+action_457 x = happyTcHack x happyFail
+
+action_458 x = happyTcHack x happyReduce_213
+
+action_459 x = happyTcHack x happyReduce_168
+
+action_460 (96#) = happyShift action_24
+action_460 (98#) = happyShift action_25
+action_460 (104#) = happyShift action_26
+action_460 (109#) = happyShift action_27
+action_460 (110#) = happyShift action_28
+action_460 (111#) = happyShift action_29
+action_460 (114#) = happyShift action_30
+action_460 (119#) = happyShift action_31
+action_460 (124#) = happyShift action_32
+action_460 (125#) = happyShift action_33
+action_460 (126#) = happyShift action_34
+action_460 (127#) = happyShift action_35
+action_460 (128#) = happyShift action_36
+action_460 (129#) = happyShift action_37
+action_460 (131#) = happyShift action_38
+action_460 (134#) = happyShift action_39
+action_460 (137#) = happyShift action_40
+action_460 (140#) = happyShift action_41
+action_460 (145#) = happyShift action_42
+action_460 (156#) = happyShift action_43
+action_460 (157#) = happyShift action_44
+action_460 (161#) = happyShift action_45
+action_460 (162#) = happyShift action_46
+action_460 (167#) = happyShift action_47
+action_460 (170#) = happyShift action_6
+action_460 (171#) = happyShift action_48
+action_460 (172#) = happyShift action_49
+action_460 (173#) = happyShift action_50
+action_460 (174#) = happyShift action_51
+action_460 (8#) = happyGoto action_10
+action_460 (9#) = happyGoto action_11
+action_460 (10#) = happyGoto action_12
+action_460 (11#) = happyGoto action_13
+action_460 (12#) = happyGoto action_14
+action_460 (58#) = happyGoto action_15
+action_460 (59#) = happyGoto action_16
+action_460 (60#) = happyGoto action_17
+action_460 (61#) = happyGoto action_18
+action_460 (62#) = happyGoto action_19
+action_460 (63#) = happyGoto action_371
+action_460 (64#) = happyGoto action_21
+action_460 (72#) = happyGoto action_22
+action_460 (77#) = happyGoto action_23
+action_460 (86#) = happyGoto action_372
+action_460 (87#) = happyGoto action_473
+action_460 x = happyTcHack x happyReduce_257
+
+action_461 (96#) = happyShift action_24
+action_461 (98#) = happyShift action_25
+action_461 (104#) = happyShift action_26
+action_461 (109#) = happyShift action_27
+action_461 (110#) = happyShift action_28
+action_461 (111#) = happyShift action_29
+action_461 (114#) = happyShift action_30
+action_461 (119#) = happyShift action_31
+action_461 (124#) = happyShift action_32
+action_461 (125#) = happyShift action_33
+action_461 (126#) = happyShift action_34
+action_461 (127#) = happyShift action_35
+action_461 (128#) = happyShift action_36
+action_461 (129#) = happyShift action_37
+action_461 (131#) = happyShift action_38
+action_461 (134#) = happyShift action_39
+action_461 (137#) = happyShift action_40
+action_461 (140#) = happyShift action_41
+action_461 (145#) = happyShift action_42
+action_461 (156#) = happyShift action_43
+action_461 (157#) = happyShift action_44
+action_461 (161#) = happyShift action_45
+action_461 (162#) = happyShift action_46
+action_461 (167#) = happyShift action_47
+action_461 (170#) = happyShift action_6
+action_461 (171#) = happyShift action_48
+action_461 (172#) = happyShift action_49
+action_461 (173#) = happyShift action_50
+action_461 (174#) = happyShift action_51
+action_461 (8#) = happyGoto action_10
+action_461 (9#) = happyGoto action_11
+action_461 (10#) = happyGoto action_12
+action_461 (11#) = happyGoto action_13
+action_461 (12#) = happyGoto action_14
+action_461 (58#) = happyGoto action_15
+action_461 (59#) = happyGoto action_16
+action_461 (60#) = happyGoto action_17
+action_461 (61#) = happyGoto action_18
+action_461 (62#) = happyGoto action_19
+action_461 (63#) = happyGoto action_472
+action_461 (64#) = happyGoto action_21
+action_461 (72#) = happyGoto action_22
+action_461 (77#) = happyGoto action_23
+action_461 x = happyTcHack x happyFail
+
+action_462 x = happyTcHack x happyReduce_136
+
+action_463 x = happyTcHack x happyReduce_186
+
+action_464 x = happyTcHack x happyReduce_166
+
+action_465 (140#) = happyShift action_471
+action_465 x = happyTcHack x happyFail
+
+action_466 (169#) = happyShift action_470
+action_466 x = happyTcHack x happyFail
+
+action_467 (102#) = happyShift action_469
+action_467 x = happyTcHack x happyReduce_28
+
+action_468 x = happyTcHack x happyReduce_67
+
+action_469 (151#) = happyShift action_356
+action_469 (28#) = happyGoto action_510
+action_469 x = happyTcHack x happyReduce_55
+
+action_470 (98#) = happyShift action_408
+action_470 (174#) = happyShift action_51
+action_470 (12#) = happyGoto action_406
+action_470 (27#) = happyGoto action_509
+action_470 (29#) = happyGoto action_425
+action_470 x = happyTcHack x happyReduce_52
+
+action_471 x = happyTcHack x happyReduce_56
+
+action_472 x = happyTcHack x happyReduce_256
+
+action_473 x = happyTcHack x happyReduce_259
+
+action_474 (96#) = happyShift action_508
+action_474 x = happyTcHack x happyReduce_96
+
+action_475 (100#) = happyShift action_507
+action_475 x = happyTcHack x happyFail
+
+action_476 (174#) = happyShift action_51
+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_51
+action_477 (12#) = happyGoto action_505
+action_477 x = happyTcHack x happyFail
+
+action_478 (97#) = happyShift action_504
+action_478 (132#) = happyShift action_210
+action_478 (134#) = happyShift action_211
+action_478 (135#) = happyShift action_212
+action_478 (136#) = happyShift action_213
+action_478 (138#) = happyShift action_214
+action_478 (146#) = happyShift action_215
+action_478 (147#) = happyShift action_216
+action_478 (148#) = happyShift action_217
+action_478 (149#) = happyShift action_218
+action_478 (152#) = happyShift action_219
+action_478 (154#) = happyShift action_220
+action_478 (155#) = happyShift action_221
+action_478 (156#) = happyShift action_222
+action_478 (158#) = happyShift action_223
+action_478 (163#) = happyShift action_224
+action_478 (164#) = happyShift action_225
+action_478 (166#) = happyShift action_226
+action_478 (35#) = happyGoto action_209
+action_478 x = happyTcHack x happyFail
+
+action_479 (174#) = happyShift action_51
+action_479 (12#) = happyGoto action_503
+action_479 x = happyTcHack x happyFail
+
+action_480 (174#) = happyShift action_51
+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 (96#) = happyShift action_140
+action_481 (98#) = happyShift action_455
+action_481 (104#) = happyShift action_26
+action_481 (109#) = happyShift action_83
+action_481 (110#) = happyShift action_28
+action_481 (111#) = happyShift action_29
+action_481 (125#) = happyShift action_33
+action_481 (126#) = happyShift action_34
+action_481 (127#) = happyShift action_35
+action_481 (128#) = happyShift action_36
+action_481 (129#) = happyShift action_37
+action_481 (134#) = happyShift action_39
+action_481 (170#) = happyShift action_6
+action_481 (171#) = happyShift action_48
+action_481 (172#) = happyShift action_49
+action_481 (173#) = happyShift action_50
+action_481 (174#) = happyShift action_51
+action_481 (8#) = happyGoto action_10
+action_481 (9#) = happyGoto action_11
+action_481 (10#) = happyGoto action_12
+action_481 (11#) = happyGoto action_13
+action_481 (12#) = happyGoto action_79
+action_481 (58#) = happyGoto action_453
+action_481 (72#) = happyGoto action_22
+action_481 (88#) = happyGoto action_454
+action_481 x = happyTcHack x happyReduce_108
+
+action_482 (96#) = happyShift action_24
+action_482 (98#) = happyShift action_25
+action_482 (104#) = happyShift action_26
+action_482 (109#) = happyShift action_27
+action_482 (110#) = happyShift action_28
+action_482 (111#) = happyShift action_29
+action_482 (114#) = happyShift action_30
+action_482 (119#) = happyShift action_31
+action_482 (124#) = happyShift action_32
+action_482 (125#) = happyShift action_33
+action_482 (126#) = happyShift action_34
+action_482 (127#) = happyShift action_35
+action_482 (128#) = happyShift action_36
+action_482 (129#) = happyShift action_37
+action_482 (131#) = happyShift action_38
+action_482 (134#) = happyShift action_39
+action_482 (137#) = happyShift action_40
+action_482 (140#) = happyShift action_41
+action_482 (145#) = happyShift action_42
+action_482 (156#) = happyShift action_43
+action_482 (157#) = happyShift action_44
+action_482 (161#) = happyShift action_45
+action_482 (162#) = happyShift action_46
+action_482 (167#) = happyShift action_47
+action_482 (170#) = happyShift action_6
+action_482 (171#) = happyShift action_48
+action_482 (172#) = happyShift action_49
+action_482 (173#) = happyShift action_50
+action_482 (174#) = happyShift action_51
+action_482 (8#) = happyGoto action_10
+action_482 (9#) = happyGoto action_11
+action_482 (10#) = happyGoto action_12
+action_482 (11#) = happyGoto action_13
+action_482 (12#) = happyGoto action_14
+action_482 (58#) = happyGoto action_15
+action_482 (59#) = happyGoto action_16
+action_482 (60#) = happyGoto action_17
+action_482 (61#) = happyGoto action_18
+action_482 (62#) = happyGoto action_19
+action_482 (63#) = happyGoto action_501
+action_482 (64#) = happyGoto action_21
+action_482 (72#) = happyGoto action_22
+action_482 (77#) = happyGoto action_23
+action_482 x = happyTcHack x happyFail
+
+action_483 x = happyTcHack x happyReduce_73
+
+action_484 x = happyTcHack x happyReduce_39
+
+action_485 (95#) = happyShift action_499
+action_485 (99#) = happyShift action_500
+action_485 x = happyTcHack x happyFail
+
+action_486 (98#) = happyShift action_408
+action_486 (174#) = happyShift action_51
+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 (151#) = happyShift action_356
+action_487 (28#) = happyGoto action_497
+action_487 x = happyTcHack x happyReduce_55
+
+action_488 (98#) = happyShift action_408
+action_488 (174#) = happyShift action_51
+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 (97#) = happyShift action_495
+action_489 (132#) = happyShift action_210
+action_489 (134#) = happyShift action_211
+action_489 (135#) = happyShift action_212
+action_489 (136#) = happyShift action_213
+action_489 (138#) = happyShift action_214
+action_489 (146#) = happyShift action_215
+action_489 (147#) = happyShift action_216
+action_489 (148#) = happyShift action_217
+action_489 (149#) = happyShift action_218
+action_489 (152#) = happyShift action_219
+action_489 (154#) = happyShift action_220
+action_489 (155#) = happyShift action_221
+action_489 (156#) = happyShift action_222
+action_489 (158#) = happyShift action_223
+action_489 (163#) = happyShift action_224
+action_489 (164#) = happyShift action_225
+action_489 (166#) = happyShift action_226
+action_489 (35#) = happyGoto action_209
+action_489 x = happyTcHack x happyFail
+
+action_490 x = happyTcHack x happyReduce_69
+
+action_491 (105#) = happyShift action_494
+action_491 x = happyTcHack x happyFail
+
+action_492 (94#) = happyShift action_493
+action_492 x = happyTcHack x happyFail
+
+action_493 (174#) = happyShift action_51
+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 (102#) = happyShift action_518
+action_496 x = happyTcHack x happyReduce_44
+
+action_497 (96#) = happyShift action_517
+action_497 x = happyTcHack x happyFail
+
+action_498 x = happyTcHack x happyReduce_54
+
+action_499 (174#) = happyShift action_51
+action_499 (12#) = happyGoto action_516
+action_499 x = happyTcHack x happyFail
+
+action_500 x = happyTcHack x happyReduce_58
+
+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 (94#) = 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 (96#) = happyShift action_24
+action_507 (98#) = happyShift action_25
+action_507 (104#) = happyShift action_26
+action_507 (109#) = happyShift action_27
+action_507 (110#) = happyShift action_28
+action_507 (111#) = happyShift action_29
+action_507 (114#) = happyShift action_30
+action_507 (119#) = happyShift action_31
+action_507 (124#) = happyShift action_32
+action_507 (125#) = happyShift action_33
+action_507 (126#) = happyShift action_34
+action_507 (127#) = happyShift action_35
+action_507 (128#) = happyShift action_36
+action_507 (129#) = happyShift action_37
+action_507 (131#) = happyShift action_38
+action_507 (134#) = happyShift action_39
+action_507 (137#) = happyShift action_40
+action_507 (140#) = happyShift action_41
+action_507 (145#) = happyShift action_42
+action_507 (156#) = happyShift action_43
+action_507 (157#) = happyShift action_44
+action_507 (161#) = happyShift action_45
+action_507 (162#) = happyShift action_46
+action_507 (167#) = happyShift action_47
+action_507 (170#) = happyShift action_6
+action_507 (171#) = happyShift action_48
+action_507 (172#) = happyShift action_49
+action_507 (173#) = happyShift action_50
+action_507 (174#) = happyShift action_51
+action_507 (8#) = happyGoto action_10
+action_507 (9#) = happyGoto action_11
+action_507 (10#) = happyGoto action_12
+action_507 (11#) = happyGoto action_13
+action_507 (12#) = happyGoto action_14
+action_507 (58#) = happyGoto action_15
+action_507 (59#) = happyGoto action_16
+action_507 (60#) = happyGoto action_17
+action_507 (61#) = happyGoto action_18
+action_507 (62#) = happyGoto action_19
+action_507 (63#) = happyGoto action_513
+action_507 (64#) = happyGoto action_21
+action_507 (72#) = happyGoto action_22
+action_507 (77#) = happyGoto action_23
+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 (102#) = happyShift action_511
+action_509 x = happyTcHack x happyReduce_30
+
+action_510 x = happyTcHack x happyReduce_29
+
+action_511 (151#) = happyShift action_356
+action_511 (28#) = happyGoto action_530
+action_511 x = happyTcHack x happyReduce_55
+
+action_512 (97#) = 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 (151#) = happyShift action_356
+action_518 (28#) = happyGoto action_525
+action_518 x = happyTcHack x happyReduce_55
+
+action_519 (95#) = happyShift action_524
+action_519 x = happyTcHack x happyFail
+
+action_520 (94#) = happyShift action_523
+action_520 x = happyTcHack x happyReduce_18
+
+action_521 (97#) = happyShift action_522
+action_521 x = happyTcHack x happyFail
+
+action_522 x = happyTcHack x happyReduce_14
+
+action_523 (174#) = happyShift action_51
+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_51
+action_524 (12#) = happyGoto action_533
+action_524 (18#) = happyGoto action_534
+action_524 x = happyTcHack x happyFail
+
+action_525 (96#) = happyShift action_532
+action_525 x = happyTcHack x happyFail
+
+action_526 (97#) = happyShift action_531
+action_526 (132#) = happyShift action_210
+action_526 (134#) = happyShift action_211
+action_526 (135#) = happyShift action_212
+action_526 (136#) = happyShift action_213
+action_526 (138#) = happyShift action_214
+action_526 (146#) = happyShift action_215
+action_526 (147#) = happyShift action_216
+action_526 (148#) = happyShift action_217
+action_526 (149#) = happyShift action_218
+action_526 (152#) = happyShift action_219
+action_526 (154#) = happyShift action_220
+action_526 (155#) = happyShift action_221
+action_526 (156#) = happyShift action_222
+action_526 (158#) = happyShift action_223
+action_526 (163#) = happyShift action_224
+action_526 (164#) = happyShift action_225
+action_526 (166#) = happyShift action_226
+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 (97#) = happyShift action_538
+action_537 (132#) = happyShift action_210
+action_537 (134#) = happyShift action_211
+action_537 (135#) = happyShift action_212
+action_537 (136#) = happyShift action_213
+action_537 (138#) = happyShift action_214
+action_537 (146#) = happyShift action_215
+action_537 (147#) = happyShift action_216
+action_537 (148#) = happyShift action_217
+action_537 (149#) = happyShift action_218
+action_537 (152#) = happyShift action_219
+action_537 (154#) = happyShift action_220
+action_537 (155#) = happyShift action_221
+action_537 (156#) = happyShift action_222
+action_537 (158#) = happyShift action_223
+action_537 (163#) = happyShift action_224
+action_537 (164#) = happyShift action_225
+action_537 (166#) = happyShift action_226
+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 (164#) = happyShift action_541
+action_540 x = happyTcHack x happyFail
+
+action_541 (140#) = happyShift action_542
+action_541 (153#) = happyShift action_543
+action_541 x = happyTcHack x happyFail
+
+action_542 (98#) = happyShift action_408
+action_542 (174#) = happyShift action_51
+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_51
+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 happy_var_1) :: Integer
+	)
+happyReduction_5 _  = notHappyAtAll 
+
+happyReduce_6 = happySpecReduce_1  9# happyReduction_6
+happyReduction_6 (HappyTerminal (PT _ (TL happy_var_1)))
+	 =  HappyAbsSyn9
+		 (happy_var_1
+	)
+happyReduction_6 _  = notHappyAtAll 
+
+happyReduce_7 = happySpecReduce_1  10# happyReduction_7
+happyReduction_7 (HappyTerminal (PT _ (TD happy_var_1)))
+	 =  HappyAbsSyn10
+		 ((read 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 ";") -> cont 94#;
+	PT _ (TS "=") -> cont 95#;
+	PT _ (TS "{") -> cont 96#;
+	PT _ (TS "}") -> cont 97#;
+	PT _ (TS "(") -> cont 98#;
+	PT _ (TS ")") -> cont 99#;
+	PT _ (TS ":") -> cont 100#;
+	PT _ (TS "->") -> cont 101#;
+	PT _ (TS "**") -> cont 102#;
+	PT _ (TS ",") -> cont 103#;
+	PT _ (TS "[") -> cont 104#;
+	PT _ (TS "]") -> cont 105#;
+	PT _ (TS "-") -> cont 106#;
+	PT _ (TS ".") -> cont 107#;
+	PT _ (TS "|") -> cont 108#;
+	PT _ (TS "%") -> cont 109#;
+	PT _ (TS "?") -> cont 110#;
+	PT _ (TS "<") -> cont 111#;
+	PT _ (TS ">") -> cont 112#;
+	PT _ (TS "@") -> cont 113#;
+	PT _ (TS "#") -> cont 114#;
+	PT _ (TS "!") -> cont 115#;
+	PT _ (TS "*") -> cont 116#;
+	PT _ (TS "+") -> cont 117#;
+	PT _ (TS "++") -> cont 118#;
+	PT _ (TS "\\") -> cont 119#;
+	PT _ (TS "=>") -> cont 120#;
+	PT _ (TS "_") -> cont 121#;
+	PT _ (TS "$") -> cont 122#;
+	PT _ (TS "/") -> cont 123#;
+	PT _ (TS "Lin") -> cont 124#;
+	PT _ (TS "PType") -> cont 125#;
+	PT _ (TS "Str") -> cont 126#;
+	PT _ (TS "Strs") -> cont 127#;
+	PT _ (TS "Tok") -> cont 128#;
+	PT _ (TS "Type") -> cont 129#;
+	PT _ (TS "abstract") -> cont 130#;
+	PT _ (TS "case") -> cont 131#;
+	PT _ (TS "cat") -> cont 132#;
+	PT _ (TS "concrete") -> cont 133#;
+	PT _ (TS "data") -> cont 134#;
+	PT _ (TS "def") -> cont 135#;
+	PT _ (TS "flags") -> cont 136#;
+	PT _ (TS "fn") -> cont 137#;
+	PT _ (TS "fun") -> cont 138#;
+	PT _ (TS "grammar") -> cont 139#;
+	PT _ (TS "in") -> cont 140#;
+	PT _ (TS "include") -> cont 141#;
+	PT _ (TS "incomplete") -> cont 142#;
+	PT _ (TS "instance") -> cont 143#;
+	PT _ (TS "interface") -> cont 144#;
+	PT _ (TS "let") -> cont 145#;
+	PT _ (TS "lin") -> cont 146#;
+	PT _ (TS "lincat") -> cont 147#;
+	PT _ (TS "lindef") -> cont 148#;
+	PT _ (TS "lintype") -> cont 149#;
+	PT _ (TS "of") -> cont 150#;
+	PT _ (TS "open") -> cont 151#;
+	PT _ (TS "oper") -> cont 152#;
+	PT _ (TS "out") -> cont 153#;
+	PT _ (TS "package") -> cont 154#;
+	PT _ (TS "param") -> cont 155#;
+	PT _ (TS "pattern") -> cont 156#;
+	PT _ (TS "pre") -> cont 157#;
+	PT _ (TS "printname") -> cont 158#;
+	PT _ (TS "resource") -> cont 159#;
+	PT _ (TS "reuse") -> cont 160#;
+	PT _ (TS "strs") -> cont 161#;
+	PT _ (TS "table") -> cont 162#;
+	PT _ (TS "tokenizer") -> cont 163#;
+	PT _ (TS "transfer") -> cont 164#;
+	PT _ (TS "union") -> cont 165#;
+	PT _ (TS "var") -> cont 166#;
+	PT _ (TS "variants") -> cont 167#;
+	PT _ (TS "where") -> cont 168#;
+	PT _ (TS "with") -> 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 })
+
+pExp tks = happySomeParser where
+  happySomeParser = happyThen (happyParse action_3 tks) (\x -> case x of {HappyAbsSyn58 z -> happyReturn z; _other -> notHappyAtAll })
+
+pModHeader tks = happySomeParser where
+  happySomeParser = happyThen (happyParse action_4 tks) (\x -> case x of {HappyAbsSyn15 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 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-2.9/GF/Source/ParGF.y b/src-2.9/GF/Source/ParGF.y
new file mode 100644
index 000000000..2109434e5
--- /dev/null
+++ b/src-2.9/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 (pGrammar, pModDef, pOldGrammar, pExp, pModHeader, myLexer) where --H
+import GF.Source.AbsGF       --H
+import GF.Source.LexGF       --H
+import GF.Infra.Ident        --H
+import GF.Data.ErrM          --H
+}
+
+%name pGrammar Grammar
+%name pModDef ModDef
+%name pOldGrammar OldGrammar
+%name pExp Exp
+%partial pModHeader ModHeader
+
+-- 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 "/") }
+ 'Lin' { PT _ (TS "Lin") }
+ 'PType' { PT _ (TS "PType") }
+ 'Str' { PT _ (TS "Str") }
+ 'Strs' { PT _ (TS "Strs") }
+ 'Tok' { PT _ (TS "Tok") }
+ 'Type' { PT _ (TS "Type") }
+ 'abstract' { PT _ (TS "abstract") }
+ 'case' { PT _ (TS "case") }
+ 'cat' { PT _ (TS "cat") }
+ 'concrete' { PT _ (TS "concrete") }
+ 'data' { PT _ (TS "data") }
+ 'def' { PT _ (TS "def") }
+ 'flags' { PT _ (TS "flags") }
+ 'fn' { PT _ (TS "fn") }
+ 'fun' { PT _ (TS "fun") }
+ 'grammar' { PT _ (TS "grammar") }
+ 'in' { PT _ (TS "in") }
+ 'include' { PT _ (TS "include") }
+ 'incomplete' { PT _ (TS "incomplete") }
+ 'instance' { PT _ (TS "instance") }
+ 'interface' { PT _ (TS "interface") }
+ 'let' { PT _ (TS "let") }
+ 'lin' { PT _ (TS "lin") }
+ 'lincat' { PT _ (TS "lincat") }
+ 'lindef' { PT _ (TS "lindef") }
+ 'lintype' { PT _ (TS "lintype") }
+ 'of' { PT _ (TS "of") }
+ 'open' { PT _ (TS "open") }
+ 'oper' { PT _ (TS "oper") }
+ 'out' { PT _ (TS "out") }
+ 'package' { PT _ (TS "package") }
+ 'param' { PT _ (TS "param") }
+ 'pattern' { PT _ (TS "pattern") }
+ 'pre' { PT _ (TS "pre") }
+ 'printname' { PT _ (TS "printname") }
+ 'resource' { PT _ (TS "resource") }
+ 'reuse' { PT _ (TS "reuse") }
+ 'strs' { PT _ (TS "strs") }
+ 'table' { PT _ (TS "table") }
+ 'tokenizer' { PT _ (TS "tokenizer") }
+ 'transfer' { PT _ (TS "transfer") }
+ 'union' { PT _ (TS "union") }
+ 'var' { PT _ (TS "var") }
+ 'variants' { PT _ (TS "variants") }
+ 'where' { PT _ (TS "where") }
+ 'with' { PT _ (TS "with") }
+
+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 $1) :: Integer }
+String  :: { String }  : L_quoted { $1 }
+Double  :: { Double }  : L_doubl  { (read $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 prToken (take 4 ts))
+
+myLexer = tokens
+}
+
diff --git a/src-2.9/GF/Source/PrintGF.hs b/src-2.9/GF/Source/PrintGF.hs
new file mode 100644
index 000000000..0a260f5bf
--- /dev/null
+++ b/src-2.9/GF/Source/PrintGF.hs
@@ -0,0 +1,532 @@
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module GF.Source.PrintGF where
+
+-- pretty-printer generated by the BNF converter
+
+import GF.Source.AbsGF
+import Char
+
+-- the top-level printing method
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+type Doc = [ShowS] -> [ShowS]
+
+doc :: ShowS -> Doc
+doc = (:)
+
+render :: Doc -> String
+render d = rend 0 (map ($ "") $ d []) "" where
+  rend i ss = case ss of
+    "["      :ts -> showChar '[' . rend i ts
+    "("      :ts -> showChar '(' . rend i ts
+    "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
+    "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
+    "}"      :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
+    ";"      :ts -> showChar ';' . new i . rend i ts
+    t  : "," :ts -> showString t . space "," . rend i ts
+    t  : ")" :ts -> showString t . showChar ')' . rend i ts
+    t  : "]" :ts -> showString t . showChar ']' . rend i ts
+    t        :ts -> space t . rend i ts
+    _            -> id
+  new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
+  space t = showString t . (\s -> if null s then "" else (' ':s))
+
+parenth :: Doc -> Doc
+parenth ss = doc (showChar '(') . ss . doc (showChar ')')
+
+concatS :: [ShowS] -> ShowS
+concatS = foldr (.) id
+
+concatD :: [Doc] -> Doc
+concatD = foldr (.) id
+
+replicateS :: Int -> ShowS -> ShowS
+replicateS n f = concatS (replicate n f)
+
+-- the printer class does the job
+class Print a where
+  prt :: Int -> a -> Doc
+  prtList :: [a] -> Doc
+  prtList = concatD . map (prt 0)
+
+instance Print a => Print [a] where
+  prt _ = prtList
+
+instance Print Char where
+  prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
+  prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
+
+mkEsc :: Char -> Char -> ShowS
+mkEsc q s = case s of
+  _ | s == q -> showChar '\\' . showChar s
+  '\\'-> showString "\\\\"
+  '\n' -> showString "\\n"
+  '\t' -> showString "\\t"
+  _ -> showChar s
+
+prPrec :: Int -> Int -> Doc -> Doc
+prPrec i j = if j<i then parenth else id
+
+
+instance Print Integer where
+  prt _ x = doc (shows x)
+
+
+instance Print Double where
+  prt _ x = doc (shows x)
+
+
+
+instance Print LString where
+  prt _ (LString i) = doc (showString i)
+
+
+instance Print PIdent where
+  prt _ (PIdent (_,i)) = doc (showString 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-2.9/GF/Source/SkelGF.hs b/src-2.9/GF/Source/SkelGF.hs
new file mode 100644
index 000000000..3bd192f9d
--- /dev/null
+++ b/src-2.9/GF/Source/SkelGF.hs
@@ -0,0 +1,364 @@
+module GF.Source.SkelGF where
+
+-- Haskell module generated by the BNF converter
+
+import GF.Source.AbsGF
+import GF.Source.ErrM
+type Result = Err String
+
+failure :: Show a => a -> Result
+failure x = Bad $ "Undefined case: " ++ show x
+
+transLString :: LString -> Result
+transLString x = case x of
+  LString str  -> failure x
+
+
+transPIdent :: PIdent -> Result
+transPIdent x = case x of
+  PIdent str  -> failure x
+
+
+transGrammar :: Grammar -> Result
+transGrammar x = case x of
+  Gr moddefs  -> failure x
+
+
+transModDef :: ModDef -> Result
+transModDef x = case x of
+  MMain pident0 pident concspecs  -> failure x
+  MModule complmod modtype modbody  -> failure x
+
+
+transConcSpec :: ConcSpec -> Result
+transConcSpec x = case x of
+  ConcSpec pident concexp  -> failure x
+
+
+transConcExp :: ConcExp -> Result
+transConcExp x = case x of
+  ConcExp pident transfers  -> failure x
+
+
+transTransfer :: Transfer -> Result
+transTransfer x = case x of
+  TransferIn open  -> failure x
+  TransferOut open  -> failure x
+
+
+transModType :: ModType -> Result
+transModType x = case x of
+  MTAbstract pident  -> failure x
+  MTResource pident  -> failure x
+  MTInterface pident  -> failure x
+  MTConcrete pident0 pident  -> failure x
+  MTInstance pident0 pident  -> failure x
+  MTTransfer pident open0 open  -> failure x
+
+
+transModBody :: ModBody -> Result
+transModBody x = case x of
+  MBody extend opens topdefs  -> failure x
+  MNoBody includeds  -> failure x
+  MWith included opens  -> failure x
+  MWithBody included opens0 opens topdefs  -> failure x
+  MWithE includeds included opens  -> failure x
+  MWithEBody includeds included opens0 opens topdefs  -> failure x
+  MReuse pident  -> failure x
+  MUnion includeds  -> failure x
+
+
+transExtend :: Extend -> Result
+transExtend x = case x of
+  Ext includeds  -> failure x
+  NoExt  -> failure x
+
+
+transOpens :: Opens -> Result
+transOpens x = case x of
+  NoOpens  -> failure x
+  OpenIn opens  -> failure x
+
+
+transOpen :: Open -> Result
+transOpen x = case x of
+  OName pident  -> failure x
+  OQualQO qualopen pident  -> failure x
+  OQual qualopen pident0 pident  -> failure x
+
+
+transComplMod :: ComplMod -> Result
+transComplMod x = case x of
+  CMCompl  -> failure x
+  CMIncompl  -> failure x
+
+
+transQualOpen :: QualOpen -> Result
+transQualOpen x = case x of
+  QOCompl  -> failure x
+  QOIncompl  -> failure x
+  QOInterface  -> failure x
+
+
+transIncluded :: Included -> Result
+transIncluded x = case x of
+  IAll pident  -> failure x
+  ISome pident pidents  -> failure x
+  IMinus pident pidents  -> failure x
+
+
+transDef :: Def -> Result
+transDef x = case x of
+  DDecl names exp  -> failure x
+  DDef names exp  -> failure x
+  DPatt name patts exp  -> failure x
+  DFull names exp0 exp  -> failure x
+
+
+transTopDef :: TopDef -> Result
+transTopDef x = case x of
+  DefCat catdefs  -> failure x
+  DefFun fundefs  -> failure x
+  DefFunData fundefs  -> failure x
+  DefDef defs  -> failure x
+  DefData datadefs  -> failure x
+  DefTrans defs  -> failure x
+  DefPar pardefs  -> failure x
+  DefOper defs  -> failure x
+  DefLincat printdefs  -> failure x
+  DefLindef defs  -> failure x
+  DefLin defs  -> failure x
+  DefPrintCat printdefs  -> failure x
+  DefPrintFun printdefs  -> failure x
+  DefFlag flagdefs  -> failure x
+  DefPrintOld printdefs  -> failure x
+  DefLintype defs  -> failure x
+  DefPattern defs  -> failure x
+  DefPackage pident topdefs  -> failure x
+  DefVars defs  -> failure x
+  DefTokenizer pident  -> failure x
+
+
+transCatDef :: CatDef -> Result
+transCatDef x = case x of
+  SimpleCatDef pident ddecls  -> failure x
+  ListCatDef pident ddecls  -> failure x
+  ListSizeCatDef pident ddecls n  -> failure x
+
+
+transFunDef :: FunDef -> Result
+transFunDef x = case x of
+  FunDef pidents exp  -> failure x
+
+
+transDataDef :: DataDef -> Result
+transDataDef x = case x of
+  DataDef pident dataconstrs  -> failure x
+
+
+transDataConstr :: DataConstr -> Result
+transDataConstr x = case x of
+  DataId pident  -> failure x
+  DataQId pident0 pident  -> failure x
+
+
+transParDef :: ParDef -> Result
+transParDef x = case x of
+  ParDefDir pident parconstrs  -> failure x
+  ParDefIndir pident0 pident  -> failure x
+  ParDefAbs pident  -> failure x
+
+
+transParConstr :: ParConstr -> Result
+transParConstr x = case x of
+  ParConstr pident ddecls  -> failure x
+
+
+transPrintDef :: PrintDef -> Result
+transPrintDef x = case x of
+  PrintDef names exp  -> failure x
+
+
+transFlagDef :: FlagDef -> Result
+transFlagDef x = case x of
+  FlagDef pident0 pident  -> failure x
+
+
+transName :: Name -> Result
+transName x = case x of
+  IdentName pident  -> failure x
+  ListName pident  -> failure x
+
+
+transLocDef :: LocDef -> Result
+transLocDef x = case x of
+  LDDecl pidents exp  -> failure x
+  LDDef pidents exp  -> failure x
+  LDFull pidents exp0 exp  -> failure x
+
+
+transExp :: Exp -> Result
+transExp x = case x of
+  EIdent pident  -> failure x
+  EConstr pident  -> failure x
+  ECons pident  -> failure x
+  ESort sort  -> failure x
+  EString str  -> failure x
+  EInt n  -> failure x
+  EFloat d  -> failure x
+  EMeta  -> failure x
+  EEmpty  -> failure x
+  EData  -> failure x
+  EList pident exps  -> failure x
+  EStrings str  -> failure x
+  ERecord locdefs  -> failure x
+  ETuple tuplecomps  -> failure x
+  EIndir pident  -> failure x
+  ETyped exp0 exp  -> failure x
+  EProj exp label  -> failure x
+  EQConstr pident0 pident  -> failure x
+  EQCons pident0 pident  -> failure x
+  EApp exp0 exp  -> failure x
+  ETable cases  -> failure x
+  ETTable exp cases  -> failure x
+  EVTable exp exps  -> failure x
+  ECase exp cases  -> failure x
+  EVariants exps  -> failure x
+  EPre exp alterns  -> failure x
+  EStrs exps  -> failure x
+  EConAt pident exp  -> failure x
+  EPatt patt  -> failure x
+  EPattType exp  -> failure x
+  ESelect exp0 exp  -> failure x
+  ETupTyp exp0 exp  -> failure x
+  EExtend exp0 exp  -> failure x
+  EGlue exp0 exp  -> failure x
+  EConcat exp0 exp  -> failure x
+  EAbstr binds exp  -> failure x
+  ECTable binds exp  -> failure x
+  EProd decl exp  -> failure x
+  ETType exp0 exp  -> failure x
+  ELet locdefs exp  -> failure x
+  ELetb locdefs exp  -> failure x
+  EWhere exp locdefs  -> failure x
+  EEqs equations  -> failure x
+  EExample exp str  -> failure x
+  ELString lstring  -> failure x
+  ELin pident  -> failure x
+
+
+transExps :: Exps -> Result
+transExps x = case x of
+  NilExp  -> failure x
+  ConsExp exp exps  -> failure x
+
+
+transPatt :: Patt -> Result
+transPatt x = case x of
+  PChar  -> failure x
+  PChars str  -> failure x
+  PMacro pident  -> failure x
+  PM pident0 pident  -> failure x
+  PW  -> failure x
+  PV pident  -> failure x
+  PCon pident  -> failure x
+  PQ pident0 pident  -> failure x
+  PInt n  -> failure x
+  PFloat d  -> failure x
+  PStr str  -> failure x
+  PR pattasss  -> failure x
+  PTup patttuplecomps  -> failure x
+  PC pident patts  -> failure x
+  PQC pident0 pident patts  -> failure x
+  PDisj patt0 patt  -> failure x
+  PSeq patt0 patt  -> failure x
+  PRep patt  -> failure x
+  PAs pident patt  -> failure x
+  PNeg patt  -> failure x
+
+
+transPattAss :: PattAss -> Result
+transPattAss x = case x of
+  PA pidents patt  -> failure x
+
+
+transLabel :: Label -> Result
+transLabel x = case x of
+  LIdent pident  -> failure x
+  LVar n  -> failure x
+
+
+transSort :: Sort -> Result
+transSort x = case x of
+  Sort_Type  -> failure x
+  Sort_PType  -> failure x
+  Sort_Tok  -> failure x
+  Sort_Str  -> failure x
+  Sort_Strs  -> failure x
+
+
+transBind :: Bind -> Result
+transBind x = case x of
+  BIdent pident  -> failure x
+  BWild  -> failure x
+
+
+transDecl :: Decl -> Result
+transDecl x = case x of
+  DDec binds exp  -> failure x
+  DExp exp  -> failure x
+
+
+transTupleComp :: TupleComp -> Result
+transTupleComp x = case x of
+  TComp exp  -> failure x
+
+
+transPattTupleComp :: PattTupleComp -> Result
+transPattTupleComp x = case x of
+  PTComp patt  -> failure x
+
+
+transCase :: Case -> Result
+transCase x = case x of
+  Case patt exp  -> failure x
+
+
+transEquation :: Equation -> Result
+transEquation x = case x of
+  Equ patts exp  -> failure x
+
+
+transAltern :: Altern -> Result
+transAltern x = case x of
+  Alt exp0 exp  -> failure x
+
+
+transDDecl :: DDecl -> Result
+transDDecl x = case x of
+  DDDec binds exp  -> failure x
+  DDExp exp  -> failure x
+
+
+transOldGrammar :: OldGrammar -> Result
+transOldGrammar x = case x of
+  OldGr include topdefs  -> failure x
+
+
+transInclude :: Include -> Result
+transInclude x = case x of
+  NoIncl  -> failure x
+  Incl filenames  -> failure x
+
+
+transFileName :: FileName -> Result
+transFileName x = case x of
+  FString str  -> failure x
+  FIdent pident  -> failure x
+  FSlash filename  -> failure x
+  FDot filename  -> failure x
+  FMinus filename  -> failure x
+  FAddId pident filename  -> failure x
+
+
+
diff --git a/src-2.9/GF/Source/SourceToGrammar.hs b/src-2.9/GF/Source/SourceToGrammar.hs
new file mode 100644
index 000000000..132bd4704
--- /dev/null
+++ b/src-2.9/GF/Source/SourceToGrammar.hs
@@ -0,0 +1,755 @@
+----------------------------------------------------------------------
+-- |
+-- 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.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)
+
+-- 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
+
+prPIdent :: PIdent -> String
+prPIdent (PIdent (_,c)) = c
+
+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)
+
+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
+      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
+        defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
+        flags'   <- return       [f | Right fs <- defs0, f <- fs]
+        return (id',GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs'))
+       MReuse _ -> do
+        return (id', GM.ModMod (GM.Module mtyp' mstat' [] [] [] emptyBinTree))
+       MUnion imps -> do
+        imps' <- mapM transIncluded imps        
+        return (id', 
+          GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' [] [] [] emptyBinTree))
+
+       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
+        defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
+        flags'   <- return       [f | Right fs <- defs0, f <- fs]
+        return (id',
+          GM.ModWith (GM.Module mtyp' mstat' flags' extends' opens' defs') 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)
+
+transAbsDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
+transAbsDef x = case x of
+  DefCat catdefs -> liftM (Left . concat) $ mapM transCatDef catdefs
+  DefFun fundefs -> do
+    fundefs' <- mapM transFunDef fundefs
+    returnl [(fun, G.AbsFun (yes typ) nope) | (funs,typ) <- fundefs', fun <- funs]
+  DefFunData fundefs -> do
+    fundefs' <- mapM transFunDef fundefs
+    returnl $
+      [(cat, G.AbsCat nope (yes [M.cn fun])) | (funs,typ) <- fundefs', 
+                                       fun <- funs, 
+                                       Ok (_,cat) <- [M.valCat typ]
+      ] ++
+      [(fun, G.AbsFun (yes typ) (yes G.EData)) | (funs,typ) <- fundefs', fun <- funs]
+  DefDef defs  -> do
+    defs' <- liftM concat $ mapM getDefsGen defs
+    returnl [(c, G.AbsFun nope pe) | (c,(_,pe)) <- defs']
+  DefData ds -> do
+    ds' <- mapM transDataDef ds
+    returnl $ 
+      [(c, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++
+      [(f, G.AbsFun nope (yes G.EData))  | (_,fs) <- ds', tf <- fs, f <- funs tf]
+  DefTrans defs  -> do
+    defs' <- liftM concat $ mapM getDefsGen defs
+    returnl [(c, G.AbsTrans f) | (c,(_,Yes f)) <- defs']
+  DefFlag defs -> liftM Right $ 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.Option
+transFlagDef x = case x of
+  FlagDef f x  -> return $ GO.Opt (prPIdent f,[prPIdent x])
+
+-- | Cat definitions can also return some fun defs
+--   if it is a list category definition
+transCatDef :: CatDef -> Err [(Ident, G.Info)]
+transCatDef x = case x of
+  SimpleCatDef id ddecls        -> do
+    id' <- transIdent id
+    liftM (:[]) $ cat id' ddecls
+  ListCatDef id ddecls          -> listCat id ddecls 0
+  ListSizeCatDef id ddecls size -> listCat id ddecls size
+ where 
+   cat i ddecls = do
+		       -- i <- transIdent id
+		       cont <- liftM concat $ mapM transDDecl ddecls
+		       return (i, G.AbsCat (yes cont) nope)
+   listCat id ddecls size = do
+         id' <- transIdent id
+	 let 
+           li = mkListId id'
+           baseId = mkBaseId id'
+           consId = mkConsId id'
+	 catd0@(c,G.AbsCat (Yes cont0) _) <- cat li ddecls
+	 let
+  	   catd = (c,G.AbsCat (Yes cont0) (Yes [M.cn baseId,M.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, G.AbsFun (yes niltyp) (yes G.EData))
+	   constyp = M.mkProdSimple (cont ++ [cd, M.mkDecl lc]) lc
+	   consfund = (consId, G.AbsFun (yes constyp) (yes G.EData))
+	 return [catd,nilfund,consfund]
+   mkId x i = if isWildIdent x then (mkIdent "x" 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, G.Info)] [GO.Option])
+transResDef x = case x of
+  DefPar pardefs -> do
+    pardefs' <- mapM transParDef pardefs
+    returnl $ [(p, G.ResParam (if null pars 
+                                  then nope -- abstract param type 
+                                  else (yes (pars,Nothing)))) 
+                                     | (p,pars) <- pardefs']
+           ++ [(f, G.ResValue (yes (M.mkProdSimple co (G.Cn p),Nothing))) |
+                     (p,pars) <- pardefs', (f,co) <- pars]
+
+{-
+  ---- encoding of AnyInd without changing syntax. AR 20/9/2007
+  DefOper [DDef [c] (EApp (EInt status) (EIdent mo))] -> do
+    c' <- transName c
+    mo' <- transIdent mo
+    return $ Left [(c',G.AnyInd (status==1) mo')]
+-}
+  DefOper defs -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    returnl $ concatMap mkOverload [(f, G.ResOper pt pe) | (f,(pt,pe)) <- defs']
+
+  DefLintype defs -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    returnl [(f, G.ResOper pt pe) | (f,(pt,pe)) <- defs']
+
+  DefFlag defs -> liftM Right $ mapM transFlagDef defs
+  _ -> Bad $ "illegal definition form in resource" +++ printTree x
+ where
+   mkOverload (c,j) = case j of
+     G.ResOper _ (Yes (G.App keyw (G.R fs@(_:_:_)))) | 
+                                          isOverloading keyw c fs -> 
+       [(c,G.ResOverload [(ty,fu) | (_,(Just ty,fu)) <- fs])]
+
+     -- to enable separare type signature --- not type-checked
+     G.ResOper (Yes (G.App keyw (G.RecType fs@(_:_:_)))) _ | 
+                                          isOverloading keyw c fs -> []
+     _ -> [(c,j)]
+   isOverloading keyw c fs = 
+     GP.prt keyw == "overload" &&       -- overload is a "soft keyword"
+     all (== GP.prt c) (map (GP.prt . fst) fs)
+
+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, G.Info)] [GO.Option])
+transCncDef x = case x of
+  DefLincat defs  -> do
+    defs' <- liftM concat $ mapM transPrintDef defs
+    returnl [(f, G.CncCat (yes t) nope nope) | (f,t) <- defs']
+  DefLindef defs  -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    returnl [(f, G.CncCat pt pe nope) | (f,(pt,pe)) <- defs']
+  DefLin defs  -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    returnl [(f, G.CncFun Nothing pe nope) | (f,(_,pe)) <- defs']
+  DefPrintCat defs -> do
+    defs' <- liftM concat $ mapM transPrintDef defs
+    returnl [(f, G.CncCat nope nope (yes e)) | (f,e) <- defs']    
+  DefPrintFun defs -> do
+    defs' <- liftM concat $ mapM transPrintDef defs
+    returnl [(f, 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, G.CncFun Nothing nope (yes e)) | (f,e) <- defs']    
+  DefFlag defs -> liftM Right $ mapM transFlagDef defs
+  DefPattern defs  -> do
+    defs' <- liftM concat $ mapM getDefs defs
+    let defs2 = [(f, termInPattern t) | (f,(_,Yes t)) <- defs']
+    returnl [(f, G.CncFun Nothing (yes t) nope) | (f,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, (G.Perh G.Type, G.Perh G.Term))]
+getDefsGen d = case d of
+  DDecl ids t -> do
+    ids' <- mapM transName ids
+    t'   <- transExp t
+    return [(i,(yes t', nope)) | i <- ids']
+  DDef ids e -> do
+    ids' <- mapM transName ids
+    e'   <- transExp e
+    return [(i,(nope, yes e')) | i <- ids']
+  DFull ids t e -> do
+    ids' <- mapM transName ids
+    t'   <- transExp t
+    e'   <- transExp e
+    return [(i,(yes t', yes e')) | i <- ids']
+  DPatt id patts e  -> do
+    id' <- transName 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, (G.Perh G.Type, G.Perh G.Term))]
+getDefs d = case d of
+  DPatt id patts e  -> do
+    id' <- transName 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    -> liftM G.Sort $ transSort sort
+  EInt n        -> return $ G.EInt n
+  EFloat n      -> return $ G.EFloat n
+  EMeta         -> return $ M.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 str 
+  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 (M.ident2label lab,ty)
+    _ -> Bad $ "illegal record type field" +++ GP.prt (fst f) --- manifest fields ?!
+  tryR f = case f of
+    (lab,(mty, Just t)) -> return (M.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
+
+  -- this case is for bward compatibility and should be removed
+  LIdent (PIdent (_,'v':ds@(_:_))) | all isDigit ds -> return $ G.LVar $ readIntArg ds 
+  
+  LIdent (PIdent (_, s)) -> return $ G.LIdent s
+  LVar x   -> return $ G.LVar $ fromInteger x
+
+transSort :: Sort -> Err String
+transSort x = case x of
+  _ -> return $ printTree x
+
+{-
+--- 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 three 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,mkRes ops r,mkCnc ops c] ++ map mkPack ps
+     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)
+     _ -> (a,r,c,ps)
+   mkAbs a = MModule q (MTAbstract absName) (MBody ne (OpenIn [])  (topDefs a))
+   mkRes ps r = MModule q (MTResource resName) (MBody ne (OpenIn ops) (topDefs r))
+                  where ops = map OName ps
+   mkCnc ps r = MModule q (MTConcrete cncName absName) 
+                               (MBody ne (OpenIn (map OName (resName:ps))) (topDefs r))
+   mkPack (m, ds) = MModule q (MTResource m) (MBody ne  (OpenIn []) (topDefs ds))
+   topDefs t = t
+   ne = NoExt
+   q = CMCompl
+
+   name = maybe name0 (++ ".gf") $ getOptVal opts useName
+   absName = identPI $ maybe topic id $ getOptVal opts useAbsName
+   resName = identPI $ maybe ("Res" ++ lang) id $ getOptVal opts useResName
+   cncName = identPI $ maybe lang id $ getOptVal opts useCncName
+
+   identPI s = PIdent ((0,0),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 = case x of
+  NoIncl -> return []
+  Incl filenames  -> return $ map trans filenames
+ where
+   trans f = case f of
+     FString s  -> s
+     FIdent (PIdent (_, s)) -> modif s
+     FSlash filename  -> '/' : trans filename
+     FDot filename  -> '.' : trans filename
+     FMinus filename  -> '-' : trans filename
+     FAddId (PIdent (_, s)) filename  -> modif s ++ trans filename
+   modif s = let s' = init s ++ [toLower (last s)] in 
+             if elem s' newReservedWords then s' else s 
+                      --- unsafe hack ; cf. GetGrammar.oldLexer
+
+
+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 "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 "List"
+mkConsId = prefixId "Cons"
+mkBaseId = prefixId "Base"
+
+prefixId :: String -> Ident -> Ident
+prefixId pref id = IC (pref ++ prIdent id)
diff --git a/src-2.9/GF/Source/TestGF.hs b/src-2.9/GF/Source/TestGF.hs
new file mode 100644
index 000000000..e4c072467
--- /dev/null
+++ b/src-2.9/GF/Source/TestGF.hs
@@ -0,0 +1,58 @@
+-- automatically generated by BNF Converter
+module Main where
+
+
+import IO ( stdin, hGetContents )
+import System ( getArgs, getProgName )
+
+import GF.Source.LexGF
+import GF.Source.ParGF
+import GF.Source.SkelGF
+import GF.Source.PrintGF
+import GF.Source.AbsGF
+
+
+
+
+import GF.Source.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-2.9/GF/Speech/CFGToFiniteState.hs b/src-2.9/GF/Speech/CFGToFiniteState.hs
new file mode 100644
index 000000000..7e6f80ba1
--- /dev/null
+++ b/src-2.9/GF/Speech/CFGToFiniteState.hs
@@ -0,0 +1,265 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : CFGToFiniteState
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/10 16:43:44 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- Approximates CFGs with finite state networks.
+-----------------------------------------------------------------------------
+
+module GF.Speech.CFGToFiniteState (cfgToFA, makeSimpleRegular,
+                                   MFA(..), MFALabel, 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 GF.Data.Utilities
+import GF.Formalism.CFG 
+import GF.Formalism.Utilities (Symbol(..), mapSymbol, filterCats, symbol, NameProfile(..))
+import GF.Conversion.Types
+import GF.Infra.Ident (Ident)
+import GF.Infra.Option (Options)
+import GF.Compile.ShellState (StateGrammar)
+
+import GF.Speech.FiniteState
+import GF.Speech.Graph
+import GF.Speech.Relation
+import GF.Speech.TransformCFG
+
+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
+--
+
+type MFALabel a = Symbol String a    
+
+data MFA a = MFA String [(String,DFA (MFALabel a))]
+
+
+
+cfgToFA :: Options -> StateGrammar -> DFA Token
+cfgToFA opts s = minimize $ compileAutomaton start $ makeSimpleRegular opts s
+  where start = getStartCatCF opts s
+
+makeSimpleRegular :: Options -> StateGrammar -> CFRules
+makeSimpleRegular opts s = makeRegular $ preprocess $ cfgToCFRules s
+  where start = getStartCatCF opts s
+        preprocess = topDownFilter start . bottomUpFilter
+                     . removeCycles
+
+
+--
+-- * Compile strongly regular grammars to NFAs
+--
+
+-- Convert a strongly regular grammar to a finite automaton.
+compileAutomaton :: Cat_ -- ^ Start category
+                 -> CFRules
+                 -> NFA Token
+compileAutomaton start g = make_fa (g,ns) s [Cat start] 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 :: (CFRules,MutRecSets) -> State -> [Symbol Cat_ Token] -> State 
+          -> NFA Token -> NFA Token
+make_fa c@(g,ns) q0 alpha q1 fa = 
+   case alpha of
+        []       -> newTransition q0 q1 Nothing fa
+        [Tok t]  -> newTransition q0 q1 (Just t) fa
+        [Cat a]  -> case Map.lookup a ns of
+                        -- a is recursive
+                        Just n@(MutRecSet { mrCats = ni, mrNonRecRules = nrs, mrRecRules = rs} ) -> 
+                              case mrRec n of
+                               RightR ->
+                                -- the set Ni is right-recursive or cyclic
+                                let new = [(getState c, xs, q1) | CFRule c xs _ <- nrs]
+                                          ++ [(getState c, xs, getState d) | CFRule c ss _ <- rs, 
+                                                                             let (xs,Cat d) = (init ss,last ss)]
+                                 in make_fas new $ newTransition q0 (getState a) Nothing fa'
+                               LeftR ->
+                                -- the set Ni is left-recursive
+                                let new = [(q0, xs, getState c) | CFRule c xs _ <- nrs]
+                                          ++ [(getState d, xs, getState c) | CFRule c (Cat 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 :: Options -> StateGrammar -> MFA Token
+cfgToMFA opts s = buildMFA start $ makeSimpleRegular opts s
+  where start = getStartCatCF opts s
+
+-- | Build a DFA by building and expanding an MFA
+cfgToFA' :: Options -> StateGrammar -> DFA Token
+cfgToFA' opts s = mfaToDFA $ cfgToMFA opts s
+
+buildMFA :: Cat_ -- ^ Start category
+         -> CFRules -> MFA Token
+buildMFA start g = sortSubLats $ removeUnusedSubLats mfa
+  where fas = compileAutomata g
+        mfa = MFA start [(c, minimize fa) | (c,fa) <- fas]
+
+mfaStartDFA :: MFA a -> DFA (MFALabel a)
+mfaStartDFA (MFA start subs) = 
+    fromMaybe (error $ "Bad start MFA: " ++ start) $ lookup start subs
+
+mfaToDFA :: Ord a => MFA a -> DFA a
+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 (Tok s) -> newTransition f t (Just s) fa
+             Just (Cat l) -> insertNFA fa (f,t) (expand $ getSub l)
+
+removeUnusedSubLats :: MFA a -> MFA a
+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 a -> Map String (Set String)
+subLatUseMap (MFA _ subs) = Map.fromList [(c,usedSubLats n) | (c,n) <- subs]
+
+usedSubLats :: DFA (MFALabel a) -> Set String
+usedSubLats fa = Set.fromList [s | (_,_,Cat s) <- transitions fa]
+
+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]
+
+-- | Sort sub-networks topologically.
+sortSubLats :: MFA a -> MFA a
+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 :: CFRules
+                 -> [(Cat_,NFA (Symbol Cat_ Token))]
+                    -- ^ 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 [Cat 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
+         -> [Symbol Cat_ Token] -- ^ Symbols to accept
+         -> State     -- ^ State to end up in
+         -> NFA (Symbol Cat_ Token) -- ^ FA to add to.
+         -> NFA (Symbol Cat_ Token)
+make_fa1 mr q0 alpha q1 fa = 
+   case alpha of
+        []        -> newTransition q0 q1 Nothing fa
+        [t@(Tok _)] -> newTransition q0 q1 (Just t) fa
+        [c@(Cat a)] | not (a `Set.member` mrCats mr) -> newTransition q0 q1 (Just c) fa
+        [Cat 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,Cat 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 (Cat 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 :: CFRules -> [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))
diff --git a/src-2.9/GF/Speech/FiniteState.hs b/src-2.9/GF/Speech/FiniteState.hs
new file mode 100644
index 000000000..35274e3c4
--- /dev/null
+++ b/src-2.9/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.Visualization.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-2.9/GF/Speech/GrammarToVoiceXML.hs b/src-2.9/GF/Speech/GrammarToVoiceXML.hs
new file mode 100644
index 000000000..ad7f25d1c
--- /dev/null
+++ b/src-2.9/GF/Speech/GrammarToVoiceXML.hs
@@ -0,0 +1,285 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GrammarToVoiceXML
+-- Maintainer  : Bjorn Bringert
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- Create VoiceXML dialogue system from a GF grammar.
+-----------------------------------------------------------------------------
+
+module GF.Speech.GrammarToVoiceXML (grammar2vxml) where
+
+import GF.Canon.CanonToGFCC (canon2gfcc)
+import qualified GF.GFCC.CId as C
+import GF.GFCC.DataGFCC (GFCC(..), Abstr(..))
+import GF.GFCC.Macros
+import qualified GF.Canon.GFC as GFC
+import GF.Canon.AbsGFC (Term)
+import GF.Canon.PrintGFC (printTree)
+import GF.Canon.CMacros (noMark, strsFromTerm)
+import GF.Canon.Unlex (formatAsText)
+import GF.Data.Utilities
+import GF.CF.CFIdent (cfCat2Ident)
+import GF.Compile.ShellState (StateGrammar,stateGrammarST,cncId,grammar,
+                              startCatStateOpts,stateOptions)
+import GF.Data.Str (sstrV)
+import GF.Grammar.Macros hiding (assign,strsFromTerm)
+import GF.Grammar.Grammar (Fun)
+import GF.Grammar.Values (Tree)
+import GF.Infra.Option (Options, addOptions, getOptVal, speechLanguage)
+import GF.UseGrammar.GetTree (string2treeErr)
+import GF.UseGrammar.Linear (linTree2strings)
+
+import GF.Infra.Ident
+import GF.Infra.Option (noOptions)
+import GF.Infra.Modules
+import GF.Data.Operations
+
+import GF.Data.XML
+
+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 :: Options -> StateGrammar -> String
+grammar2vxml opt s = showsXMLDoc (skel2vxml name language startcat gr' qs) ""
+    where (_, gr') = vSkeleton (stateGrammarST s)
+          name = prIdent (cncId s)
+          qs = catQuestions s (map fst gr')
+          opts = addOptions opt (stateOptions s)
+          language = fmap (replace '_' '-') $ getOptVal opts speechLanguage
+          startcat = C.CId $ prIdent $ cfCat2Ident $ startCatStateOpts opts s
+
+--
+-- * VSkeleton: a simple description of the abstract syntax.
+--
+
+type VSkeleton = [(VIdent, [(VIdent, [VIdent])])]
+type VIdent = C.CId
+
+prid :: VIdent -> String
+prid (C.CId x) = x
+
+vSkeleton :: GFC.CanonGrammar -> (VIdent,VSkeleton)
+vSkeleton = gfccSkeleton . canon2gfcc noOptions
+
+gfccSkeleton :: GFCC -> (VIdent,VSkeleton)
+gfccSkeleton gfcc = (absname gfcc, ts)
+  where a = abstract gfcc
+        ts = [(c,[(f,ft f) | f <- fs]) | (c,fs) <- Map.toList (catfuns a)]
+        ft f = case lookMap (error $ prid f) f (funs a) of
+                 (ty,_) -> fst $ GF.GFCC.Macros.catSkeleton ty
+
+--
+-- * Questions to ask 
+--
+
+type CatQuestions = [(VIdent,String)]
+
+catQuestions :: StateGrammar -> [VIdent] -> CatQuestions
+catQuestions gr cats = [(c,catQuestion gr c) | c <- cats]
+
+catQuestion :: StateGrammar -> VIdent -> String
+catQuestion gr cat = err errHandler id (getPrintname gr cat >>= term2string)
+  where -- FIXME: use some better warning facility
+        errHandler e = trace ("GrammarToVoiceXML: " ++ e) ("quest_"++prid cat)
+        term2string = liftM sstrV . strsFromTerm
+
+getPrintname :: StateGrammar -> VIdent -> Err Term
+getPrintname gr cat = 
+    do m <- lookupModMod (grammar gr) (cncId gr)
+       i <- lookupInfo m (IC (prid cat))
+       case i of
+         GFC.CncCat _ _ p -> return p
+         _ -> fail $ "getPrintname " ++ prid cat
+                      ++ ": Expected CncCat, got " ++ show i
+
+
+{-
+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 :: VIdent -> CatQuestions -> String
+getCatQuestion c qs = 
+    fromMaybe (error "No question for category " ++ prid c) (lookup c qs)
+
+--
+-- * Generate VoiceXML
+--
+
+skel2vxml :: String -> Maybe String -> VIdent -> VSkeleton -> 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 -> VIdent -> [(VIdent, [VIdent])] -> [XML]
+catForms gr qs cat fs = 
+    comments [prid cat ++ " category."]
+    ++ [cat2form gr qs cat fs] 
+
+cat2form :: String -> CatQuestions -> VIdent -> [(VIdent, [VIdent])] -> 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 -> VIdent -> VIdent -> [VIdent] -> [XML]
+fun2sub gr cat fun args = 
+    comments [prid fun ++ " : (" 
+              ++ concat (intersperse ", " (map prid args))
+              ++ ") " ++ prid cat] ++ ss
+  where 
+  ss = zipWith mkSub [0..] args
+  mkSub n t = subdialog s [("src","#"++catFormId t),
+                           ("cond","term.name == "++string (prid fun))] 
+              [param "old" v,
+               filled [] [assign v (s++".term")]]
+    where s = prid fun ++ "_" ++ show n
+          v = "term.args["++show n++"]"
+
+catFormId :: VIdent -> String
+catFormId c = prid 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 :: (VIdent, [(VIdent, [VIdent])]) -> 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 :: VIdent -> Bool
+isBaseFun f = "Base" `isPrefixOf` prIdent f
+
+isConsFun :: VIdent -> Bool
+isConsFun f = "Cons" `isPrefixOf` prIdent f
+
+baseSize :: (VIdent, [(VIdent, [VIdent])]) -> Int
+baseSize (_,rules) = length bs
+    where Just (_,bs) = find (isBaseFun . fst) rules
+-}
diff --git a/src-2.9/GF/Speech/Graph.hs b/src-2.9/GF/Speech/Graph.hs
new file mode 100644
index 000000000..1a0ebe0c0
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Speech/PrFA.hs b/src-2.9/GF/Speech/PrFA.hs
new file mode 100644
index 000000000..2856039ec
--- /dev/null
+++ b/src-2.9/GF/Speech/PrFA.hs
@@ -0,0 +1,56 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrSLF
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/10 16:43:44 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- This module prints finite automata and regular grammars 
+-- for a context-free grammar.
+--
+-- FIXME: remove \/ warn \/ fail if there are int \/ string literal
+-- categories in the grammar
+-----------------------------------------------------------------------------
+
+module GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter) where
+
+import GF.Data.Utilities
+import GF.Conversion.Types
+import GF.Formalism.CFG
+import GF.Formalism.Utilities (Symbol(..),symbol)
+import GF.Infra.Ident
+import GF.Infra.Option (Options)
+import GF.Infra.Print
+import GF.Speech.CFGToFiniteState
+import GF.Speech.FiniteState
+import GF.Speech.TransformCFG
+import GF.Compile.ShellState (StateGrammar)
+
+import Data.Char (toUpper,toLower)
+import Data.List
+import Data.Maybe (fromMaybe)
+
+
+
+faGraphvizPrinter :: Options -> StateGrammar -> String
+faGraphvizPrinter opts s = 
+    prFAGraphviz $ mapStates (const "") $ cfgToFA opts s
+
+-- | Convert the grammar to a regular grammar and print it in BNF
+regularPrinter :: Options -> StateGrammar -> String
+regularPrinter opts s = prCFRules $ makeSimpleRegular opts s
+  where
+  prCFRules :: CFRules -> String
+  prCFRules g = unlines [ c ++ " ::= " ++ join " | " (map (showRhs . ruleRhs) rs) | (c,rs) <- allRulesGrouped g]
+  join g = concat . intersperse g
+  showRhs = unwords . map (symbol id show)
+
+faCPrinter :: Options -> StateGrammar -> String
+faCPrinter opts s = fa2c $ cfgToFA opts s
+
+fa2c :: DFA String -> String
+fa2c fa = undefined
diff --git a/src-2.9/GF/Speech/PrGSL.hs b/src-2.9/GF/Speech/PrGSL.hs
new file mode 100644
index 000000000..248991380
--- /dev/null
+++ b/src-2.9/GF/Speech/PrGSL.hs
@@ -0,0 +1,113 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrGSL
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/01 20:09:04 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.22 $
+--
+-- This module prints a CFG as a Nuance GSL 2.0 grammar.
+--
+-- FIXME: remove \/ warn \/ fail if there are int \/ string literal
+-- categories in the grammar
+-----------------------------------------------------------------------------
+
+module GF.Speech.PrGSL (gslPrinter) where
+
+import GF.Data.Utilities
+import GF.Speech.SRG
+import GF.Speech.RegExp
+import GF.Infra.Ident
+
+import GF.Formalism.CFG
+import GF.Formalism.Utilities (Symbol(..))
+import GF.Conversion.Types
+import GF.Infra.Print
+import GF.Infra.Option
+import GF.Probabilistic.Probabilistic (Probs)
+import GF.Compile.ShellState (StateGrammar)
+
+import Data.Char (toUpper,toLower)
+import Data.List (partition)
+import Text.PrettyPrint.HughesPJ
+
+width :: Int
+width = 75
+
+gslPrinter :: Options -> StateGrammar -> String
+gslPrinter opts s = renderStyle st $ prGSL $ makeSimpleSRG opts s
+  where st = style { lineLength = width } 
+
+prGSL :: SRG -> Doc
+prGSL (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
+    = header $++$ mainCat $++$ foldr ($++$) empty (map prRule rs)
+    where
+    header = text ";GSL2.0" $$
+	     comment ("Nuance speech recognition grammar for " ++ name) $$
+             comment ("Generated by GF") 
+    mainCat = comment ("Start category: " ++ origStart) $$
+	      text ".MAIN" <+> prCat start
+    prRule (SRGRule cat origCat rhs) = 
+	comment (prt origCat) $$ 
+        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 (Cat (c,_)) = prCat c
+prSymbol (Tok t) = doubleQuotes (showToken t)
+
+-- GSL requires an upper case letter in category names
+prCat :: SRGCat -> Doc
+prCat c = text (firstToUpper c)
+
+
+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 t = text (map toLower (prt t))
+
+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-2.9/GF/Speech/PrJSGF.hs b/src-2.9/GF/Speech/PrJSGF.hs
new file mode 100644
index 000000000..037a4f4e2
--- /dev/null
+++ b/src-2.9/GF/Speech/PrJSGF.hs
@@ -0,0 +1,145 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrJSGF
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/01 20:09:04 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.16 $
+--
+-- 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.PrJSGF (jsgfPrinter) where
+
+import GF.Conversion.Types
+import GF.Data.Utilities
+import GF.Formalism.CFG
+import GF.Formalism.Utilities (Symbol(..), NameProfile(..), Profile(..), filterCats)
+import GF.Infra.Ident
+import GF.Infra.Print
+import GF.Infra.Option
+import GF.Probabilistic.Probabilistic (Probs)
+import GF.Speech.SISR
+import GF.Speech.SRG
+import GF.Speech.RegExp
+import GF.Compile.ShellState (StateGrammar)
+
+import Data.Char
+import Data.List
+import Data.Maybe
+import Text.PrettyPrint.HughesPJ
+import Debug.Trace
+
+width :: Int
+width = 75
+
+jsgfPrinter :: Maybe SISRFormat
+	    -> Options 
+            -> StateGrammar -> String
+jsgfPrinter sisr opts s = renderStyle st $ prJSGF sisr $ makeSimpleSRG opts s
+  where st = style { lineLength = width }
+
+prJSGF :: Maybe SISRFormat -> SRG -> Doc
+prJSGF sisr srg@(SRG{grammarName=name,grammarLanguage=ml,
+                     startCat=start,origStartCat=origStart,rules=rs})
+    = header $++$ mainCat $++$ vcat topCatRules $++$ foldr ($++$) empty (map prRule rs)
+    where
+    header = text "#JSGF" <+> text "V1.0" <+> text "UTF-8" <+> lang <> char ';' $$
+             comment ("JSGF speech recognition grammar for " ++ name) $$
+             comment "Generated by GF" $$
+	     text ("grammar " ++ name ++ ";") 
+    lang = maybe empty text ml
+    mainCat = comment ("Start category: " ++ origStart) $$
+              case cfgCatToGFCat origStart of
+                Just c  -> rule True "MAIN" [prCat (catFormId c)]
+                Nothing -> empty
+    prRule (SRGRule cat origCat rhs) = 
+	comment origCat $$
+        rule False cat (map prAlt rhs)
+--        rule False cat (map prAlt rhs)
+    -- FIXME: use the probability
+    prAlt (SRGAlt mp n rhs) = sep [initTag, p (prItem sisr n rhs), finalTag]
+--    prAlt (SRGAlt mp n rhs) = initTag <+> 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
+
+    topCatRules = [rule True (catFormId tc) (map (it tc) cs) | (tc,cs) <- srgTopCats srg]
+        where it i c = prCat c <+> tag sisr (topCatSISR c)
+
+catFormId :: String -> String
+catFormId = (++ "_cat")
+
+prCat :: SRGCat -> 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
+
+{-
+prItem :: Maybe SISRFormat -> CFTerm -> [Symbol SRGNT Token] -> Doc
+prItem _ _ [] = text "<NULL>"
+prItem sisr cn ss = paren $ hsep $ map (prSymbol sisr cn) ss
+  where paren = if length ss == 1 then id else parens
+-}
+
+prSymbol :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> Doc
+prSymbol sisr cn (Cat n@(c,_)) = prCat c <+> tag sisr (catSISR cn n)
+prSymbol _ cn (Tok t) | all isPunct (prt t) = empty  -- removes punctuation
+                      | otherwise = text (prt 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 -> SRGCat -> [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-2.9/GF/Speech/PrRegExp.hs b/src-2.9/GF/Speech/PrRegExp.hs
new file mode 100644
index 000000000..55a25d69b
--- /dev/null
+++ b/src-2.9/GF/Speech/PrRegExp.hs
@@ -0,0 +1,33 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrSLF
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- This module prints a grammar as a regular expression.
+-----------------------------------------------------------------------------
+
+module GF.Speech.PrRegExp (regexpPrinter,multiRegexpPrinter) where
+
+import GF.Conversion.Types
+import GF.Formalism.Utilities
+import GF.Infra.Ident
+import GF.Infra.Option (Options)
+import GF.Speech.CFGToFiniteState
+import GF.Speech.RegExp
+import GF.Compile.ShellState (StateGrammar)
+
+
+regexpPrinter :: Options -> StateGrammar -> String
+regexpPrinter opts s = (++"\n") $ prRE $ dfa2re $ cfgToFA opts s
+
+multiRegexpPrinter :: Options -> StateGrammar -> String
+multiRegexpPrinter opts s = prREs $ mfa2res $ cfgToMFA opts s
+
+prREs :: [(String,RE (MFALabel String))] -> String
+prREs res = unlines [l ++ " = " ++ prRE (mapRE showLabel re) | (l,re) <- res]
+  where showLabel = symbol (\l -> "<" ++ l ++ ">") id
+
+mfa2res :: MFA String -> [(String,RE (MFALabel String))]
+mfa2res (MFA _ dfas) = [(l, minimizeRE (dfa2re dfa)) | (l,dfa) <- dfas]
diff --git a/src-2.9/GF/Speech/PrSLF.hs b/src-2.9/GF/Speech/PrSLF.hs
new file mode 100644
index 000000000..9bc025558
--- /dev/null
+++ b/src-2.9/GF/Speech/PrSLF.hs
@@ -0,0 +1,190 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrSLF
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/10 16:43:44 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.12 $
+--
+-- 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.
+--
+-- FIXME: remove \/ warn \/ fail if there are int \/ string literal
+-- categories in the grammar
+-----------------------------------------------------------------------------
+
+module GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter,
+                        slfSubPrinter,slfSubGraphvizPrinter) where
+
+import GF.Data.Utilities
+import GF.Conversion.Types
+import GF.Formalism.CFG
+import GF.Formalism.Utilities (Symbol(..),symbol,mapSymbol)
+import GF.Infra.Ident
+import GF.Infra.Option (Options)
+import GF.Infra.Print
+import GF.Speech.CFGToFiniteState
+import GF.Speech.FiniteState
+import GF.Speech.TransformCFG
+import qualified GF.Visualization.Graphviz as Dot
+import GF.Compile.ShellState (StateGrammar)
+
+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 (MFALabel String)) ()
+
+mkFAs :: Options -> StateGrammar -> (SLF_FA, [(String,SLF_FA)])
+mkFAs opts s = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
+  where MFA start subs = {- renameSubs $ -} cfgToMFA opts s
+        main = let (fa,s,f) = newFA_ in newTransition s f (Cat 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 String -> MFA String
+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 :: Options -> StateGrammar -> String
+slfGraphvizPrinter opts s
+    = prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' opts s
+  where 
+  gvFA = mapStates (fromMaybe "") . mapTransitions (const "")
+
+--
+-- * SLF graphviz printing (with sub-networks)
+--
+
+slfSubGraphvizPrinter :: Options -> StateGrammar -> String
+slfSubGraphvizPrinter opts s = Dot.prGraphviz g
+  where (main, subs) = mkFAs opts s
+        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 :: Options -> StateGrammar -> String
+slfPrinter opts s 
+    = prSLF $ automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' opts s
+
+--
+-- * SLF printing (with sub-networks)
+--
+
+-- | Make a network with subnetworks in SLF
+slfSubPrinter :: Options -> StateGrammar -> String
+slfSubPrinter opts s = prSLFs slfs
+  where 
+  (main,subs) = mkFAs opts s
+  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 (MFALabel String) -> SLFNode
+mfaNodeToSLFNode i l = case l of
+                              Nothing -> mkSLFNode i Nothing
+                              Just (Tok x) -> mkSLFNode i (Just x)
+                              Just (Cat 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-2.9/GF/Speech/PrSRGS.hs b/src-2.9/GF/Speech/PrSRGS.hs
new file mode 100644
index 000000000..d8ae07867
--- /dev/null
+++ b/src-2.9/GF/Speech/PrSRGS.hs
@@ -0,0 +1,153 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrSRGS
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- This module prints a CFG as an SRGS XML grammar.
+--
+-- FIXME: remove \/ warn \/ fail if there are int \/ string literal
+-- categories in the grammar
+-----------------------------------------------------------------------------
+
+module GF.Speech.PrSRGS (srgsXmlPrinter, srgsXmlNonRecursivePrinter) where
+
+import GF.Data.Utilities
+import GF.Data.XML
+import GF.Speech.RegExp
+import GF.Speech.SISR as SISR
+import GF.Speech.SRG
+import GF.Infra.Ident
+import GF.Today
+
+import GF.Formalism.CFG
+import GF.Formalism.Utilities (Symbol(..), NameProfile(..), Profile(..), forestName, filterCats)
+import GF.Conversion.Types
+import GF.Infra.Print
+import GF.Infra.Option
+import GF.Probabilistic.Probabilistic (Probs)
+import GF.Compile.ShellState (StateGrammar)
+
+import Data.Char (toUpper,toLower)
+import Data.List
+import Data.Maybe
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+srgsXmlPrinter :: Maybe SISRFormat 
+	       -> Bool -- ^ Include probabilities
+	       -> Options 
+               -> StateGrammar -> String
+srgsXmlPrinter sisr probs opts s = prSrgsXml sisr probs $ makeSimpleSRG opts s
+
+srgsXmlNonRecursivePrinter :: Options -> StateGrammar -> String
+srgsXmlNonRecursivePrinter opts s = prSrgsXml Nothing False $ makeNonRecursiveSRG opts s
+
+
+prSrgsXml :: Maybe SISRFormat -> Bool -> SRG -> String
+prSrgsXml sisr probs srg@(SRG{grammarName=name,startCat=start,
+                        origStartCat=origStart,grammarLanguage=l,rules=rs})
+    = showXMLDoc (optimizeSRGS xmlGr)
+    where
+    Just root = cfgCatToGFCat origStart 
+    xmlGr = grammar sisr (catFormId root) l $
+              [meta "description" 
+               ("SRGS XML speech recognition grammar for " ++ name
+                ++ ". " ++ "Original start category: " ++ origStart),
+               meta "generator" ("Grammatical Framework " ++ version)]
+            ++ topCatRules
+	    ++ concatMap ruleToXML rs
+    ruleToXML (SRGRule cat origCat alts) = 
+        comments ["Category " ++ origCat] ++ [rule cat (prRhs alts)]
+    prRhs rhss = [oneOf (map (mkProd sisr probs) rhss)] 
+    -- externally visible rules for each of the GF categories
+    topCatRules = [topRule tc [oneOf (map (it tc) cs)] | (tc,cs) <- srgTopCats srg]
+        where it i c = Tag "item" [] ([ETag "ruleref" [("uri","#" ++ c)]] 
+                                      ++ tag sisr (topCatSISR c))
+              topRule i is = Tag "rule" [("id",catFormId i),("scope","public")] is
+
+rule :: String -> [XML] -> XML
+rule i = Tag "rule" [("id",i)]
+
+mkProd :: Maybe SISRFormat -> Bool -> SRGAlt -> XML
+mkProd sisr probs (SRGAlt mp n rhs) = Tag "item" w (ti ++ [x] ++ tf)
+  where x = mkItem sisr n rhs
+        w | probs = maybe [] (\p -> [("weight", show p)]) mp
+          | otherwise = []
+        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
+
+{-
+mkProd :: Maybe SISRFormat -> Bool -> SRGAlt -> XML
+mkProd sisr probs (SRGAlt mp n rhs) = Tag "item" w (ti ++ xs ++ tf)
+  where xs = mkItem sisr n rhs
+        w | probs = maybe [] (\p -> [("weight", show p)]) mp
+          | otherwise = []
+        ti = [tag sisr (profileInitSISR n)]
+        tf = [tag sisr (profileFinalSISR n)]
+
+
+mkItem :: Maybe SISRFormat -> CFTerm -> [Symbol SRGNT Token] -> [XML]
+mkItem sisr cn ss = map (symItem sisr cn) ss
+-}
+
+symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML
+symItem sisr cn (Cat n@(c,_)) = 
+    Tag "item" [] $ [ETag "ruleref" [("uri","#" ++ c)]] ++ tag sisr (catSISR cn n)
+symItem _ _ (Tok 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)]]
+
+catFormId :: String -> String
+catFormId = (++ "_cat")
+
+
+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-2.9/GF/Speech/PrSRGS_ABNF.hs b/src-2.9/GF/Speech/PrSRGS_ABNF.hs
new file mode 100644
index 000000000..abb84c5dc
--- /dev/null
+++ b/src-2.9/GF/Speech/PrSRGS_ABNF.hs
@@ -0,0 +1,147 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : PrJSRGS_ABNF
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/01 20:09:04 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.16 $
+--
+-- 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.PrSRGS_ABNF (srgsAbnfPrinter, srgsAbnfNonRecursivePrinter) where
+
+import GF.Conversion.Types
+import GF.Data.Utilities
+import GF.Formalism.CFG
+import GF.Formalism.Utilities (Symbol(..), NameProfile(..), Profile(..), filterCats)
+import GF.Infra.Ident
+import GF.Infra.Print
+import GF.Infra.Option
+import GF.Probabilistic.Probabilistic (Probs)
+import GF.Speech.SISR
+import GF.Speech.SRG
+import GF.Speech.RegExp
+import GF.Compile.ShellState (StateGrammar)
+import GF.Today
+
+import Data.Char
+import Data.List
+import Data.Maybe
+import Text.PrettyPrint.HughesPJ
+import Debug.Trace
+
+width :: Int
+width = 75
+
+srgsAbnfPrinter :: Maybe SISRFormat
+                -> Bool -- ^ Include probabilities
+	        -> Options 
+                -> StateGrammar -> String
+srgsAbnfPrinter sisr probs opts s = showDoc $ prABNF sisr probs $ makeSimpleSRG opts s
+
+srgsAbnfNonRecursivePrinter :: Options -> StateGrammar -> String
+srgsAbnfNonRecursivePrinter opts s = showDoc $ prABNF Nothing False $ makeNonRecursiveSRG opts s
+
+showDoc = renderStyle (style { lineLength = width })
+
+prABNF :: Maybe SISRFormat -> Bool -> SRG -> Doc
+prABNF sisr probs srg@(SRG{grammarName=name,grammarLanguage=ml,
+                     startCat=start,origStartCat=origStart,rules=rs})
+    = header $++$ vcat topCatRules $++$ foldr ($++$) empty (map prRule rs)
+    where
+    header = text "#ABNF 1.0 UTF-8;" $$
+             meta "description" 
+               ("Speech recognition grammar for " ++ name
+                ++ ". " ++ "Original start category: " ++ origStart) $$
+             meta "generator" ("Grammatical Framework " ++ version) $$
+             language $$ tagFormat $$ mainCat
+    language = maybe empty (\l -> text "language" <+> text l <> char ';') ml
+    tagFormat | isJust sisr = text "tag-format" <+> text "<semantics/1.0>" <> char ';'
+              | otherwise = empty
+    mainCat = case cfgCatToGFCat origStart of
+                Just c  -> text "root" <+> prCat (catFormId c) <> char ';'
+                Nothing -> empty
+    prRule (SRGRule cat origCat rhs) = 
+	comment origCat $$
+        rule False cat (map prAlt rhs)
+    -- FIXME: use the probability
+    prAlt (SRGAlt mp n rhs) = sep [initTag, p (prItem sisr n rhs), finalTag]
+      where initTag = tag sisr (profileInitSISR n)
+            finalTag = tag sisr (profileFinalSISR n)
+            p = if isEmpty initTag && isEmpty finalTag then id else parens
+
+    topCatRules = [rule True (catFormId tc) (map (it tc) cs) | (tc,cs) <- srgTopCats srg]
+        where it i c = prCat c <+> tag sisr (topCatSISR c)
+
+catFormId :: String -> String
+catFormId = (++ "_cat")
+
+prCat :: SRGCat -> Doc
+prCat c = char '$' <> text c
+
+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 <> text "<0->"
+    f _ (RESymbol s)  = prSymbol sisr t s
+
+
+prSymbol :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> Doc
+prSymbol sisr cn (Cat n@(c,_)) = prCat c <+> tag sisr (catSISR cn n)
+prSymbol _ cn (Tok t) | all isPunct (prt t) = empty  -- removes punctuation
+                      | otherwise = text (prt 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
+      -- grr, silly SRGS ABNF does not have an escaping mechanism
+      ts | '{' `elem` x || '}' `elem` x -> text "{!{" <+> text x <+> text "}!}"
+         | otherwise -> text "{" <+> text x <+> text "}"
+         where x = prSISR ts
+
+isPunct :: Char -> Bool
+isPunct c = c `elem` "-_.;.,?!"
+
+comment :: String -> Doc
+comment s = text "//" <+> text s
+
+alts :: [Doc] -> Doc
+alts = fsep . prepunctuate (text "| ")
+
+rule :: Bool -> SRGCat -> [Doc] -> Doc
+rule pub c xs = p <+> prCat c <+> char '=' <+> nest 2 (alts xs) <+> char ';'
+  where p = if pub then text "public" else empty
+
+meta :: String -> String -> Doc
+meta n v = text "meta" <+> text (show n) <+> text "is" <+> text (show v) <> char ';'
+
+-- 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-2.9/GF/Speech/RegExp.hs b/src-2.9/GF/Speech/RegExp.hs
new file mode 100644
index 000000000..5ee40828e
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Speech/Relation.hs b/src-2.9/GF/Speech/Relation.hs
new file mode 100644
index 000000000..641d671a9
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Speech/RelationQC.hs b/src-2.9/GF/Speech/RelationQC.hs
new file mode 100644
index 000000000..47f783986
--- /dev/null
+++ b/src-2.9/GF/Speech/RelationQC.hs
@@ -0,0 +1,39 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : RelationQC
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/26 17:13:13 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.1 $
+--
+-- QuickCheck properties for GF.Speech.Relation
+-----------------------------------------------------------------------------
+
+module GF.Speech.RelationQC where
+
+import GF.Speech.Relation
+
+import Test.QuickCheck
+
+prop_transitiveClosure_trans :: [(Int,Int)] -> Bool
+prop_transitiveClosure_trans ps = isTransitive (transitiveClosure (mkRel ps))
+
+prop_symmetricSubrelation_symm :: [(Int,Int)] -> Bool
+prop_symmetricSubrelation_symm ps = isSymmetric (symmetricSubrelation (mkRel ps))
+
+prop_symmetricSubrelation_sub :: [(Int,Int)] -> Bool
+prop_symmetricSubrelation_sub ps = symmetricSubrelation r `isSubRelationOf` r
+  where r = mkRel ps
+
+prop_symmetricClosure_symm :: [(Int,Int)] -> Bool
+prop_symmetricClosure_symm ps = isSymmetric (symmetricClosure (mkRel ps))
+
+prop_reflexiveClosure_refl :: [(Int,Int)] -> Bool
+prop_reflexiveClosure_refl ps = isReflexive (reflexiveClosure (mkRel ps))
+
+prop_mkEquiv_equiv :: [(Int,Int)] -> Bool
+prop_mkEquiv_equiv ps = isEquivalence (mkEquiv ps)
+  where mkEquiv = transitiveClosure . symmetricClosure . reflexiveClosure . mkRel
diff --git a/src-2.9/GF/Speech/SISR.hs b/src-2.9/GF/Speech/SISR.hs
new file mode 100644
index 000000000..3e68a2e55
--- /dev/null
+++ b/src-2.9/GF/Speech/SISR.hs
@@ -0,0 +1,87 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GF.Speech.SISR
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- 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.Conversion.Types
+import GF.Data.Utilities
+import GF.Formalism.CFG
+import GF.Formalism.Utilities (Symbol(..), NameProfile(..), Profile(..), forestName)
+import GF.Infra.Ident
+import GF.Speech.TransformCFG
+import GF.Speech.SRG (SRGNT)
+
+import qualified GF.JavaScript.AbsJS   as JS
+import qualified GF.JavaScript.PrintJS as JS
+
+data SISRFormat = 
+    -- SISR Working draft 1 April 2003
+    -- http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/
+    SISROld
+ deriving Show
+
+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 (prIdent 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 typ)]
+
+fmtOut SISROld = JS.EVar (JS.Ident "$")
+
+fmtRef SISROld 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-2.9/GF/Speech/SRG.hs b/src-2.9/GF/Speech/SRG.hs
new file mode 100644
index 000000000..19b6c1c1b
--- /dev/null
+++ b/src-2.9/GF/Speech/SRG.hs
@@ -0,0 +1,235 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : SRG
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/01 20:09:04 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.20 $
+--
+-- 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,
+                      SRGCat, SRGNT, CFTerm
+                     , makeSRG
+                     , makeSimpleSRG
+                     , makeNonRecursiveSRG
+                     , lookupFM_, prtS
+                     , cfgCatToGFCat, srgTopCats
+                     ) where
+
+import GF.Data.Operations
+import GF.Data.Utilities
+import GF.Infra.Ident
+import GF.Formalism.CFG
+import GF.Formalism.Utilities (Symbol(..), NameProfile(..)
+                              , Profile(..), SyntaxForest
+                              , filterCats, mapSymbol, symbol)
+import GF.Conversion.Types
+import GF.Infra.Print
+import GF.Speech.TransformCFG
+import GF.Speech.Relation
+import GF.Speech.FiniteState
+import GF.Speech.RegExp
+import GF.Speech.CFGToFiniteState
+import GF.Infra.Option
+import GF.Probabilistic.Probabilistic (Probs)
+import GF.Compile.ShellState (StateGrammar, stateProbs, stateOptions, cncId)
+
+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 { grammarName :: String    -- ^ grammar name
+		 , startCat :: SRGCat     -- ^ start category name
+		 , origStartCat :: String -- ^ original start category name
+                 , grammarLanguage :: Maybe String -- ^ The language for which the grammar 
+                                                   --   is intended, e.g. en-UK
+	         , rules :: [SRGRule] 
+	       }
+	 deriving (Eq,Show)
+
+data SRGRule = SRGRule SRGCat String [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 (Symbol SRGNT Token)
+
+type SRGCat = String
+
+-- | An SRG non-terminal. Category name and its number in the profile.
+type SRGNT = (SRGCat, Int)
+
+-- | SRG category name and original name
+type CatName = (SRGCat,String) 
+
+type CatNames = Map String String
+
+-- | Create a non-left-recursive SRG. 
+--   FIXME: the probabilities in the returned 
+--   grammar may be meaningless.
+makeSimpleSRG :: Options   -- ^ Grammar options
+	      -> StateGrammar
+	      -> SRG
+makeSimpleSRG opt s = makeSRG preprocess opt s
+    where
+      preprocess origStart = traceStats "After mergeIdentical"
+                             . mergeIdentical
+                             . traceStats "After removeLeftRecursion"
+                             . removeLeftRecursion origStart 
+                             . traceStats "After topDownFilter" 
+                             . topDownFilter origStart
+                             . traceStats "After bottomUpFilter"
+                             . bottomUpFilter
+                             . traceStats "After removeCycles"
+                             . removeCycles 
+                             . traceStats "Inital CFG"
+
+traceStats s g = trace ("---- " ++ s ++ ": " ++ stats g {- ++ "\n" ++ prCFRules g ++ "----" -}) g
+
+stats g = "Categories: " ++ show (countCats g)
+          ++ " Rules: " ++ show (countRules g)
+
+makeNonRecursiveSRG :: Options 
+                    -> StateGrammar
+                    -> SRG
+makeNonRecursiveSRG opt s = renameSRG $ 
+      SRG { grammarName = prIdent (cncId s),
+	    startCat = start,
+	    origStartCat = origStart,
+            grammarLanguage = getSpeechLanguage opt s,
+	    rules = rs }
+  where
+    origStart = getStartCatCF opt s
+    MFA start dfas = cfgToMFA opt s
+    rs = [SRGRule l l [SRGAlt Nothing dummyCFTerm (dfaToSRGItem dfa)] | (l,dfa) <- dfas]
+      where dfaToSRGItem = mapRE dummySRGNT . minimizeRE . dfa2re
+            dummyCFTerm = CFMeta "dummy"
+            dummySRGNT = mapSymbol (\c -> (c,0)) id
+
+makeSRG :: (Cat_ -> CFRules -> CFRules)
+        -> Options   -- ^ Grammar options
+	-> StateGrammar
+	-> SRG
+makeSRG preprocess opt s = renameSRG $ 
+      SRG { grammarName = name,
+	    startCat = origStart,
+	    origStartCat = origStart,
+            grammarLanguage = getSpeechLanguage opt s,
+	    rules = rs }
+    where 
+    name = prIdent (cncId s)
+    origStart = getStartCatCF opt s
+    (_,cfgRules) = unzip $ allRulesGrouped $ preprocess origStart $ cfgToCFRules s
+    rs = map (cfgRulesToSRGRule (stateProbs s)) cfgRules
+
+-- | Give names on the form NameX to all categories.
+renameSRG :: SRG -> SRG
+renameSRG srg = srg { startCat = renameCat (startCat srg),
+                      rules = map renameRule (rules srg) }
+  where
+    names = mkCatNames (grammarName srg) (allSRGCats srg)
+    renameRule (SRGRule _ origCat alts) = SRGRule (renameCat origCat) origCat (map renameAlt alts)
+    renameAlt (SRGAlt mp n rhs) = SRGAlt mp n (mapRE renameSymbol rhs) 
+    renameSymbol = mapSymbol (\ (c,x) -> (renameCat c, x)) id
+    renameCat = lookupFM_ names
+
+getSpeechLanguage :: Options -> StateGrammar -> Maybe String
+getSpeechLanguage opt s = 
+    fmap (replace '_' '-') $ getOptVal (addOptions opt (stateOptions s)) speechLanguage
+
+-- FIXME: merge alternatives with same rhs and profile but different probabilities
+cfgRulesToSRGRule :: Probs -> [CFRule_] -> SRGRule
+cfgRulesToSRGRule probs rs@(r:_) = SRGRule origCat origCat rhs
+    where 
+      origCat = lhsCat r
+      alts = [((n,ruleProb probs r),mkSRGSymbols 0 ss) | CFRule c ss n <- rs]
+      rhs = [SRGAlt p n (srgItem sss) | ((n,p),sss) <- buildMultiMap alts ]
+
+      mkSRGSymbols _ [] = []
+      mkSRGSymbols i (Cat c:ss) = Cat (c,i) : mkSRGSymbols (i+1) ss
+      mkSRGSymbols i (Tok t:ss) = Tok t : mkSRGSymbols i ss
+
+ruleProb :: Probs -> CFRule_ -> Maybe Double
+ruleProb probs r = lookupProb probs (ruleFun r)
+
+-- FIXME: move to GF.Probabilistic.Probabilistic?
+lookupProb :: Probs -> Ident -> Maybe Double
+lookupProb probs i = lookupTree prIdent i probs
+
+mkCatNames :: String   -- ^ Category name prefix
+	   -> [String] -- ^ Original category names
+	   -> Map String String -- ^ Maps original names to SRG names
+mkCatNames prefix origNames = Map.fromList (zip origNames names)
+    where names = [prefix ++ "_" ++ show x | x <- [0..]]
+
+
+allSRGCats :: SRG -> [String]
+allSRGCats SRG { rules = rs } = [c | SRGRule c _ _ <- rs]
+
+cfgCatToGFCat :: SRGCat -> Maybe String
+cfgCatToGFCat c 
+    -- categories introduced by removeLeftRecursion contain dashes
+    | '-' `elem` c = Nothing 
+    -- some categories introduced by -conversion=finite have the form
+    -- "{fun:cat}..."
+    | "{" `isPrefixOf` c = case dropWhile (/=':') $ takeWhile (/='}') $ tail c of
+                             ':':c' -> Just c'
+                             _ -> error $ "cfgCatToGFCat: Strange category " ++ show c
+    | otherwise = Just $ takeWhile (/='{') c
+
+srgTopCats :: SRG -> [(String,[SRGCat])]
+srgTopCats srg = buildMultiMap [(oc, cat) | SRGRule cat origCat _ <- rules srg, 
+                                            oc <- maybeToList $ cfgCatToGFCat origCat]
+
+--
+-- * Size-optimized EBNF SRGs
+--
+
+srgItem :: [[Symbol SRGNT Token]] -> 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 :: [[Symbol SRGNT Token]] -> SRGItem
+mergeItems = minimizeRE . ungroupTokens . minimizeRE . unionRE . map seqRE . map groupTokens
+
+groupTokens :: [Symbol SRGNT Token] -> [Symbol SRGNT [Token]]
+groupTokens [] = []
+groupTokens (Tok t:ss) = case groupTokens ss of
+                           Tok ts:ss' -> Tok (t:ts):ss'
+                           ss'        -> Tok [t]:ss'
+groupTokens (Cat c:ss) = Cat c : groupTokens ss
+
+ungroupTokens :: RE (Symbol SRGNT [Token]) -> RE (Symbol SRGNT Token)
+ungroupTokens = joinRE . mapRE (symbol (RESymbol . Cat) (REConcat . map (RESymbol . Tok)))
+
+--
+-- * 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-2.9/GF/Speech/TransformCFG.hs b/src-2.9/GF/Speech/TransformCFG.hs
new file mode 100644
index 000000000..3d7ebd809
--- /dev/null
+++ b/src-2.9/GF/Speech/TransformCFG.hs
@@ -0,0 +1,378 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : TransformCFG
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/01 20:09:04 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.24 $
+--
+--  This module does some useful transformations on CFGs.
+--
+-- peb thinks: most of this module should be moved to GF.Conversion...
+-----------------------------------------------------------------------------
+
+module GF.Speech.TransformCFG where
+
+import GF.Canon.CanonToGFCC (canon2gfcc)
+import qualified GF.GFCC.CId as C
+import GF.GFCC.Macros (lookType,catSkeleton)
+import GF.GFCC.DataGFCC (GFCC)
+import GF.Conversion.Types
+import GF.CF.PPrCF (prCFCat)
+import GF.Data.Utilities
+import GF.Formalism.CFG 
+import GF.Formalism.Utilities (Symbol(..), mapSymbol, filterCats, symbol, 
+			       NameProfile(..), Profile(..), name2fun, forestName)
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Infra.Print
+import GF.Speech.Relation
+import GF.Compile.ShellState (StateGrammar, stateCFG, stateGrammarST, startCatStateOpts, stateOptions)
+
+import Control.Monad
+import Control.Monad.State (State, get, put, evalState)
+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
+
+-- not very nice to replace the structured CFCat type with a simple string
+type CFRule_ = CFRule Cat_ CFTerm Token
+
+data CFTerm
+    = CFObj Fun [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 String -- ^ A metavariable
+  deriving (Eq,Ord,Show)
+
+type Cat_ = String
+type CFSymbol_ = Symbol Cat_ Token
+
+type CFRules = Map Cat_ (Set CFRule_)
+
+
+cfgToCFRules :: StateGrammar -> CFRules
+cfgToCFRules s = 
+    groupProds [CFRule (catToString c) (map symb r) (nameToTerm n) 
+                    | CFRule c r n <- cfg]
+    where cfg = stateCFG s
+          symb = mapSymbol catToString id
+	  catToString = prt
+          gfcc = stateGFCC s
+          nameToTerm (Name IW [Unify [n]]) = CFRes n
+          nameToTerm (Name f@(IC c) prs) = 
+              CFObj f (zipWith profileToTerm args prs)
+            where (args,_) = catSkeleton $ lookType gfcc (C.CId c)
+          nameToTerm n = error $ "cfgToCFRules.nameToTerm" ++ show n
+          profileToTerm (C.CId t) (Unify []) = CFMeta t
+          profileToTerm _ (Unify xs) = CFRes (last xs) -- FIXME: unify
+          profileToTerm (C.CId t) (Constant f) = maybe (CFMeta t) (\x -> CFObj x []) (forestName f)
+
+getStartCat :: Options -> StateGrammar -> String
+getStartCat opts sgr = prCFCat (startCatStateOpts opts' sgr)
+  where opts' = addOptions opts (stateOptions sgr)
+
+getStartCatCF :: Options -> StateGrammar -> String
+getStartCatCF opts sgr = getStartCat opts sgr ++ "{}.s"
+
+stateGFCC :: StateGrammar -> GFCC
+stateGFCC = canon2gfcc noOptions . stateGrammarST
+
+-- * 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 :: CFRules -> CFRules 
+removeCycles = groupProds . f . allRules
+  where f rs = filter (not . isCycle) rs
+          where alias = transitiveClosure $ mkRel [(c,c') | CFRule c [Cat c'] _ <- rs]
+                isCycle (CFRule c [Cat c'] _) = isRelatedTo alias c' c
+                isCycle _ = False
+
+-- | Better bottom-up filter that also removes categories which contain no finite
+-- strings.
+bottomUpFilter :: CFRules -> CFRules
+bottomUpFilter gr = fix grow Map.empty
+  where grow g = g `unionCFRules` filterCFRules (all (okSym g) . ruleRhs) gr
+        okSym g = symbol (`elem` allCats g) (const True)
+
+-- | Removes categories which are not reachable from the start category.
+topDownFilter :: Cat_ -> CFRules -> CFRules
+topDownFilter start rules = filterCFRulesCats (isRelatedTo uses start) rules
+  where
+    rhsCats = [ (lhsCat r, c') | r <- allRules rules, c' <- filterCats (ruleRhs r) ]
+    uses = reflexiveClosure_ (allCats rules) $ transitiveClosure $ mkRel rhsCats
+
+-- | Merges categories with identical right-hand-sides.
+-- FIXME: handle probabilities
+mergeIdentical :: CFRules -> CFRules
+mergeIdentical g = groupProds $ map subst $ allRules g
+  where
+    -- maps categories to their replacement
+    m = Map.fromList [(y,concat (intersperse "+" xs)) 
+                          | (_,xs) <- buildMultiMap [(rulesKey rs,c) | (c,rs) <- Map.toList 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 :: Cat_ -> CFRules -> CFRules
+removeLeftRecursion start gr 
+    = groupProds $ concat [scheme1, scheme2, scheme3, scheme4]
+  where
+    scheme1 = [CFRule a [x,Cat a_x] n' | 
+               a <- retainedLeftRecursive, 
+               x <- properLeftCornersOf a,
+               not (isLeftRecursive x),
+               let a_x = mkCat (Cat 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++[Cat a_b]) n' | 
+               a <- retainedLeftRecursive, 
+               b@(Cat b') <- properLeftCornersOf a,
+               isLeftRecursive b,
+               CFRule _ (x:beta) n <- catRules gr b', 
+               let a_x = mkCat (Cat a) x,
+               let a_b = mkCat (Cat 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 (Cat a) x,
+               let n' = symbol (\_ -> CFAbs 1 (shiftTerm n)) 
+                               (\_ -> n) x]
+    scheme4 = catSetRules gr $ Set.fromList $ filter (not . isLeftRecursive . Cat) 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 [(Cat c,t) | CFRule c (t:_) _ <- allRules gr]
+    leftCorner = reflexiveClosure_ (map Cat cats) $ transitiveClosure directLeftCorner
+    properLeftCorner = transitiveClosure directLeftCorner
+    properLeftCornersOf = Set.toList . allRelated properLeftCorner . Cat
+    isProperLeftCornerOf = flip (isRelatedTo properLeftCorner)
+
+    leftRecursive = reflexiveElements properLeftCorner
+    isLeftRecursive = (`Set.member` leftRecursive)
+
+    retained = start `Set.insert`
+                Set.fromList [a | r <- allRules (filterCFRulesCats (not . isLeftRecursive . Cat) gr),
+                                  Cat a <- ruleRhs r]
+    isRetained = (`Set.member` retained)
+
+    retainedLeftRecursive = filter (isLeftRecursive . Cat) $ Set.toList retained
+
+mkCat :: CFSymbol_ -> CFSymbol_ -> Cat_
+mkCat x y = showSymbol x ++ "-" ++ showSymbol y
+  where showSymbol = symbol id show
+
+{-
+
+-- Paull's algorithm, see
+-- http://research.microsoft.com/users/bobmoore/naacl2k-proc-rev.pdf
+removeLeftRecursion :: Cat_ -> CFRules -> CFRules
+removeLeftRecursion start rs = removeDirectLeftRecursions $ map handleProds rs
+    where 
+    handleProds (c, r) = (c, concatMap handleProd r)
+    handleProd (CFRule ai (Cat aj:alpha) n) | aj < ai  =
+              -- FIXME: for non-recursive categories, this changes
+	      -- the grammar unneccessarily, maybe we can use mutRecCats
+	      -- to make this less invasive
+              -- FIXME: this will give multiple rules with the same name,
+	      -- which may mess up the probabilities.
+             [CFRule ai (beta ++ alpha) n | CFRule _ beta _ <- lookup' aj rs]
+    handleProd r = [r]
+
+removeDirectLeftRecursions :: CFRules -> CFRules
+removeDirectLeftRecursions = concat . flip evalState 0 . mapM removeDirectLeftRecursion
+
+removeDirectLeftRecursion :: (Cat_,[CFRule_]) -- ^ All productions for a category
+			  -> State Int CFRules
+removeDirectLeftRecursion (a,rs) 
+    | null dr = return [(a,rs)]
+    | otherwise = 
+        do
+        a' <- fresh a
+        let as = maybeEndWithA' nr
+            is = [CFRule a' (tail r) n | CFRule _ r n <- dr]
+            a's = maybeEndWithA' is
+            -- the not null constraint here avoids creating new 
+            -- left recursive (cyclic) rules.
+            maybeEndWithA' xs = xs ++ [CFRule c (r++[Cat a']) n | CFRule c r n <- xs, 
+                                                                  not (null r)] 
+        return [(a, as), (a', a's)]
+    where 
+    (dr,nr) = partition isDirectLeftRecursive rs
+    fresh x = do { n <- get; put (n+1); return $ x ++ "-" ++ show n }
+
+isDirectLeftRecursive :: CFRule_ -> Bool
+isDirectLeftRecursive (CFRule c (Cat c':_) _) = c == c'
+isDirectLeftRecursive _ = False
+
+-}
+
+-- | 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.
+           -> CFRules -> [Set Cat_]
+mutRecCats incAll g = equivalenceClasses $ refl $ symmetricSubrelation $ transitiveClosure r
+  where r = mkRel [(c,c') | CFRule c ss _ <- allRules g, Cat c' <- ss]
+        refl = if incAll then reflexiveClosure_ (allCats g) else reflexiveSubrelation
+
+--
+-- * Approximate context-free grammars with regular grammars.
+--
+
+-- 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 :: CFRules -> CFRules
+makeRegular g = 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 ++ [Cat (newCat c)]) n -- no non-terminals left
+                              (Cat b:zs) -> newRule b' (xs ++ [Cat 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 == [Cat c] = []
+                                            | otherwise = [CFRule c rhs n]
+        newCat c = c ++ "$"
+
+--
+-- * CFG rule utilities
+--
+
+-- | Group productions by their lhs categories
+groupProds :: [CFRule_] -> CFRules
+groupProds = Map.fromListWith Set.union . map (\r -> (lhsCat r,Set.singleton r))
+
+allRules :: CFRules -> [CFRule_]
+allRules = concat . map Set.toList . Map.elems
+
+allRulesGrouped :: CFRules -> [(Cat_,[CFRule_])]
+allRulesGrouped = Map.toList . Map.map Set.toList
+
+allCats :: CFRules -> [Cat_]
+allCats = Map.keys
+
+catRules :: CFRules -> Cat_ -> [CFRule_]
+catRules rs c = Set.toList $ Map.findWithDefault Set.empty c rs
+
+catSetRules :: CFRules -> Set Cat_ -> [CFRule_]
+catSetRules g cs = allRules $ Map.filterWithKey (\c _ -> c `Set.member` cs) g
+
+cleanCFRules :: CFRules -> CFRules
+cleanCFRules = Map.filter (not . Set.null)
+
+unionCFRules :: CFRules -> CFRules -> CFRules
+unionCFRules = Map.unionWith Set.union
+
+filterCFRules :: (CFRule_ -> Bool) -> CFRules -> CFRules
+filterCFRules p = cleanCFRules . Map.map (Set.filter p)
+
+filterCFRulesCats :: (Cat_ -> Bool) -> CFRules -> CFRules
+filterCFRulesCats p = Map.filterWithKey (\c _ -> p c)
+
+countCats :: CFRules -> Int
+countCats = Map.size . cleanCFRules
+
+countRules :: CFRules -> Int
+countRules = length . allRules
+
+lhsCat :: CFRule c n t -> c
+lhsCat (CFRule c _ _) = c
+
+ruleRhs :: CFRule c n t ->  [Symbol c t]
+ruleRhs (CFRule _ ss _) = ss
+
+ruleFun :: CFRule_ -> Fun
+ruleFun (CFRule _ _ t) = f t
+  where f (CFObj n _) = n
+        f (CFApp _ x) = f x
+        f (CFAbs _ x) = f x
+        f _ = IC ""
+
+-- | 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
+
+-- | Check if any of the categories used on the right-hand side
+--   are in the given list of categories.
+anyUsedBy :: Eq c => [c] -> CFRule c n t -> Bool
+anyUsedBy cs (CFRule _ ss _) = any (`elem` cs) (filterCats ss)
+
+mkCFTerm :: String -> CFTerm
+mkCFTerm n = CFObj (IC n) []
+
+ruleIsNonRecursive :: Ord c => Set c -> CFRule c n t -> Bool
+ruleIsNonRecursive cs = noCatsInSet cs . ruleRhs
+
+noCatsInSet :: Ord c => Set c -> [Symbol c t] -> Bool
+noCatsInSet cs = not . any (`catElem` cs)
+
+-- | Check if all the rules are right-linear, or all the rules are
+--   left-linear, with respect to given categories.
+allXLinear :: Ord c => Set c -> [CFRule c n t] -> Bool
+allXLinear cs rs = all (isRightLinear cs) rs || all (isLeftLinear cs) rs
+
+-- | Checks if a context-free rule is right-linear.
+isRightLinear :: Ord c => 
+                 Set c  -- ^ The categories to consider
+              -> CFRule c n t   -- ^ The rule to check for right-linearity
+              -> Bool
+isRightLinear cs = noCatsInSet cs . safeInit . ruleRhs
+
+-- | Checks if a context-free rule is left-linear.
+isLeftLinear :: Ord c => 
+                Set c  -- ^ The categories to consider
+             -> CFRule c n t   -- ^ The rule to check for left-linearity
+             -> Bool
+isLeftLinear cs = noCatsInSet cs . drop 1 . ruleRhs
+
+prCFRules :: CFRules -> String
+prCFRules = unlines . map prRule . allRules
+    where 
+      prRule r = lhsCat r ++ " --> " ++ unwords (map prSym (ruleRhs r))
+      prSym = symbol id (\t -> "\""++ t ++"\"")
diff --git a/src-2.9/GF/System/ATKSpeechInput.hs b/src-2.9/GF/System/ATKSpeechInput.hs
new file mode 100644
index 000000000..4b50293af
--- /dev/null
+++ b/src-2.9/GF/System/ATKSpeechInput.hs
@@ -0,0 +1,137 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GF.System.ATKSpeechInput
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (non-portable)
+--
+-- > CVS $Date: 2005/05/10 15:04:01 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Use ATK and Speech.ATKRec for speech input.
+-----------------------------------------------------------------------------
+
+module GF.System.ATKSpeechInput (recognizeSpeech) where
+
+import GF.Infra.Ident (Ident, prIdent)
+import GF.Infra.Option
+import GF.Conversion.Types (CGrammar)
+import GF.Speech.PrSLF
+
+import Speech.ATKRec
+
+import Control.Monad
+import Data.Maybe
+import Data.IORef
+import System.Environment
+import System.IO
+import System.IO.Unsafe
+
+data ATKLang = ATKLang {
+                        hmmlist :: FilePath,
+                        mmf0 :: FilePath,
+                        mmf1 :: FilePath,
+                        dict :: FilePath,
+                        opts :: [(String,String)]
+                       }
+
+atk_home_error = "The environment variable ATK_HOME is not set. "
+                 ++ "It should contain the path to your copy of ATK."
+
+gf_atk_cfg_error = "The environment variable GF_ATK_CFG is not set. "
+                   ++ "It should contain the path to your GF ATK configuration"
+                   ++ " file. A default version of this file can be found"
+                   ++ " in GF/src/gf_atk.cfg"
+
+getLanguage :: String -> IO ATKLang
+getLanguage l = 
+    case l of 
+           "en_UK" -> do
+                      atk_home <- getEnv_ "ATK_HOME" atk_home_error
+                      let res = atk_home ++ "/Resources"
+                      return $ ATKLang {
+                                 hmmlist = res ++ "/UK_SI_ZMFCC/hmmlistbg",
+                                 mmf0 = res ++ "/UK_SI_ZMFCC/WI4",
+                                 mmf1 = res ++ "/UK_SI_ZMFCC/BGHMM2",
+                                 dict = res ++ "/beep.dct",
+                                 opts = [("TARGETKIND", "MFCC_0_D_A_Z"),
+                                         ("HPARM:CMNDEFAULT", res ++ "/UK_SI_ZMFCC/cepmean")]
+                                       }
+           "sv_SE" -> do
+                      let res = "/home/bjorn/projects/atkswe/numerals-swe/final"
+                      return $ ATKLang {
+                                 hmmlist = res ++ "/hmm_tri/hmmlist",
+                                 mmf0 = res ++ "/hmm_tri/macros",
+                                 mmf1 = res ++ "/hmm_tri/hmmdefs",
+                                 dict = res ++ "/NumeralsSwe.dct",
+                                 opts = [("TARGETKIND", "MFCC_0_D_A")]
+                                        }
+           _ -> fail $ "ATKSpeechInput: language " ++ l ++ " not supported"
+
+-- | Current language for which we have loaded the HMM
+--   and dictionary.
+{-# NOINLINE currentLang #-}
+currentLang :: IORef (Maybe String)
+currentLang = unsafePerformIO $ newIORef Nothing
+
+-- | Initializes the ATK, loading the given language.
+--   ATK must not be initialized when calling this function.
+loadLang :: String -> IO ()
+loadLang lang = 
+    do
+    l <- getLanguage lang
+    config <- getEnv_ "GF_ATK_CFG" gf_atk_cfg_error
+    hPutStrLn stderr $ "Initializing ATK..."
+    initialize (Just config) (opts l)
+    let hmmName = "hmm_" ++ lang
+        dictName = "dict_" ++ lang
+    hPutStrLn stderr $ "Initializing ATK (" ++ lang ++ ")..."
+    loadHMMSet hmmName (hmmlist l) (mmf0 l) (mmf1 l)
+    loadDict dictName (dict l)
+    writeIORef currentLang (Just lang)
+
+initATK :: String -> IO ()
+initATK lang = 
+    do
+    ml <- readIORef currentLang
+    case ml of
+            Nothing -> loadLang lang
+            Just l | l == lang -> return ()
+                   | otherwise -> do
+                                  deinitialize
+                                  loadLang lang
+
+recognizeSpeech :: Ident -- ^ Grammar name
+	        -> String -- ^ Language, e.g. en_UK
+                -> CGrammar -- ^ Context-free grammar for input
+                -> String -- ^ Start category name
+                -> Int -- ^ Number of utterances
+                -> IO [String]
+recognizeSpeech name language cfg start number = 
+    do
+    let slf = slfPrinter name start cfg
+        n = prIdent name
+        hmmName = "hmm_" ++ language
+        dictName = "dict_" ++ language
+        slfName = "gram_" ++ n
+        recName = "rec_" ++ language ++ "_" ++ n
+    writeFile "debug.net" slf
+    initATK language
+    hPutStrLn stderr $ "Loading grammar " ++ n ++ " ..."
+    loadGrammarString slfName slf
+    createRecognizer recName hmmName dictName slfName
+    hPutStrLn stderr $ "Listening in category " ++ start ++ "..."
+    s <- replicateM number (recognize recName)
+    return s
+
+
+getEnv_ :: String    -- ^ Name of environment variable
+        -> String    -- ^ Message to fail with if the variable is not set.
+        -> IO String
+getEnv_ e err = 
+    do
+    env <- getEnvironment
+    case lookup e env of
+                      Just v -> return v
+                      Nothing -> fail err
diff --git a/src-2.9/GF/System/Arch.hs b/src-2.9/GF/System/Arch.hs
new file mode 100644
index 000000000..c0dac3644
--- /dev/null
+++ b/src-2.9/GF/System/Arch.hs
@@ -0,0 +1,90 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Arch
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/10 14:55:01 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- architecture\/compiler dependent definitions for unix\/hbc
+-----------------------------------------------------------------------------
+
+module GF.System.Arch (
+ myStdGen, prCPU, selectLater, modifiedFiles, ModTime, getModTime,getNowTime,
+ welcomeArch, fetchCommand, laterModTime) where
+
+import System.Time
+import System.Random
+import System.CPUTime
+import Control.Monad (filterM)
+import System.Directory
+
+import GF.System.Readline (fetchCommand)
+
+---- import qualified UnicodeF as U --(fudlogueWrite)
+
+-- architecture/compiler dependent definitions for unix/hbc
+
+myStdGen :: Int -> IO StdGen ---
+--- myStdGen _ = newStdGen --- gives always the same result
+myStdGen int0 = do
+  t0  <- getClockTime 
+  cal <- toCalendarTime t0 
+  let int = int0 + ctSec cal + fromInteger (div (ctPicosec cal) 10000000)
+  return $ mkStdGen int
+
+prCPU :: Integer -> IO Integer
+prCPU cpu = do 
+  cpu' <- getCPUTime
+  putStrLn (show ((cpu' - cpu) `div` 1000000000) ++ " msec")
+  return cpu'
+
+welcomeArch :: String
+welcomeArch = "This is the system compiled with ghc."
+
+-- | selects the one with the later modification time of two
+selectLater :: FilePath -> FilePath -> IO FilePath
+selectLater x y = do
+  ex <- doesFileExist x
+  if not ex 
+    then return y --- which may not exist
+    else do
+      ey <- doesFileExist y
+      if not ey 
+        then return x
+        else do 
+          tx <- getModificationTime x
+          ty <- getModificationTime y
+          return $ if tx < ty then y else x
+
+-- | a file is considered modified also if it has not been read yet
+--
+-- new 23\/2\/2004: the environment ofs has just module names
+modifiedFiles :: [(FilePath,ModTime)] -> [FilePath] -> IO [FilePath]
+modifiedFiles ofs fs = do
+  filterM isModified fs
+ where
+  isModified file = case lookup (justModName file) ofs of
+    Just to -> do
+      t <- getModificationTime file
+      return $ to < t
+    _ -> return True
+
+  justModName = 
+    reverse . takeWhile (/='/') . tail . dropWhile (/='.') . reverse
+
+type ModTime = ClockTime
+
+laterModTime :: ModTime -> ModTime -> Bool
+laterModTime = (>)
+
+getModTime :: FilePath -> IO (Maybe ModTime)
+getModTime f = do
+  b <- doesFileExist f
+  if b then (getModificationTime f >>= return . Just) else return Nothing
+
+getNowTime :: IO ModTime
+getNowTime = getClockTime
diff --git a/src-2.9/GF/System/ArchEdit.hs b/src-2.9/GF/System/ArchEdit.hs
new file mode 100644
index 000000000..39b558cef
--- /dev/null
+++ b/src-2.9/GF/System/ArchEdit.hs
@@ -0,0 +1,30 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ArchEdit
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:46:15 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.System.ArchEdit (
+  fudlogueEdit, fudlogueWrite, fudlogueWriteUni
+ ) where
+
+fudlogueEdit :: a -> b -> IO ()
+fudlogueEdit _ _ = do
+  putStrLn "sorry no fudgets available in Hugs"
+  return ()
+
+fudlogueWrite :: a -> b -> IO ()
+fudlogueWrite _ _ = do
+  putStrLn "sorry no fudgets available in Hugs"
+
+fudlogueWriteUni :: a -> b -> IO ()
+fudlogueWriteUni _ _ = do
+  putStrLn "sorry no fudgets available in Hugs"
diff --git a/src-2.9/GF/System/NoReadline.hs b/src-2.9/GF/System/NoReadline.hs
new file mode 100644
index 000000000..138ba4e28
--- /dev/null
+++ b/src-2.9/GF/System/NoReadline.hs
@@ -0,0 +1,27 @@
+----------------------------------------------------------------------
+-- |
+-- 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) 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
diff --git a/src-2.9/GF/System/NoSignal.hs b/src-2.9/GF/System/NoSignal.hs
new file mode 100644
index 000000000..5d82a431e
--- /dev/null
+++ b/src-2.9/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-2.9/GF/System/NoSpeechInput.hs b/src-2.9/GF/System/NoSpeechInput.hs
new file mode 100644
index 000000000..04197ce92
--- /dev/null
+++ b/src-2.9/GF/System/NoSpeechInput.hs
@@ -0,0 +1,28 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GF.System.NoSpeechInput
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/10 15:04:01 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Dummy speech input.
+-----------------------------------------------------------------------------
+
+module GF.System.NoSpeechInput (recognizeSpeech) where
+
+import GF.Infra.Ident (Ident)
+import GF.Infra.Option (Options)
+import GF.Conversion.Types (CGrammar)
+
+
+recognizeSpeech :: Ident -- ^ Grammar name
+	        -> String -- ^ Language, e.g. en_UK
+                -> CGrammar -- ^ Context-free grammar for input
+                -> String -- ^ Start category name
+                -> Int -- ^ Number of utterances
+                -> IO [String]
+recognizeSpeech _ _ _ _ _ = fail "No speech input available"
diff --git a/src-2.9/GF/System/Readline.hs b/src-2.9/GF/System/Readline.hs
new file mode 100644
index 000000000..c12493f98
--- /dev/null
+++ b/src-2.9/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) where
+
+#ifdef USE_READLINE
+
+import GF.System.UseReadline (fetchCommand)
+
+#else
+
+import GF.System.NoReadline (fetchCommand)
+
+#endif
diff --git a/src-2.9/GF/System/Signal.hs b/src-2.9/GF/System/Signal.hs
new file mode 100644
index 000000000..fe8a12483
--- /dev/null
+++ b/src-2.9/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-2.9/GF/System/SpeechInput.hs b/src-2.9/GF/System/SpeechInput.hs
new file mode 100644
index 000000000..6c2374473
--- /dev/null
+++ b/src-2.9/GF/System/SpeechInput.hs
@@ -0,0 +1,27 @@
+{-# OPTIONS -cpp #-}
+
+----------------------------------------------------------------------
+-- |
+-- Module      : GF.System.SpeechInput
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/10 15:04:01 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.2 $
+--
+-- Uses the right speech recognition library for speech input.
+-----------------------------------------------------------------------------
+
+module GF.System.SpeechInput (recognizeSpeech) where
+
+#ifdef USE_ATK
+
+import GF.System.ATKSpeechInput (recognizeSpeech)
+
+#else
+
+import GF.System.NoSpeechInput (recognizeSpeech)
+
+#endif
diff --git a/src-2.9/GF/System/Tracing.hs b/src-2.9/GF/System/Tracing.hs
new file mode 100644
index 000000000..71bacfb75
--- /dev/null
+++ b/src-2.9/GF/System/Tracing.hs
@@ -0,0 +1,73 @@
+{-# OPTIONS -cpp #-}
+
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/26 09:54:11 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.4 $
+--
+-- Tracing utilities for debugging purposes.
+-- If the CPP symbol TRACING is set, then the debugging output is shown.
+-----------------------------------------------------------------------------
+
+
+module GF.System.Tracing
+    (trace, trace2, traceM, traceCall, tracePrt, traceCalcFirst) where
+
+import qualified Debug.Trace as Trace
+
+-- | emit a string inside braces, before(?) calculating the value:
+-- @{str}@
+trace :: String -> a -> a
+
+-- | emit function name and debugging output:
+-- @{fun: out}@
+trace2 :: String -> String -> a -> a
+
+-- | monadic version of 'trace2'
+traceM :: Monad m => String -> String -> m ()
+
+-- | show when a value is starting to be calculated (with a '+'), 
+-- and when it is finished (with a '-')
+traceCall :: String -> String -> (a -> String) -> a -> a
+
+-- | showing the resulting value (filtered through a printing function):
+-- @{fun: value}@
+tracePrt :: String -> (a -> String) -> a -> a
+
+-- | this is equivalent to 'seq' when tracing, but
+-- just skips the first argument otherwise
+traceCalcFirst :: a -> b -> b
+
+#if TRACING
+trace str a = Trace.trace (bold ++ "{" ++ normal ++ str ++ bold ++ "}" ++ normal) a
+trace2 fun str a = trace (bold ++ fgcol 1 ++ fun ++ ": " ++ normal ++ str) a 
+traceM fun str = trace2 fun str (return ())
+traceCall fun start prt val 
+    = trace2 ("+" ++ fun) start $
+      val `seq` trace2 ("-" ++ fun) (prt val) val
+tracePrt mod prt val = val `seq` trace2 mod (prt val) val
+traceCalcFirst = seq
+
+#else
+trace _ = id
+trace2 _ _ = id
+traceM _ _ = return ()
+traceCall _ _ _ = id
+tracePrt _ _ = id
+traceCalcFirst _ = id
+
+#endif
+
+
+escape    = "\ESC"
+highlight = escape ++ "[7m"
+bold      = escape ++ "[1m"
+underline = escape ++ "[4m"
+normal    = escape ++ "[0m"
+fgcol col = escape ++ "[0" ++ show (30+col) ++ "m"
+bgcol col = escape ++ "[0" ++ show (40+col) ++ "m"
diff --git a/src-2.9/GF/System/UseReadline.hs b/src-2.9/GF/System/UseReadline.hs
new file mode 100644
index 000000000..c84b9d7f4
--- /dev/null
+++ b/src-2.9/GF/System/UseReadline.hs
@@ -0,0 +1,25 @@
+----------------------------------------------------------------------
+-- |
+-- 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) where
+
+import System.Console.Readline (readline, addHistory)
+
+fetchCommand :: String -> IO (String)
+fetchCommand s = do
+  res <- readline s
+  case res of
+   Nothing -> return "q"
+   Just s -> do addHistory s
+                return s
diff --git a/src-2.9/GF/System/UseSignal.hs b/src-2.9/GF/System/UseSignal.hs
new file mode 100644
index 000000000..5e6d81237
--- /dev/null
+++ b/src-2.9/GF/System/UseSignal.hs
@@ -0,0 +1,58 @@
+----------------------------------------------------------------------
+-- |
+-- 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
+import System.Posix.Signals
+
+{-# 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 <- installHandler sigINT (Catch (killThread t)) Nothing
+       x <- p `catch` h
+       installHandler sigINT oldH Nothing
+       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 <- installHandler sigINT Ignore Nothing
+       x <- a
+       installHandler sigINT oldH Nothing
+       return x
diff --git a/src-2.9/GF/Text/Arabic.hs b/src-2.9/GF/Text/Arabic.hs
new file mode 100644
index 000000000..c482b1172
--- /dev/null
+++ b/src-2.9/GF/Text/Arabic.hs
@@ -0,0 +1,63 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Arabic
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:34 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.Arabic (mkArabic) where
+
+mkArabic :: String -> String
+mkArabic = unwords . (map mkArabicWord) . words
+----mkArabic = reverse . unwords . (map mkArabicWord) . words
+--- reverse : assumes everything's on same line
+
+type ArabicChar = Char
+
+mkArabicWord :: String -> [ArabicChar]
+mkArabicWord = map mkArabicChar . getLetterPos
+
+getLetterPos :: String -> [(Char,Int)]
+getLetterPos []     = []
+getLetterPos ('I':cs)  = ('*',7) : getLetterPos cs           -- 0xfe80
+getLetterPos ('O':cs)  = ('*',8) : getIn cs                  -- 0xfe8b
+getLetterPos ('l':'a':cs) = ('*',5) : getLetterPos cs        -- 0xfefb
+getLetterPos [c]    = [(c,1)]                                -- 1=isolated
+getLetterPos (c:cs) | isReduced c = (c,1) : getLetterPos cs
+getLetterPos (c:cs) = (c,3) : getIn cs                       -- 3=initial
+
+  
+getIn []     = []
+getIn ('I':cs)  = ('*',7) : getLetterPos cs                -- 0xfe80
+getIn ('O':cs)  = ('*',9) : getIn cs                       -- 0xfe8c
+getIn ('l':'a':cs) = ('*',6) : getLetterPos cs             -- 0xfefc
+getIn [c]    = [(c,2)]                                     -- 2=final
+getIn (c:cs) | isReduced c = (c,2) : getLetterPos cs
+getIn (c:cs) = (c,4) : getIn cs                            -- 4=medial
+
+isReduced :: Char -> Bool
+isReduced c = c `elem` "UuWiYOaAdVrzwj"
+
+mkArabicChar ('*',p) | p > 4 && p < 10 = 
+  (map toEnum [0xfefb,0xfefc,0xfe80,0xfe8b,0xfe8c]) !! (p-5)  
+mkArabicChar cp@(c,p) = case lookup c cc of Just c' -> (c' !! (p-1)) ; _ -> c 
+ where 
+   cc = mkArabicTab allArabicCodes allArabic
+
+mkArabicTab (c:cs) as = (c,as1) : mkArabicTab cs as2 where
+  (as1,as2) = if isReduced c then splitAt 2 as else splitAt 4 as
+mkArabicTab [] _ = []
+
+allArabicCodes = "UuWiYOabAtvgHCdVrzscSDTZoxfqklmnhwjy" 
+
+allArabic :: String
+allArabic = (map toEnum [0xfe81 .. 0xfef4]) -- I=0xfe80
+
+
diff --git a/src-2.9/GF/Text/Devanagari.hs b/src-2.9/GF/Text/Devanagari.hs
new file mode 100644
index 000000000..bf4343cd0
--- /dev/null
+++ b/src-2.9/GF/Text/Devanagari.hs
@@ -0,0 +1,97 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Devanagari
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:34 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.Devanagari (mkDevanagari) where
+
+mkDevanagari :: String -> String
+mkDevanagari = digraphWordToUnicode . adHocToDigraphWord
+
+adHocToDigraphWord :: String -> [(Char, Char)]
+adHocToDigraphWord str = case str of
+  [] -> []
+  '<' : cs -> ('\\', '<') : spoolMarkup cs 
+  ' ' : cs -> ('\\', ' ') : adHocToDigraphWord cs -- skip space
+
+-- if c1 is a vowel
+  -- Two of the same vowel => lengthening 
+  c1 : c2 : cs | c1 == c2 && isVowel c1 -> (cap c1, ':') : adHocToDigraphWord cs
+  -- digraphed or long vowel
+  c1 : c2 : cs | isVowel c1 && isVowel c2 -> (cap c1, cap c2) : adHocToDigraphWord cs
+  c1 : cs | isVowel c1 -> (' ', cap c1) : adHocToDigraphWord cs
+
+-- c1 isn't a vowel
+  -- c1 : 'a' : [] -> [(' ', c1)] -- a inherent
+  -- c1 : c2 : [] | isVowel c2 -> (' ', c1) : [(' ', c2)]
+
+  -- c1 is aspirated
+  c1 : 'H' : c2 : c3 : cs | c2 == c3 && isVowel c2 -> 
+    (c1, 'H') : (c2, ':') : adHocToDigraphWord cs
+  c1 : 'H' : c2 : c3 : cs | isVowel c2 && isVowel c3 -> 
+    (c1, 'H') : (c2, c3) : adHocToDigraphWord cs
+  c1 : 'H' : 'a' : cs -> (c1, 'H') : adHocToDigraphWord cs -- a inherent
+  c1 : 'H' : c2 : cs | isVowel c2 -> (c1, 'H') : (' ', c2) : adHocToDigraphWord cs  
+  -- not vowelless at EOW
+  c1 : 'H' : ' ' : cs -> (c1, 'H') : ('\\', ' ')  : adHocToDigraphWord cs
+  c1 : 'H' : [] -> [(c1, 'H')]
+  c1 : 'H' : cs -> (c1, 'H') : (' ', '^') : adHocToDigraphWord cs -- vowelless
+
+  -- c1 unasp.
+  c1 : c2 : c3 : cs | c2 == c3 && isVowel c2 -> (' ', c1) : (c2, ':') : adHocToDigraphWord cs
+  c1 : c2 : c3 : cs | isVowel c2 && isVowel c3 -> (' ', c1) : (c2, c3) : adHocToDigraphWord cs
+  c1 : 'a' : cs -> (' ', c1) : adHocToDigraphWord cs -- a inherent
+  c1 : c2 : cs | isVowel c2 -> (' ', c1) : (' ', c2) : adHocToDigraphWord cs  
+  -- not vowelless at EOW
+  c1 : ' ' : cs -> (' ', c1) : ('\\', ' '): adHocToDigraphWord cs
+  c1 : [] -> [(' ', c1)]
+  'M' : cs -> (' ', 'M') : adHocToDigraphWord cs -- vowelless but no vowelless sign for anusvara
+  c1 : cs -> (' ', c1) : (' ', '^') : adHocToDigraphWord cs -- vowelless  
+
+isVowel x = elem x "aeiou:"
+cap :: Char -> Char
+cap x = case x of 
+  'a' -> 'A'
+  'e' -> 'E'
+  'i' -> 'I'
+  'o' -> 'O'
+  'u' -> 'U'
+  c   -> c 
+
+spoolMarkup :: String -> [(Char, Char)]
+spoolMarkup s = case s of
+  -- [] -> [] -- Shouldn't happen
+  '>' : cs -> ('\\', '>') : adHocToDigraphWord cs  
+  c1 : cs -> ('\\', c1) : spoolMarkup cs
+
+
+digraphWordToUnicode :: [(Char, Char)] -> String
+digraphWordToUnicode = map digraphToUnicode
+
+digraphToUnicode :: (Char, Char) -> Char
+digraphToUnicode (c1, c2) = case lookup (c1, c2) cc of Just c' -> c' ; _ -> c2 
+ where 
+   cc = zip allDevanagariCodes allDevanagari
+
+digraphedDevanagari = " ~ M ;__ AA: II: UU:RoLoEvE~ EE:AvA~ OAU kkH ggHNG ccH jjH \241 TTH DDH N ttH ddH nn. ppH bbH m y rr. l LL. v \231 S s h____ .-Sa: ii: uu:ror:eve~ eaiava~ oau ^____OM | -dddu______ Q X G zD.RH fy.R:L:mrmR#I#d#0#1#2#3#4#5#6#7#8#9#o" 
+
+allDevanagariCodes :: [(Char, Char)]
+allDevanagariCodes = mkPairs digraphedDevanagari
+
+allDevanagari :: String
+allDevanagari = (map toEnum [0x0901 .. 0x0970]) 
+
+mkPairs :: String -> [(Char, Char)]
+mkPairs str = case str of
+  [] -> []
+  c1 : c2 : cs -> (c1, c2) : mkPairs cs
+
diff --git a/src-2.9/GF/Text/Ethiopic.hs b/src-2.9/GF/Text/Ethiopic.hs
new file mode 100644
index 000000000..81abbf719
--- /dev/null
+++ b/src-2.9/GF/Text/Ethiopic.hs
@@ -0,0 +1,72 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Ethiopic
+-- Maintainer  : HH
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:35 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- Ascii-Unicode decoding for Ethiopian.
+-- Copyright (c) Harald Hammarström 2003 under Gnu General Public License
+-----------------------------------------------------------------------------
+
+module GF.Text.Ethiopic (mkEthiopic) where
+
+mkEthiopic :: String -> String
+mkEthiopic = digraphWordToUnicode . adHocToDigraphWord
+
+-- mkEthiopic :: String -> String
+-- mkEthiopic = reverse . unwords . (map (digraphWordToUnicode . adHocToDigraphWord)) . words
+--- reverse : assumes everything's on same line
+
+adHocToDigraphWord :: String -> [(Char, Int)]
+adHocToDigraphWord str = case str of
+  [] -> []
+  '<' : cs -> ('<', -1) : spoolMarkup cs
+  c1 : cs | isVowel c1 -> (')', vowelOrder c1) : adHocToDigraphWord cs
+  -- c1 isn't a vowel
+  c1 : cs | not (elem c1 allEthiopicCodes) -> (c1, -1) : adHocToDigraphWord cs
+  c1 : c2 : cs | isVowel c2 -> (c1, vowelOrder c2) : adHocToDigraphWord cs
+  c1 : cs -> (c1, 5) : adHocToDigraphWord cs 
+  
+spoolMarkup :: String -> [(Char, Int)]
+spoolMarkup s = case s of
+  -- [] -> [] -- Shouldn't happen
+  '>' : cs -> ('>', -1) : adHocToDigraphWord cs  
+  c1 : cs -> (c1, -1) : spoolMarkup cs
+    
+isVowel x = elem x "A\228ui\239aeoI"
+
+vowelOrder :: Char -> Int
+vowelOrder x = case x of 
+  'A' -> 0
+  '\228' -> 0 -- ä
+  'u' -> 1
+  'i' -> 2
+  'a' -> 3
+  'e' -> 4
+  'I' -> 5
+  '\239' -> 5 -- ï
+  'o' -> 6
+  c   -> 5 -- vowelless 
+
+digraphWordToUnicode = map digraphToUnicode
+
+digraphToUnicode :: (Char, Int) -> Char
+-- digraphToUnicode (c1, c2) = c1
+ 
+digraphToUnicode (c1, -1) = c1 
+digraphToUnicode (c1, c2) = toEnum (0x1200 + c2 + 8*case lookup c1 cc of Just c' -> c') 
+    where 
+      cc = zip allEthiopicCodes allEthiopic
+
+allEthiopic :: [Int]
+allEthiopic = [0 .. 44] -- x 8
+
+allEthiopicCodes = "hlHmLrs$KQ__bBtcxXnN)kW__w(zZyd_jgG_TCPSLfp"
+
+-- Q = kW, X = xW, W = kW, G = gW  
+
diff --git a/src-2.9/GF/Text/ExtendedArabic.hs b/src-2.9/GF/Text/ExtendedArabic.hs
new file mode 100644
index 000000000..d2c5faac5
--- /dev/null
+++ b/src-2.9/GF/Text/ExtendedArabic.hs
@@ -0,0 +1,99 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ExtendedArabic
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:36 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.ExtendedArabic (mkArabic0600, mkExtendedArabic) where
+
+mkArabic0600 :: String -> String
+mkArabic0600 = digraphWordToUnicode . aarnesToDigraphWord
+
+aarnesToDigraphWord :: String -> [(Char, Char)]
+aarnesToDigraphWord str = case str of
+  [] -> []
+  '<' : cs -> ('\\', '<') : spoolMarkup2 cs
+
+  'v' : cs -> ('T', 'H') : aarnesToDigraphWord cs
+  'a' : cs -> (' ', 'A') : aarnesToDigraphWord cs
+  'o' : cs -> (' ', '3') : aarnesToDigraphWord cs
+  'O' : cs -> ('\'', 'i') : aarnesToDigraphWord cs
+
+  'u' : cs -> ('\'', 'A') : aarnesToDigraphWord cs
+  'C' : cs -> (' ', 'X') : aarnesToDigraphWord cs
+
+  'U' : cs -> ('~', 'A') : aarnesToDigraphWord cs
+  'A' : cs -> ('"', 't') : aarnesToDigraphWord cs
+  'c' : cs -> ('s', 'h') : aarnesToDigraphWord cs
+  c : cs -> (' ', c) : aarnesToDigraphWord cs
+
+mkExtendedArabic :: String -> String
+mkExtendedArabic = digraphWordToUnicode . adHocToDigraphWord
+
+adHocToDigraphWord :: String -> [(Char, Char)]
+adHocToDigraphWord str = case str of
+  [] -> []
+  '<' : cs -> ('\\', '<') : spoolMarkup cs
+  -- Sorani 
+  'W' : cs -> (':', 'w') : adHocToDigraphWord cs -- ?? Will do
+  'E' : cs -> (' ', 'i') : adHocToDigraphWord cs -- ?? Letter missing!
+  'j' : cs -> ('d', 'j') : adHocToDigraphWord cs
+  'O' : cs -> ('v', 'w') : adHocToDigraphWord cs
+  'F' : cs -> (' ', 'v') : adHocToDigraphWord cs
+  'Z' : cs -> ('z', 'h') : adHocToDigraphWord cs
+  'I' : cs -> (' ', 'i') : adHocToDigraphWord cs -- ?? Letter missing!
+  'C' : cs -> ('c', 'h') : adHocToDigraphWord cs
+  -- Pashto
+  'e' : cs -> (':', 'y') : adHocToDigraphWord cs 
+  '$' : cs -> ('3', 'H') : adHocToDigraphWord cs 
+  'X' : cs -> ('s', '.') : adHocToDigraphWord cs
+  'G' : cs -> ('z', '.') : adHocToDigraphWord cs
+  'a' : cs -> (' ', 'A') : adHocToDigraphWord cs
+  'P' : cs -> ('\'', 'H') : adHocToDigraphWord cs
+  'R' : cs -> ('o', 'r') : adHocToDigraphWord cs 
+   -- Shared
+  'A' : cs -> (' ', 'h') : adHocToDigraphWord cs -- ?? Maybe to "t or 0x06d5
+  'c' : cs -> ('s', 'h') : adHocToDigraphWord cs
+  c : cs -> (' ', c) : adHocToDigraphWord cs
+
+
+-- Beginning 0x621 up and including 0x06d1
+digraphedExtendedArabic = " '~A'A'w,A'i A b\"t tTHdj H X dDH r z ssh S D T Z 3GH__________ - f q k l m n h w i y&a&w&i/a/w/i/W/o/~/'/,/|/6/v_____________#0#1#2#3#4#5#6#7#8#9#%#,#'#*>b>q$|> A2'2,3'A'w'w&y'Tb:b:BoT3b p4b4B'H:H2H\"H3Hch4HTdod.dTD:d:D3d3D4dTrvror.rvRz.:rzh4zs.+s*S:S3S3T33>ff.f: v4f.q3q-k~kok.k3k3K gog:g:G3Gvl.l3l3L:n>nTnon3n?h4H't>Y\"Yow-wvwww|w^w:w3w>y/yvy.w:y3y____ -ae"  
+
+digraphWordToUnicode = map digraphToUnicode
+
+digraphToUnicode :: (Char, Char) -> Char
+digraphToUnicode (c1, c2) = case lookup (c1, c2) cc of Just c' -> c' ; _ -> c2  
+ where 
+   cc = zip allExtendedArabicCodes allExtendedArabic
+
+allExtendedArabicCodes :: [(Char, Char)]
+allExtendedArabicCodes = mkPairs digraphedExtendedArabic
+
+allExtendedArabic :: String
+allExtendedArabic = (map toEnum [0x0621 .. 0x06d1]) 
+
+mkPairs :: String -> [(Char, Char)]
+mkPairs str = case str of
+  [] -> []
+  c1 : c2 : cs -> (c1, c2) : mkPairs cs
+
+spoolMarkup :: String -> [(Char, Char)]
+spoolMarkup s = case s of
+   [] -> [] -- Shouldn't happen
+   '>' : cs -> ('\\', '>') : adHocToDigraphWord cs
+   c1 : cs -> ('\\', c1) : spoolMarkup cs
+
+spoolMarkup2 :: String -> [(Char, Char)]
+spoolMarkup2 s = case s of
+   [] -> [] -- Shouldn't happen
+   '>' : cs -> ('\\', '>') : aarnesToDigraphWord cs
+   c1 : cs -> ('\\', c1) : spoolMarkup2 cs
diff --git a/src-2.9/GF/Text/ExtraDiacritics.hs b/src-2.9/GF/Text/ExtraDiacritics.hs
new file mode 100644
index 000000000..f3d811c2c
--- /dev/null
+++ b/src-2.9/GF/Text/ExtraDiacritics.hs
@@ -0,0 +1,37 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : ExtraDiacritics
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:36 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.ExtraDiacritics (mkExtraDiacritics) where
+
+mkExtraDiacritics :: String -> String
+mkExtraDiacritics = mkExtraDiacriticsWord
+
+mkExtraDiacriticsWord :: String -> String
+mkExtraDiacriticsWord str = case str of
+  [] -> []
+  '<' : cs -> '<' : spoolMarkup cs
+  -- 
+  '/' : cs -> toEnum 0x0301 : mkExtraDiacriticsWord cs
+  '~' : cs -> toEnum 0x0306 : mkExtraDiacriticsWord cs
+  ':' : cs -> toEnum 0x0304 : mkExtraDiacriticsWord cs -- some of these could be put in LatinA
+  '.' : cs -> toEnum 0x0323 : mkExtraDiacriticsWord cs
+  'i' : '-' : cs -> toEnum 0x0268 : mkExtraDiacriticsWord cs -- in IPA extensions
+  -- Default 
+  c : cs -> c : mkExtraDiacriticsWord cs
+
+spoolMarkup :: String -> String
+spoolMarkup s = case s of
+   [] -> [] -- Shouldn't happen
+   '>' : cs -> '>' : mkExtraDiacriticsWord cs
+   c1 : cs -> c1 : spoolMarkup cs
diff --git a/src-2.9/GF/Text/Greek.hs b/src-2.9/GF/Text/Greek.hs
new file mode 100644
index 000000000..6b9361a29
--- /dev/null
+++ b/src-2.9/GF/Text/Greek.hs
@@ -0,0 +1,172 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Greek
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:37 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.Greek (mkGreek) where
+
+mkGreek :: String -> String
+mkGreek = unwords . (map mkGreekWord) . mkGravis . words
+
+--- TODO : optimize character formation by factorizing the case expressions
+
+type GreekChar = Char
+
+mkGreekWord :: String -> [GreekChar]
+mkGreekWord = map (toEnum . mkGreekChar) . mkGreekSpec
+
+mkGravis :: [String] -> [String]
+mkGravis [] = []
+mkGravis [w] = [w]
+mkGravis (w1:w2:ws)
+ | stressed w2 = mkG w1 : mkGravis (w2:ws)
+ | otherwise = w1 : w2 : mkGravis ws
+  where
+    stressed w = any (`elem`  "'~`") w
+    mkG :: String -> String
+    mkG w = let (w1,w2) = span (/='\'') w in
+               case w2 of
+                 '\'':v:cs | not (any isVowel cs) -> w1 ++ "`" ++ [v] ++ cs
+                 '\'':'!':v:cs | not (any isVowel cs) -> w1 ++ "`!" ++ [v] ++ cs
+                 _ -> w
+    isVowel c = elem c "aehiouw"
+
+mkGreekSpec :: String -> [(Char,Int)]
+mkGreekSpec str = case str of
+  [] -> []
+  '(' :'\'': '!' : c : cs -> (c,25)  : mkGreekSpec cs
+  '(' :'~' : '!' : c : cs -> (c,27)  : mkGreekSpec cs
+  '(' :'`' : '!' : c : cs -> (c,23)  : mkGreekSpec cs
+  '(' :      '!' : c : cs -> (c,21)  : mkGreekSpec cs
+  ')' :'\'': '!' : c : cs -> (c,24)  : mkGreekSpec cs
+  ')' :'~' : '!' : c : cs -> (c,26)  : mkGreekSpec cs
+  ')' :'`' : '!' : c : cs -> (c,22)  : mkGreekSpec cs
+  ')' :      '!' : c : cs -> (c,20)  : mkGreekSpec cs
+  '\'':      '!' : c : cs -> (c,30)  : mkGreekSpec cs
+  '~' :      '!' : c : cs -> (c,31)  : mkGreekSpec cs
+  '`' :      '!' : c : cs -> (c,32)  : mkGreekSpec cs
+  '!' :            c : cs -> (c,33)  : mkGreekSpec cs
+  '(' :'\'': c : cs -> (c,5)  : mkGreekSpec cs
+  '(' :'~' : c : cs -> (c,7)  : mkGreekSpec cs
+  '(' :'`' : c : cs -> (c,3)  : mkGreekSpec cs
+  '(' :      c : cs -> (c,1)  : mkGreekSpec cs
+  ')' :'\'': c : cs -> (c,4)  : mkGreekSpec cs
+  ')' :'~' : c : cs -> (c,6)  : mkGreekSpec cs
+  ')' :'`' : c : cs -> (c,2)  : mkGreekSpec cs
+  ')' :      c : cs -> (c,0)  : mkGreekSpec cs
+  '\'':      c : cs -> (c,10) : mkGreekSpec cs
+  '~' :      c : cs -> (c,11) : mkGreekSpec cs
+  '`' :      c : cs -> (c,12) : mkGreekSpec cs
+  c   :          cs -> (c,-1) : mkGreekSpec cs
+
+mkGreekChar (c,-1) = case lookup c cc of Just c' -> c' ; _ -> fromEnum c 
+ where 
+   cc = zip "abgdezhqiklmnxoprjstyfcuw" allGreekMin
+mkGreekChar (c,n) = case (c,n) of
+  ('a',10)        -> 0x03ac 
+  ('a',11)        -> 0x1fb6
+  ('a',12)        -> 0x1f70
+  ('a',30)        -> 0x1fb4
+  ('a',31)        -> 0x1fb7
+  ('a',32)        -> 0x1fb2
+  ('a',33)        -> 0x1fb3
+  ('a',n) | n >19 -> 0x1f80 + n - 20
+  ('a',n)         -> 0x1f00 + n
+  ('e',10)        -> 0x03ad    -- ' 
+--  ('e',11)        -> 0x1fb6    -- ~ can't happen
+  ('e',12)        -> 0x1f72    -- `
+  ('e',n)         -> 0x1f10 + n
+  ('h',10)        -> 0x03ae    -- ' 
+  ('h',11)        -> 0x1fc6    -- ~
+  ('h',12)        -> 0x1f74    -- `
+
+  ('h',30)        -> 0x1fc4
+  ('h',31)        -> 0x1fc7
+  ('h',32)        -> 0x1fc2
+  ('h',33)        -> 0x1fc3
+  ('h',n) | n >19 -> 0x1f90 + n - 20
+
+  ('h',n)         -> 0x1f20 + n
+  ('i',10)        -> 0x03af    -- ' 
+  ('i',11)        -> 0x1fd6    -- ~
+  ('i',12)        -> 0x1f76    -- `
+  ('i',n)         -> 0x1f30 + n
+  ('o',10)        -> 0x03cc    -- ' 
+--  ('o',11)        -> 0x1fb6    -- ~ can't happen
+  ('o',12)        -> 0x1f78    -- `
+  ('o',n)         -> 0x1f40 + n
+  ('y',10)        -> 0x03cd    -- ' 
+  ('y',11)        -> 0x1fe6    -- ~
+  ('y',12)        -> 0x1f7a    -- `
+  ('y',n)         -> 0x1f50 + n
+  ('w',10)        -> 0x03ce    -- ' 
+  ('w',11)        -> 0x1ff6    -- ~
+  ('w',12)        -> 0x1f7c    -- `
+
+  ('w',30)        -> 0x1ff4
+  ('w',31)        -> 0x1ff7
+  ('w',32)        -> 0x1ff2
+  ('w',33)        -> 0x1ff3
+  ('w',n) | n >19 -> 0x1fa0 + n - 20
+
+  ('w',n)         -> 0x1f60 + n
+  ('r',1)         -> 0x1fe5
+  _               -> mkGreekChar (c,-1) --- should not happen
+
+allGreekMin :: [Int]
+allGreekMin = [0x03b1 .. 0x03c9]
+
+
+{-
+encoding of Greek writing. Those hard to guess are marked with ---
+
+               maj   min
+A a Alpha     0391  03b1  
+B b Beta      0392  03b2
+G g Gamma     0393  03b3
+D d Delta     0394  03b4
+E e Epsilon   0395  03b5
+Z z Zeta      0396  03b6
+H h Eta ---   0397  03b7
+Q q Theta --- 0398  03b8
+I i Iota      0399  03b9
+K k Kappa     039a  03ba
+L l Lambda    039b  03bb
+M m My        039c  03bc
+N n Ny        039d  03bd
+X x Xi        039e  03be
+O o Omikron   039f  03bf
+P p Pi        03a0  03c0
+R r Rho       03a1  03c1
+  j Sigma ---       03c2
+S s Sigma     03a3  03c3
+T t Tau       03a4  03c4
+Y y Ypsilon   03a5  03c5
+F f Phi       03a6  03c6
+C c Khi ---   03a7  03c7
+U u Psi       03a8  03c8
+W w Omega --- 03a9  03c9
+
+( spiritus asper
+) spiritus lenis
+! iota subscriptum
+
+' acutus
+~ circumflexus
+` gravis
+
+-}
+
+
+
+
+
diff --git a/src-2.9/GF/Text/Hebrew.hs b/src-2.9/GF/Text/Hebrew.hs
new file mode 100644
index 000000000..c7026d8da
--- /dev/null
+++ b/src-2.9/GF/Text/Hebrew.hs
@@ -0,0 +1,53 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Hebrew
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:37 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.Hebrew (mkHebrew) where
+
+mkHebrew :: String -> String
+mkHebrew = mkHebrewWord
+----mkHebrew = reverse . mkHebrewWord
+--- reverse : assumes everything's on same line
+
+type HebrewChar = Char
+
+-- HH 031103 added code for spooling the markup
+-- removed reverse, words, unwords 
+-- (seemed obsolete and come out wrong on the screen)
+-- AR 26/1/2004 put reverse back - needed in Fudgets (but not in Java?)
+
+mkHebrewWord :: String -> [HebrewChar]
+-- mkHebrewWord = map mkHebrewChar
+
+mkHebrewWord s = case s of 
+  [] -> [] 
+  '<' : cs -> '<' : spoolMarkup cs
+  ' ' : cs -> ' ' : mkHebrewWord cs
+  c1 : cs -> mkHebrewChar c1 : mkHebrewWord cs
+
+spoolMarkup :: String -> String
+spoolMarkup s = case s of
+  [] -> [] -- Shouldn't happen
+  '>' : cs -> '>' : mkHebrewWord cs  
+  c1 : cs -> c1 : spoolMarkup cs
+
+mkHebrewChar c = case lookup c cc of Just c' -> c' ; _ -> c 
+ where 
+   cc = zip allHebrewCodes allHebrew
+
+allHebrewCodes = "-abgdhwzHTyKklMmNnSoPpCcqrst"
+
+allHebrew :: String
+allHebrew = (map toEnum (0x05be : [0x05d0 .. 0x05ea]))
+
+
diff --git a/src-2.9/GF/Text/Hiragana.hs b/src-2.9/GF/Text/Hiragana.hs
new file mode 100644
index 000000000..ba74fc83c
--- /dev/null
+++ b/src-2.9/GF/Text/Hiragana.hs
@@ -0,0 +1,95 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Hiragana
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:38 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.Hiragana (mkJapanese) where
+
+-- long vowel romaaji must be ei, ou not ee, oo  
+
+mkJapanese :: String -> String
+mkJapanese = digraphWordToUnicode . romaajiToDigraphWord
+
+romaajiToDigraphWord :: String -> [(Char, Char)]
+romaajiToDigraphWord str = case str of
+  [] -> []
+  '<' : cs -> ('\\', '<') : spoolMarkup cs 
+  ' ' : cs -> ('\\', ' ') : romaajiToDigraphWord cs
+  
+  c1 : cs | isVowel c1 -> (' ', cap c1) : romaajiToDigraphWord cs
+
+  -- The combinations
+  c1 : 'y' : c2 : cs -> (c1, 'i') : ('y', cap c2) : romaajiToDigraphWord cs 
+
+  's' : 'h' : 'a' : cs -> ('S', 'i') : ('y', 'A') : romaajiToDigraphWord cs
+  'c' : 'h' : 'a' : cs -> ('C', 'i') : ('y', 'A') : romaajiToDigraphWord cs
+  'j' : 'a' : cs -> ('j', 'i') : ('y', 'A') : romaajiToDigraphWord cs
+
+  's' : 'h' : 'u' : cs -> ('S', 'i') : ('y', 'U') : romaajiToDigraphWord cs
+  'c' : 'h' : 'u' : cs -> ('C', 'i') : ('y', 'U') : romaajiToDigraphWord cs
+  'j' : 'u' : cs -> ('j', 'i') : ('y', 'U') : romaajiToDigraphWord cs
+
+  's' : 'h' : 'o' : cs -> ('S', 'i') : ('y', 'O') : romaajiToDigraphWord cs
+  'c' : 'h' : 'o' : cs -> ('C', 'i') : ('y', 'O') : romaajiToDigraphWord cs
+  'j' : 'o' : cs -> ('j', 'i') : ('y', 'O') : romaajiToDigraphWord cs
+
+  'd' : 'z' : c3 : cs -> ('D', c3) : romaajiToDigraphWord cs
+  't' : 's' : c3 : cs -> ('T', c3) : romaajiToDigraphWord cs
+  'c' : 'h' : c3 : cs -> ('C', c3) : romaajiToDigraphWord cs
+  's' : 'h' : c3 : cs -> ('S', c3) : romaajiToDigraphWord cs
+  'z' : 'h' : c3 : cs -> ('Z', c3) : romaajiToDigraphWord cs
+
+  c1 : ' ' : cs -> (' ', c1) : ('\\', ' ') : romaajiToDigraphWord cs -- n
+  c1 : [] -> [(' ', c1)] -- n
+   
+  c1 : c2 : cs | isVowel c2 -> (c1, c2) : romaajiToDigraphWord cs
+  c1 : c2 : cs | c1 == c2 -> ('T', 'U') : romaajiToDigraphWord (c2 : cs) -- double cons
+  c1 : cs -> (' ', c1) : romaajiToDigraphWord cs -- n
+  
+isVowel x = elem x "aeiou"
+cap :: Char -> Char
+cap x = case x of 
+  'a' -> 'A'
+  'e' -> 'E'
+  'i' -> 'I'
+  'o' -> 'O'
+  'u' -> 'U'
+  c   -> c 
+
+spoolMarkup :: String -> [(Char, Char)]
+spoolMarkup s = case s of
+  -- [] -> [] -- Shouldn't happen
+  '>' : cs -> ('\\', '>') : romaajiToDigraphWord cs  
+  c1 : cs -> ('\\', c1) : spoolMarkup cs
+
+digraphWordToUnicode :: [(Char, Char)] -> String
+digraphWordToUnicode = map digraphToUnicode
+
+digraphToUnicode :: (Char, Char) -> Char
+digraphToUnicode (c1, c2) = case lookup (c1, c2) cc of Just c' -> c' ; _ -> c2 
+ where 
+   cc = zip allHiraganaCodes allHiragana
+
+allHiraganaCodes :: [(Char, Char)]
+allHiraganaCodes = mkPairs digraphedHiragana
+
+allHiragana :: String
+allHiragana = (map toEnum [0x3041 .. 0x309f]) 
+
+mkPairs :: String -> [(Char, Char)]
+mkPairs str = case str of
+  [] -> []
+  c1 : c2 : cs -> (c1, c2) : mkPairs cs
+
+digraphedHiragana = " a A i I u U e E o OkagakigikugukegekogosazaSiZisuzusezesozotadaCijiTUTuDutedetodonaninunenohabapahibipihubupuhebepehobopomamimumemoyAyayUyuyOyorarirurerowaWawiwewo nvukAkE____<< o>>o  >'> b"
+
+
diff --git a/src-2.9/GF/Text/LatinASupplement.hs b/src-2.9/GF/Text/LatinASupplement.hs
new file mode 100644
index 000000000..f42423c91
--- /dev/null
+++ b/src-2.9/GF/Text/LatinASupplement.hs
@@ -0,0 +1,69 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : LatinASupplement
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:39 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.LatinASupplement (mkLatinASupplement) where
+
+mkLatinASupplement :: String -> String
+mkLatinASupplement = mkLatinASupplementWord
+
+mkLatinASupplementWord :: String -> String
+mkLatinASupplementWord str = case str of
+  [] -> []
+  '<' : cs -> '<' : spoolMarkup cs
+  -- Romanian & partly Turkish
+  's' : ',' : cs -> toEnum 0x015f : mkLatinASupplementWord cs
+  'a' : '%' : cs -> toEnum 0x0103 : mkLatinASupplementWord cs
+  -- Slavic and more
+  'c' : '^' : cs -> toEnum 0x010d : mkLatinASupplementWord cs
+  's' : '^' : cs -> toEnum 0x0161 : mkLatinASupplementWord cs
+  'c' : '\'' : cs -> toEnum 0x0107 : mkLatinASupplementWord cs
+  'z' : '^' : cs -> toEnum 0x017e : mkLatinASupplementWord cs
+  -- Turkish
+  'g' : '%' : cs -> toEnum 0x011f : mkLatinASupplementWord cs
+  'I' : cs -> toEnum 0x0131 : mkLatinASupplementWord cs
+  'c' : ',' : cs -> toEnum 0x00e7 : mkLatinASupplementWord cs
+  -- Polish
+  'e' : ',' : cs -> toEnum 0x0119 : mkLatinASupplementWord cs
+  'a' : ',' : cs -> toEnum 0x0105 : mkLatinASupplementWord cs
+  'l' : '/' : cs -> toEnum 0x0142 : mkLatinASupplementWord cs
+  'z' : '.' : cs -> toEnum 0x017c : mkLatinASupplementWord cs
+  'n' : '\'' : cs -> toEnum 0x0144 : mkLatinASupplementWord cs
+  's' : '\'' : cs -> toEnum 0x015b : mkLatinASupplementWord cs
+-- 'c' : '\'' : cs -> toEnum 0x0107 : mkLatinASupplementWord cs
+
+  -- Hungarian 
+  'o' : '%' : cs -> toEnum 0x0151 : mkLatinASupplementWord cs
+  'u' : '%' : cs -> toEnum 0x0171 : mkLatinASupplementWord cs
+
+  -- Mongolian
+  'j' : '^' : cs -> toEnum 0x0135 : mkLatinASupplementWord cs
+
+  -- Khowar (actually in Combining diacritical marks not Latin-A Suppl.)
+  'o' : '.' : cs -> 'o' : (toEnum 0x0323 : mkLatinASupplementWord cs)
+
+  -- Length bars over vowels e.g korean
+  'a' : ':' : cs -> toEnum 0x0101 : mkLatinASupplementWord cs
+  'e' : ':' : cs -> toEnum 0x0113 : mkLatinASupplementWord cs
+  'i' : ':' : cs -> toEnum 0x012b : mkLatinASupplementWord cs
+  'o' : ':' : cs -> toEnum 0x014d : mkLatinASupplementWord cs
+  'u' : ':' : cs -> toEnum 0x016b : mkLatinASupplementWord cs
+
+  -- Default 
+  c : cs -> c : mkLatinASupplementWord cs
+
+spoolMarkup :: String -> String
+spoolMarkup s = case s of
+   [] -> [] -- Shouldn't happen
+   '>' : cs -> '>' : mkLatinASupplementWord cs
+   c1 : cs -> c1 : spoolMarkup cs
diff --git a/src-2.9/GF/Text/OCSCyrillic.hs b/src-2.9/GF/Text/OCSCyrillic.hs
new file mode 100644
index 000000000..0d4696944
--- /dev/null
+++ b/src-2.9/GF/Text/OCSCyrillic.hs
@@ -0,0 +1,47 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:39 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.OCSCyrillic (mkOCSCyrillic) where
+
+mkOCSCyrillic :: String -> String
+mkOCSCyrillic = mkOCSCyrillicWord
+
+mkOCSCyrillicWord :: String -> String
+mkOCSCyrillicWord str = case str of
+  [] -> []
+  ' ' : cs -> ' ' : mkOCSCyrillicWord cs
+  '<' : cs -> '<' : spoolMarkup cs  
+  '\228' : cs -> toEnum 0x0463 : mkOCSCyrillicWord cs -- ä
+  'j' : 'e' : '~' : cs -> toEnum 0x0469 : mkOCSCyrillicWord cs 
+  'j' : 'o' : '~' : cs -> toEnum 0x046d : mkOCSCyrillicWord cs
+  'j' : 'e' : cs -> toEnum 0x0465 : mkOCSCyrillicWord cs
+  'e' : '~' : cs -> toEnum 0x0467 : mkOCSCyrillicWord cs
+  'o' : '~' : cs -> toEnum 0x046b : mkOCSCyrillicWord cs
+  'j' : 'u' : cs -> toEnum 0x044e : mkOCSCyrillicWord cs
+  'j' : 'a' : cs -> toEnum 0x044f : mkOCSCyrillicWord cs 
+  'u' : cs -> toEnum 0x0479 : mkOCSCyrillicWord cs
+  c : cs -> (mkOCSCyrillicChar c) : mkOCSCyrillicWord cs   
+
+spoolMarkup :: String -> String
+spoolMarkup s = case s of
+   [] -> [] -- Shouldn't happen
+   '>' : cs -> '>' : mkOCSCyrillicWord cs
+   c1 : cs -> c1 : spoolMarkup cs
+
+mkOCSCyrillicChar :: Char -> Char
+mkOCSCyrillicChar c = case lookup c cc of Just c' -> c' ; _ -> c 
+ where 
+   cc = zip "abvgdeZziJklmnoprstYfxCqwWUyIE" allOCSCyrillic
+
+allOCSCyrillic :: String
+allOCSCyrillic = (map toEnum [0x0430 .. 0x044e])
diff --git a/src-2.9/GF/Text/Russian.hs b/src-2.9/GF/Text/Russian.hs
new file mode 100644
index 000000000..c4f1bfd89
--- /dev/null
+++ b/src-2.9/GF/Text/Russian.hs
@@ -0,0 +1,56 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Russian
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:40 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.Russian (mkRussian, mkRusKOI8) where
+
+-- | an ad hoc ASCII encoding. Delimiters: @\/_ _\/@
+mkRussian :: String -> String
+mkRussian = unwords . (map mkRussianWord) . words
+
+-- | the KOI8 encoding, incomplete. Delimiters: @\/* *\/@
+mkRusKOI8 :: String -> String
+mkRusKOI8 = unwords . (map mkRussianKOI8) . words
+
+type RussianChar = Char
+
+mkRussianWord :: String -> [RussianChar]
+mkRussianWord = map (mkRussianChar allRussianCodes)
+
+mkRussianKOI8 :: String -> [RussianChar]
+mkRussianKOI8 = map (mkRussianChar allRussianKOI8)
+
+mkRussianChar chars c = case lookup c cc of Just c' -> c' ; _ -> c 
+ where 
+   cc = zip chars allRussian
+
+allRussianCodes :: [Char]
+allRussianCodes = 
+ -- changed to Ints to work with Haskell compilers e.g. GHC 6.5 CVS
+ -- which expect source files to be in UTF-8
+ -- /bringert 2006-05-19
+ -- "ÅåABVGDEXZIJKLMNOPRSTUFHCQW£}!*ÖYÄabvgdexzijklmnoprstufhcqw#01'öyä"
+ map toEnum [197,229,65,66,86,71,68,69,88,90,73,74,75,76,77,78,79,80,82,83,84,85,70,72,67,81,87,163,125,33,42,214,89,196,97,98,118,103,100,101,120,122,105,106,107,108,109,110,111,112,114,115,116,117,102,104,99,113,119,35,48,49,39,246,121,228]
+
+allRussianKOI8 :: [Char]
+allRussianKOI8 =
+ -- changed to Ints to work with Haskell compilers e.g. GHC 6.5 CVS
+ -- which expect source files to be in UTF-8
+ -- /bringert 2006-05-19
+ -- "^@áâ÷çäåöúéêëìíîïðòóôõæèãþûýøùÿüàñÁÂ×ÇÄÅÖÚÉÊËÌÍÎÏÐÒÓÔÕÆÈÃÞÛÝØÙßÜÀÑ"
+ map toEnum [94,64,225,226,247,231,228,229,246,250,233,234,235,236,237,238,239,240,242,243,244,245,230,232,227,254,251,253,248,249,255,252,224,241,193,194,215,199,196,197,214,218,201,202,203,204,205,206,207,208,210,211,212,213,198,200,195,222,219,221,216,217,223,220,192,209]
+
+allRussian :: String
+allRussian = (map toEnum (0x0401:0x0451:[0x0410 .. 0x044f])) -- Ëë in odd places
+
+
diff --git a/src-2.9/GF/Text/Tamil.hs b/src-2.9/GF/Text/Tamil.hs
new file mode 100644
index 000000000..8ee171acf
--- /dev/null
+++ b/src-2.9/GF/Text/Tamil.hs
@@ -0,0 +1,77 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Tamil
+-- Maintainer  : (Maintainer)
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:40 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Text.Tamil (mkTamil) where
+
+mkTamil :: String -> String
+mkTamil = digraphWordToUnicode . adHocToDigraphWord
+
+adHocToDigraphWord :: String -> [(Char, Char)]
+adHocToDigraphWord str = case str of
+  [] -> []
+  '<' : cs -> ('\\', '<') : spoolMarkup cs 
+  ' ' : cs -> ('\\', ' ') : adHocToDigraphWord cs -- skip space
+
+-- if c1 is a vowel
+  -- Two of the same vowel => lengthening 
+  c1 : c2 : cs | c1 == c2 && isVowel c1 -> (cap c1, ':') : adHocToDigraphWord cs  
+  -- digraphed or long vowel
+  c1 : c2 : cs | isVowel c1 && isVowel c2 -> (cap c1, cap c2) : adHocToDigraphWord cs
+  c1 : cs | isVowel c1 -> (' ', cap c1) : adHocToDigraphWord cs
+
+-- c1 isn't a vowel
+  c1 : c2 : c3 : cs | c2 == c3 && isVowel c2 -> (' ', c1) : (c2, ':') : adHocToDigraphWord cs
+  c1 : c2 : c3 : cs | isVowel c2 && isVowel c3 -> (' ', c1) : (c2, c3) : adHocToDigraphWord cs
+  c1 : 'a' : cs -> (' ', c1) : adHocToDigraphWord cs -- a inherent
+  c1 : c2 : cs | isVowel c2 -> (' ', c1) : (' ', c2) : adHocToDigraphWord cs  
+
+  c1 : cs -> (' ', c1) : (' ', '.') : adHocToDigraphWord cs -- vowelless  
+
+isVowel x = elem x "aeiou:"
+cap :: Char -> Char
+cap x = case x of 
+  'a' -> 'A'
+  'e' -> 'E'
+  'i' -> 'I'
+  'o' -> 'O'
+  'u' -> 'U'
+  c   -> c 
+
+spoolMarkup :: String -> [(Char, Char)]
+spoolMarkup s = case s of
+  -- [] -> [] -- Shouldn't happen
+  '>' : cs -> ('\\', '>') : adHocToDigraphWord cs  
+  c1 : cs -> ('\\', c1) : spoolMarkup cs
+
+digraphWordToUnicode :: [(Char, Char)] -> String
+digraphWordToUnicode = map digraphToUnicode
+
+digraphToUnicode :: (Char, Char) -> Char
+digraphToUnicode (c1, c2) = case lookup (c1, c2) cc of Just c' -> c' ; _ -> c2 
+ where 
+   cc = zip allTamilCodes allTamil
+
+mkPairs :: String -> [(Char, Char)]
+mkPairs str = case str of
+  [] -> []
+  c1 : c2 : cs -> (c1, c2) : mkPairs cs
+
+allTamilCodes :: [(Char, Char)]
+allTamilCodes = mkPairs digraphedTamil
+
+allTamil :: String
+allTamil = (map toEnum [0x0b85 .. 0x0bfa]) 
+
+digraphedTamil = " AA: II: UU:______ EE:AI__ OO:AU k______ G c__ j__ \241 T______ N t______ V n p______ m y r l L M v__ s S h________a: ii: uu:______ ee:ai__ oo:au .__________________ :______________________________#1#2#3#4#5#6#7#8#9^1^2^3=d=m=y=d=c==ru##"
+
diff --git a/src-2.9/GF/Text/Text.hs b/src-2.9/GF/Text/Text.hs
new file mode 100644
index 000000000..b55355c20
--- /dev/null
+++ b/src-2.9/GF/Text/Text.hs
@@ -0,0 +1,149 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Text
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/23 14:32:44 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.10 $
+--
+-- elementary text postprocessing. AR 21\/11\/2001.
+--
+-- This is very primitive indeed. The functions should work on
+-- token lists and not on strings. AR 5\/12\/2002
+--
+-- XML hack 14\/8\/2004; not in use yet
+-----------------------------------------------------------------------------
+
+module GF.Text.Text (untokWithXML,
+	     exceptXML,
+	     formatAsTextLit,
+	     formatAsCodeLit,
+	     formatAsText,
+	     formatAsHTML,
+	     formatAsLatex,
+	     formatAsCode,
+	     performBinds,
+	     performBindsFinnish,
+	     unStringLit,
+	     concatRemSpace
+	    ) where
+
+import GF.Data.Operations
+import Data.Char
+
+-- | does not apply untokenizer within XML tags --- heuristic "< "
+-- this function is applied from top level...
+untokWithXML :: (String -> String) -> String -> String
+untokWithXML unt s = case s of
+  '<':cs@(c:_) | isAlpha c -> '<':beg ++ ">" ++ unto (drop 1 rest) where 
+                  (beg,rest) = span (/='>') cs
+  '<':cs -> '<':unto cs ---
+  [] -> []
+  _ -> unt beg ++ unto rest where
+               (beg,rest) = span (/='<') s
+ where
+   unto = untokWithXML unt
+
+-- | ... whereas this one is embedded on a branch
+exceptXML :: (String -> String) -> String -> String
+exceptXML unt s = '<':beg ++ ">" ++ unt (drop 1 rest) where 
+  (beg,rest) = span (/='>') s
+
+formatAsTextLit :: String -> String
+formatAsTextLit = formatAsText . unwords . map unStringLit . words 
+--- hope that there will be deforestation...
+
+formatAsCodeLit :: String -> String
+formatAsCodeLit = formatAsCode . unwords . map unStringLit . words 
+
+formatAsText,formatAsHTML,formatAsLatex :: String -> String
+formatAsText  = formatAsTextGen (const False) (=="&-") 
+formatAsHTML  = formatAsTextGen (\s -> take 1 s == "<" || last s == '>') (const False) 
+formatAsLatex = formatAsTextGen ((=="\\") . take 1)  (const False) 
+
+formatAsTextGen :: (String -> Bool) -> (String -> Bool) -> String -> String
+formatAsTextGen tag para = unwords . format . cap . words where
+  format ws = case ws of
+    w :     ww | capit w -> format $ (cap ww)
+    w : c : ww | major c -> format $ (w ++ c) :(cap ww)
+    w : c : ww | minor c -> format $ (w ++ c) :    ww
+    p : c : ww | openp p -> format $ (p ++ c) :ww
+    p : c : ww | spanish p -> format $ (p ++ concat (cap [c])) :ww
+    c     : ww | para  c -> "\n\n"        : format ww
+    w     : ww           -> w             : format ww
+    [] -> []
+  cap (p:ww) | tag p = p : cap ww
+  cap ((c:cs):ww) = (toUpper c : cs) : ww
+  cap [] = []
+  capit = (=="&|")
+  major = flip elem (map singleton ".!?") 
+  minor = flip elem (map singleton ",:;)")
+  openp = all (flip elem "(")
+  spanish = all (flip elem "\161\191")
+
+formatAsCode :: String -> String
+formatAsCode = rend 0 . words where
+  -- render from BNF Converter
+  rend i ss = case ss of
+    "["      :ts -> cons "["  $ rend i ts
+    "("      :ts -> cons "("  $ rend i ts
+    "{"      :ts -> cons "{"  $ new (i+1) $ rend (i+1) ts
+    "}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts
+    "}"      :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts
+    ";"      :ts -> cons ";"  $ new i $ rend i ts
+    t  : "," :ts -> cons t    $ space "," $ rend i ts
+    t  : ")" :ts -> cons t    $ cons ")"  $ rend i ts
+    t  : "]" :ts -> cons t    $ cons "]"  $ rend i ts
+    t        :ts -> space t   $ rend i ts
+    _            -> ""
+  cons s t  = s ++ t
+  new i s   = '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s
+  space t s = if null s then t else t ++ " " ++ s
+
+performBinds :: String -> String
+performBinds = performBindsOpt (\x y -> y) 
+
+
+-- The function defines an effect of the former on the latter part,
+-- such as in vowel harmony. It is triggered by the binder token "&*"
+
+performBindsOpt :: (String -> String -> String) -> String -> String
+performBindsOpt harm = unwords . format . words where
+  format ws = case ws of
+    w : "&+" : u : ws -> format ((w ++        u) : ws)
+    w : "&*" : u : ws -> format ((w ++ harm w u) : ws)
+    w : ws            -> w : format ws
+    []                -> []
+
+-- unlexer for Finnish particles
+-- Notice: left associativity crucial for "tie &* ko &* han" --> "tieköhän"
+
+performBindsFinnish :: String -> String
+performBindsFinnish = performBindsOpt vowelHarmony where
+  vowelHarmony w p = if any (flip elem "aouAOU") w then p else map toFront p
+  toFront c = case c of
+    'A' -> '\196'
+    'O' -> '\214'
+    'a' -> '\228'
+    'o' -> '\246'
+    _ -> c
+
+unStringLit :: String -> String
+unStringLit s = case s of
+  c : cs | strlim c && strlim (last cs) -> init cs
+  _ -> s
+ where
+   strlim = (=='\'')
+
+concatRemSpace :: String -> String
+concatRemSpace = concat . words
+{-
+concatRemSpace s = case s of
+  '<':cs -> exceptXML concatRemSpace cs
+  c : cs | isSpace c -> concatRemSpace cs
+  c :cs -> c : concatRemSpace cs
+  _ -> s
+-}
diff --git a/src-2.9/GF/Text/Thai.hs b/src-2.9/GF/Text/Thai.hs
new file mode 100644
index 000000000..1b186cb3a
--- /dev/null
+++ b/src-2.9/GF/Text/Thai.hs
@@ -0,0 +1,368 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Thai
+-- Maintainer  : (Maintainer)
+-- Stability   : (experimental)
+-- Portability : (portable)
+--
+--
+-- Thai transliteration and other alphabet information.
+-----------------------------------------------------------------------------
+
+-- AR 27/12/2006. Execute test2 to see the transliteration table.
+
+module GF.Text.Thai (
+  mkThai,mkThaiWord,mkThaiPron,mkThaiFake,thaiFile,thaiPronFile,thaiFakeFile
+  ) where
+
+import qualified Data.Map as Map
+import Data.Char
+
+-- for testing
+import GF.Text.UTF8 
+import Data.List
+
+import Debug.Trace
+
+
+mkThai :: String -> String
+mkThai = concat . map mkThaiWord . words
+mkThaiPron = unwords . map mkPronSyllable . words
+mkThaiFake = unwords . map (fakeEnglish . mkPronSyllable) . words
+
+
+type ThaiChar = Char
+
+mkThaiWord :: String -> [ThaiChar]
+mkThaiWord = map (toEnum . mkThaiChar) . unchar . snd . pronAndOrth
+
+mkThaiChar :: String -> Int
+mkThaiChar c = maybe 0 id $ Map.lookup c thaiMap
+
+thaiMap :: Map.Map String Int
+thaiMap = Map.fromList $ zip allThaiTrans allThaiCodes
+
+-- convert all string literals in a text
+
+thaiStrings :: String -> String
+thaiStrings = convStrings mkThai
+
+thaiPronStrings :: String -> String
+thaiPronStrings = convStrings mkThaiPron
+
+convStrings conv s = case s of
+  '"':cs -> let (t,_:r) = span (/='"') cs in
+            '"': conv t ++ "\"" ++ convStrings conv r
+  c:cs -> c : convStrings conv cs
+  _ -> s
+
+
+-- each character is either [letter] or [letter+nonletter]
+
+unchar :: String -> [String]
+unchar s = case s of
+  c:d:cs 
+   | isAlpha d -> [c]   : unchar (d:cs)
+   | d == '?'  ->         unchar cs -- use "o?" to represent implicit 'o'
+   | otherwise -> [c,d] : unchar cs
+  [_]          -> [s]
+  _            -> []
+
+-- you can prefix transliteration by irregular phonology in []
+
+pronAndOrth :: String -> (Maybe String, String)
+pronAndOrth s = case s of
+  '[':cs -> case span (/=']') cs of
+    (p,_:o) -> (Just p,o)
+    _ -> (Nothing,s)
+  _ -> (Nothing,s)
+
+allThaiTrans :: [String]
+allThaiTrans = 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 -  -  -  -  -  -  "
+
+allThaiCodes :: [Int]
+allThaiCodes = [0x0e00 .. 0x0e7f]
+
+
+---------------------
+-- heuristic pronunciation of codes
+---------------------
+
+-- fake English for TTS, a la Teach Yourself Thai
+
+fakeEnglish :: String -> String
+fakeEnglish s = case s of
+  'a':'a':cs -> "ah"  ++ fakeEnglish cs
+  'a':'y':cs -> "ai"  ++ fakeEnglish cs
+  'a'    :cs -> "ah"  ++ fakeEnglish cs
+  'c':'h':cs -> "ch"  ++ fakeEnglish cs
+  'c'    :cs -> "j"   ++ fakeEnglish cs
+  'e':'e':cs -> "aih" ++ fakeEnglish cs
+  'g'    :cs -> "ng"  ++ fakeEnglish cs
+  'i':'i':cs -> "ee"  ++ fakeEnglish cs
+  'k':'h':cs -> "k"   ++ fakeEnglish cs
+  'k'    :cs -> "g"   ++ fakeEnglish cs
+  'O':'O':cs -> "or"  ++ fakeEnglish cs
+  'O'    :cs -> "or"  ++ fakeEnglish cs
+  'o':'o':cs -> "or"  ++ fakeEnglish cs
+  'p':'h':cs -> "p"   ++ fakeEnglish cs
+  'p'    :cs -> "b"   ++ fakeEnglish cs
+  't':'h':cs -> "t"   ++ fakeEnglish cs
+  't'    :cs -> "d"   ++ fakeEnglish cs
+  'u':'u':cs -> "oo"  ++ fakeEnglish cs
+  'u'    :cs -> "oo"  ++ fakeEnglish cs
+  'v':'v':cs -> "eu"  ++ fakeEnglish cs
+  'v'    :cs -> "eu"  ++ fakeEnglish cs
+  '\228':'\228':cs -> "air" ++ fakeEnglish cs
+  '\228'    :cs -> "a"   ++ fakeEnglish cs
+  '\246':'\246':cs -> "er"  ++ fakeEnglish cs
+  '\246'    :cs -> "er"  ++ fakeEnglish cs
+  c:cs | isTone c -> fakeEnglish cs
+  c:cs -> c : fakeEnglish cs
+  _ -> s
+ where
+   isTone = flip elem "'`^~"
+
+
+-- this works for one syllable
+
+mkPronSyllable s = case fst $ pronAndOrth s of
+  Just p -> p
+  _ -> pronSyllable $ getSyllable $ map mkThaiChar $ unchar s
+
+data Syllable = Syll {
+  initv   :: [Int],
+  initc   :: [Int],
+  midv    :: [Int],
+  finalc  :: [Int],
+  finalv  :: [Int],
+  tone    :: [Int],
+  shorten :: Bool,
+  kill    :: Bool
+  }
+   deriving Show
+
+data Tone = TMid | TLow | THigh | TRise | TFall
+  deriving Show
+
+data CClass = CLow | CMid | CHigh
+  deriving Show
+
+pronSyllable :: Syllable -> String
+pronSyllable s = 
+  initCons ++ tonem ++ vowel ++ finalCons
+ where
+
+  vowel = case (initv s, midv s, finalv s, finalc s, shorten s, tone s) of
+    ([0x0e40],[0x0e35],_,[0x0e22],_,_) -> "ia" -- e-i:y
+    ([0x0e40],[0x0e2d,0x0e35],_,_,_,_) -> "va" -- e-i:O
+    ([0x0e40],[0x0e30,0x0e35],_,[0x0e22],_,_) -> "ia" -- e-i:ya.
+    ([0x0e40],[0x0e30,0x0e2d],_,_,_,_) -> "\246"  -- e-Oa.
+    ([0x0e40],[0x0e30,0x0e32],_,_,_,_) -> "O"  -- e-a:a. -- open o 
+    ([0x0e40],[0x0e2d],_,_,_,_) -> "\246\246"        -- e-O
+    ([0x0e40],[0x0e34],_,_,_,_) -> "\246\246"        -- e-i
+    ([0x0e40],[0x0e30],_,_,_,_) -> "e"         -- e-a.
+    ([0x0e40],[0x0e32],_,_,_,_) -> "aw"        -- e-a:
+    ([0x0e40],[],[],[0x0e22],_,_) -> "\246\246y"     -- e-y
+    ([0x0e40],[],[],_,True,_) -> "e"
+
+    ([0x0e41],[0x0e30],_,_,_,_) -> "\228"         -- ä-a.
+    ([0x0e41],[],[],_,True,_)   -> "\228"
+
+    ([0x0e42],[0x0e30],_,_,_,_) -> "o"         -- o:-a.
+
+    ([],[0x0e2d],_,[0x0e22],_,_) -> "OOy"      -- Oy
+    ([],[0x0e2d],_,_,_,_)        -> "OO"       -- O
+
+    ([],[],[],_,_,_) -> "o"
+
+    (i,m,f,_,_,_) -> concatMap pronThaiChar (reverse $ f ++ m ++ i) ----
+
+  initCons = concatMap pronThaiChar $ case (reverse $ initc s) of
+    0x0e2b:cs@(_:_) -> cs -- high h
+    0x0e2d:cs@(_:_) -> cs -- O
+    cs -> cs
+
+  finalCons =
+    let (c,cs) = splitAt 1 $ finalc s
+    in
+    case c of
+      [] -> []
+      [0x0e22] -> [] --- y
+      [k] -> concatMap pronThaiChar (reverse cs) ++ finalThai k
+
+  iclass = case take 1 (reverse $ initc s) of
+    [c] -> classThai c
+    []  -> CMid -- O
+
+  isLong = not (shorten s) && case vowel of
+    _:_:_ -> True ----
+    _ -> False
+
+  isLive = case finalCons of
+    c | elem c ["n","m","g"] -> True
+    "" -> isLong
+    _ -> False
+
+  tonem = case (iclass,isLive,isLong,tone s) of
+    (_,_,_,   [0x0e4a])    -> tHigh
+    (_,_,_,   [0x0e4b])    -> tRise
+    (CLow,_,_,[0x0e49])    -> tRise
+    (_,_,_,   [0x0e49])    -> tFall
+    (CLow,_,_,[0x0e48])    -> tFall
+    (_,   _,_,[0x0e48])    -> tLow
+    (CHigh,True,_,_)       -> tRise
+    (_,    True,_,_)       -> tMid
+    (CLow,False,False,_)   -> tHigh
+    (CLow,False,_,_)       -> tFall
+    _                      -> tLow
+
+(tMid,tHigh,tLow,tRise,tFall) = ("-","'","`","~","^")
+
+isVowel c = 0x0e30 <= c && c <= 0x0e44 ----
+isCons c  = 0x0e01 <= c && c <= 0x0e2f ----
+isTone c  = 0x0e48 <= c && c <= 0x0e4b
+
+getSyllable :: [Int] -> Syllable
+getSyllable = foldl get (Syll [] [] [] [] [] [] False False) where
+  get syll c = case c of
+    0x0e47 -> syll {shorten = True}
+    0x0e4c -> syll {kill = True, finalc = tail (finalc syll)} --- always last
+    0x0e2d 
+      | null (initc syll) -> syll {initc = [c]}  -- "O"
+      | otherwise -> syll {midv = c : midv syll}
+    _ 
+      | isVowel c -> if null (initc syll) 
+                       then syll {initv = c : initv syll}
+                       else syll {midv  = c : midv syll}
+      | isCons c  -> if  null (initc syll) || 
+                        (null (midv syll) && isCluster (initc syll) c) 
+                       then syll {initc  = c : initc syll}
+                       else syll {finalc = c : finalc syll}
+      | isTone c  -> syll {tone = [c]}
+    _ -> syll ---- check this
+
+  isCluster s c = length s == 1 && (c == 0x0e23 || s == [0x0e2b])
+
+-- to test
+
+test1 = testThai "k2wa:mrak"
+test2 = putStrLn $ thaiTable
+test3 = do
+  writeFile  "thai.txt" "Thai Character Coding in GF\nAR 2007\n"
+  appendFile "thai.txt" thaiTable
+test4 = do
+  writeFile  "alphthai.txt" "Thai Characters by Pronunciation\nAR 2007\n"
+  appendFile "alphthai.txt" thaiTableAlph
+
+
+testThai :: String -> IO ()
+testThai s = do
+  putStrLn $ encodeUTF8 $ mkThai s
+  putStrLn $ unwords $ map mkPronSyllable $ words s
+
+testSyllable s =
+  let y = getSyllable $ map mkThaiChar $ unchar s 
+  in
+  putStrLn $ pronSyllable $ trace (show y) y
+
+thaiFile :: FilePath -> Maybe FilePath -> IO ()
+thaiFile f mo = do
+  s <- readFile f
+  let put = maybe putStr writeFile mo
+  put $ encodeUTF8 $ thaiStrings s
+
+thaiPronFile :: FilePath -> Maybe FilePath -> IO ()
+thaiPronFile f mo = do
+  s <- readFile f
+  let put = maybe putStr writeFile mo
+  put $ encodeUTF8 $ thaiPronStrings s
+
+thaiFakeFile :: FilePath -> Maybe FilePath -> IO ()
+thaiFakeFile f mo = do
+  s <- readFile f
+  let put = maybe putStr writeFile mo
+  put $ encodeUTF8 $ (convStrings mkThaiFake) s
+
+finalThai c = maybe "" return (Map.lookup c thaiFinalMap)
+thaiFinalMap = Map.fromList $ zip allThaiCodes finals
+
+classThai c = maybe CLow readClass (Map.lookup c thaiClassMap)
+thaiClassMap = Map.fromList $ zip allThaiCodes heights
+
+readClass s = case s of
+  'L' -> CLow
+  'M' -> CMid
+  'H' -> CHigh
+
+
+thaiTable :: String
+thaiTable = unlines $ ("\n|| hex | thai | trans | pron | fin | class |" ) : [
+  "| " ++ 
+  hex c ++ " | " ++ 
+  encodeUTF8 (showThai s) ++ " | " ++ 
+  s ++ " | " ++ 
+  pronThai s ++ " | " ++
+  [f] ++ " | " ++
+  [q] ++ " | "
+    |
+      (c,q,f,s) <- zip4 allThaiCodes heights finals allThaiTrans
+  ]
+
+thaiTableAlph :: String
+thaiTableAlph = unlines $ ("\n|| pron | thai | trans |" ) : [
+  "| " ++ a ++
+  " | " ++ unwords (map (encodeUTF8 . showThai) ss) ++ 
+  " | " ++ unwords ss ++
+  " |"
+   |
+    (a,ss) <- allProns
+  ]
+ where
+   prons = sort $ nub 
+     [p | s <- allThaiTrans, let p = pronThai s, not (null p),isAlpha (head p)]
+   allProns = 
+     [(a,[s | s <- allThaiTrans, pronThai s == a]) | a <- prons]
+
+showThai s = case s of
+  "-" -> "-"
+---  v:_ | elem v "ivu" -> map (toEnum . mkThaiChar) ["O",s] 
+  _   -> [toEnum $ mkThaiChar s]
+
+
+pronThaiChar = pronThai . recodeThai
+  
+recodeThai c = allThaiTrans !! (c - 0x0e00)
+
+pronThai s = case s of
+  [c,p]
+    | c == 'N' && isDigit p -> [p]
+    | c == 'T' && isDigit p -> ['\'',p]
+    | isDigit p   -> c:"h"
+    | p==':'      -> c:[c]
+    | elem p "%&" -> c:"y"
+    | p=='+'      -> c:"m"
+    | s == "e'"   -> "\228\228"
+    | otherwise   -> [c]
+  "O"             -> "O"
+  "e"             -> "ee"
+  [c] | isUpper c -> "" 
+  _ -> s
+
+hex = map hx . reverse . digs where
+  digs 0 = [0]
+  digs n = n `mod` 16 : digs (n `div` 16)
+  hx d = "0123456789ABCDEF" !! d
+
+heights :: String
+finals  :: String
+heights = 
+  " MHHLLLLMHLLLLMMHLLLMMHLLLMMHHLLLLLL-L-LHHHHLML" ++ replicate 99 ' '
+finals  = 
+  " kkkkkkgt-tt-ntttttntttttnpp--pppmyn-n-wttt-n--" ++ replicate 99 ' '
diff --git a/src-2.9/GF/Text/UTF8.hs b/src-2.9/GF/Text/UTF8.hs
new file mode 100644
index 000000000..5e9687684
--- /dev/null
+++ b/src-2.9/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-2.9/GF/Text/Unicode.hs b/src-2.9/GF/Text/Unicode.hs
new file mode 100644
index 000000000..9d0b9d1a8
--- /dev/null
+++ b/src-2.9/GF/Text/Unicode.hs
@@ -0,0 +1,69 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Unicode
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:42 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.12 $
+--
+-- ad hoc Unicode conversions from different alphabets.
+-- AR 12\/4\/2000, 18\/9\/2001, 30\/5\/2002, 26\/1\/2004
+-----------------------------------------------------------------------------
+
+module GF.Text.Unicode (mkUnicode, treat) where
+
+import GF.Text.Greek (mkGreek)
+import GF.Text.Arabic (mkArabic)
+import GF.Text.Hebrew (mkHebrew)
+import GF.Text.Russian (mkRussian, mkRusKOI8)
+import GF.Text.Ethiopic (mkEthiopic)
+import GF.Text.Tamil (mkTamil)
+import GF.Text.OCSCyrillic (mkOCSCyrillic)
+import GF.Text.LatinASupplement (mkLatinASupplement)
+import GF.Text.Devanagari (mkDevanagari)
+import GF.Text.Hiragana (mkJapanese)
+import GF.Text.ExtendedArabic (mkArabic0600)
+import GF.Text.ExtendedArabic (mkExtendedArabic)
+import GF.Text.ExtraDiacritics (mkExtraDiacritics)
+
+import Data.Char
+
+mkUnicode :: String -> String
+mkUnicode s = case s of
+  '/':'/':cs -> treat [] mkGreek   unic ++ mkUnicode rest
+  '/':'+':cs -> mkHebrew  unic ++ mkUnicode rest
+  '/':'-':cs -> mkArabic  unic ++ mkUnicode rest
+  '/':'_':cs -> treat [] mkRussian unic ++ mkUnicode rest
+  '/':'*':cs -> mkRusKOI8 unic ++ mkUnicode rest
+  '/':'E':cs -> mkEthiopic unic ++ mkUnicode rest
+  '/':'T':cs -> mkTamil unic ++ mkUnicode rest
+  '/':'C':cs -> mkOCSCyrillic unic ++ mkUnicode rest
+  '/':'&':cs -> mkDevanagari unic ++ mkUnicode rest
+  '/':'L':cs -> mkLatinASupplement unic ++ mkUnicode rest
+  '/':'J':cs -> mkJapanese unic ++ mkUnicode rest
+  '/':'6':cs -> mkArabic0600 unic ++ mkUnicode rest
+  '/':'A':cs -> mkExtendedArabic unic ++ mkUnicode rest
+  '/':'X':cs -> mkExtraDiacritics unic ++ mkUnicode rest
+  c:cs -> c:mkUnicode cs
+  _ -> s
+ where
+   (unic,rest) = remClosing [] $ dropWhile isSpace $ drop 2 s
+   remClosing u s = case s of
+     c:'/':s | elem c "/+-_*ETC&LJ6AX" -> (reverse u, s) --- end need not match
+     c:cs -> remClosing (c:u) cs
+     _ -> (reverse u,[]) -- forgiving missing end
+
+-- | don't convert XML tags --- assumes \<\> always means XML tags
+treat :: String -> (String -> String) -> String -> String
+treat old mk s = case s of
+     '<':cs -> mk (reverse old) ++ '<':noTreat cs
+     c:cs -> treat (c:old) mk cs
+     _ -> mk (reverse old)
+    where
+      noTreat s = case s of
+        '>':cs -> '>' : treat [] mk cs
+        c:cs -> c : noTreat cs
+        _ -> s
diff --git a/src-2.9/GF/Translate/GFT.hs b/src-2.9/GF/Translate/GFT.hs
new file mode 100644
index 000000000..e4a9d8193
--- /dev/null
+++ b/src-2.9/GF/Translate/GFT.hs
@@ -0,0 +1,56 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:43 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.7 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.Translate.GFT (main) where
+
+import GF.Compile.ShellState
+import GF.Canon.GetGFC
+import GF.API
+
+import GF.Text.Unicode
+import GF.Text.UTF8
+import GF.Infra.UseIO
+import GF.Infra.Option
+import GF.Infra.Modules (emptyMGrammar) ----
+import GF.Data.Operations
+
+import System
+import Data.List
+
+
+main :: IO ()
+main = do
+  file:_ <- getArgs
+  let opts = noOptions
+  can    <- useIOE (error "no grammar file") $ getCanonGrammar file
+  st     <- err error return $ 
+               grammar2shellState opts (can, emptyMGrammar)
+  let grs = allStateGrammars st
+  let cat = firstCatOpts opts (firstStateGrammar st)
+
+----  interact (doTranslate grs cat)
+  s <- getLine
+  putStrLnFlush $ doTranslate grs cat $ drop 2 s -- to remove "n="
+
+doTranslate grs cat s =
+  let ss = [l +++ ":" +++ s | (l,s) <- zip (map (prIdent . cncId) grs) 
+                                                (translateBetweenAll grs cat s)]
+  in mkHTML ss
+
+mkHTML = unlines . htmlDoc . intersperse "<p>" . map (encodeUTF8 . mkUnicode) . sort
+
+htmlDoc ss = "<html>":metaHead:"<body>": ss ++ ["</body>","</html>"]
+
+metaHead =
+ "<HEAD><META http-equiv=Content-Type content=\"text/html; charset=utf-8\"></HEAD>"
+
diff --git a/src-2.9/GF/UseGrammar/Custom.hs b/src-2.9/GF/UseGrammar/Custom.hs
new file mode 100644
index 000000000..983b7f683
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Custom.hs
@@ -0,0 +1,494 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Custom
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/16 10:21:21 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.85 $
+--
+-- A database for customizable GF shell commands. 
+--
+-- databases for customizable commands. AR 21\/11\/2001.
+-- for:  grammar parsers, grammar printers, term commands, string commands.
+-- idea: items added here are usable throughout GF; nothing else need be edited.
+-- they are often usable through the API: hence API cannot be imported here!
+--
+-- Major redesign 3\/4\/2002: the first entry in each database is DEFAULT.
+-- If no other value is given, the default is selected.
+-- Because of this, two invariants have to be preserved:
+--
+--  - no databases may be empty
+--
+--  - additions are made to the end of the database
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Custom where
+
+import GF.Data.Operations
+import GF.Text.Text
+import GF.UseGrammar.Tokenize
+import GF.Grammar.Values
+import qualified GF.Grammar.Grammar as G
+import qualified GF.Canon.AbsGFC as A
+import qualified GF.Canon.GFC as C
+
+import qualified GF.Devel.GFCCtoJS as JS
+import GF.Canon.CanonToGFCC
+import qualified GF.Devel.GFCCtoHaskell as CCH
+
+import qualified GF.Source.AbsGF as GF
+import qualified GF.Grammar.MMacros as MM
+import GF.Grammar.AbsCompute
+import GF.Grammar.TypeCheck
+import GF.UseGrammar.Generate
+import GF.UseGrammar.MatchTerm
+import GF.UseGrammar.Linear (unoptimizeCanon)
+------import Compile
+import GF.Compile.ShellState
+import GF.UseGrammar.Editing
+import GF.UseGrammar.Paraphrases
+import GF.Infra.Option
+import GF.CF.CF
+import GF.CF.CFIdent
+
+import GF.Canon.CanonToGrammar
+import GF.CF.PPrCF
+import GF.CF.PrLBNF
+import GF.Grammar.PrGrammar
+import GF.Compile.PrOld
+import GF.Canon.MkGFC
+import GF.Speech.PrGSL (gslPrinter)
+import GF.Speech.PrJSGF (jsgfPrinter)
+import GF.Speech.PrSRGS
+import GF.Speech.PrSRGS_ABNF
+import qualified GF.Speech.SISR as SISR
+import GF.Speech.PrSLF
+import GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter)
+import GF.Speech.PrRegExp (regexpPrinter,multiRegexpPrinter)
+import GF.Speech.GrammarToVoiceXML (grammar2vxml)
+
+import GF.Data.Zipper
+
+import GF.UseGrammar.Statistics
+import GF.UseGrammar.Morphology
+import GF.UseGrammar.Information
+import GF.API.GrammarToHaskell
+import GF.API.GrammarToTransfer
+-----import GrammarToCanon (showCanon, showCanonOpt)
+-----import qualified GrammarToGFC as GFC
+import GF.Probabilistic.Probabilistic (prProbs)
+
+-- the cf parsing algorithms
+import GF.CF.ChartParser -- OBSOLETE
+import qualified GF.Parsing.CF as PCF
+import qualified GF.OldParsing.ParseCF as PCFOld -- OBSOLETE
+
+-- grammar conversions -- peb 19/4-04
+-- see also customGrammarPrinter
+import qualified GF.OldParsing.ConvertGrammar as CnvOld -- OBSOLETE
+import qualified GF.Printing.PrintParser as PrtOld -- OBSOLETE
+import qualified GF.Infra.Print as Prt
+import qualified GF.Conversion.GFC as Cnv
+import qualified GF.Conversion.Types as CnvTypes
+import qualified GF.Conversion.Haskell as CnvHaskell
+import qualified GF.Conversion.Prolog as CnvProlog
+import qualified GF.Conversion.TypeGraph as CnvTypeGraph
+import GF.Canon.Unparametrize
+import GF.Canon.Subexpressions
+import GF.Canon.AbsToBNF
+
+import GF.Canon.GFC
+import qualified GF.Canon.MkGFC as MC
+import GF.CFGM.PrintCFGrammar (prCanonAsCFGM)
+import GF.Visualization.VisualizeGrammar (visualizeCanonGrammar, visualizeSourceGrammar)
+
+import GF.API.MyParser
+
+import qualified GF.Infra.Modules as M
+import GF.Infra.UseIO
+
+import Control.Monad
+import Data.Char
+import Data.Maybe (fromMaybe)
+
+-- character codings
+import GF.Text.Unicode
+import GF.Text.UTF8 (decodeUTF8)
+import GF.Text.Greek (mkGreek)
+import GF.Text.Arabic (mkArabic)
+import GF.Text.Hebrew (mkHebrew)
+import GF.Text.Russian (mkRussian, mkRusKOI8)
+import GF.Text.Ethiopic (mkEthiopic)
+import GF.Text.Tamil (mkTamil)
+import GF.Text.OCSCyrillic (mkOCSCyrillic)
+import GF.Text.LatinASupplement (mkLatinASupplement)
+import GF.Text.Devanagari (mkDevanagari)
+import GF.Text.Hiragana (mkJapanese)
+import GF.Text.ExtendedArabic (mkArabic0600)
+import GF.Text.ExtendedArabic (mkExtendedArabic)
+import GF.Text.ExtraDiacritics (mkExtraDiacritics)
+
+-- minimal version also used in Hugs. AR 2/12/2002. 
+
+-- databases for customizable commands. AR 21/11/2001
+-- for:  grammar parsers, grammar printers, term commands, string commands
+-- idea: items added here are usable throughout GF; nothing else need be edited
+-- they are often usable through the API: hence API cannot be imported here!
+
+-- Major redesign 3/4/2002: the first entry in each database is DEFAULT.
+-- If no other value is given, the default is selected.
+-- Because of this, two invariants have to be preserved:
+--  - no databases may be empty
+--  - additions are made to the end of the database
+
+-- * these are the databases; the comment gives the name of the flag
+
+-- | grammarFormat, \"-format=x\" or file suffix
+customGrammarParser :: CustomData (FilePath -> IOE C.CanonGrammar) 
+
+-- | grammarPrinter, \"-printer=x\"
+customGrammarPrinter :: CustomData (Options -> StateGrammar -> String)             
+
+-- | multiGrammarPrinter, \"-printer=x\"
+customMultiGrammarPrinter :: CustomData (Options -> CanonGrammar -> String)    
+
+-- | syntaxPrinter, \"-printer=x\"
+customSyntaxPrinter  :: CustomData (GF.Grammar -> String)        
+
+-- | termPrinter, \"-printer=x\"
+customTermPrinter  :: CustomData (StateGrammar -> Tree -> String)
+
+-- | termCommand, \"-transform=x\"
+customTermCommand    :: CustomData (StateGrammar -> Tree -> [Tree])
+
+-- | editCommand, \"-edit=x\"
+customEditCommand    :: CustomData (StateGrammar -> Action)
+
+-- | filterString, \"-filter=x\"
+customStringCommand  :: CustomData (StateGrammar -> String -> String)
+
+-- | useParser, \"-parser=x\"
+customParser         :: CustomData (StateGrammar -> CFCat -> CFParser)
+
+-- | useTokenizer, \"-lexer=x\"
+customTokenizer      :: CustomData (StateGrammar -> String -> [[CFTok]])  
+
+-- | useUntokenizer, \"-unlexer=x\" --- should be from token list to string
+customUntokenizer    :: CustomData (StateGrammar -> String -> String)  
+
+-- | uniCoding, \"-coding=x\"
+--
+-- contains conversions from different codings to the internal
+-- unicode coding
+customUniCoding :: CustomData (String -> String)
+
+-- | this is the way of selecting an item
+customOrDefault :: Options -> OptFun -> CustomData a -> a
+customOrDefault opts optfun db = maybe (defaultCustomVal db) id $ 
+                                   customAsOptVal opts optfun db
+
+-- | to produce menus of custom operations
+customInfo :: CustomData a -> (String, [String])
+customInfo c = (titleCustomData c, map (ciStr . fst) (dbCustomData c))
+
+-------------------------------
+-- * types and stuff 
+
+type CommandId = String
+
+strCI :: String -> CommandId
+strCI = id
+
+ciStr :: CommandId -> String
+ciStr = id
+
+ciOpt :: CommandId -> Option
+ciOpt = iOpt
+
+newtype CustomData a = CustomData (String, [(CommandId,a)])
+
+customData :: String -> [(CommandId, a)] -> CustomData a
+customData title db = CustomData (title,db)
+
+dbCustomData :: CustomData a -> [(CommandId, a)]
+dbCustomData (CustomData (_,db)) = db
+
+titleCustomData :: CustomData a -> String
+titleCustomData (CustomData (t,_)) = t
+
+lookupCustom :: CustomData a -> CommandId -> Maybe a
+lookupCustom = flip lookup . dbCustomData
+
+customAsOptVal :: Options -> OptFun -> CustomData a -> Maybe a
+customAsOptVal opts optfun db = do
+  arg <- getOptVal opts optfun
+  lookupCustom db (strCI arg)
+
+-- | take the first entry from the database
+defaultCustomVal :: CustomData a -> a
+defaultCustomVal (CustomData (s,db)) = 
+  ifNull (error ("empty database:" +++ s)) (snd . head) db
+
+-------------------------------------------------------------------------
+-- * and here's the customizable part:
+
+-- grammar parsers: the ID is also used as file name suffix
+customGrammarParser = 
+  customData "Grammar parsers, selected by file name suffix" $
+  [
+------   (strCI "gf",  compileModule noOptions) -- DEFAULT
+-- add your own grammar parsers here
+  ] 
+
+
+customGrammarPrinter = 
+  customData "Grammar printers, selected by option -printer=x" $
+  [
+   (strCI "gfc",     \_ -> prCanon . stateGrammarST) -- DEFAULT
+  ,(strCI "gf",      \_ -> err id prGrammar . canon2sourceGrammar . stateGrammarST)
+  ,(strCI "cf",      \_ -> prCF . stateCF)
+  ,(strCI "old",     \_ -> printGrammarOld . stateGrammarST)
+  ,(strCI "gsl",     gslPrinter)
+  ,(strCI "jsgf",    jsgfPrinter Nothing)
+  ,(strCI "jsgf_sisr_old", jsgfPrinter (Just SISR.SISROld))
+  ,(strCI "srgs_xml",           srgsXmlPrinter Nothing False)
+  ,(strCI "srgs_xml_non_rec",   srgsXmlNonRecursivePrinter)
+  ,(strCI "srgs_xml_prob",      srgsXmlPrinter Nothing True)
+  ,(strCI "srgs_xml_sisr_old",  srgsXmlPrinter (Just SISR.SISROld) False)
+  ,(strCI "srgs_abnf",          srgsAbnfPrinter Nothing False)
+  ,(strCI "srgs_abnf_non_rec",  srgsAbnfNonRecursivePrinter)
+  ,(strCI "srgs_abnf_sisr_old", srgsAbnfPrinter (Just SISR.SISROld) False)
+  ,(strCI "vxml", grammar2vxml)
+  ,(strCI "slf",  slfPrinter)
+  ,(strCI "slf_graphviz", slfGraphvizPrinter)
+  ,(strCI "slf_sub", slfSubPrinter)
+  ,(strCI "slf_sub_graphviz", slfSubGraphvizPrinter)
+  ,(strCI "fa_graphviz", faGraphvizPrinter)
+  ,(strCI "fa_c",  faCPrinter)
+  ,(strCI "regexp", regexpPrinter)
+  ,(strCI "regexps", multiRegexpPrinter)
+  ,(strCI "regular", regularPrinter)
+  ,(strCI "plbnf",   \_ -> prLBNF True)
+  ,(strCI "lbnf",    \_ -> prLBNF False)
+  ,(strCI "bnf",     \_ -> prBNF False)
+  ,(strCI "absbnf",  \_ -> abstract2bnf . stateGrammarST)
+  ,(strCI "haskell", \_ -> grammar2haskell . stateGrammarST)
+  ,(strCI "gfcc_haskell", \opts -> CCH.grammar2haskell . 
+                                canon2gfcc opts . stateGrammarST)
+  ,(strCI "haskell_gadt", \_ -> grammar2haskellGADT . stateGrammarST)
+  ,(strCI "transfer", \_ -> grammar2transfer . stateGrammarST)
+  ,(strCI "morpho",  \_ -> prMorpho . stateMorpho)
+  ,(strCI "fullform",\_ -> prFullForm . stateMorpho)
+  ,(strCI "opts",    \_ -> prOpts . stateOptions)
+  ,(strCI "words",   \_ -> unwords . stateGrammarWords)
+  ,(strCI "printnames", \_ -> C.prPrintnamesGrammar . stateGrammarST)
+  ,(strCI "stat",    \_ -> prStatistics . stateGrammarST)
+  ,(strCI "probs",   \_ -> prProbs . stateProbs)
+  ,(strCI "unpar",   \_ -> prCanon . unparametrizeCanon . stateGrammarST)
+  ,(strCI "subs",    \_ -> prSubtermStat . stateGrammarST)
+
+{- ----
+   (strCI "gf",      prt  . st2grammar . stateGrammarST)  -- DEFAULT
+  ,(strCI "canon",   showCanon "Lang" . stateGrammarST)
+  ,(strCI "gfc",     GFC.showGFC . stateGrammarST)
+  ,(strCI "canonOpt",showCanonOpt "Lang" . stateGrammarST)
+-}
+
+-- add your own grammar printers here
+
+-- grammar conversions:
+  ,(strCI "mcfg",     \_ -> Prt.prt . stateMCFG)
+  ,(strCI "fcfg",     \_ -> Prt.prt . fst . stateFCFG)
+  ,(strCI "cfg",      \_ -> Prt.prt . stateCFG)
+  ,(strCI "pinfo",    \_ -> Prt.prt . statePInfo)
+  ,(strCI "abstract", \_ -> Prt.prtAfter "\n" . Cnv.gfc2abstract . stateGrammarLang)
+
+  ,(strCI "functiongraph",\_ -> CnvTypeGraph.prtFunctionGraph . Cnv.gfc2simple noOptions . stateGrammarLang)
+  ,(strCI "typegraph",    \_ -> CnvTypeGraph.prtTypeGraph . Cnv.gfc2simple noOptions . stateGrammarLang)
+
+  ,(strCI "gfc-haskell",  \_ -> CnvHaskell.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts)
+  ,(strCI "mcfg-haskell", \_ -> CnvHaskell.prtMGrammar . stateMCFG)
+  ,(strCI "cfg-haskell",  \_ -> CnvHaskell.prtCGrammar . stateCFG)
+  ,(strCI "gfc-prolog",   \_ -> CnvProlog.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts)
+  ,(strCI "mcfg-prolog",  \_ -> CnvProlog.prtMGrammar . stateMCFG)
+  ,(strCI "cfg-prolog",   \_ -> CnvProlog.prtCGrammar . stateCFG)
+
+-- obsolete, or only for testing:
+  ,(strCI "abs-skvatt", \_ -> Cnv.abstract2skvatt . Cnv.gfc2abstract . stateGrammarLang)
+  ,(strCI "cfg-skvatt", \_ -> Cnv.cfg2skvatt . stateCFG)
+  ,(strCI "simple",   \_ -> Prt.prt . uncurry Cnv.gfc2simple . stateGrammarLangOpts)
+  ,(strCI "mcfg-erasing", \_ -> Prt.prt . fst . snd . uncurry Cnv.convertGFC . stateGrammarLangOpts)
+--  ,(strCI "mcfg-old", PrtOld.prt . CnvOld.mcfg . statePInfoOld)
+--  ,(strCI "cfg-old",  PrtOld.prt . CnvOld.cfg . statePInfoOld)
+  ] 
+  where stateGrammarLangOpts s = (stateOptions s, stateGrammarLang s)
+
+customMultiGrammarPrinter = 
+  customData "Printers for multiple grammars, selected by option -printer=x" $
+  [
+   (strCI "gfcm", const MC.prCanon)
+  ,(strCI "gfcc", canon2gfccPr)
+  ,(strCI "js", \opts -> JS.gfcc2js . canon2gfcc opts)
+  ,(strCI "header", const (MC.prCanonMGr . unoptimizeCanon))
+  ,(strCI "cfgm", prCanonAsCFGM)
+  ,(strCI "graph", visualizeCanonGrammar)
+  ,(strCI "missing", const missingLinCanonGrammar)
+
+-- to prolog format:
+  ,(strCI "gfc-prolog", CnvProlog.prtSMulti)
+  ,(strCI "mcfg-prolog", CnvProlog.prtMMulti)
+  ,(strCI "cfg-prolog", CnvProlog.prtCMulti)
+  ]
+
+
+customSyntaxPrinter = 
+  customData "Syntax printers, selected by option -printer=x" $
+  [ 
+-- add your own grammar printers here
+  ] 
+
+
+customTermPrinter = 
+  customData "Term printers, selected by option -printer=x" $
+  [ 
+    (strCI "gf",     const prt) -- DEFAULT
+-- add your own term printers here
+  ]
+
+customTermCommand = 
+  customData "Term transformers, selected by option -transform=x" $
+  [
+   (strCI "identity",   \_ t -> [t]) -- DEFAULT
+  ,(strCI "compute",    \g t -> let gr = grammar g in
+                                  err (const [t]) return 
+                                    (exp2termCommand gr (computeAbsTerm gr) t))
+  ,(strCI "nodup",      \_ t -> if (hasDupIdent $ tree2exp t) then [] else [t])
+  ,(strCI "nodupatom",  \_ t -> if (hasDupAtom  $ tree2exp t) then [] else [t])
+  ,(strCI "paraphrase", \g t -> let gr = grammar g in
+                                  exp2termlistCommand gr (mkParaphrases gr) t)
+
+  ,(strCI "generate",   \g t -> let gr = grammar g
+                                    cat = actCat $ tree2loc t --- not needed
+                                in
+                         [tr | t <- generateTrees noOptions gr cat 2 Nothing (Just t), 
+                               Ok tr <- [annotate gr $ MM.qualifTerm (absId g) t]])
+  ,(strCI "typecheck",   \g t -> err (const []) (return . loc2tree)
+                                    (reCheckStateReject (grammar g) (tree2loc t)))
+  ,(strCI "solve",      \g t -> err (const []) (return . loc2tree)
+                                   (solveAll (grammar g) (tree2loc t)
+                                      >>= rejectUnsolvable))
+  ,(strCI "context",    \g t -> err (const [t]) (return . loc2tree)
+                                   (contextRefinements (grammar g) (tree2loc t)))
+  ,(strCI "reindex",    \g t -> let gr = grammar g in
+                                  err (const [t]) return 
+                                    (exp2termCommand gr (return . MM.reindexTerm) t))
+---  ,(strCI "delete",     \g t -> [MM.mExp0])
+-- add your own term commands here
+  ]
+
+customEditCommand = 
+  customData "Editor state transformers, selected by option -edit=x" $
+  [
+   (strCI "identity",   const return) -- DEFAULT
+  ,(strCI "typecheck",  \g -> reCheckState (grammar g))
+  ,(strCI "solve",      \g -> solveAll (grammar g))
+  ,(strCI "context",    \g -> contextRefinements (grammar g))
+  ,(strCI "compute",    \g -> computeSubTree (grammar g))
+  ,(strCI "paraphrase", const return) --- done ad hoc on top level
+  ,(strCI "generate",   const return) --- done ad hoc on top level
+  ,(strCI "transfer",   const return) --- done ad hoc on top level
+-- add your own edit commands here
+  ]
+
+customStringCommand = 
+  customData "String filters, selected by option -filter=x" $
+  [
+   (strCI "identity",  const $ id)   -- DEFAULT
+  ,(strCI "erase",     const $ const "")
+  ,(strCI "take100",   const $ take 100)
+  ,(strCI "text",      const $ formatAsText)
+  ,(strCI "code",      const $ formatAsCode)
+----  ,(strCI "latexfile", const $ mkLatexFile)
+  ,(strCI "length",    const $ show . length)
+-- add your own string commands here
+  ]
+
+customParser = 
+  customData "Parsers, selected by option -parser=x" $
+  [
+   (strCI "chart",  PCFOld.parse "ibn" . stateCF) -- DEPRECATED
+  ,(strCI "bottomup",  PCF.parse "gb" . stateCF)
+  ,(strCI "topdown",  PCF.parse "gt" . stateCF)
+-- commented for now, since there's a bug in the incremental algorithm:
+--   ,(strCI "incremental",  PCF.parse "ib" . stateCF)
+--   ,(strCI "incremental-bottomup",  PCF.parse "ib" . stateCF)
+--   ,(strCI "incremental-topdown",  PCF.parse "it" . stateCF)
+  ,(strCI "old",    chartParser . stateCF) -- DEPRECATED
+  ,(strCI "myparser", myParser)
+-- add your own parsers here
+  ]
+
+customTokenizer =
+  let sg = singleton in 
+  customData "Tokenizers, selected by option -lexer=x" $
+  [
+   (strCI "words",     const $ sg . tokWords)
+  ,(strCI "literals",  const $ sg . tokLits)
+  ,(strCI "vars",      const $ sg . tokVars)
+  ,(strCI "chars",     const $ sg . map (tS . singleton))
+  ,(strCI "code",      const $ sg . lexHaskell)
+  ,(strCI "codevars",  \gr -> sg . (lexHaskellVar $ stateIsWord gr))
+  ,(strCI "textvars",  \gr -> sg . (lexTextVar $ stateIsWord gr))
+  ,(strCI "text",      const $ sg . lexText)
+  ,(strCI "unglue",    \gr -> sg . map tS . decomposeWords (stateMorpho gr))
+  ,(strCI "codelit",   \gr -> sg . (lexHaskellLiteral $ stateIsWord gr))
+  ,(strCI "textlit",   \gr -> sg . (lexTextLiteral $ stateIsWord gr))
+  ,(strCI "codeC",     const $ sg . lexC2M)
+  ,(strCI "ignore",    \gr -> sg . lexIgnore (stateIsWord gr) . tokLits)
+  ,(strCI "subseqs",   \gr -> subSequences . lexIgnore (stateIsWord gr) . tokLits)
+  ,(strCI "codeCHigh", const $ sg . lexC2M' True)
+-- add your own tokenizers here
+  ]
+
+customUntokenizer = 
+  customData "Untokenizers, selected by option -unlexer=x" $
+  [
+   (strCI "unwords",   const $ id)   -- DEFAULT
+  ,(strCI "text",      const $ formatAsText)
+  ,(strCI "html",      const $ formatAsHTML)
+  ,(strCI "latex",     const $ formatAsLatex)
+  ,(strCI "code",      const $ formatAsCode)
+  ,(strCI "concat",    const $ filter (not . isSpace))
+  ,(strCI "textlit",   const $ formatAsTextLit)
+  ,(strCI "codelit",   const $ formatAsCodeLit)
+  ,(strCI "concat",    const $ concatRemSpace)
+  ,(strCI "glue",      const $ performBinds)
+  ,(strCI "finnish",   const $ performBindsFinnish)
+  ,(strCI "reverse",   const $ reverse)
+  ,(strCI "bind",      const $ performBinds) -- backward compat
+-- add your own untokenizers here
+  ]
+
+customUniCoding = 
+  customData "Alphabet codings, selected by option -coding=x" $
+  [
+   (strCI "latin1",           id) -- DEFAULT
+  ,(strCI "utf8",             decodeUTF8)
+  ,(strCI "greek",            treat [] mkGreek)
+  ,(strCI "hebrew",           mkHebrew)
+  ,(strCI "arabic",           mkArabic)
+  ,(strCI "russian",          treat [] mkRussian)
+  ,(strCI "russianKOI8",      mkRusKOI8)
+  ,(strCI "ethiopic",         mkEthiopic)
+  ,(strCI "tamil",            mkTamil)
+  ,(strCI "OCScyrillic",      mkOCSCyrillic)
+  ,(strCI "devanagari",       mkDevanagari)
+  ,(strCI "latinasupplement", mkLatinASupplement)
+  ,(strCI "japanese",         mkJapanese)
+  ,(strCI "arabic0600",       mkArabic0600)
+  ,(strCI "extendedarabic",   mkExtendedArabic)
+  ,(strCI "extradiacritics",  mkExtraDiacritics)
+  ]
diff --git a/src-2.9/GF/UseGrammar/Editing.hs b/src-2.9/GF/UseGrammar/Editing.hs
new file mode 100644
index 000000000..762562eb0
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Editing.hs
@@ -0,0 +1,435 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Editing
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:45 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.14 $
+--
+-- generic tree editing, with some grammar notions assumed. AR 18\/8\/2001.
+-- 19\/6\/2003 for GFC
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Editing where
+
+import GF.Grammar.Abstract
+import qualified GF.Canon.GFC as GFC
+import GF.Grammar.TypeCheck
+import GF.Grammar.LookAbs
+import GF.Grammar.AbsCompute
+import GF.Grammar.Macros (errorCat)
+
+import GF.Data.Operations
+import GF.Data.Zipper
+
+-- generic tree editing, with some grammar notions assumed. AR 18/8/2001 
+-- 19/6/2003 for GFC
+
+type CGrammar = GFC.CanonGrammar
+
+type State = Loc TrNode
+
+-- | the "empty" state
+initState :: State
+initState = tree2loc uTree 
+
+isRootState :: State -> Bool
+isRootState s = case actPath s of
+  Top -> True
+  _ -> False
+
+actTree :: State -> Tree
+actTree (Loc (t,_)) = t
+
+actPath :: State -> Path TrNode
+actPath (Loc (_,p)) = p
+
+actVal :: State -> Val
+actVal = valNode . nodeTree . actTree
+
+actCat :: State -> Cat
+actCat = errVal errorCat . val2cat . actVal ---- undef
+
+actAtom :: State -> Atom
+actAtom = atomTree . actTree
+
+actFun :: State -> Err Fun
+actFun s = case actAtom s of
+  AtC f -> return f
+  t -> prtBad "active atom: expected function, found" t
+
+actExp :: State -> Exp
+actExp = tree2exp . actTree
+
+-- | current local bindings
+actBinds :: State -> Binds
+actBinds = bindsNode . nodeTree . actTree
+
+-- | constraints in current subtree
+actConstrs :: State -> Constraints
+actConstrs = allConstrsTree . actTree   
+
+-- | constraints in the whole tree
+allConstrs :: State -> Constraints
+allConstrs = allConstrsTree . loc2tree   
+
+-- | metas in current subtree
+actMetas :: State -> [Meta]
+actMetas = metasTree . actTree   
+
+-- | metas in the whole tree
+allMetas :: State -> [Meta]
+allMetas = metasTree . loc2tree
+
+actTreeBody :: State -> Tree
+actTreeBody = bodyTree . actTree
+
+allPrevBinds :: State -> Binds
+allPrevBinds = concatMap bindsNode . traverseCollect . actPath
+
+allBinds :: State -> Binds
+allBinds s = actBinds s ++ allPrevBinds s
+
+actGen :: State -> Int
+actGen = length . allBinds -- symbol generator for VGen
+
+allPrevVars :: State -> [Var]
+allPrevVars = map fst . allPrevBinds
+
+allVars :: State -> [Var]
+allVars = map fst . allBinds
+
+vGenIndex :: State -> Int
+vGenIndex = length . allBinds
+
+actIsMeta :: State -> Bool
+actIsMeta = atomIsMeta . actAtom
+
+actMeta :: State -> Err Meta
+actMeta = getMetaAtom . actAtom
+
+-- | meta substs are not only on the actual path...
+entireMetaSubst :: State -> MetaSubst
+entireMetaSubst = concatMap metaSubstsNode . scanTree . loc2tree
+
+isCompleteTree :: Tree -> Bool
+isCompleteTree = null . filter atomIsMeta . map atomNode . scanTree 
+
+isCompleteState :: State -> Bool
+isCompleteState = isCompleteTree . loc2tree
+
+initStateCat :: Context -> Cat -> Err State
+initStateCat cont cat = do
+  return $ tree2loc (Tr (mkNode [] mAtom (cat2val cont cat) ([],[]), []))
+
+-- | this function only concerns the body of an expression...
+annotateInState :: CGrammar -> Exp -> State -> Err Tree
+annotateInState gr exp state = do
+  let binds = allBinds state
+      val   = actVal state
+  annotateIn gr binds exp (Just val)
+
+-- | ...whereas this one works with lambda abstractions
+annotateExpInState :: CGrammar -> Exp -> State -> Err Tree
+annotateExpInState gr exp state = do
+  let cont  = allPrevBinds state
+      binds = actBinds state
+      val   = actVal state
+  typ <- mkProdVal binds val
+  annotateIn gr binds exp (Just typ)
+  
+treeByExp :: (Exp -> Err Exp) -> CGrammar -> Exp -> State -> Err Tree
+treeByExp trans gr exp0 state = do
+  exp <- trans exp0
+  annotateExpInState gr exp state
+
+-- * actions
+
+type Action = State -> Err State
+
+newCat :: CGrammar -> Cat -> Action
+newCat gr cat@(m,c) _ = do
+  cont <- lookupCatContext gr m c
+  testErr (null cont) "start cat must have null context" -- for easier meta refresh
+  initStateCat cont cat
+
+newFun :: CGrammar -> Fun -> Action
+newFun gr fun@(m,c) _ = do
+  typ <- lookupFunType gr m c
+  cat <- valCat typ
+  st1 <- newCat gr cat initState
+  refineWithAtom True gr (qq fun) st1
+
+newTree :: Tree -> Action
+newTree t _ = return $ tree2loc t
+
+newExpTC :: CGrammar -> Exp -> Action
+newExpTC gr t s = annotate gr (refreshMetas [] t) >>= flip newTree s
+
+goNextMeta, goPrevMeta, goNextNewMeta, goPrevNewMeta, goNextMetaIfCan :: Action
+
+goNextMeta = repeatUntilErr actIsMeta goAhead -- can be the location itself
+goPrevMeta = repeatUntilErr actIsMeta goBack
+
+goNextNewMeta s = goAhead s >>= goNextMeta    -- always goes away from location
+goPrevNewMeta s = goBack  s >>= goPrevMeta
+
+goNextMetaIfCan = actionIfPossible goNextMeta
+
+actionIfPossible :: Action -> Action
+actionIfPossible a s = return $ errVal s (a s)
+
+goFirstMeta, goLastMeta :: Action
+goFirstMeta s = goNextMeta $ goRoot s
+goLastMeta  s = goLast s >>= goPrevMeta
+
+noMoreMetas :: State -> Bool
+noMoreMetas = err (const True) (const False) . goNextMeta 
+
+replaceSubTree :: Tree -> Action
+replaceSubTree tree state = changeLoc state tree
+
+refineOrReplaceWithTree :: Bool -> CGrammar -> Tree -> Action
+refineOrReplaceWithTree der gr tree state = case actMeta state of
+  Ok m -> refineWithTreeReal der gr tree m state
+  _ -> do
+    let tree1 = addBinds (actBinds state) $ tree
+    state' <- replaceSubTree tree1 state
+    reCheckState gr state'
+
+refineWithTree :: Bool -> CGrammar -> Tree -> Action
+refineWithTree der gr tree state = do
+  m <- errIn "move pointer to meta" $ actMeta state
+  refineWithTreeReal der gr tree m state
+
+refineWithTreeReal :: Bool -> CGrammar -> Tree -> Meta -> Action
+refineWithTreeReal der gr tree m state = do
+  state' <- replaceSubTree tree state
+  let cs0     = allConstrs state'
+      (cs,ms) = splitConstraints gr cs0
+      v       = vClos $ tree2exp (bodyTree tree)
+      msubst  = (m,v) : ms
+  metaSubstRefinements gr msubst $ 
+    mapLoc (reduceConstraintsNode gr . performMetaSubstNode msubst) state'
+
+  -- without dep. types, no constraints, no grammar needed - simply: do
+  --   testErr (actIsMeta state) "move pointer to meta"
+  --   replaceSubTree tree state
+
+refineAllNodes :: Action -> Action
+refineAllNodes act state = do  
+  let estate0 = goFirstMeta state
+  case estate0 of
+    Bad _ -> return state
+    Ok state0 -> do 
+      (state',n) <- tryRefine 0 state0
+      if n==0 
+        then return state
+        else actionIfPossible goFirstMeta state'
+ where
+   tryRefine n state = err (const $ return (state,n)) return $ do 
+     state' <- goNextMeta state
+     meta   <- actMeta state'
+     case act state' of
+       Ok state2 -> tryRefine (n+1) state2
+       _ -> err (const $ return (state',n)) return $ do
+         state2 <- goNextNewMeta state' 
+         tryRefine n state2
+
+uniqueRefinements :: CGrammar -> Action
+uniqueRefinements = refineAllNodes . uniqueRefine
+
+metaSubstRefinements :: CGrammar -> MetaSubst -> Action
+metaSubstRefinements gr = refineAllNodes . metaSubstRefine gr
+
+contextRefinements :: CGrammar -> Action
+contextRefinements gr = refineAllNodes contextRefine where
+  contextRefine state = case varRefinementsState state of
+    [(e,_)] -> refineWithAtom False gr e state
+    _ -> Bad "no unique refinement in context"
+  varRefinementsState state = 
+    [r | r@(e,_) <- refinementsState gr state, isVariable e]
+
+uniqueRefine :: CGrammar -> Action
+uniqueRefine gr state = case refinementsState gr state of
+  [(e,(_,True))] -> Bad "only circular refinement"
+  [(e,_)] -> refineWithAtom False gr e state
+  _ -> Bad "no unique refinement"
+
+metaSubstRefine :: CGrammar -> MetaSubst -> Action
+metaSubstRefine gr msubst state = do
+  m <- errIn "move pointer to meta" $ actMeta state
+  case lookup m msubst of
+    Just v -> do
+       e <- val2expSafe v
+       refineWithExpTC False gr e state
+    _ -> Bad "no metavariable substitution available"
+
+refineWithExpTC :: Bool -> CGrammar -> Exp -> Action
+refineWithExpTC der gr exp0 state = do
+  let oldmetas = allMetas state
+      exp = refreshMetas oldmetas exp0
+  tree0 <- annotateInState gr exp state
+  let tree = addBinds (actBinds state) $ tree0
+  refineWithTree der gr tree state
+
+refineWithAtom :: Bool -> CGrammar -> Ref -> Action -- function or variable
+refineWithAtom der gr at state = do
+  val <- lookupRef gr (allBinds state) at
+  typ <- val2exp val
+  let oldvars  = allVars state
+  exp <- ref2exp oldvars typ at
+  refineWithExpTC der gr exp state
+
+-- | in this command, we know that the result is well-typed, since computation
+-- rules have been type checked and the result is equal
+computeSubTree :: CGrammar -> Action
+computeSubTree gr state = do
+  let exp = tree2exp (actTree state)
+  tree <- treeByExp (compute gr) gr exp state
+  replaceSubTree tree state
+
+-- | but here we don't, since the transfer flag isn't type checked,
+-- and computing the transfer function is not checked to preserve equality
+transferSubTree :: Maybe Fun -> CGrammar -> Action
+transferSubTree Nothing _ s = return s
+transferSubTree (Just fun) gr state = do
+  let exp = mkApp (qq fun) [tree2exp $ actTree state]
+  tree <- treeByExp (compute gr) gr exp state
+  state' <- replaceSubTree tree state
+  reCheckState gr state'
+
+deleteSubTree :: CGrammar -> Action
+deleteSubTree gr state = 
+  if isRootState state
+     then do
+       let cat = actCat state
+       newCat gr cat state
+     else do
+       let metas = allMetas state
+           binds = actBinds state
+           exp = refreshMetas metas mExp0
+       tree <- annotateInState gr exp state
+       state' <- replaceSubTree (addBinds binds tree) state
+       reCheckState gr state' --- must be unfortunately done. 20/11/2001
+
+wrapWithFun :: CGrammar -> (Fun,Int) -> Action
+wrapWithFun gr (f@(m,c),i) state = do
+  typ <- lookupFunType gr m c
+  let olds = allPrevVars state
+      oldmetas = allMetas state
+  exp0  <- fun2wrap olds ((f,i),typ) (tree2exp (actTreeBody state))
+  let exp = refreshMetas oldmetas exp0
+  tree0 <- annotateInState gr exp state  
+  let tree = addBinds (actBinds state) $ tree0
+  state' <- replaceSubTree tree state
+  reCheckState gr state' --- must be unfortunately done. 20/11/2001
+
+alphaConvert :: CGrammar -> (Var,Var) -> Action
+alphaConvert gr (x,x') state = do
+  let oldvars = allPrevVars state
+  testErr (notElem x' oldvars) ("clash with previous bindings" +++ show x')
+  let binds0  = actBinds state
+      vars0   = map fst binds0
+  testErr (notElem x' vars0) ("clash with other bindings" +++ show x')
+  let binds   = [(if z==x then x' else z, t) | (z,t) <- binds0]
+      vars    = map fst binds
+  exp' <- alphaConv (vars ++ oldvars) (x,x') (tree2exp (actTreeBody state))
+  let exp = mkAbs vars exp'
+  tree <- annotateExpInState gr exp state
+  replaceSubTree tree state
+
+changeFunHead :: CGrammar -> Fun -> Action
+changeFunHead gr f state = do
+  let state' = changeNode (changeAtom (const (atomC f))) state
+  reCheckState gr state' --- must be done because of constraints elsewhere
+
+peelFunHead :: CGrammar -> (Fun,Int) -> Action
+peelFunHead gr (f@(m,c),i) state = do
+  tree0 <- nthSubtree i $ actTree state
+  let tree = addBinds (actBinds state) $ tree0
+  state' <- replaceSubTree tree state
+  reCheckState gr state' --- must be unfortunately done. 20/11/2001
+
+-- | an expensive operation
+reCheckState :: CGrammar -> State -> Err State
+reCheckState gr st = annotate gr (tree2exp (loc2tree st)) >>= return . tree2loc
+
+-- | a variant that returns Bad instead of a tree with unsolvable constraints
+reCheckStateReject :: CGrammar -> State -> Err State
+reCheckStateReject gr st = do
+  st' <- reCheckState gr st
+  rejectUnsolvable st'
+
+rejectUnsolvable :: State -> Err State
+rejectUnsolvable st = case (constrsNode $ nodeTree $ actTree st) of 
+  [] -> return st
+  cs -> Bad $ "Unsolvable constraints:" +++ prConstraints cs
+
+-- | extract metasubstitutions from constraints and solve them
+solveAll :: CGrammar -> State -> Err State
+solveAll gr st = solve st >>= solve where 
+  solve st0 = do ---- why need twice?
+    st <- reCheckState gr st0
+    let cs0     = allConstrs st
+        (cs,ms) = splitConstraints gr cs0
+    metaSubstRefinements gr ms $ 
+      mapLoc (reduceConstraintsNode gr . performMetaSubstNode ms) st
+
+-- * active refinements
+
+refinementsState :: CGrammar -> State -> [(Term,(Val,Bool))]
+refinementsState gr state = 
+  let filt = possibleRefVal gr state in 
+  if actIsMeta state 
+     then refsForType filt gr (allBinds state) (actVal state)
+     else []
+
+wrappingsState :: CGrammar -> State -> [((Fun,Int),Type)]
+wrappingsState gr state
+  | actIsMeta state = []
+  | isRootState state = funs 
+  | otherwise = [rule | rule@(_,typ) <- funs, possibleRefVal gr state aval typ]
+ where 
+   funs = funsOnType (possibleRefVal gr state) gr aval
+   aval = actVal state
+
+peelingsState :: CGrammar -> State -> [(Fun,Int)]
+peelingsState gr state
+  | actIsMeta state = []
+  | isRootState state = 
+      err (const []) (\f -> [(f,i) | i <- [0 .. arityTree tree - 1]]) $ actFun state
+  | otherwise = 
+      err (const []) 
+          (\f -> [fi | (fi@(g,_),typ) <- funs, 
+                       possibleRefVal gr state aval typ,g==f]) $ actFun state
+ where 
+   funs = funsOnType (possibleRefVal gr state) gr aval
+   aval = actVal state
+   tree = actTree state
+
+headChangesState :: CGrammar -> State -> [Fun]
+headChangesState gr state = errVal [] $ do 
+  f@(m,c) <-  funAtom (actAtom state)
+  typ0 <- lookupFunType gr m c
+  return [fun | (fun,typ) <- funRulesOf gr, fun /= f, typ == typ0] 
+                                                          --- alpha-conv !
+
+possibleRefVal :: CGrammar -> State -> Val -> Type -> Bool
+possibleRefVal gr state val typ = errVal True $ do --- was False
+  vtyp <- valType typ
+  let gen = actGen state
+  cs   <- return [(val, vClos vtyp)] --- eqVal gen val (vClos vtyp) --- only poss cs
+  return $ possibleConstraints gr cs --- a simple heuristic
+
+possibleTreeVal :: CGrammar -> State -> Tree -> Bool
+possibleTreeVal gr state tree = errVal True $ do --- was False
+  let aval = actVal state
+  let gval = valTree tree
+  let gen = actGen state
+  cs  <- return [(aval, gval)] --- eqVal gen val (vClos vtyp) --- only poss cs
+  return $ possibleConstraints gr cs --- a simple heuristic
+
diff --git a/src-2.9/GF/UseGrammar/Generate.hs b/src-2.9/GF/UseGrammar/Generate.hs
new file mode 100644
index 000000000..5f07e0b85
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Generate.hs
@@ -0,0 +1,116 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Generate
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/12 12:38:30 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.16 $
+--
+-- Generate all trees of given category and depth. AR 30\/4\/2004
+--
+-- (c) Aarne Ranta 2004 under GNU GPL
+--
+-- Purpose: to generate corpora. We use simple types and don't
+-- guarantee the correctness of bindings\/dependences.
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Generate (generateTrees,generateAll) where
+
+import GF.Canon.GFC
+import GF.Grammar.LookAbs
+import GF.Grammar.PrGrammar
+import GF.Grammar.Macros
+import GF.Grammar.Values
+import GF.Grammar.Grammar (Cat)
+import GF.Grammar.SGrammar
+import GF.Data.Operations
+import GF.Data.Zipper
+import GF.Infra.Option
+import Data.List
+
+-- Generate all trees of given category and depth. AR 30/4/2004
+-- (c) Aarne Ranta 2004 under GNU GPL
+--
+-- Purpose: to generate corpora. We use simple types and don't
+-- guarantee the correctness of bindings/dependences.
+
+
+-- | the main function takes an abstract syntax and returns a list of trees
+generateTrees :: 
+  Options -> GFCGrammar -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp]
+generateTrees opts gr cat n mn mt = map str2tr $ generate gr' opts cat' n mn mt'
+  where
+    gr'  = gr2sgr opts emptyProbs gr
+    cat' = prt $ snd cat
+    mt'  = maybe Nothing (return . tr2str) mt
+---    ifm  = oElem withMetas opts
+    ifm  = oElem showOld opts
+
+generateAll :: Options -> (Exp -> IO ()) -> GFCGrammar -> Cat -> IO ()
+generateAll opts io gr cat = mapM_ (io . str2tr) $ num $ gen cat'
+  where
+    num  = optIntOrAll opts flagNumber
+    gr'  = gr2sgr opts emptyProbs gr
+    cat' = prt $ snd cat
+    gen c = generate gr' opts c 10 Nothing Nothing
+
+
+
+------------------------------------------
+-- do the main thing with a simpler data structure
+-- the first Int gives tree depth, the second constrains subtrees
+-- chosen for each branch. A small number, such as 2, is a good choice
+-- if the depth is large (more than 3)
+-- If a tree is given as argument, generation concerns its metavariables.
+
+generate :: SGrammar -> Options -> SCat -> Int -> Maybe Int -> Maybe STree -> [STree]
+generate gr opts cat i mn mt = case mt of
+  Nothing -> gen opts cat
+  Just t  -> genM t
+ where
+--- now use ifm to choose between two algorithms
+  gen opts cat 
+   | oElem (iOpt "mem") opts   = concat $ errVal [] $ lookupTree id cat $ allTrees -- -old
+   | oElem (iOpt "nonub") opts =       concatMap (\i -> gener i cat) [0..i-1] -- some duplicates
+   | otherwise                 = nub $ concatMap (\i -> gener i cat) [0..i-1] -- new
+
+  gener 0 c = [SApp (f, []) | (f,([],_)) <- funs c]
+  gener i c = [
+    tr | 
+      (f,(cs,_)) <- funs c,
+      let alts = map (gener (i-1)) cs,
+      ts <- combinations alts,
+      let tr = SApp (f, ts)
+--      depth tr >= i -- NO!
+    ]
+
+  allTrees = genAll i
+
+  -- dynamic generation
+  genAll :: Int -> BinTree SCat [[STree]]
+  genAll i = iter i genNext (mapTree (\ (c,_) -> (c,[[]])) gr)
+
+  iter 0 f tr = tr
+  iter n f tr = iter (n-1) f (f tr)
+
+  genNext tr = mapTree (genNew tr) tr
+
+  genNew tr (cat,ts) = let size = length ts in
+    (cat, [SApp (f, xs) | 
+            (f,(cs,_)) <- funs cat, 
+            xs <- combinations (map look cs),
+            let fxs = SApp (f, xs),
+            depth fxs == size]
+         : ts)
+   where
+     look c = concat $ errVal [] $ lookupTree id c tr
+
+  funs cat = maybe id take mn $ errVal [] $ lookupTree id cat gr
+
+  genM t = case t of
+    SApp (f,ts) -> [SApp (f,ts') | ts' <- combinations (map genM ts)]
+    SMeta k     -> gen opts k 
+    _ -> [t]
diff --git a/src-2.9/GF/UseGrammar/GetTree.hs b/src-2.9/GF/UseGrammar/GetTree.hs
new file mode 100644
index 000000000..e980a3d95
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/GetTree.hs
@@ -0,0 +1,74 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : GetTree
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/15 16:22:02 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.9 $
+--
+-- how to form linearizable trees from strings and from terms of different levels
+--
+-- 'String' --> raw 'Term' --> annot, qualif 'Term' --> 'Tree'
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.GetTree where
+
+import GF.Canon.GFC
+import GF.Grammar.Values
+import qualified GF.Grammar.Grammar as G
+import GF.Infra.Ident
+import GF.Grammar.MMacros
+import GF.Grammar.Macros
+import GF.Compile.Rename
+import GF.Grammar.TypeCheck
+import GF.Grammar.AbsCompute (beta)
+import GF.Compile.PGrammar
+import GF.Compile.ShellState
+
+import GF.Data.Operations
+
+import Data.Char
+
+-- how to form linearizable trees from strings and from terms of different levels
+--
+-- String --> raw Term --> annot, qualif Term --> Tree
+
+string2tree :: StateGrammar -> String -> Tree
+string2tree gr = errVal uTree . string2treeErr gr
+
+string2treeErr :: StateGrammar -> String -> Err Tree
+string2treeErr _ "" = Bad "empty string"
+string2treeErr gr s = do
+  t <- pTerm s
+  let t0 = beta [] t
+  let t1 = refreshMetas [] t0
+  let t2 = qualifTerm abstr t1
+  annotate grc t2
+ where
+   abstr = absId gr
+   grc = grammar gr
+
+string2Cat, string2Fun :: StateGrammar -> String -> (Ident,Ident)
+string2Cat gr c = (absId gr,identC c)
+string2Fun = string2Cat
+
+strings2Cat, strings2Fun :: String -> (Ident,Ident)
+strings2Cat s = (identC m, identC (drop 1 c)) where (m,c) = span (/= '.') s
+strings2Fun = strings2Cat
+
+string2ref :: StateGrammar -> String -> Err G.Term
+string2ref gr s = case s of 
+  'x':'_':ds -> return $ freshAsTerm ds --- hack for generated vars
+  '"':_:_ -> return $ G.K $ init $ tail s
+  _:_ | all isDigit s -> return $ G.EInt $ read s
+  _ | elem '.' s -> return $ uncurry G.Q $ strings2Fun s
+  _ -> return $ G.Vr $ identC s
+
+string2cat :: StateGrammar -> String -> Err G.Cat
+string2cat gr s = 
+  if elem '.' s 
+    then return $ strings2Fun s
+    else return $ curry id (absId gr) (identC s)
diff --git a/src-2.9/GF/UseGrammar/Information.hs b/src-2.9/GF/UseGrammar/Information.hs
new file mode 100644
index 000000000..4526980d6
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Information.hs
@@ -0,0 +1,162 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Information
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/10/05 20:02:20 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.7 $
+--
+-- information on module, category, function, operation, parameter,... 
+-- AR 16\/9\/2003.
+-- uses source grammar
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Information (
+   showInformation,
+   missingLinCanonGrammar
+   ) where
+
+import GF.Grammar.Grammar
+import GF.Infra.Ident
+import GF.Infra.Modules
+import GF.Infra.Option
+import GF.CF.CF
+import GF.CF.PPrCF
+import GF.Compile.ShellState
+import GF.Grammar.PrGrammar
+import GF.Grammar.Lookup
+import GF.Grammar.Macros (zIdent)
+import qualified GF.Canon.GFC as GFC
+import qualified GF.Canon.AbsGFC as AbsGFC
+
+import GF.Data.Operations
+import GF.Infra.UseIO
+
+-- information on module, category, function, operation, parameter,... AR 16/9/2003
+-- uses source grammar
+
+-- | the top level function
+showInformation :: Options -> ShellState -> Ident -> IOE ()
+showInformation opts st c = do
+  is <- ioeErr $ getInformation opts st c
+  if null is 
+     then putStrLnE "Identifier not in scope" 
+     else mapM_ (putStrLnE . prInformationM c) is
+ where
+   prInformationM c (i,m) = prInformation opts c i ++ "file:" +++ m ++ "\n"
+
+-- | the data type of different kinds of information
+data Information = 
+   IModAbs  SourceAbs
+ | IModRes  SourceRes
+ | IModCnc  SourceCnc
+ | IModule  SourceAbs -- ^ to be deprecated
+ | ICatAbs  Ident Context [Ident]
+ | ICatCnc  Ident Type    [CFRule] Term
+ | IFunAbs  Ident Type    (Maybe Term)
+ | IFunCnc  Ident Type    [CFRule] Term
+ | IOper    Ident Type    Term
+ | IParam   Ident         [Param] [Term]
+ | IValue   Ident Type
+
+type CatId = AbsGFC.CIdent
+type FunId = AbsGFC.CIdent
+
+prInformation :: Options -> Ident -> Information -> String
+prInformation opts c i = unlines $ prt c : case i of
+  IModule m -> [
+    "module of type" +++ show (mtype m),
+    "extends" +++ show (extends m),
+    "opens" +++ show (opens m),
+    "defines" +++ unwords (map prt (ownConstants (jments m)))
+    ]
+  ICatAbs m co _ -> [
+    "category in abstract module" +++ prt m,
+    if null co then "not a dependent type" 
+      else "dependent type with context" +++ prContext co
+    ]
+  ICatCnc m ty cfs tr -> [
+    "category in concrete module" +++ prt m,
+    "linearization type" +++ prt ty
+    ]
+  IFunAbs m ty _ -> [
+    "function in abstract module" +++ prt m,
+    "type" +++ prt ty
+    ]
+  IFunCnc m ty cfs tr -> [
+    "function in concrete module" +++ prt m,
+    "linearization" +++ prt tr
+   ---    "linearization type" +++ prt ty
+    ]
+  IOper m ty tr -> [
+    "operation in resource module" +++ prt m,
+    "type" +++ prt ty,
+    "definition" +++ prt tr 
+    ]
+  IParam m ty ts -> [
+    "parameter type in resource module" +++ prt m,
+    "constructors" +++ unwords (map prParam ty),
+    "values" +++ unwords (map prt ts)
+    ]
+  IValue m ty -> [
+    "parameter constructor in resource module" +++ prt m,
+    "type" +++ show ty
+    ]
+
+-- | also finds out if an identifier is defined in many places
+getInformation :: Options -> ShellState -> Ident -> Err [(Information,FilePath)]
+getInformation opts st c = allChecks $ [
+  do
+    m <- lookupModule src c 
+    case m of
+      ModMod mo -> returnm c $ IModule mo
+      _ -> prtBad "not a source module" c
+  ] ++ map lookInSrc ss ++ map lookInCan cs
+ where
+   lookInSrc (i,m) = do
+     j <- lookupInfo m c 
+     case j of
+       AbsCat (Yes co) _ -> returnm i $ ICatAbs i co [] ---
+       AbsFun (Yes ty) _ -> returnm i $ IFunAbs i ty Nothing ---
+       CncCat (Yes ty) _ _ -> do
+         ---- let cat = ident2CFCat i c
+         ---- rs <- concat [rs | (c,rs) <- cf, ]
+         returnm i $ ICatCnc i ty [] ty ---       
+       CncFun _ (Yes tr) _ -> do
+         rs <- return []
+         returnm i $ IFunCnc i tr rs tr ---       
+       ResOper (Yes ty) (Yes tr) -> returnm i $ IOper i ty tr
+       ResParam (Yes (ps,_)) -> do
+         ts <- allParamValues src (QC i c)
+         returnm i $ IParam i ps ts
+       ResValue (Yes (ty,_)) -> returnm i $ IValue i ty ---
+       
+       _ -> prtBad "nothing available for" i
+   lookInCan (i,m) = do
+     Bad "nothing available yet in canonical"
+
+   returnm m i = return (i, pathOfModule st m)
+
+   src = srcModules st
+   can = canModules st
+   ss  = [(i,m) | (i,ModMod m) <- modules src]
+   cs  = [(i,m) | (i,ModMod m) <- modules can]
+   cf  = concatMap ruleGroupsOfCF $ map snd $ cfs st
+
+ownConstants :: BinTree Ident Info -> [Ident]
+ownConstants = map fst . filter isOwn . tree2list where
+  isOwn (c,i) = case i of
+    AnyInd _ _ -> False
+    _ -> True
+
+missingLinCanonGrammar :: GFC.CanonGrammar -> String
+missingLinCanonGrammar cgr = 
+  unlines $ concat [prt_ c : missing js | (c,js) <- concretes] where
+  missing js = map (("  " ++) . prt_) $ filter (not . flip isInBinTree js) abstract
+  abstract = err (const []) (map fst . tree2list . jments) $ lookupModMod cgr absId
+  absId = maybe (zIdent "") id $ greatestAbstract cgr
+  concretes = [(cnc,jments mo) | 
+    cnc <- allConcretes cgr absId, Ok mo <- [lookupModMod cgr cnc]]
diff --git a/src-2.9/GF/UseGrammar/Linear.hs b/src-2.9/GF/UseGrammar/Linear.hs
new file mode 100644
index 000000000..c9b94ccb0
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Linear.hs
@@ -0,0 +1,292 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Linear
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/11/14 16:03:41 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.19 $
+--
+-- Linearization for canonical GF. AR 7\/6\/2003
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Linear where
+
+import GF.Canon.GFC
+import GF.Canon.AbsGFC
+import qualified GF.Grammar.Abstract as A
+import GF.Canon.MkGFC (rtQIdent) ----
+import GF.Infra.Ident
+import GF.Grammar.PrGrammar
+import GF.Canon.CMacros
+import GF.Canon.Look
+import GF.Grammar.LookAbs
+import GF.Grammar.MMacros
+import GF.Grammar.TypeCheck (annotate) ----
+import GF.Data.Str
+import GF.Text.Text
+----import TypeCheck -- to annotate
+
+import GF.Data.Operations
+import GF.Data.Zipper
+import qualified GF.Infra.Modules as M
+
+import Control.Monad
+import Data.List (intersperse)
+
+-- Linearization for canonical GF. AR 7/6/2003
+
+-- | The worker function: linearize a Tree, return
+-- a record. Possibly mark subtrees.
+--
+-- NB. Constants in trees are annotated by the name of the abstract module.
+-- A concrete module name must be given to find (and choose) linearization rules.
+--
+--  - If no marking is wanted, 'noMark'  :: 'Marker'.
+--
+--  - For xml marking, use     'markXML' :: 'Marker'
+linearizeToRecord :: CanonGrammar -> Marker -> Ident -> A.Tree -> Err Term
+linearizeToRecord gr mk m = lin [] where
+
+  lin ts t@(Tr (n,xs)) = errIn ("linearization of" +++ prt t) $ do
+
+    let binds = A.bindsNode n
+        at    = A.atomNode n
+        fmk   = markSubtree mk n ts (A.isFocusNode n)
+    c   <- A.val2cat $ A.valNode n
+    xs' <- mapM (\ (i,x) -> lin (i:ts) x) $ zip [0..] xs
+
+    r <- case at of
+      A.AtC f -> lookf c t f >>= comp xs'
+      A.AtI i -> return $ recInt i
+      A.AtL s -> return $ recS $ tK $ prt at
+      A.AtF i -> return $ recS $ tK $ prt at
+      A.AtV x -> lookCat c >>= comp [tK (prt_ at)]
+      A.AtM m -> lookCat c >>= comp [tK (prt_ at)] 
+
+    r' <- case r of     -- to see stg in case the result is variants {}
+      FV [] -> lookCat c >>= comp [tK (prt_ t)]
+      _ -> return r
+
+    return $ fmk $ mkBinds binds r'
+
+  look = lookupLin gr . redirectIdent m . rtQIdent
+  comp = ccompute gr
+  mkBinds bs bdy = case bdy of
+    R fs  -> R $ [Ass (LV i) (tK (prt t)) | (i,(t,_)) <- zip [0..] bs] ++ fs
+    FV rs -> FV $ map (mkBinds bs) rs
+
+  recS t = R [Ass (L (identC "s")) t] ----
+
+  recInt i = R [
+              Ass (L (identC "last")) (EInt (rem i 10)),
+              Ass (L (identC "s"))  (tK $ show i),
+              Ass (L (identC "size")) (EInt (if i > 9 then 1 else 0))
+              ]
+
+  lookCat = return . errVal defLindef . look 
+         ---- should always be given in the module
+
+  -- to show missing linearization as term
+  lookf c t f = case look f of
+    Ok h -> return h
+    _ -> lookCat c >>= comp [tK (prt_ t)]
+
+
+-- | thus the special case:
+linearizeNoMark :: CanonGrammar -> Ident -> A.Tree -> Err Term
+linearizeNoMark gr = linearizeToRecord gr noMark
+
+-- | expand tables in linearized term to full, normal-order tables
+--
+-- NB expand from inside-out so that values are not looked up in copies of branches
+
+expandLinTables :: CanonGrammar -> Term -> Err Term
+expandLinTables gr t = case t of
+  R rs -> liftM (R . map (uncurry Ass)) $ mapPairsM exp [(l,r) | Ass l r <- rs]
+  T ty rs -> do
+    rs' <- mapPairsM exp [(l,r) | Cas l r <- rs] -- expand from inside-out
+    let t' = T ty $ map (uncurry Cas) rs'
+    vs  <- alls ty
+    ps  <- mapM term2patt vs
+    ts' <- mapM (comp . S t') $ vs
+    return $ T ty [Cas [p] t | (p,t) <- zip ps ts']
+  V ty ts0 -> do
+    ts  <- mapM exp ts0 -- expand from inside-out
+    vs  <- alls ty
+    ps  <- mapM term2patt vs
+    return $ T ty [Cas [p] t | (p,t) <- zip ps ts]
+  FV ts -> liftM FV $ mapM exp ts
+  _ -> composOp exp t
+ where
+   alls = allParamValues gr
+   exp  = expandLinTables gr
+   comp = ccompute gr []
+
+-- Do this for an entire grammar:
+
+unoptimizeCanon :: CanonGrammar -> CanonGrammar
+unoptimizeCanon g@(M.MGrammar ms) = M.MGrammar $ map (unoptimizeCanonMod g) ms 
+
+unoptimizeCanonMod :: CanonGrammar -> CanonModule -> CanonModule
+unoptimizeCanonMod g = convMod where
+  convMod (m, M.ModMod (M.Module (M.MTConcrete a) x flags me os defs)) = 
+    (m, M.ModMod (M.Module (M.MTConcrete a) x flags me os (mapTree convDef defs)))
+  convMod mm = mm
+  convDef (c,CncCat ty df pr) = (c,CncCat ty (convT df) (convT pr))
+  convDef (f,CncFun c xs li pr) = (f,CncFun c xs (convT li) (convT pr))
+  convDef cd = cd
+  convT = err error id . exp
+  -- a version of expandLinTables that does not destroy share optimization
+  exp t = case t of
+    R rs -> liftM (R . map (uncurry Ass)) $ mapPairsM exp [(l,r) | Ass l r <- rs]
+    T ty rs@[Cas [_] _] -> do
+      rs' <- mapPairsM exp [(l,r) | Cas l r <- rs] -- expand from inside-out
+      let t' = T ty $ map (uncurry Cas) rs'
+      vs  <- alls ty
+      ps  <- mapM term2patt vs
+      ts' <- mapM (comp . S t') $ vs
+      return $ T ty [Cas [p] t | (p,t) <- zip ps ts']
+    V ty ts0 -> do
+      ts  <- mapM exp ts0 -- expand from inside-out
+      vs  <- alls ty
+      ps  <- mapM term2patt vs
+      return $ T ty [Cas [p] t | (p,t) <- zip ps ts]
+    FV ts -> liftM FV $ mapM exp ts
+    I _   -> comp t
+    _ -> composOp exp t
+   where
+     alls = allParamValues g
+     comp = ccompute g []
+
+
+-- | from records, one can get to records of tables of strings
+rec2strTables :: Term -> Err [[(Label,[([Patt],[Str])])]]
+rec2strTables r = do
+  vs <- allLinValues r
+  mapM (mapPairsM (mapPairsM strsFromTerm)) vs
+
+-- | from these tables, one may want to extract the ones for the "s" label
+strTables2sTables :: [[(Label,[([Patt],[Str])])]] -> [[([Patt],[Str])]]
+strTables2sTables ts = [t | r <- ts, (l,t) <- r, l == linLab0]
+
+linLab0 :: Label
+linLab0 = L (identC "s")
+
+-- | to get lists of token lists is easy
+sTables2strs :: [[([Patt],[Str])]] -> [[Str]]
+sTables2strs = map snd . concat
+
+-- | from this, to get a list of strings
+strs2strings :: [[Str]] -> [String]
+strs2strings = map unlex
+
+-- | this is just unwords; use an unlexer from Text to postprocess
+unlex :: [Str] -> String
+unlex = concat . map sstr . take 1 ----
+
+-- | finally, a top-level function to get a string from an expression
+linTree2string :: Marker -> CanonGrammar -> Ident -> A.Tree -> String
+linTree2string mk gr m e = head $ linTree2strings mk gr m e -- never empty
+
+-- | you can also get many strings
+linTree2strings :: Marker -> CanonGrammar -> Ident -> A.Tree -> [String]
+linTree2strings mk gr m e = err return id $ do
+  t  <- linearizeToRecord gr mk m e
+  r  <- expandLinTables gr t
+  ts <- rec2strTables r
+  let ss = strs2strings $ sTables2strs $ strTables2sTables ts
+  ifNull (prtBad "empty linearization of" e) return ss   -- thus never empty
+
+-- | argument is a Tree, value is a list of strs; needed in Parsing
+allLinsOfTree :: CanonGrammar -> Ident -> A.Tree -> [Str]
+allLinsOfTree gr a e = err (singleton . str) id $ do
+  e' <- return e ---- annotateExp gr e
+  r  <- linearizeNoMark gr a e'
+  r' <- expandLinTables gr r
+  ts <- rec2strTables r'
+  return $ concat $ sTables2strs $ strTables2sTables ts
+
+-- | the value is a list of structures arranged as records of tables of terms
+allLinsAsRec :: CanonGrammar -> Ident -> A.Tree -> Err [[(Label,[([Patt],Term)])]]
+allLinsAsRec gr c t = linearizeNoMark gr c t >>= expandLinTables gr >>= allLinValues
+
+-- | the value is a list of structures arranged as records of tables of strings
+-- only taking into account string fields
+-- True: sep. by /, False: sep by \n
+allLinTables :: 
+  Bool -> CanonGrammar ->Ident ->A.Tree ->Err [[(Label,[([Patt],[String])])]]
+allLinTables slash gr c t = do
+  r' <- allLinsAsRec gr c t
+  mapM (mapM getS) r'
+ where 
+   getS (lab,pss) = liftM (curry id lab) $ mapM gets pss
+   gets (ps,t) = liftM (curry id ps . cc . map str2strings) $ strsFromTerm t
+   cc = concat . intersperse [if slash then "/" else "\n"]
+
+-- | the value is a list of strings gathered from all fields
+
+allLinBranchFields :: CanonGrammar -> Ident -> A.Tree -> Err [String]
+allLinBranchFields gr c trm = do
+  r <- linearizeNoMark gr c trm >>= expandLinTables gr
+  return [s | (_,t) <- allLinBranches r, s <- gets t]
+ where 
+   gets t = concat [cc (map str2strings s) | Ok s <- [strsFromTerm t]]
+   cc = concat . intersperse ["/"]
+
+prLinTable :: Bool -> [[(Label,[([Patt],[String])])]] -> [String]
+prLinTable pars = concatMap prOne . concat where
+  prOne (lab,pss) = (if pars then ((prt lab) :) else id) (map pr pss) ----
+  pr (ps,ss) = (if pars then ((unwords (map prt_ ps) +++ ":") +++)
+                             else id) (unwords ss)
+
+{-
+-- the value is a list of strs
+allLinStrings :: CanonGrammar -> Tree -> [Str]
+allLinStrings gr ft = case allLinsAsStrs gr ft of
+  Ok ts -> map snd $ concat $ map snd $ concat ts
+  Bad s -> [str s]
+
+-- the value is a list of strs, not forgetting their arguments
+allLinsAsStrs :: CanonGrammar -> Tree -> Err [[(Label,[([Patt],Str)])]]
+allLinsAsStrs gr ft = do
+  lpts <- allLinearizations gr ft
+  return $ concat $ mapM (mapPairsM (mapPairsM strsFromTerm)) lpts
+
+
+-- to a list of strings
+linearizeToStrings :: CanonGrammar -> ([Int] ->Term -> Term) -> Tree -> Err [String]
+linearizeToStrings gr mk = liftM (map unlex) . linearizeToStrss gr mk
+
+-- to a list of token lists
+linearizeToStrss :: CanonGrammar -> ([Int] -> Term -> Term) -> Tree -> Err [[Str]]
+linearizeToStrss gr mk e = do
+  R rs <- linearizeToRecord gr mk e ----
+  t <- lookupErr linLab0 [(r,s) | Ass r s <- rs]
+  return $ map strsFromTerm $ allInTable t 
+-}
+
+-- | the value is a list of strings, not forgetting their arguments
+allLinsOfFun :: CanonGrammar -> CIdent -> Err [[(Label,[([Patt],Term)])]]
+allLinsOfFun gr f = do
+  t <- lookupLin gr f 
+  allAllLinValues t --- all fields, not only s. 11/12/2005
+
+
+-- | returns printname if one exists; otherwise linearizes with metas
+printOrLinearize :: CanonGrammar -> Ident -> A.Fun -> String
+printOrLinearize gr c f@(m, d) = errVal (prt fq) $ 
+  case lookupPrintname gr (CIQ c d) of
+    Ok t -> do
+      ss <- strsFromTerm t
+      let s = strs2strings [ss]
+      return $ ifNull (prt fq) head s
+    _ -> do
+      ty  <- lookupFunType gr m d
+      f'  <- ref2exp [] ty (A.QC m d)
+      tr  <- annotate gr f' 
+      return $ linTree2string noMark gr c tr
+   where
+     fq = CIQ m d  
diff --git a/src-2.9/GF/UseGrammar/MatchTerm.hs b/src-2.9/GF/UseGrammar/MatchTerm.hs
new file mode 100644
index 000000000..9acffd44c
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/MatchTerm.hs
@@ -0,0 +1,50 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : MatchTerm
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+--
+-- functions for matching with terms. AR 16/3/2006
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.MatchTerm where
+
+import GF.Data.Operations
+import GF.Data.Zipper
+
+import GF.Grammar.Grammar
+import GF.Grammar.PrGrammar
+import GF.Infra.Ident
+import GF.Grammar.Values
+import GF.Grammar.Macros
+import GF.Grammar.MMacros
+
+import Control.Monad
+import Data.List
+
+-- test if a term has duplicated idents, either any or just atoms
+
+hasDupIdent, hasDupAtom :: Exp -> Bool
+hasDupIdent = (>1) . maximum . map length . group . sort . allConstants True
+hasDupAtom  = (>1) . maximum . map length . group . sort . allConstants False
+
+-- test if a certain ident occurs in term
+
+grepIdent :: Ident -> Exp -> Bool
+grepIdent c = elem c . allConstants True
+
+-- form the list of all constants, optionally ignoring all but atoms
+
+allConstants :: Bool -> Exp -> [Ident]
+allConstants alsoApp = err (const []) snd . flip appSTM [] . collect where
+  collect e = case e of
+    Q _ c  -> add c e
+    QC _ c -> add c e
+    Cn c   -> add c e
+    App f a | not alsoApp -> case f of
+      App g b -> collect b >> collect a 
+      _ -> collect a
+    _ -> composOp collect e
+  add c e = updateSTM (c:) >> return e
diff --git a/src-2.9/GF/UseGrammar/Morphology.hs b/src-2.9/GF/UseGrammar/Morphology.hs
new file mode 100644
index 000000000..3aeb08dc7
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Morphology.hs
@@ -0,0 +1,140 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Morphology
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:49 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- Morphological analyser constructed from a GF grammar.
+--
+-- we first found the binary search tree sorted by word forms more efficient
+-- than a trie, at least for grammars with 7000 word forms
+-- (18\/11\/2003) but this may change since we have to use a trie 
+-- for decompositions and also want to use it in the parser
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Morphology where
+
+import GF.Canon.AbsGFC
+import GF.Canon.GFC
+import GF.Grammar.PrGrammar
+import GF.Canon.CMacros
+import GF.Canon.Look
+import GF.Grammar.LookAbs
+import GF.Infra.Ident
+import qualified GF.Grammar.Macros as M
+import GF.UseGrammar.Linear
+
+import GF.Data.Operations
+import GF.Data.Glue
+
+import Data.Char
+import Data.List (sortBy, intersperse)
+import Control.Monad (liftM)
+import GF.Data.Trie2
+
+-- construct a morphological analyser from a GF grammar. AR 11/4/2001
+
+-- we first found the binary search tree sorted by word forms more efficient
+-- than a trie, at least for grammars with 7000 word forms
+-- (18\/11\/2003) but this may change since we have to use a trie 
+-- for decompositions and also want to use it in the parser
+
+type Morpho = Trie Char String
+
+emptyMorpho :: Morpho
+emptyMorpho = emptyTrie
+
+appMorpho :: Morpho -> String -> (String,[String])
+appMorpho = appMorphoOnly
+---- add lookup for literals
+
+-- without literals
+appMorphoOnly :: Morpho -> String -> (String,[String])
+appMorphoOnly m s = trieLookup m s
+
+-- recognize word, exluding literals
+isKnownWord :: Morpho -> String -> Bool
+isKnownWord mo = not . null . snd . appMorphoOnly mo
+
+mkMorpho :: CanonGrammar -> Ident -> Morpho 
+mkMorpho gr a = tcompile $ concatMap mkOne $ allItems where
+
+  comp = ccompute gr [] -- to undo 'values' optimization
+
+  mkOne (Left (fun,c))  = map (prOne fun c) $ allLins fun
+  mkOne (Right (fun,_)) = map (prSyn fun) $ allSyns fun
+  
+  -- gather forms of lexical items
+  allLins fun@(m,f) = errVal [] $ do
+    ts <- lookupLin gr (CIQ a f) >>= comp >>= allAllLinValues  
+    ss <- mapM (mapPairsM (mapPairsM (liftM wordsInTerm . comp))) ts
+    return [(p,s) | (p,fs) <- concat $ map snd $ concat ss, s <- fs]
+  prOne (_,f) c (ps,s) = (s, [prt f +++ tagPrt c +++ unwords (map prt_ ps)])
+
+  -- gather syncategorematic words
+  allSyns fun@(m,f) = errVal [] $ do
+    tss <- allLinsOfFun gr (CIQ a f) 
+    let ss = [s | ts <- tss, (_,fs) <- ts, (_,s) <- fs]
+    return $ concat $ map wordsInTerm ss
+  prSyn f s = (s, ["+<syncategorematic>" ++ tagPrt f])
+
+  -- all words, Left from lexical rules and Right syncategorematic
+  allItems = [lexRole t (f,c) | (f,c,t) <- allFuns] where
+    allFuns = [(f,c,t) | (f,t) <- funRulesOf gr, Ok c <- [M.valCat t]]
+    lexRole t = case M.typeForm t of
+      Ok ([],_,_) -> Left
+      _ -> Right
+
+-- printing full-form lexicon and results
+
+prMorpho :: Morpho -> String
+prMorpho = unlines . map prMorphoAnalysis . collapse
+
+prMorphoAnalysis :: (String,[String]) -> String
+prMorphoAnalysis (w,fs0) = 
+  let fs = filter (not . null) fs0  in
+  if null fs then w ++++ "*" else unlines (w:fs)
+
+prMorphoAnalysisShort :: (String,[String]) -> String
+prMorphoAnalysisShort (w,fs) = prBracket (w' ++ prTList "/" fs) where
+  w' = if null fs then w +++ "*" else ""
+
+tagPrt :: Print a => (a,a) -> String
+tagPrt (m,c) = "+" ++ prt c --- module name
+
+-- | print all words recognized
+allMorphoWords :: Morpho -> [String]
+allMorphoWords = map fst . collapse
+
+-- analyse running text and show results either in short form or on separate lines
+
+-- | analyse running text and show just the word, with "*" if not found
+morphoTextStatus :: Morpho -> String -> String
+morphoTextStatus mo = unlines . map (prMark . appMorpho mo) . words where
+  prMark (w,fs) = if null fs then "*" +++ w else w
+
+-- | analyse running text and show results in short form, one word per line
+morphoTextShort :: Morpho -> String -> String
+morphoTextShort mo = unlines . map (prMorphoAnalysisShort . appMorpho mo) . words
+
+-- | analyse running text and show results on separate lines
+morphoText :: Morpho -> String -> String
+morphoText mo = unlines . map (('\n':) . prMorphoAnalysis . appMorpho mo) . words
+
+-- format used in the Italian Verb Engine
+prFullForm :: Morpho -> String
+prFullForm = unlines . map prOne . collapse where
+  prOne (s,ps) = s ++ " : " ++ unwords (intersperse "/" ps)
+
+-- using Huet's unglueing method to find word boundaries
+---- it would be much better to use a trie also for morphological analysis,
+---- so this is for the sake of experiment
+---- Moreover, we should specify the cases in which this happens - not all words
+
+decomposeWords :: Morpho -> String -> [String]
+decomposeWords mo s = errVal (words s) $ decomposeSimple mo s
diff --git a/src-2.9/GF/UseGrammar/Paraphrases.hs b/src-2.9/GF/UseGrammar/Paraphrases.hs
new file mode 100644
index 000000000..d04f22aa6
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Paraphrases.hs
@@ -0,0 +1,70 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Paraphrases
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:49 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.6 $
+--
+-- paraphrases of GF terms. AR 6\/10\/1998 -- 24\/9\/1999 -- 5\/7\/2000 -- 5\/6\/2002
+--
+-- Copyright (c) Aarne Ranta 1998--99, under GNU General Public License (see GPL)
+--
+-- thus inherited from the old GF. Incomplete and inefficient...
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Paraphrases (mkParaphrases) where
+
+import GF.Grammar.Abstract
+import GF.Grammar.PrGrammar
+import GF.Grammar.LookAbs
+import GF.Grammar.AbsCompute
+
+import GF.Data.Operations
+
+import Data.List (nub)
+
+-- paraphrases of GF terms. AR 6/10/1998 -- 24/9/1999 -- 5/7/2000 -- 5/6/2002
+-- Copyright (c) Aarne Ranta 1998--99, under GNU General Public License (see GPL)
+-- thus inherited from the old GF. Incomplete and inefficient...
+
+mkParaphrases :: GFCGrammar -> Term -> [Term]
+mkParaphrases st = nub . map (beta []) . paraphrases (allDefs st)
+
+type Definition = (Fun,Term)
+
+paraphrases :: [Definition] -> Term -> [Term]
+paraphrases th t =
+  paraImmed th t ++
+---  paraMatch th t ++
+  case t of
+    App c a -> [App d b | d <- paraphrases th c, b <- paraphrases th a]
+    Abs x b -> [Abs x d | d <- paraphrases th b]
+    c       -> []
+  ++ [t]
+
+paraImmed :: [Definition] -> Term -> [Term]
+paraImmed defs t = 
+  [Q m f | ((m,f), u) <- defs, t == u] ++ --- eqTerm
+  case t of
+  ----  Cn c -> [u | (f, u) <- defs, eqStrIdent f c]
+    _    -> []
+
+{- ---
+paraMatch :: [Definition] -> Trm -> [Trm]
+paraMatch th@defs t = 
+ [mkApp (Cn f) xx | (PC f zz, u) <- defs, 
+                    let (fs,sn) = fullApp u, fs == h, length sn == length zz] ++
+ case findAMatch defs t of
+   Ok (g,b) -> [substTerm [] g b]
+   _        -> []
+  where 
+    (h,xx)    = fullApp t
+    fullApp c = case c of 
+                  App f a -> (f', a' ++ [a]) where (f',a') = fullApp f
+                  c       -> (c,[])
+
+-}
diff --git a/src-2.9/GF/UseGrammar/Parsing.hs b/src-2.9/GF/UseGrammar/Parsing.hs
new file mode 100644
index 000000000..2ca057410
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Parsing.hs
@@ -0,0 +1,177 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Parsing
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/06/02 10:23:52 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.25 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Parsing where
+
+import GF.Infra.CheckM
+import qualified GF.Canon.AbsGFC as C
+import GF.Canon.GFC
+import GF.Canon.MkGFC (trExp) ----
+import GF.Canon.CMacros
+import GF.Grammar.MMacros (refreshMetas)
+import GF.UseGrammar.Linear
+import GF.Data.Str
+import GF.CF.CF
+import GF.CF.CFIdent
+import GF.Infra.Ident
+import GF.Grammar.TypeCheck
+import GF.Grammar.Values
+--import CFMethod
+import GF.UseGrammar.Tokenize
+import GF.UseGrammar.Morphology (isKnownWord)
+import GF.CF.Profile
+import GF.Infra.Option
+import GF.UseGrammar.Custom
+import GF.Compile.ShellState
+
+import GF.CF.PPrCF (prCFTree)
+-- import qualified GF.OldParsing.ParseGFC as NewOld -- OBSOLETE
+import qualified GF.Parsing.GFC as New
+
+import GF.Data.Operations
+
+import Data.List (nub,sortBy)
+import Data.Char (toLower)
+import Control.Monad (liftM)
+
+-- AR 26/1/2000 -- 8/4 -- 28/1/2001 -- 9/12/2002
+
+parseString :: Options -> StateGrammar -> CFCat -> String -> Err [Tree]
+parseString os sg cat = liftM fst . parseStringMsg os sg cat
+
+parseStringMsg :: Options -> StateGrammar -> CFCat -> String -> Err ([Tree],String)
+parseStringMsg os sg cat s = do
+  case checkStart $ parseStringC os sg cat s of
+    Ok (ts,(_,ss)) -> return (ts, unlines $ reverse ss)
+    Bad s -> return ([],s)
+
+parseStringC :: Options -> StateGrammar -> CFCat -> String -> Check [Tree]
+parseStringC opts0 sg cat s 
+ | oElem (iOpt "old") opts0 ||
+   (not (oElem (iOpt "fcfg") opts0) && stateHasHOAS sg) = do
+  let opts = unionOptions opts0 $ stateOptions sg
+      cf  = stateCF sg
+      gr  = stateGrammarST sg
+      cn  = cncId sg
+      toks = customOrDefault opts useTokenizer customTokenizer sg s
+      parser = customOrDefault opts useParser customParser sg cat
+  if oElem (iOpt "cut") opts 
+    then doUntil (not . null) $ map (tokens2trms opts sg cn parser) toks
+    else mapM (tokens2trms opts sg cn parser) toks >>= return . concat
+
+---- | or [oElem p opts0 | 
+----        p <- [newCParser,newMParser,newFParser,newParser,newerParser] = do  
+
+ | otherwise = do
+  let opts      = unionOptions opts0 $ stateOptions sg
+      algorithm | oElem newCParser opts0 = "c"
+		| oElem newMParser opts0 = "m"
+		| oElem newFParser opts0 = "f"
+		| otherwise              = "f" -- default algorithm: FCFG
+      strategy  = maybe "bottomup" id $ getOptVal opts useParser 
+                      -- -parser=bottomup/topdown
+      tokenizer = customOrDefault opts useTokenizer customTokenizer sg
+      toks = case tokenizer s of
+               t:_ -> t
+               _ -> [] ---- no support for undet. tok.
+      unknowns = 
+        [w | TC w <- toks, unk w && unk (uncap w)] ++ [w | TS w <- toks, unk w]
+       where
+        unk w = not $ isKnownWord (morpho sg) w
+        uncap (c:cs) = toLower c : cs
+        uncap s = s
+
+  case unknowns of
+    _:_ | oElem (iOpt "trynextlang") opts -> return []
+    _:_  -> fail $ "Unknown words:" +++ unwords unknowns
+    _ -> do  
+  
+     ts <- checkErr $ New.parse algorithm strategy (pInfo sg) (absId sg) cat toks
+     ts' <- checkErr $ 
+             allChecks $ map (annotate (stateGrammarST sg) . refreshMetas []) ts
+     return $ optIntOrAll opts flagNumber ts'
+
+
+tokens2trms :: Options ->StateGrammar ->Ident -> CFParser -> [CFTok] -> Check [Tree]
+tokens2trms opts sg cn parser toks = trees2trms opts sg cn toks trees info
+    where result = parser toks
+	  info   = snd result
+	  trees  = {- nub $ -} cfParseResults result -- peb 25/5-04: removed nub (O(n^2))
+
+trees2trms :: 
+  Options -> StateGrammar -> Ident -> [CFTok] -> [CFTree] -> String -> Check [Tree]
+trees2trms opts sg cn as ts0 info = do
+  let s = unwords $ map prCFTok as
+  ts  <- case () of
+    _ | null ts0 -> checkWarn ("No success in cf parsing" +++ s) >> return []
+    _ | raw      -> do
+      ts1 <- return (map cf2trm0 ts0) ----- should not need annot
+      checks [
+         mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated, often fails
+        ,checkWarn (unlines ("Raw CF trees:":(map prCFTree ts0))) >> return []
+        ]
+    _ -> do
+      let num = optIntOrN opts flagRawtrees 999999
+      let (ts01,rest) = splitAt num ts0
+      if null rest then return () 
+         else raise ("Warning: only" +++ show num +++ "raw parses out of" +++ 
+                          show (length ts0) +++ 
+                          "considered; use -rawtrees=<Int> to see more"
+                     )
+      (ts1,ss) <- checkErr $ mapErrN 1 postParse ts01
+      if null ts1 then raise ss else return ()
+      ts2 <- checkErr $ 
+               allChecks $ map (annotate gr . refreshMetas [] . trExp) ts1 ---- 
+      if forgive then return ts2 else do
+        let tsss = [(t, allLinsOfTree gr cn t) | t <- ts2]
+            ps = [t | (t,ss) <- tsss, 
+                      any (compatToks as) (map str2cftoks ss)]
+        if null ps 
+           then raise $ "Failure in morphology." ++
+                  if verb 
+                     then "\nPossible corrections: " +++++
+                          unlines (nub (map sstr (concatMap snd tsss)))
+                     else ""
+           else return ps
+  if verb 
+     then checkWarn $ " the token list" +++ show as ++++ unknownWords sg as +++++ info
+     else return ()
+
+  return $ optIntOrAll opts flagNumber $ nub ts
+ where
+   gr  = stateGrammarST sg
+
+   raw     = oElem rawParse opts
+   verb    = oElem beVerbose opts
+   forgive = oElem forgiveParse opts
+
+---- Operatins.allChecks :: ErrorMonad m => [m a] -> m [a]
+
+unknownWords sg ts = case filter noMatch [t | t@(TS _) <- ts] of
+     [] -> "where all words are known"
+     us -> "with the unknown tokens" +++ show us --- needs to be fixed for literals
+  where
+   terminals = map TS $ stateGrammarWords sg
+   noMatch t = all (not . compatTok t) terminals 
+     
+
+--- too much type checking in building term info? return FullTerm to save work?
+
+-- | raw parsing: so simple it is for a context-free CF grammar
+cf2trm0 :: CFTree -> C.Exp
+cf2trm0 (CFTree (fun, (_, trees))) = mkAppAtom (cffun2trm fun) (map cf2trm0 trees)
+ where
+   cffun2trm (CFFun (fun,_)) = fun
+   mkApp = foldl C.EApp
+   mkAppAtom a = mkApp (C.EAtom a)
diff --git a/src-2.9/GF/UseGrammar/Randomized.hs b/src-2.9/GF/UseGrammar/Randomized.hs
new file mode 100644
index 000000000..c1c77edb2
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Randomized.hs
@@ -0,0 +1,66 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Randomized
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:51 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.8 $
+--
+-- random generation and refinement. AR 22\/8\/2001.
+-- implemented as sequence of refinement menu selecsions, encoded as integers
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Randomized where
+
+import GF.Grammar.Abstract
+import GF.UseGrammar.Editing
+
+import GF.Data.Operations
+import GF.Data.Zipper
+
+--- import Arch (myStdGen) --- circular for hbc
+import System.Random --- (mkStdGen, StdGen, randoms) --- bad import for hbc
+
+-- random generation and refinement. AR 22/8/2001
+-- implemented as sequence of refinement menu selecsions, encoded as integers
+
+myStdGen :: Int -> StdGen
+myStdGen = mkStdGen ---
+
+-- | build one random tree; use mx to prevent infinite search
+mkRandomTree :: StdGen -> Int -> CGrammar -> Either Cat Fun -> Err Tree
+mkRandomTree gen mx gr cat = mkTreeFromInts (take mx (randoms gen)) gr cat
+
+refineRandom :: StdGen -> Int -> CGrammar -> Action
+refineRandom gen mx = mkStateFromInts $ take mx $ map abs (randoms gen)
+
+-- | build a tree from a list of integers
+mkTreeFromInts :: [Int] -> CGrammar -> Either Cat Fun -> Err Tree
+mkTreeFromInts ints gr catfun = do
+  st0   <- either (\cat -> newCat gr cat initState)
+                  (\fun -> newFun gr fun initState)
+                  catfun
+  state <- mkStateFromInts ints gr st0
+  return $ loc2tree state
+
+mkStateFromInts :: [Int] -> CGrammar -> Action
+mkStateFromInts ints gr z = mkRandomState ints z >>= reCheckState gr where
+  mkRandomState [] state = do
+    testErr (isCompleteState state) "not completed"
+    return state
+  mkRandomState (n:ns) state = do 
+    let refs  = refinementsState gr state
+        refs0 = map (not . snd . snd) refs
+    testErr (not (null refs0)) $ "no nonrecursive refinements available for" +++ 
+                                              prt (actVal state)
+    (ref,_) <- (refs !? (n `mod` (length refs)))
+    state1  <- refineWithAtom False gr ref state
+    if isCompleteState state1 
+       then return state1
+       else do 
+         state2  <- goNextMeta state1
+	 mkRandomState ns state2
+
diff --git a/src-2.9/GF/UseGrammar/Session.hs b/src-2.9/GF/UseGrammar/Session.hs
new file mode 100644
index 000000000..e54d0e3fb
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Session.hs
@@ -0,0 +1,181 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Session
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/08/17 15:13:55 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.12 $
+--
+-- (Description of the module)
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Session where
+
+import GF.Grammar.Abstract
+import GF.Infra.Option
+import GF.UseGrammar.Custom
+import GF.UseGrammar.Editing
+import GF.Compile.ShellState ---- grammar
+
+import GF.Data.Operations
+import GF.Data.Zipper (keepPosition) ---
+
+-- First version 8/2001. Adapted to GFC with modules 19/6/2003.
+-- Nothing had to be changed, which is a sign of good modularity.
+
+-- keep these abstract
+
+-- | 'Exp'-list: candidate refinements,clipboard
+type SState = [(State,([Exp],[Clip]),SInfo)] 
+
+-- | 'String' is message, 'Int' is the view
+type SInfo  = ([String],(Int,Options))       
+
+initSState :: SState
+initSState = [(initState, ([],[]), (["Select 'New' category to start"],(0,noOptions)))] 
+             -- instead of empty
+
+type Clip = Tree ---- (Exp,Type)
+
+-- | (peb): Something wrong with this definition??
+-- Shouldn't the result type be 'SInfo'?
+--
+-- > okInfo :: Int -> SInfo == ([String], (Int, Options))
+okInfo :: n -> ([s], (n, Bool))
+okInfo n = ([],(n,True))
+
+stateSState :: SState -> State
+candsSState :: SState -> [Exp]
+clipSState  :: SState -> [Clip]
+infoSState  :: SState -> SInfo
+msgSState   :: SState -> [String]
+viewSState  :: SState -> Int
+optsSState  :: SState -> Options
+
+stateSState ((s,_,_):_)     = s
+candsSState ((_,(ts,_),_):_)= ts
+clipSState  ((_,(_,ts),_):_)= ts
+infoSState  ((_,_,i):_)     = i
+msgSState   ((_,_,(m,_)):_) = m
+viewSState  ((_,_,(_,(v,_))):_) = v
+optsSState  ((_,_,(_,(_,o))):_) = o
+
+treeSState :: SState -> Tree
+treeSState = actTree . stateSState
+
+
+-- | from state to state
+type ECommand = SState -> SState
+
+-- * elementary commands
+
+-- ** change state, drop cands, drop message, preserve options
+
+changeState :: State -> ECommand
+changeState s ss = changeMsg [] $ (s,([],clipSState ss),infoSState ss) : ss 
+
+changeCands :: [Exp] -> ECommand
+changeCands ts ss@((s,(_,cb),(_,b)):_) = (s,(ts,cb),(candInfo ts,b)) : ss   
+
+addtoClip :: Clip -> ECommand
+addtoClip t ss@((s,(ts,cb),(i,b)):_) = (s,(ts,t:cb),(i,b)) : ss   
+
+removeClip :: Int -> ECommand
+removeClip n ss@((s,(ts,cb),(i,b)):_) = (s,(ts, drop n cb),(i,b)) : ss   
+
+changeMsg :: [String] -> ECommand
+changeMsg m ((s,ts,(_,b)):ss) = (s,ts,(m,b)) : ss   -- just change message
+changeMsg m _                 = (s,ts,(m,b)) : []  where [(s,ts,(_,b))] = initSState
+
+changeView :: ECommand
+changeView ((s,ts,(m,(v,b))):ss) = (s,ts,(m,(v+1,b))) : ss    -- toggle view
+
+withMsg :: [String] -> ECommand -> ECommand
+withMsg m c = changeMsg m . c
+
+changeStOptions :: (Options -> Options) -> ECommand
+changeStOptions f ((s,ts,(m,(v,o))):ss) = (s,ts,(m,(v, f o))) : ss
+
+noNeedForMsg :: ECommand
+noNeedForMsg = changeMsg [] -- everything's all right: no message
+
+candInfo :: [Exp] -> [String]
+candInfo ts = case length ts of
+  0 -> ["no acceptable alternative"]
+  1 -> ["just one acceptable alternative"]
+  n -> [show n +++ "alternatives to select"]
+
+-- * keep SState abstract from this on
+
+-- ** editing commands
+
+action2command :: Action -> ECommand
+action2command act state = case act (stateSState state) of 
+  Ok  s -> changeState s state 
+  Bad m -> changeMsg [m] state
+  
+action2commandNext :: Action -> ECommand -- move to next meta after execution
+action2commandNext act = action2command (\s -> act s >>= goNextMetaIfCan)
+
+action2commandKeep :: Action -> ECommand -- keep old position after execution
+action2commandKeep act = action2command (\s -> keepPosition act s)
+
+undoCommand :: Int -> ECommand
+undoCommand n ss =
+  let k = length ss in
+  if k < n 
+     then changeMsg ["cannot go all the way back"] [last ss]
+     else changeMsg ["successful undo"] (drop n ss)
+
+selectCand :: CGrammar -> Int -> ECommand
+selectCand gr i state = err (\m -> changeMsg [m] state) id $ do
+  exp <- candsSState state !? i
+  let s = stateSState state
+  tree <- annotateInState gr exp s
+  return $ case replaceSubTree tree s of
+      Ok st' -> changeState st' state
+      Bad s  -> changeMsg [s] state
+
+refineByExps :: Bool -> CGrammar -> [Exp] -> ECommand
+refineByExps der gr trees = case trees of
+  [t] -> action2commandNext (refineWithExpTC der gr t)
+  _  -> changeCands trees
+
+refineByTrees :: Bool -> CGrammar -> [Tree] -> ECommand
+refineByTrees der gr trees = case trees of
+  [t] -> action2commandNext (refineOrReplaceWithTree der gr t)
+  _  -> changeCands  $ map tree2exp trees
+
+replaceByTrees :: CGrammar -> [Exp] -> ECommand
+replaceByTrees gr trees = case trees of
+  [t] -> action2commandNext (\s -> 
+            annotateExpInState gr t s >>= flip replaceSubTree s)
+  _  -> changeCands trees
+
+replaceByEditCommand :: StateGrammar -> String -> ECommand
+replaceByEditCommand gr co = 
+  action2commandKeep $
+  maybe return ($ gr) $
+  lookupCustom customEditCommand (strCI co) 
+
+replaceByTermCommand :: Bool -> StateGrammar -> String -> Tree -> ECommand ----
+replaceByTermCommand der gr co exp = 
+  let g = grammar gr in
+    refineByTrees der g $ maybe [exp] (\f -> f gr exp) $
+      lookupCustom customTermCommand (strCI co)
+
+possClipsSState :: StateGrammar -> SState -> [(Int,Clip)]
+possClipsSState gr s = filter poss $ zip [0..] (clipSState s) 
+ where
+  poss = possibleTreeVal cgr st . snd
+  st   = stateSState s
+  cgr  = grammar gr
+
+getNumberedClip :: Int -> SState -> Err Clip
+getNumberedClip i s = if length cs > i then return (cs !! i) 
+                         else Bad "not enough clips"
+  where
+   cs = clipSState s
diff --git a/src-2.9/GF/UseGrammar/Statistics.hs b/src-2.9/GF/UseGrammar/Statistics.hs
new file mode 100644
index 000000000..46e4fcc3b
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Statistics.hs
@@ -0,0 +1,44 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Statistics
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/04 11:45:38 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.1 $
+--
+-- statistics on canonical grammar: amounts of generated code
+-- AR 4\/9\/2005.
+-- uses canonical grammar
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Statistics (prStatistics) where
+
+import GF.Infra.Modules
+import GF.Infra.Option
+import GF.Grammar.PrGrammar
+import GF.Canon.GFC
+import GF.Canon.MkGFC
+
+import GF.Data.Operations
+
+import Data.List (sortBy)
+
+-- | the top level function
+prStatistics :: CanonGrammar -> String
+prStatistics can = unlines $ [
+  show (length mods)  ++ "\t\t modules",
+  show chars ++ "\t\t gfc size",
+  "",
+  "Top 40 definitions"
+  ] ++
+  [show d ++ "\t\t " ++ f | (d,f) <- tops]
+ where
+   tops = take 40 $ reverse $ sortBy (\ (i,_) (j,_) -> compare i j) defs
+   defs = [(length (prt (info2def j)), name m j) | (m,j) <- infos]
+   infos = [(m,j) | (m,ModMod mo) <- mods, j <- tree2list (jments mo)]
+   name m (f,_) = prt m ++ "." ++ prt f
+   mods = modules can
+   chars = length $ prCanon can
diff --git a/src-2.9/GF/UseGrammar/Tokenize.hs b/src-2.9/GF/UseGrammar/Tokenize.hs
new file mode 100644
index 000000000..9f1ab5449
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Tokenize.hs
@@ -0,0 +1,222 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Tokenize
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/29 13:20:08 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.14 $
+--
+-- lexers = tokenizers, to prepare input for GF grammars. AR 4\/1\/2002.
+-- an entry for each is included in 'Custom.customTokenizer'
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Tokenize ( tokWords,
+		  tokLits,
+		  tokVars,
+		  lexHaskell,
+		  lexHaskellLiteral,
+		  lexHaskellVar,
+		  lexText,
+		  lexTextVar,
+		  lexC2M, lexC2M',
+		  lexTextLiteral,
+                  lexIgnore,
+                  wordsLits
+		) where
+
+import GF.Data.Operations
+---- import UseGrammar (isLiteral,identC)
+import GF.CF.CFIdent
+
+import Data.Char
+
+-- lexers = tokenizers, to prepare input for GF grammars. AR 4/1/2002
+-- an entry for each is included in Custom.customTokenizer
+
+-- | just words
+tokWords :: String -> [CFTok]
+tokWords = map tS . words
+
+tokLits :: String -> [CFTok]
+tokLits = map mkCFTok . mergeStr . wordsLits where
+  mergeStr ss = case ss of
+    w@(c:cs):rest | elem c "\'\"" && c /= last w -> getStr [w] rest
+    w      :rest                  -> w : mergeStr rest
+    [] -> []
+  getStr v ss = case ss of
+    w@(_:_):rest | elem (last w) "\'\"" -> (unwords (reverse (w:v))) : mergeStr rest
+    w      :rest                 -> getStr (w:v) rest
+    [] -> reverse v
+
+tokVars :: String -> [CFTok]
+tokVars = map mkCFTokVar . wordsLits
+
+isFloat s = case s of
+  c:cs | isDigit c -> isFloat cs
+  '.':cs@(_:_)     -> all isDigit cs
+  _ -> False
+
+isString s = case s of
+  c:cs@(_:_) -> (c == '\'' && d == '\'') || (c == '"' && d == '"') where d = last cs
+  _ -> False
+
+
+mkCFTok :: String -> CFTok
+mkCFTok s = case s of
+  '"' :cs@(_:_) | last cs == '"'  -> tL $ init cs
+  '\'':cs@(_:_) | last cs == '\'' -> tL $ init cs --- 's Gravenhage
+  _:_ | isFloat s -> tF s
+  _:_ | all isDigit s -> tI s
+  _ -> tS s
+
+mkCFTokVar :: String -> CFTok
+mkCFTokVar s = case s of
+  '?':_:_      -> tM s --- "?" --- compat with prCF
+  'x':'_':_    -> tV s
+  'x':[]       -> tV s
+  '$':xs@(_:_) -> if last s == '$' then tV (init xs) else tS s
+  _            -> tS s
+
+mkTokVars :: (String -> [CFTok]) -> String -> [CFTok]
+mkTokVars tok = map tv . tok where
+  tv (TS s) = mkCFTokVar s
+  tv t = t
+
+mkLit :: String -> CFTok
+mkLit s 
+  | isFloat s = tF s
+  | all isDigit s = tI s
+  | otherwise = tL s
+
+-- obsolete
+mkTL :: String -> CFTok
+mkTL s 
+  | isFloat s = tF s
+  | all isDigit s = tI s
+  | otherwise = tL ("'" ++ s ++ "'")
+
+
+-- | Haskell lexer, usable for much code
+lexHaskell :: String -> [CFTok]
+lexHaskell ss = case lex ss of
+  [(w@(_:_),ws)] -> tS w : lexHaskell ws
+  _ -> []
+
+-- | somewhat shaky text lexer
+lexText :: String -> [CFTok]
+lexText = uncap . lx where
+
+  lx s = case s of
+    '?':'?':cs          -> tS "??" : lx cs
+    p : cs | isMPunct p -> tS [p] : uncap (lx cs)
+    p : cs | isPunct p  -> tS [p] : lx cs
+    s : cs | isSpace s  -> lx cs
+    _ : _  -> getWord s
+    _ -> []
+
+  getWord s  = tS w : lx ws where (w,ws) = span isNotSpec s
+  isMPunct c = elem c ".!?"
+  isPunct c  = elem c ",:;()\""
+  isNotSpec c = not (isMPunct c || isPunct c || isSpace c)
+  uncap (TS (c:cs) : ws) = tC (c:cs) : ws
+  uncap s = s
+
+-- | lexer for C--, a mini variant of C
+lexC2M :: String -> [CFTok]
+lexC2M = lexC2M' False
+
+lexC2M' :: Bool -> String -> [CFTok]
+lexC2M' isHigherOrder s = case s of
+  '#':cs                 -> lexC $ dropWhile (/='\n') cs
+  '/':'*':cs             -> lexC $ dropComment cs
+  c:cs   | isSpace c     -> lexC cs
+  c:cs   | isAlpha c     -> getId s
+  c:cs   | isDigit c     -> getLit s
+  c:d:cs | isSymb [c,d]  -> tS [c,d] : lexC cs
+  c:cs   | isSymb [c]    -> tS [c]   : lexC cs
+  _                      -> [] --- covers end of file and unknown characters
+ where
+  lexC = lexC2M' isHigherOrder
+  getId s  = mkT i : lexC cs where (i,cs) = span isIdChar s
+  getLit s = tI i  : lexC cs where (i,cs) = span isDigit s ---- Float!
+  isIdChar c = isAlpha c || isDigit c || elem c "'_"
+  isSymb = reservedAnsiCSymbol 
+  dropComment s = case s of
+    '*':'/':cs -> cs
+    _:cs -> dropComment cs
+    _ -> []
+  mkT i = if (isRes i) then (tS i) else 
+            if isHigherOrder then (tV i) else (tL ("'" ++ i ++ "'"))
+  isRes = reservedAnsiC
+
+
+reservedAnsiCSymbol s = case lookupTree show s ansiCtree of
+  Ok True -> True 
+  _ -> False
+
+reservedAnsiC s = case lookupTree show s ansiCtree of
+  Ok False -> True 
+  _ -> False
+
+-- | for an efficient lexer: precompile this!
+ansiCtree = buildTree $ [(s,True)  | s <- reservedAnsiCSymbols] ++
+                        [(s,False) | s <- reservedAnsiCWords]
+
+reservedAnsiCSymbols = words $
+    "<<= >>= << >> ++ -- == <= >= *= += -= %= /= &= ^= |= " ++ 
+    "^ { } = , ; + * - ( ) < > & % ! ~"
+
+reservedAnsiCWords = words $ 
+    "auto break case char const continue default " ++ 
+    "do double else enum extern float for goto if int " ++
+    "long register return short signed sizeof static struct switch typedef " ++
+    "union unsigned void volatile while " ++
+    "main printin putchar"  --- these are not ansi-C
+
+-- | turn unknown tokens into string literals; not recursively for literals 123, 'foo'
+unknown2string :: (String -> Bool) -> [CFTok] -> [CFTok]
+unknown2string isKnown = map mkOne where
+  mkOne t@(TS s) 
+    | isKnown s = t
+    | isFloat s = tF s
+    | all isDigit s = tI s 
+    | otherwise = tL s
+  mkOne t@(TC s) = if isKnown s then t else mkLit s
+  mkOne t        = t
+
+unknown2var :: (String -> Bool) -> [CFTok] -> [CFTok]
+unknown2var isKnown = map mkOne where
+  mkOne t@(TS "??") = if isKnown "??" then t else tM "??"
+  mkOne t@(TS s) 
+    | isKnown s = t
+    | isFloat s = tF s
+    | isString s = tL (init (tail s))
+    | all isDigit s = tI s 
+    | otherwise = tV s
+  mkOne t@(TC s) = if isKnown s then t else tV s
+  mkOne t        = t
+
+lexTextLiteral, lexHaskellLiteral, lexHaskellVar :: (String -> Bool) -> String -> [CFTok]
+
+lexTextLiteral    isKnown = unknown2string (eitherUpper isKnown) . lexText
+lexHaskellLiteral isKnown = unknown2string isKnown . lexHaskell
+
+lexHaskellVar     isKnown = unknown2var isKnown . lexHaskell
+lexTextVar    isKnown = unknown2var (eitherUpper isKnown) . lexText
+
+
+eitherUpper isKnown w@(c:cs) = isKnown (toLower c : cs) || isKnown (toUpper c : cs)
+eitherUpper isKnown w = isKnown w
+
+-- ignore unknown tokens (e.g. keyword spotting)
+
+lexIgnore :: (String -> Bool) -> [CFTok] -> [CFTok]
+lexIgnore isKnown = concatMap mkOne where
+  mkOne t@(TS s) 
+    | isKnown s = [t]
+    | otherwise = []
+  mkOne t       = [t]
+
diff --git a/src-2.9/GF/UseGrammar/Transfer.hs b/src-2.9/GF/UseGrammar/Transfer.hs
new file mode 100644
index 000000000..5d62f4385
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Transfer.hs
@@ -0,0 +1,79 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Transfer
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/04/21 16:23:53 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.5 $
+--
+-- linearize, parse, etc, by transfer. AR 9\/10\/2003
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Transfer where
+
+import GF.Grammar.Grammar
+import GF.Grammar.Values
+import GF.Grammar.AbsCompute
+import qualified GF.Canon.GFC as GFC
+import GF.Grammar.LookAbs
+import GF.Grammar.MMacros
+import GF.Grammar.Macros
+import GF.Grammar.PrGrammar
+import GF.Grammar.TypeCheck
+
+import GF.Infra.Ident
+import GF.Data.Operations
+
+import qualified Transfer.Core.Abs as T
+
+import Control.Monad
+
+
+-- transfer is done in T.Exp - we only need these conversions.
+
+exp2core :: Ident -> Exp -> T.Exp
+exp2core f = T.EApp (T.EVar (var f)) . exp2c where
+ exp2c e = case e of
+  App f a -> T.EApp (exp2c f) (exp2c a)
+  Abs x b -> T.EAbs (T.PVVar (var x)) (exp2c b) ---- should be syntactic abstr
+  Q  _ c  -> T.EVar (var c)
+  QC _ c  -> T.EVar (var c)
+  K s     -> T.EStr s
+  EInt i  -> T.EInteger $ toInteger i
+  Meta m  -> T.EMeta (T.TMeta (prt m))   ---- which meta symbol?
+  Vr x    -> T.EVar (var x)              ---- should be syntactic var
+
+ var x = T.CIdent $ prt x
+
+core2exp :: T.Exp -> Exp
+core2exp e = case e of
+  T.EApp f a -> App (core2exp f) (core2exp a)
+  T.EAbs (T.PVVar x) b -> Abs (var x) (core2exp b) ---- only from syntactic abstr
+  T.EVar c   -> Vr (var c)               -- GF annotates to Q or QC
+  T.EStr s   -> K s
+  T.EInteger i -> EInt $ fromInteger i
+  T.EMeta _  -> uExp  -- meta symbol 0, refreshed by GF
+ where
+   var :: T.CIdent -> Ident
+   var (T.CIdent x) = zIdent x
+
+
+
+-- The following are now obsolete (30/11/2005)
+-- linearize, parse, etc, by transfer. AR 9/10/2003
+
+doTransfer :: GFC.CanonGrammar -> Ident -> Tree -> Err Tree
+doTransfer gr tra t = do
+  cat <- liftM snd $ val2cat $ valTree t
+  f   <- lookupTransfer gr tra cat
+  e   <- compute gr $ App f $ tree2exp t
+  annotate gr e
+
+useByTransfer :: (Tree -> Err a) -> GFC.CanonGrammar -> Ident -> (Tree -> Err a)
+useByTransfer lin gr tra t = doTransfer gr tra t >>= lin
+
+mkByTransfer :: (a -> Err [Tree]) -> GFC.CanonGrammar -> Ident -> (a -> Err [Tree])
+mkByTransfer parse gr tra s = parse s >>= mapM (doTransfer gr tra)
diff --git a/src-2.9/GF/UseGrammar/TreeSelections.hs b/src-2.9/GF/UseGrammar/TreeSelections.hs
new file mode 100644
index 000000000..9bf2711be
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/TreeSelections.hs
@@ -0,0 +1,77 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : TreeSelections
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- choose shallowest trees, and remove an overload resolution prefix
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.TreeSelections (
+
+  getOverloadResults, smallestTrs, sizeTr, depthTr
+
+  ) where
+
+import GF.Grammar.Abstract
+import GF.Grammar.Macros
+
+import GF.Data.Operations
+import GF.Data.Zipper
+import Data.List
+
+-- AR 2/7/2007
+-- The top-level function takes a set of trees (typically parses)
+-- and returns the list of those trees that have the minimum size.
+-- In addition, the overload prefix "ovrld123_", is removed
+-- from each constructor in which it appears. This is used for 
+-- showing the library API constructors in a parsable grammar.
+-- TODO: access the generic functions smallestTrs, sizeTr, depthTr from shell
+
+getOverloadResults :: [Tree] -> [Tree]
+getOverloadResults = smallestTrs sizeTr . map (mkOverload "ovrld") 
+
+-- NB: this does not always give the desired result, since
+-- some genuine alternatives may be deeper: now we will exclude the 
+-- latter of
+--
+--   mkCl this_NP love_V2 (mkNP that_NP here_Adv)
+--   mkCl this_NP (mkVP (mkVP love_V2 that_NP) here_Adv)
+--
+-- A perfect method would know the definitional equivalences of constructors.
+--
+-- Notice also that size is a better measure than depth, because:
+-- 1. Global depth does not exclude the latter of
+--
+--   mkCl (mkNP he_Pron) love_V2 that_NP
+--   mkCl (mkNP he_Pron) (mkVP love_V2 that_NP)
+--
+-- 2. Length is needed to exclude the latter of
+--
+--   mkS (mkCl (mkNP he_Pron) love_V2 that_NP)
+--   mkS presentTense (mkCl (mkNP he_Pron) love_V2 that_NP)
+--
+
+smallestTrs :: (Tr a -> Int) -> [Tr a] -> [Tr a]
+smallestTrs size ts = map fst $ filter ((==mx) . snd) tds where
+  tds = [(t, size t) | t <- ts]
+  mx = minimum $ map snd tds
+
+depthTr :: Tr a -> Int
+depthTr (Tr (_, ts)) = case ts of
+  [] -> 1
+  _ -> 1 + (maximum $ map depthTr ts)
+
+sizeTr :: Tr a -> Int
+sizeTr (Tr (_, ts)) = 1 + sum (map sizeTr ts)
+
+-- remove from each constant a prefix starting with "pref", up to first "_"
+-- example format: ovrld123_mkNP
+
+mkOverload :: String -> Tree -> Tree
+mkOverload pref = mapTr (changeAtom overAtom) where
+  overAtom a = case a of
+    AtC (m, IC f) | isPrefixOf pref f ->
+      AtC (m, IC (tail (dropWhile (/='_') f)))
+    _ -> a
diff --git a/src-2.9/GF/UseGrammar/Treebank.hs b/src-2.9/GF/UseGrammar/Treebank.hs
new file mode 100644
index 000000000..841a9c6dc
--- /dev/null
+++ b/src-2.9/GF/UseGrammar/Treebank.hs
@@ -0,0 +1,251 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : Treebank
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- Generate multilingual treebanks. AR 8\/2\/2006
+--
+-- (c) Aarne Ranta 2006 under GNU GPL
+--
+-- Purpose: to generate treebanks.
+-----------------------------------------------------------------------------
+
+module GF.UseGrammar.Treebank (
+  mkMultiTreebank,
+  mkUniTreebank,
+  multi2uniTreebank,
+  uni2multiTreebank,
+  testMultiTreebank,
+  treesTreebank,
+  getTreebank,
+  getUniTreebank,
+  readUniTreebanks,
+  readMultiTreebank,
+  lookupTreebank,
+  assocsTreebank,
+  isWordInTreebank,
+  printAssoc,
+  mkCompactTreebank
+  ) where
+
+import GF.Compile.ShellState 
+import GF.UseGrammar.Linear -- (linTree2string)
+import GF.UseGrammar.Custom
+import GF.UseGrammar.GetTree (string2tree)
+import GF.Grammar.TypeCheck (annotate)
+import GF.Canon.CMacros (noMark)
+import GF.Grammar.Grammar (Trm)
+import GF.Grammar.MMacros (exp2tree)
+import GF.Grammar.Macros (zIdent)
+import GF.Grammar.PrGrammar (prt_,prt)
+import GF.Grammar.Values (tree2exp)
+import GF.Data.Operations
+import GF.Infra.Option
+import GF.Infra.Ident (Ident)
+import GF.Infra.UseIO
+import qualified GF.Grammar.Abstract as A
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.List as L
+import Control.Monad (liftM)
+import System.FilePath
+
+-- Generate a treebank with a multilingual grammar. AR 8/2/2006
+-- (c) Aarne Ranta 2006 under GNU GPL
+
+-- keys  are trees; format: XML file
+type MultiTreebank = [(String,[(String,String)])]       -- tree,lang,lin
+
+-- keys are strings; format: string TAB tree TAB ... TAB tree
+type UniTreebank   = Treebank -- M.Map String [String]  -- string,tree
+
+-- both formats can be read from both kinds of files
+readUniTreebanks :: FilePath -> IO [(Ident,UniTreebank)]
+readUniTreebanks file = do
+  s <- readFileIf file
+  return $ if isMultiTreebank s 
+    then multi2uniTreebank $ getTreebank $ lines s
+    else
+      let tb = getUniTreebank $ lines s
+      in [(zIdent (dropExtension file),tb)]
+
+readMultiTreebank :: FilePath -> IO MultiTreebank
+readMultiTreebank file = do
+  s <- readFileIf file
+  return $ if isMultiTreebank s 
+    then getTreebank $ lines s
+    else uni2multiTreebank (zIdent (dropExtension file)) $ getUniTreebank $ lines s
+
+isMultiTreebank :: String -> Bool
+isMultiTreebank s = take 10 s == "<treebank>" 
+
+multi2uniTreebank :: MultiTreebank -> [(Ident,UniTreebank)]
+multi2uniTreebank mt@((_,lls):_) = [(zIdent la, mkTb la) | (la,_) <- lls] where
+  mkTb la = M.fromListWith (++) [(s,[t]) | (t,lls) <- mt, (l,s) <- lls, l==la]
+multi2uniTreebank [] = []
+
+uni2multiTreebank ::  Ident -> UniTreebank -> MultiTreebank
+uni2multiTreebank la tb = 
+  [(t,[(prt_ la, s)]) | (s,ts) <- assocsTreebank tb, t <- ts]
+
+-- | the main functions 
+
+-- builds a treebank where trees are the keys, and writes a file (opt. XML)
+mkMultiTreebank :: Options -> ShellState -> String -> [A.Tree] -> Res
+mkMultiTreebank opts sh com trees 
+  | oElem (iOpt "compact") opts = mkCompactTreebank opts sh trees
+mkMultiTreebank opts sh com trees = 
+ putInXML opts "treebank" comm (concatMap mkItem tris) where
+   mkItem(t,i)= putInXML opts "item" (cat i)  (mkTree t ++ concatMap (mkLin t) langs)
+--   mkItem(t,i)= putInXML opts "item" (cat i)  (mkTree t >>mapM_ (mkLin t) langs)
+   mkTree t   = putInXML opts "tree" []       (puts $ showTree t)
+   mkLin t lg = putInXML opts "lin" (lang lg) (puts $ linearize opts sh lg t)
+
+   langs   = [prt_ l | l <- allLanguages sh]
+   comm    = "" --- " command=" ++ show com +++ "abstract=" ++ show abstr
+   abstr   = "" --- "Abs" ----
+   cat i   = " number=" ++ show (show i) --- " cat=" ++ show "S" ----
+   lang lg = " lang=" ++ show (prt_ (zIdent lg))
+   tris    = zip trees [1..]
+
+-- builds a unilingual treebank where strings are the keys into an internal treebank
+
+mkUniTreebank :: Options -> ShellState -> Language -> [A.Tree] -> Treebank
+mkUniTreebank opts sh lg trees = M.fromListWith (++) [(lin t, [prt_ t]) | t <- trees]
+ where
+   lang  = prt_ lg 
+   lin t = linearize opts sh lang t
+
+-- reads a treebank and linearizes its trees again, printing all differences
+testMultiTreebank :: Options -> ShellState -> String -> Res
+testMultiTreebank opts sh = putInXML opts "testtreebank" [] . 
+                            concatMap testOne . 
+                            getTreebanks . lines
+ where
+  testOne (e,lang,str0) = do
+    let tr = annot gr e
+    let str = linearize opts sh lang tr
+    if str == str0 then ret else putInXML opts "diff" [] $ concat [
+      putInXML opts "tree" [] (puts $ showTree tr),
+      putInXML opts "old"  (" lang=" ++ show (prt_ (zIdent lang))) $ puts str0,
+      putInXML opts "new"  (" lang=" ++ show (prt_ (zIdent lang))) $ puts str
+      ]
+  gr = firstStateGrammar sh
+
+-- writes all the trees of the treebank
+treesTreebank :: Options -> String -> [String]
+treesTreebank _ = terms . getTreebank . lines where
+  terms ts = [t | (t,_) <- ts]
+
+-- string vs. IO
+type Res = [String] -- IO ()
+puts :: String -> Res
+puts = return  -- putStrLn
+ret = [] -- return ()
+--
+
+-- here strings are keys
+assocsTreebank :: UniTreebank -> [(String,[String])]
+assocsTreebank = M.assocs
+
+isWordInTreebank :: UniTreebank -> String -> Bool
+isWordInTreebank tb w = S.member w (S.fromList (concatMap words (M.keys tb)))
+
+printAssoc (s, ts) = s ++ concat ["\t" ++ t | t <- ts]
+
+getTreebanks :: [String] -> [(String,String,String)]
+getTreebanks = concatMap grps . getTreebank where
+  grps (t,lls) = [(t,x,y) | (x,y) <- lls]
+
+getTreebank :: [String] -> MultiTreebank
+getTreebank ll = case ll of
+  l:ls@(_:_:_) -> 
+    let (l1,l2)   = getItem ls
+        (tr,lins) = getTree l1
+        lglins    = getLins lins
+    in (tr,lglins) : getTreebank l2
+  _ -> []
+ where
+   getItem = span ((/="</item") . take 6)
+
+   getTree (_:ss) = 
+     let (t1,t2) = span ((/="</tree") . take 6) ss in (last t1, drop 1 t2)
+
+   getLins (beg:str:end:ss) = (getLang beg, str):getLins ss
+   getLins _ = []
+
+   getLang = takeWhile (/='"') . tail . dropWhile (/='"')
+
+getUniTreebank :: [String] -> UniTreebank
+getUniTreebank ls = M.fromListWith (++) [(s, ts) | s:ts <- map chop ls] where
+  chop = chunks '\t'
+
+lookupTreebank :: Treebank -> String -> [String]
+lookupTreebank tb s = maybe [] id $ M.lookup s tb 
+
+annot :: StateGrammar -> String -> A.Tree
+annot gr s = errVal (error "illegal tree") $ do
+  let t = tree2exp $ string2tree gr s
+  annotate (grammar gr) t
+
+putInXML :: Options -> String -> String -> Res -> Res
+putInXML opts tag attrs io = 
+  (ifXML $ puts $ tagXML $ tag ++ attrs) ++
+  io ++
+  (ifXML $ puts $ tagXML $ '/':tag)
+ where
+  ifXML c = if oElem showXML opts then c else []
+
+
+tagXML :: String -> String
+tagXML s = "<" ++ s ++ ">"
+
+-- print the treebank in a compact format:
+-- first a sorted list of all words, referrable by index
+-- then the linearization of each tree, as sequences of word indices
+-- this format is usable in embedded translation systems.
+
+mkCompactTreebank :: Options -> ShellState -> [A.Tree] -> [String]
+mkCompactTreebank opts sh = printCompactTreebank . mkJustMultiTreebank opts sh
+
+printCompactTreebank :: (MultiTreebank,[String]) -> [String]
+printCompactTreebank (tb,lgs) = (stat:langs:unwords ws : "\n" : linss) where
+  ws = L.sort $ L.nub $ concat $ map (concatMap (words . snd) . snd) tb
+
+  linss = map (unwords . pad) linss0
+  linss0 = map (map (show . encode) . words) allExs
+  allExs = concat [[snd (ls !! i) | (_,ls) <- tb] | i <- [0..length lgs - 1]]
+  encode w = maybe undefined id $ M.lookup w wmap
+  wmap = M.fromAscList $ zip ws [1..]
+  stat = unwords $ map show [length ws, length lgs, length tb, smax]
+  langs = unwords lgs
+  smax = maximum $ map length linss0
+  pad ws = ws ++ replicate (smax - length ws) "0"
+
+-- [(String,[(String,String)])]       -- tree,lang,lin
+mkJustMultiTreebank :: Options -> ShellState -> [A.Tree] -> (MultiTreebank,[String])
+mkJustMultiTreebank opts sh ts = 
+    ([(prt_ t, [(la, lin la t) | la <- langs]) | t <- ts],langs) where
+  langs = map prt_ $ allLanguages sh
+  lin = linearize opts sh
+
+
+--- these handy functions are borrowed from EmbedAPI
+
+linearize opts mgr lang = lin where
+  sgr   = stateGrammarOfLangOpt False mgr zlang
+  cgr   = canModules mgr
+  zlang = zIdent lang
+  untok = customOrDefault (addOptions opts (stateOptions sgr)) useUntokenizer customUntokenizer sgr
+  lin   
+    | oElem showRecord opts = err id id . liftM prt . linearizeNoMark cgr zlang
+    | oElem tableLin opts = 
+        err id id . liftM (unlines . map untok . prLinTable True) .  allLinTables True cgr zlang
+    | oElem showAll opts =  
+        err id id . liftM (unlines . map untok . prLinTable False) . allLinTables False cgr zlang
+
+    | otherwise = untok . linTree2string noMark cgr zlang 
+
+showTree t = prt_ $ tree2exp t
diff --git a/src-2.9/GF/Visualization/Graphviz.hs b/src-2.9/GF/Visualization/Graphviz.hs
new file mode 100644
index 000000000..b59e3ecd2
--- /dev/null
+++ b/src-2.9/GF/Visualization/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.Visualization.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-2.9/GF/Visualization/VisualizeGrammar.hs b/src-2.9/GF/Visualization/VisualizeGrammar.hs
new file mode 100644
index 000000000..b5446aec8
--- /dev/null
+++ b/src-2.9/GF/Visualization/VisualizeGrammar.hs
@@ -0,0 +1,125 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : VisualizeGrammar
+-- Maintainer  : BB
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/14 15:17:30 $ 
+-- > CVS $Author: bringert $
+-- > CVS $Revision: 1.10 $
+--
+-- Print a graph of module dependencies in Graphviz DOT format
+-- FIXME: change this to use GF.Visualization.Graphviz, 
+--        instead of rolling its own.
+-----------------------------------------------------------------------------
+
+module GF.Visualization.VisualizeGrammar ( visualizeCanonGrammar,
+			  visualizeSourceGrammar
+			) where
+
+import qualified GF.Infra.Modules as M
+import GF.Canon.GFC
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Grammar.Grammar (SourceGrammar)
+
+import Data.List (intersperse, nub)
+import Data.Maybe (maybeToList)
+
+data GrType = GrAbstract 
+	    | GrConcrete 
+	    | GrResource 
+	    | GrInterface
+	    | GrInstance
+	    deriving Show
+
+data Node = Node { 
+		  label :: String,
+		  url :: String,
+		  grtype :: GrType,
+		  extends :: [String],
+		  opens :: [String],
+		  implements :: Maybe String
+		  }
+		  deriving Show
+
+
+visualizeCanonGrammar :: Options -> CanonGrammar -> String
+visualizeCanonGrammar opts = prGraph . canon2graph
+
+visualizeSourceGrammar :: SourceGrammar -> String
+visualizeSourceGrammar = prGraph . source2graph
+
+canon2graph :: CanonGrammar -> [Node]
+canon2graph gr = [ toNode i m | (i,M.ModMod m) <- M.modules gr ]
+
+source2graph :: SourceGrammar -> [Node]
+source2graph gr = [ toNode i m | (i,M.ModMod m) <- M.modules gr ] -- FIXME: handle ModWith?
+
+toNode :: Ident -> M.Module Ident f i -> Node
+toNode i m = Node {
+		   label = l,
+		   url = l ++ ".gf", -- FIXME: might be in a different directory
+		   grtype = t,
+		   extends = map prIdent (M.extends m),
+		   opens = nub $ map openName (M.opens m), -- FIXME: nub is needed because of triple open with 
+		                                           -- instance modules
+		   implements = is
+		  }
+    where 
+    l = prIdent i
+    (t,is) = fromModType (M.mtype m)
+
+fromModType :: M.ModuleType Ident -> (GrType, Maybe String)
+fromModType t = case t of
+		       M.MTAbstract -> (GrAbstract, Nothing)
+		       M.MTTransfer _ _ -> error "Can't visualize transfer modules yet" -- FIXME
+		       M.MTConcrete i -> (GrConcrete, Just (prIdent i))
+		       M.MTResource -> (GrResource, Nothing)
+		       M.MTInterface -> (GrInterface, Nothing)
+		       M.MTInstance i -> (GrInstance, Just (prIdent i))
+		       M.MTReuse rt -> error "Can't visualize reuse modules yet" -- FIXME
+		       M.MTUnion _ _ -> error "Can't visualize union modules yet" -- FIXME
+
+-- | FIXME: there is something odd about OQualif with 'with' modules,
+-- both names seem to be the same.
+openName :: M.OpenSpec Ident -> String
+openName (M.OSimple q i) = prIdent i
+openName (M.OQualif q i _) = prIdent i
+
+prGraph :: [Node] -> String
+prGraph ns = concat $ map (++"\n") $ ["digraph {\n"] ++ map prNode ns ++ ["}"]
+
+prNode :: Node -> String
+prNode n = concat (map (++";\n") stmts)
+    where 
+    l = label n
+    t = grtype n
+    stmts = [l ++ " [" ++ prAttributes attrs ++ "]"]
+	    ++ map (prExtend t l) (extends n)
+	    ++ map (prOpen l) (opens n)
+	    ++ map (prImplement t l) (maybeToList (implements n))
+    (shape,style) = case t of
+			   GrAbstract  -> ("ellipse","solid")
+			   GrConcrete  -> ("box","dashed")
+			   GrResource  -> ("ellipse","dashed")
+			   GrInterface -> ("ellipse","dotted")
+			   GrInstance  -> ("diamond","dotted")
+    attrs = [("style", style),("shape", shape),("URL", url n)]
+
+
+prExtend :: GrType -> String -> String -> String
+prExtend g f t = prEdge f t [("style","solid")]
+
+prOpen :: String -> String -> String
+prOpen f t = prEdge f t [("style","dotted")]
+
+prImplement :: GrType -> String -> String -> String
+prImplement g f t = prEdge f t [("arrowhead","empty"),("style","dashed")]
+
+prEdge :: String -> String -> [(String,String)] -> String
+prEdge f t as = f ++ " -> " ++ t ++ " [" ++ prAttributes as ++ "]"
+
+prAttributes :: [(String,String)] -> String
+prAttributes = concat . intersperse ", " . map (\ (n,v) -> n ++ " = " ++ show v)
diff --git a/src-2.9/GF/Visualization/VisualizeTree.hs b/src-2.9/GF/Visualization/VisualizeTree.hs
new file mode 100644
index 000000000..5fe740c12
--- /dev/null
+++ b/src-2.9/GF/Visualization/VisualizeTree.hs
@@ -0,0 +1,58 @@
+----------------------------------------------------------------------
+-- |
+-- 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 GF.Visualization.VisualizeTree ( visualizeTrees
+			) where
+
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Grammar.Abstract
+import GF.Data.Zipper
+import GF.Grammar.PrGrammar
+
+import Data.List (intersperse, nub)
+import Data.Maybe (maybeToList)
+
+visualizeTrees :: Options -> [Tree] -> String
+visualizeTrees opts = unlines . map (prGraph opts . tree2graph opts)
+
+tree2graph :: Options -> Tree -> [String]
+tree2graph opts = prf [] where
+  prf ps t@(Tr (node, trees)) = 
+    let (nod,lab) = prn ps node 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 (N (bi,at,val,_,_)) = 
+    let 
+      lab = 
+        "\"" ++ 
+        prb bi ++ 
+        prc at val ++ 
+        "\""
+    in if oElem (iOpt "g") opts then (lab,lab) else (show(show (ps :: [Int])),lab)
+  prb [] = ""
+  prb bi = "\\" ++ concat (intersperse "," (map (prt_ . fst) bi)) ++ " -> "
+  pra i nod t@(Tr (node,_)) =  nod ++ arr ++ fst (prn i node) ++ " [style = \"solid\"];"
+  prc a v 
+    | oElem (iOpt "c") opts = prt_ v
+    | oElem (iOpt "f") opts = prt_ a
+    | otherwise             = prt_ a ++ " : " ++ prt_ v
+  arr = if oElem (iOpt "g") opts then " -> " else " -- "
+
+prGraph opts ns = concat $ map (++"\n") $ [graph ++ "{\n"] ++ ns ++ ["}"] where
+  graph = if oElem (iOpt "g") opts then "digraph" else "graph"
diff --git a/src-2.9/HelpFile b/src-2.9/HelpFile
new file mode 100644
index 000000000..c6b38b313
--- /dev/null
+++ b/src-2.9/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-2.9/INSTALL b/src-2.9/INSTALL
new file mode 100644
index 000000000..ef7949b07
--- /dev/null
+++ b/src-2.9/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-2.9/INSTALL.binary b/src-2.9/INSTALL.binary
new file mode 100644
index 000000000..ef62b24af
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/DynamicTree.java b/src-2.9/JavaGUI/DynamicTree.java
new file mode 100644
index 000000000..6acc6ff64
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/DynamicTree2.java b/src-2.9/JavaGUI/DynamicTree2.java
new file mode 100644
index 000000000..9d325772d
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/GFEditor.java b/src-2.9/JavaGUI/GFEditor.java
new file mode 100644
index 000000000..0ebf91e7e
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/GFEditor2.java b/src-2.9/JavaGUI/GFEditor2.java
new file mode 100644
index 000000000..f71210d7c
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/GrammarFilter.java b/src-2.9/JavaGUI/GrammarFilter.java
new file mode 100644
index 000000000..5180a9f6e
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/LinPosition.java b/src-2.9/JavaGUI/LinPosition.java
new file mode 100644
index 000000000..2419de1df
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/MarkedArea.java b/src-2.9/JavaGUI/MarkedArea.java
new file mode 100644
index 000000000..3299db9aa
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/Numerals.java b/src-2.9/JavaGUI/Numerals.java
new file mode 100644
index 000000000..752cf232c
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/Utils.java b/src-2.9/JavaGUI/Utils.java
new file mode 100644
index 000000000..b10f54712
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI/manifest.txt b/src-2.9/JavaGUI/manifest.txt
new file mode 100644
index 000000000..006d8adfd
--- /dev/null
+++ b/src-2.9/JavaGUI/manifest.txt
@@ -0,0 +1 @@
+Main-Class: GFEditor2
diff --git a/src-2.9/JavaGUI/runNumerals b/src-2.9/JavaGUI/runNumerals
new file mode 100644
index 000000000..3445220cc
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI2/LICENCE_jargs b/src-2.9/JavaGUI2/LICENCE_jargs
new file mode 100644
index 000000000..509c1b7cb
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI2/ManifestMain.txt b/src-2.9/JavaGUI2/ManifestMain.txt
new file mode 100644
index 000000000..b398ff78d
--- /dev/null
+++ b/src-2.9/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-2.9/JavaGUI2/gf-icon.gif b/src-2.9/JavaGUI2/gf-icon.gif
new file mode 100644
index 000000000..5e8863d76
Binary files /dev/null and b/src-2.9/JavaGUI2/gf-icon.gif differ
diff --git a/src-2.9/JavaGUI2/jargs-1.0.jar b/src-2.9/JavaGUI2/jargs-1.0.jar
new file mode 100644
index 000000000..cdbc80bb3
Binary files /dev/null and b/src-2.9/JavaGUI2/jargs-1.0.jar differ
diff --git a/src-2.9/Makefile b/src-2.9/Makefile
new file mode 100644
index 000000000..421409280
--- /dev/null
+++ b/src-2.9/Makefile
@@ -0,0 +1,324 @@
+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=gf$(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 GF.Today (today,version,libdir) where' > GF/Today.hs
+	echo '{-# NOINLINE today #-}' >> GF/Today.hs
+	echo 'today :: String' >> GF/Today.hs
+	echo 'today = "'`date`'"' >> GF/Today.hs
+	echo '{-# NOINLINE version #-}' >> GF/Today.hs
+	echo 'version :: String' >> GF/Today.hs
+	echo 'version = "'$(PACKAGE_VERSION)'"' >> GF/Today.hs
+	echo '{-# NOINLINE libdir #-}' >> GF/Today.hs
+	echo 'libdir :: String' >> GF/Today.hs
+	echo 'libdir = "'$(GF_LIB_DIR)'"' >> GF/Today.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) -o gf3 GF/Devel/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-2.9/Makefile.binary b/src-2.9/Makefile.binary
new file mode 100644
index 000000000..ab52185fd
--- /dev/null
+++ b/src-2.9/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-2.9/ReleaseProcedure b/src-2.9/ReleaseProcedure
new file mode 100644
index 000000000..c04f2a065
--- /dev/null
+++ b/src-2.9/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-2.9/Setup.lhs b/src-2.9/Setup.lhs
new file mode 100644
index 000000000..e2c31e7ca
--- /dev/null
+++ b/src-2.9/Setup.lhs
@@ -0,0 +1,8 @@
+#!/usr/bin/env runghc
+
+> module Main where
+
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
diff --git a/src-2.9/Transfer/CompilerAPI.hs b/src-2.9/Transfer/CompilerAPI.hs
new file mode 100644
index 000000000..38cb58dd0
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Abs.hs b/src-2.9/Transfer/Core/Abs.hs
new file mode 100644
index 000000000..8306d5b46
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Core.cf b/src-2.9/Transfer/Core/Core.cf
new file mode 100644
index 000000000..cd4c20569
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Doc.tex b/src-2.9/Transfer/Core/Doc.tex
new file mode 100644
index 000000000..4ba6f93ed
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Lex.hs b/src-2.9/Transfer/Core/Lex.hs
new file mode 100644
index 000000000..be1198508
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Lex.x b/src-2.9/Transfer/Core/Lex.x
new file mode 100644
index 000000000..480f366ae
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Par.hs b/src-2.9/Transfer/Core/Par.hs
new file mode 100644
index 000000000..fec63662a
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Par.y b/src-2.9/Transfer/Core/Par.y
new file mode 100644
index 000000000..ceeaa313f
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Print.hs b/src-2.9/Transfer/Core/Print.hs
new file mode 100644
index 000000000..50929716a
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Skel.hs b/src-2.9/Transfer/Core/Skel.hs
new file mode 100644
index 000000000..005ae92b1
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Core/Test.hs b/src-2.9/Transfer/Core/Test.hs
new file mode 100644
index 000000000..570beed51
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/ErrM.hs b/src-2.9/Transfer/ErrM.hs
new file mode 100644
index 000000000..1f3c566fd
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Interpreter.hs b/src-2.9/Transfer/Interpreter.hs
new file mode 100644
index 000000000..926b7bd3a
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/InterpreterAPI.hs b/src-2.9/Transfer/InterpreterAPI.hs
new file mode 100644
index 000000000..2fe04e8f3
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/PathUtil.hs b/src-2.9/Transfer/PathUtil.hs
new file mode 100644
index 000000000..b344563c6
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Abs.hs b/src-2.9/Transfer/Syntax/Abs.hs
new file mode 100644
index 000000000..0ccf9ab12
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Doc.tex b/src-2.9/Transfer/Syntax/Doc.tex
new file mode 100644
index 000000000..603940459
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Layout.hs b/src-2.9/Transfer/Syntax/Layout.hs
new file mode 100644
index 000000000..de5c99870
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Lex.hs b/src-2.9/Transfer/Syntax/Lex.hs
new file mode 100644
index 000000000..83c9e1a12
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Lex.x b/src-2.9/Transfer/Syntax/Lex.x
new file mode 100644
index 000000000..107b67345
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Par.hs b/src-2.9/Transfer/Syntax/Par.hs
new file mode 100644
index 000000000..bd83f0a87
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Par.y b/src-2.9/Transfer/Syntax/Par.y
new file mode 100644
index 000000000..13c7800a8
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Print.hs b/src-2.9/Transfer/Syntax/Print.hs
new file mode 100644
index 000000000..50164477d
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/ResolveLayout.hs b/src-2.9/Transfer/Syntax/ResolveLayout.hs
new file mode 100644
index 000000000..9d7ab607a
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Skel.hs b/src-2.9/Transfer/Syntax/Skel.hs
new file mode 100644
index 000000000..b2376478b
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Syntax.cf b/src-2.9/Transfer/Syntax/Syntax.cf
new file mode 100644
index 000000000..7429e34f9
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/Syntax/Test.hs b/src-2.9/Transfer/Syntax/Test.hs
new file mode 100644
index 000000000..3f5fab7ad
--- /dev/null
+++ b/src-2.9/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-2.9/Transfer/SyntaxToCore.hs b/src-2.9/Transfer/SyntaxToCore.hs
new file mode 100644
index 000000000..32796eb50
--- /dev/null
+++ b/src-2.9/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-2.9/config.guess b/src-2.9/config.guess
new file mode 100644
index 000000000..c085f4f51
--- /dev/null
+++ b/src-2.9/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-2.9/config.mk.in b/src-2.9/config.mk.in
new file mode 100644
index 000000000..e8a8ab567
--- /dev/null
+++ b/src-2.9/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-2.9/config.sub b/src-2.9/config.sub
new file mode 100644
index 000000000..4d936e239
--- /dev/null
+++ b/src-2.9/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-2.9/configure.ac b/src-2.9/configure.ac
new file mode 100644
index 000000000..de153c796
--- /dev/null
+++ b/src-2.9/configure.ac
@@ -0,0 +1,229 @@
+dnl Run autoconf to generate configure from this file
+
+AC_INIT([GF],[2.9],[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-2.9/exper/Evaluate.hs b/src-2.9/exper/Evaluate.hs
new file mode 100644
index 000000000..7c5fb4b6a
--- /dev/null
+++ b/src-2.9/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-2.9/exper/Optimize.hs b/src-2.9/exper/Optimize.hs
new file mode 100644
index 000000000..ff4614700
--- /dev/null
+++ b/src-2.9/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 ([(strVar, typeStr)], typ) de
+      (Yes typ, Nope)   -> 
+        liftM yes $ mkLinDefault gr typ >>= partEval noOptions gr ([(strVar, 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 strVar . 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 strVar
+     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-2.9/gf.spec b/src-2.9/gf.spec
new file mode 100644
index 000000000..b46b9be62
--- /dev/null
+++ b/src-2.9/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-2.9/gf.wxs.in b/src-2.9/gf.wxs.in
new file mode 100644
index 000000000..e2b21f12b
--- /dev/null
+++ b/src-2.9/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-2.9/gf_atk.cfg b/src-2.9/gf_atk.cfg
new file mode 100644
index 000000000..37bb2c4f5
--- /dev/null
+++ b/src-2.9/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-2.9/gfc.in b/src-2.9/gfc.in
new file mode 100644
index 000000000..05addb2cb
--- /dev/null
+++ b/src-2.9/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-2.9/gfeditor.in b/src-2.9/gfeditor.in
new file mode 100644
index 000000000..129cd5e1f
--- /dev/null
+++ b/src-2.9/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-2.9/haddock/haddock-check.perl b/src-2.9/haddock/haddock-check.perl
new file mode 100644
index 000000000..93647bac7
--- /dev/null
+++ b/src-2.9/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-2.9/haddock/haddock-script.csh b/src-2.9/haddock/haddock-script.csh
new file mode 100644
index 000000000..77b3761f8
--- /dev/null
+++ b/src-2.9/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-2.9/haddock/resources/blank.html b/src-2.9/haddock/resources/blank.html
new file mode 100644
index 000000000..63ab0b172
--- /dev/null
+++ b/src-2.9/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-2.9/haddock/resources/index.html b/src-2.9/haddock/resources/index.html
new file mode 100644
index 000000000..5d8822dc5
--- /dev/null
+++ b/src-2.9/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-2.9/install-sh b/src-2.9/install-sh
new file mode 100644
index 000000000..e9de23842
--- /dev/null
+++ b/src-2.9/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-2.9/jgf.bat b/src-2.9/jgf.bat
new file mode 100644
index 000000000..d56a638d5
--- /dev/null
+++ b/src-2.9/jgf.bat
@@ -0,0 +1 @@
+java -jar "%GF_HOME%\gf-java.jar" "%GF_HOME%\gf.exe" %*
diff --git a/src-2.9/jgf.in b/src-2.9/jgf.in
new file mode 100644
index 000000000..3df121a64
--- /dev/null
+++ b/src-2.9/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-2.9/module-structure.txt b/src-2.9/module-structure.txt
new file mode 100644
index 000000000..d3b596d9f
--- /dev/null
+++ b/src-2.9/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-2.9/tools/AlphaConvGF.hs b/src-2.9/tools/AlphaConvGF.hs
new file mode 100644
index 000000000..0e87bdb7a
--- /dev/null
+++ b/src-2.9/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-2.9/tools/GFDoc.hs b/src-2.9/tools/GFDoc.hs
new file mode 100644
index 000000000..91410864a
--- /dev/null
+++ b/src-2.9/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 -> "&lt;" ++ 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-2.9/tools/Htmls.hs b/src-2.9/tools/Htmls.hs
new file mode 100644
index 000000000..ce0b3bb28
--- /dev/null
+++ b/src-2.9/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-2.9/tools/MkHelpFile.hs b/src-2.9/tools/MkHelpFile.hs
new file mode 100644
index 000000000..a0fafa918
--- /dev/null
+++ b/src-2.9/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-2.9/tools/WriteF.hs b/src-2.9/tools/WriteF.hs
new file mode 100644
index 000000000..2e5b299dc
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c++/README b/src-2.9/tools/c++/README
new file mode 100644
index 000000000..696e39469
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c++/exgf.gft b/src-2.9/tools/c++/exgf.gft
new file mode 100644
index 000000000..644fecdb9
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c++/gfex.cpp b/src-2.9/tools/c++/gfex.cpp
new file mode 100644
index 000000000..65d65fffb
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c++/peace.gft b/src-2.9/tools/c++/peace.gft
new file mode 100644
index 000000000..1e9adf1e5
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/GFCC/Abs.hs b/src-2.9/tools/c/GFCC/Abs.hs
new file mode 100644
index 000000000..f42447ebb
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/GFCC/ComposOp.hs b/src-2.9/tools/c/GFCC/ComposOp.hs
new file mode 100644
index 000000000..401c1d778
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/GFCC/ErrM.hs b/src-2.9/tools/c/GFCC/ErrM.hs
new file mode 100644
index 000000000..820473ccd
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/GFCC/Lex.hs b/src-2.9/tools/c/GFCC/Lex.hs
new file mode 100644
index 000000000..f12c824cd
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/GFCC/Lex.x b/src-2.9/tools/c/GFCC/Lex.x
new file mode 100644
index 000000000..f5fda82b6
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/GFCC/Par.hs b/src-2.9/tools/c/GFCC/Par.hs
new file mode 100644
index 000000000..1f5479e64
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/GFCC/Par.y b/src-2.9/tools/c/GFCC/Par.y
new file mode 100644
index 000000000..fa30981cb
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/GFCC/Print.hs b/src-2.9/tools/c/GFCC/Print.hs
new file mode 100644
index 000000000..3697d8b0f
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/GFCC/Test.hs b/src-2.9/tools/c/GFCC/Test.hs
new file mode 100644
index 000000000..e3c3bcc40
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/Makefile b/src-2.9/tools/c/Makefile
new file mode 100644
index 000000000..189b224e2
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/examples/bronzeage/Makefile b/src-2.9/tools/c/examples/bronzeage/Makefile
new file mode 100644
index 000000000..67367920a
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/examples/bronzeage/bronzeage-test.c b/src-2.9/tools/c/examples/bronzeage/bronzeage-test.c
new file mode 100644
index 000000000..c0bee93a2
--- /dev/null
+++ b/src-2.9/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-2.9/tools/c/gfcc2c.hs b/src-2.9/tools/c/gfcc2c.hs
new file mode 100644
index 000000000..75eb10fb8
--- /dev/null
+++ b/src-2.9/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-2.9/tools/mkHelpFile.perl b/src-2.9/tools/mkHelpFile.perl
new file mode 100644
index 000000000..91f434705
--- /dev/null
+++ b/src-2.9/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";
+
+