making apply_transfer work

4 files changed, 27 insertions, 8 deletions

diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 09209fa2d..bbae69efe 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -357,21 +357,18 @@ stateGrammarOfLang :: ShellState -> Language -> StateGrammar
 stateGrammarOfLang st0 l = StGr {
   absId    = err (const (identC "Abs")) id  $ M.abstractOfConcrete allCan l, ---
   cncId    = l,
-  grammar  = can,
+  grammar  = allCan,
   cf       = maybe emptyCF id (lookup l (cfs st)),
   mcfg     = maybe [] id $ lookup l $ mcfgs st,
   cfg      = maybe [] id $ lookup l $ cfgs st,
   pInfo    = maybe (Prs.buildPInfo [] []) 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 can
+  loptions = errVal noOptions $ lookupOptionsCan allCan
   }
  where
-   st = purgeShellState $ st0 {concrete = Just l}
+   st = purgeShellState $ errVal st0 $ changeMain (Just l) st0
    allCan = canModules st
-   can = allCan
-----   can = M.partOfGrammar allCan 
-----           (l, maybe M.emptyModInfo id (lookup l (M.modules allCan)))
 
 grammarOfLang :: ShellState -> Language -> CanonGrammar
 cfOfLang      :: ShellState -> Language -> CF
@@ -413,6 +410,7 @@ stateAbstractGrammar st = StGr {
 
 globalOptions                   :: ShellState -> Options
 allLanguages                    :: ShellState -> [Language]
+allTransfers                    :: ShellState -> [Ident]
 allCategories                   :: ShellState -> [G.Cat]
 allStateGrammars                :: ShellState -> [StateGrammar]
 allStateGrammarsWithNames       :: ShellState -> [(Language, StateGrammar)]
@@ -421,7 +419,9 @@ allActiveStateGrammarsWithNames :: ShellState -> [(Language, StateGrammar)]
 allActiveGrammars               :: ShellState -> [StateGrammar]
 
 globalOptions = gloptions
-allLanguages  = map (fst . fst) . concretes
+--allLanguages  = map (fst . fst) . concretes
+allLanguages  = M.allConcreteModules . canModules
+allTransfers  = map fst . transfers
 allCategories = map fst . allCatsOf . canModules
 
 allStateGrammars = map snd . allStateGrammarsWithNames
diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs
index f8c56d3e6..723cf7f3d 100644
--- a/src/GF/Infra/Modules.hs
+++ b/src/GF/Infra/Modules.hs
@@ -35,7 +35,8 @@ module GF.Infra.Modules (
 		lookupModule, lookupModuleType, lookupModMod, lookupInfo,
 		allModMod, isModAbs, isModRes, isModCnc, isModTrans,
 		sameMType, isCompilableModule, isCompleteModule,
-		allAbstracts, greatestAbstract, allResources, greatestResource, allConcretes
+		allAbstracts, greatestAbstract, allResources,
+		greatestResource, allConcretes, allConcreteModules
 	       ) where
 
 import GF.Infra.Ident
@@ -391,3 +392,8 @@ greatestResource gr = case allResources gr of
 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/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs
index 3162bd88a..82d3a9713 100644
--- a/src/GF/Shell/HelpFile.hs
+++ b/src/GF/Shell/HelpFile.hs
@@ -51,6 +51,7 @@ txtHelpFile =
   "\n        .gfe   example-based grammar files (only with the -ex option)" ++
   "\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 " ++
@@ -219,6 +220,15 @@ txtHelpFile =
   "\n      p -cat=S -mcfg \"jag är 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" ++
   "\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." ++
@@ -588,6 +598,7 @@ txtHelpFile =
   "\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=gfcm        M  gfcm file (default for pm)" ++
   "\n    -printer=header      M  gfcm file with header (for GF embedded in Java)" ++
   "\n    -printer=graph       M  module dependency graph in 'dot' (graphviz) format" ++
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index b9ab2c01b..bf7d4f1ff 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -124,6 +124,7 @@ 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
@@ -181,6 +182,7 @@ optionsOfCommand co = case co of
   CGenerateTrees -> both "metas" "atoms depth alts cat lang number"
   CPutTerm -> flags "transform number"
   CWrapTerm _ -> opts "c"
+  CApplyTransfer _ -> flags "lang transfer"
   CMorphoAnalyse -> both "short" "lang"
   CTestTokenizer -> flags "lexer"
   CComputeConcrete _ -> flags "res"