From 87e64a804cbe5848d20f0555dedae42e1516cbbc Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Thu, 13 Aug 2015 10:49:50 +0000
Subject: [PATCH] GF Shell: refactoring for improved modularity and
 reusability:

+ Generalize the CommandInfo type by parameterizing it on the monad
  instead of just the environment.
+ Generalize the commands defined in
  GF.Command.{Commands,Commands2,CommonCommands,SourceCommands,HelpCommand}
  to work in any monad that supports the needed operations.
+ Liberate GF.Command.Interpreter from the IO monad.
  Also, move the current PGF from CommandEnv to GFEnv in
  GF.Interactive, making the command interpreter even more generic.
+ Use a state monad to maintain the state of the interpreter in
  GF.{Interactive,Interactive2}.
---
 src/compiler/GF/Command/CommandInfo.hs    |  17 +-
 src/compiler/GF/Command/Commands.hs       |  75 +++----
 src/compiler/GF/Command/Commands2.hs      | 155 ++------------
 src/compiler/GF/Command/CommonCommands.hs |  16 +-
 src/compiler/GF/Command/Help.hs           |   6 +-
 src/compiler/GF/Command/Interpreter.hs    | 100 ++++-----
 src/compiler/GF/Command/SourceCommands.hs |  22 +-
 src/compiler/GF/Data/Operations.hs        |   5 +-
 src/compiler/GF/Data/Utilities.hs         |   6 +-
 src/compiler/GF/Infra/SIO.hs              |  19 +-
 src/compiler/GF/Infra/UseIO.hs            |  10 +-
 src/compiler/GF/Interactive.hs            | 247 ++++++++++++----------
 src/compiler/GF/Interactive2.hs           | 244 ++++++++++++---------
 13 files changed, 441 insertions(+), 481 deletions(-)

diff --git a/src/compiler/GF/Command/CommandInfo.hs b/src/compiler/GF/Command/CommandInfo.hs
index f73aa35e1..1763e57c0 100644
--- a/src/compiler/GF/Command/CommandInfo.hs
+++ b/src/compiler/GF/Command/CommandInfo.hs
@@ -1,12 +1,10 @@
 module GF.Command.CommandInfo where
 import GF.Command.Abstract(Option,Expr)
-import GF.Infra.SIO(SIO)
 import qualified PGF as H(showExpr)
 import qualified PGF.Internal as H(Literal(LStr),Expr(ELit)) ----
-import GF.Text.Pretty(Doc)
 
-data CommandInfo env = CommandInfo {
-  exec     :: env -> [Option] -> [Expr] -> SIO CommandOutput,
+data CommandInfo m = CommandInfo {
+  exec     :: [Option] -> [Expr] -> m CommandOutput,
   synopsis :: String,
   syntax   :: String,
   explanation :: String,
@@ -17,11 +15,11 @@ data CommandInfo env = CommandInfo {
   needsTypeCheck :: Bool
   }
 
-mapCommandEnv f c = c { exec = exec c . f }
+mapCommandExec f c = c { exec = \ opts ts -> f (exec c opts ts) }
 
-emptyCommandInfo :: CommandInfo env
+--emptyCommandInfo :: CommandInfo env
 emptyCommandInfo = CommandInfo {
-  exec = \_ _ ts -> return $ pipeExprs ts, ----
+  exec = error "command not implemented",
   synopsis = "",
   syntax = "",
   explanation = "",
@@ -33,10 +31,7 @@ emptyCommandInfo = CommandInfo {
   }
 --------------------------------------------------------------------------------
 
-class TypeCheckArg env where typeCheckArg :: env -> Expr -> Either Doc Expr
-
-instance TypeCheckArg env => TypeCheckArg (x,env) where
-  typeCheckArg (x,env) = typeCheckArg env
+class Monad m => TypeCheckArg m where typeCheckArg :: Expr -> m Expr
 
 --------------------------------------------------------------------------------
 
diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index c69dc64ed..09840e0b1 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -1,5 +1,6 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
 module GF.Command.Commands (
-  PGFEnv,pgf,mos,pgfEnv,pgfCommands,
+  PGFEnv,HasPGFEnv(..),pgf,mos,pgfEnv,pgfCommands,
   options,flags,
   ) where
 import Prelude hiding (putStrLn)
@@ -8,11 +9,7 @@ import PGF
 
 import PGF.Internal(lookStartCat,functionsToCat,lookValCat,restrictPGF,hasLin)
 import PGF.Internal(abstract,funs,cats,Expr(EFun)) ----
---import PGF.Morphology(isInMorpho,morphoKnown)
 import PGF.Internal(ppFun,ppCat)
---import PGF.Probabilistic(rankTreesByProbs,probTree,setProbabilities)
---import PGF.Generate (generateRandomFrom) ----
---import PGF.Tree (Tree(Fun), expr2tree, tree2expr)
 import PGF.Internal(optimizePGF)
 
 import GF.Compile.Export
@@ -21,14 +18,10 @@ import GF.Compile.ExampleBased
 import GF.Infra.Option (noOptions, readOutputFormat, outputFormatsExpl)
 import GF.Infra.UseIO(writeUTF8File)
 import GF.Infra.SIO
---import GF.Data.ErrM ----
 import GF.Command.Abstract
---import GF.Command.Messages
 import GF.Command.CommandInfo
 import GF.Command.CommonCommands
---import GF.Text.Lexing
 import GF.Text.Clitics
---import GF.Text.Transliterations
 import GF.Quiz
 
 import GF.Command.TreeOperations ---- temporary place for typecheck and compute
@@ -39,12 +32,9 @@ import PGF.Internal (encodeFile)
 import Data.List(intersperse,nub)
 import Data.Maybe
 import qualified Data.Map as Map
---import System.Cmd(system) -- use GF.Infra.UseIO.restricedSystem instead!
---import GF.System.Process
 import GF.Text.Pretty
 import Data.List (sort)
 --import Debug.Trace
---import System.Random (newStdGen) ----
 
 
 data PGFEnv = Env {pgf::PGF,mos::Map.Map Language Morpho}
@@ -52,10 +42,13 @@ data PGFEnv = Env {pgf::PGF,mos::Map.Map Language Morpho}
 pgfEnv pgf = Env pgf mos
   where mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf]
 
-instance TypeCheckArg PGFEnv where
-  typeCheckArg (Env pgf _) = either (Left . ppTcError) (Right . fst) . inferExpr pgf
+class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
 
-pgfCommands :: Map.Map String (CommandInfo PGFEnv)
+instance HasPGFEnv m => TypeCheckArg m where
+  typeCheckArg e = (either (fail . render . ppTcError) (return . fst)
+                    . flip inferExpr e . pgf) =<< getPGFEnv
+
+pgfCommands :: HasPGFEnv m => Map.Map String (CommandInfo m)
 pgfCommands = Map.fromList [
   ("aw", emptyCommandInfo {
      longname = "align_words",
@@ -68,7 +61,7 @@ pgfCommands = Map.fromList [
        "by the flag. The target format is postscript, unless overridden by the",
        "flag -format."
        ],
-     exec = \ (Env pgf mos) opts es -> do
+     exec = getEnv $ \ opts es (Env pgf mos) -> do
          let langs = optLangs pgf opts
          if isOpt "giza" opts
            then do
@@ -115,16 +108,16 @@ pgfCommands = Map.fromList [
        "by the flag '-clitics'. The list of stems is given as the list of words",
        "of the language given by the '-lang' flag."
        ],
-     exec  = \env opts -> case opts of
+     exec  = getEnv $ \opts ts env -> case opts of
                _ | isOpt "raw" opts ->
                     return . fromString .
                     unlines . map (unwords . map (concat . intersperse "+")) .
                     map (getClitics (isInMorpho (optMorpho env opts)) (optClitics opts)) .
-                    concatMap words . toStrings
+                    concatMap words $ toStrings ts
                _ ->
                     return . fromStrings .
                     getCliticsText (isInMorpho (optMorpho env opts)) (optClitics opts) .
-                    concatMap words . toStrings,
+                    concatMap words $ toStrings ts,
      flags = [
        ("clitics","the list of possible clitics (comma-separated, no spaces)"),
        ("lang",   "the language of analysis")
@@ -159,7 +152,7 @@ pgfCommands = Map.fromList [
        ("lang","the language in which to parse"),
        ("probs","file with probabilities to rank the parses")
        ],
-     exec = \ env@(Env pgf mos) opts _ -> do
+     exec = getEnv $ \ opts _ env@(Env pgf mos) -> do
        let file = optFile opts
        pgf <- optProbs opts pgf
        let printer = if (isOpt "api" opts) then exprToAPI else (showExpr [])
@@ -193,7 +186,7 @@ pgfCommands = Map.fromList [
        ("depth","the maximum generation depth"),
        ("probs", "file with biased probabilities (format 'f 0.4' one by line)")
        ],
-     exec = \ (Env pgf mos) opts xs -> do
+     exec = getEnv $ \ opts xs (Env pgf mos) -> do
        pgf <- optProbs opts (optRestricted opts pgf)
        gen <- newStdGen
        let dp = valIntOpts "depth" 4 opts
@@ -223,7 +216,7 @@ pgfCommands = Map.fromList [
        mkEx "gt -cat=NP -depth=2    -- trees in the category NP to depth 2",
        mkEx "gt (AdjCN ? (UseN ?))  -- trees of form (AdjCN ? (UseN ?))"
        ],
-     exec = \ (Env pgf mos) opts xs -> do
+     exec = getEnv $ \ opts xs (Env pgf mos) -> do
        let pgfr = optRestricted opts pgf
        let dp = valIntOpts "depth" 4 opts
        let ts = case mexp xs of
@@ -277,7 +270,7 @@ pgfCommands = Map.fromList [
        mkEx "gr -lang=LangHin -cat=Cl | l -table -to_devanagari -- hindi table",
        mkEx "l -unlexer=\"LangAra=to_arabic LangHin=to_devanagari\" -- different unlexers"
        ],
-     exec = \ (Env pgf mos) opts -> return . fromStrings . optLins pgf opts,
+     exec = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings $ optLins pgf opts ts,
      options = [
        ("all",    "show all forms and variants, one by line (cf. l -list)"),
        ("bracket","show tree structure with brackets and paths to nodes"),
@@ -302,7 +295,7 @@ pgfCommands = Map.fromList [
      examples = [
        mkEx "l -lang=LangSwe,LangNor -chunks ? a b (? c d)"
        ],
-     exec = \ (Env pgf mos) opts -> return . fromStrings . optLins pgf (opts ++ [OOpt "chunks"]),
+     exec = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings $ optLins pgf (opts ++ [OOpt "chunks"]) ts,
      options = [
        ("treebank","show the tree and tag linearizations with language names")
        ] ++ stringOpOptions,
@@ -318,18 +311,18 @@ pgfCommands = Map.fromList [
        "Prints all the analyses of space-separated words in the input string,",
        "using the morphological analyser of the actual grammar (see command pg)"
        ],
-     exec  = \env opts -> case opts of
+     exec  = getEnv $ \opts ts env -> case opts of
                _ | isOpt "missing" opts ->
                     return . fromString . unwords .
                     morphoMissing (optMorpho env opts) .
-                    concatMap words . toStrings
+                    concatMap words $ toStrings ts
                _ | isOpt "known" opts ->
                     return . fromString . unwords .
                     morphoKnown (optMorpho env opts) .
-                    concatMap words . toStrings
+                    concatMap words $ toStrings ts
                _ -> return . fromString . unlines .
                     map prMorphoAnalysis . concatMap (morphos env opts) .
-                    concatMap words . toStrings ,
+                    concatMap words $ toStrings ts,
      flags = [
        ("lang","the languages of analysis (comma-separated, no spaces)")
        ],
@@ -343,7 +336,7 @@ pgfCommands = Map.fromList [
      longname = "morpho_quiz",
      synopsis = "start a morphology quiz",
      syntax   = "mq (-cat=CAT)? (-probs=FILE)? TREE?",
-     exec = \ (Env pgf mos) opts xs -> do
+     exec = getEnv $ \ opts xs (Env pgf mos) -> do
          let lang = optLang pgf opts
          let typ  = optType pgf opts
          pgf <- optProbs opts pgf
@@ -371,7 +364,7 @@ pgfCommands = Map.fromList [
        "the parser. For example if -openclass=\"A,N,V\" is given, the parser",
        "will accept unknown adjectives, nouns and verbs with the resource grammar."
        ],
-     exec = \ (Env pgf mos) opts ts ->
+     exec = getEnv $ \ opts ts (Env pgf mos) ->
               return . Piped $ fromParse opts (concat [map ((,) s) (par pgf opts s) | s <- toStrings ts]),
      flags = [
        ("cat","target category of parsing"),
@@ -402,7 +395,7 @@ pgfCommands = Map.fromList [
         " " ++ opt ++ "\t\t" ++ expl |
            ((opt,_),expl) <- outputFormatsExpl, take 1 expl /= "*"
        ]),
-     exec  = \env opts _ -> prGrammar env opts,
+     exec  = getEnv $ \opts _ env -> prGrammar env opts,
      flags = [
        --"cat",
        ("file",   "set the file name when printing with -pgf option"),
@@ -438,8 +431,8 @@ pgfCommands = Map.fromList [
        mkEx "pt -compute (plus one two)                               -- compute value",
        mkEx "p \"4 dogs love 5 cats\" | pt -transfer=digits2numeral | l -- four...five..."
        ],
-     exec = \ (Env pgf mos) opts ->
-            returnFromExprs . takeOptNum opts . treeOps pgf opts,
+     exec = getEnv $ \ opts ts (Env pgf mos) ->
+            returnFromExprs . takeOptNum opts $ treeOps pgf opts ts,
      options = treeOpOptions undefined{-pgf-},
      flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-}
      }),
@@ -457,7 +450,7 @@ pgfCommands = Map.fromList [
        ("lines","return the list of lines, instead of the singleton of all contents"),
        ("tree","convert strings into trees")
        ],
-     exec = \ (Env pgf mos) opts _ -> do
+     exec = getEnv $ \ opts _ (Env pgf mos) -> do
        let file = valStrOpts "file" "_gftmp" opts
        let exprs []         = ([],empty)
            exprs ((n,s):ls) | null s
@@ -492,7 +485,7 @@ pgfCommands = Map.fromList [
        "by the file given by flag -probs=FILE, where each line has the form",
        "'function probability', e.g. 'youPol_Pron  0.01'."
        ],
-     exec = \ (Env pgf mos) opts ts -> do
+     exec = getEnv $ \ opts ts (Env pgf mos) -> do
          pgf <- optProbs opts pgf
          let tds = rankTreesByProbs pgf ts
          if isOpt "v" opts
@@ -514,7 +507,7 @@ pgfCommands = Map.fromList [
      longname = "translation_quiz",
      syntax   = "tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?",
      synopsis = "start a translation quiz",
-     exec = \ (Env pgf mos) opts xs -> do
+     exec = getEnv $ \ opts xs (Env pgf mos) -> do
          let from = optLangFlag "from" pgf opts
          let to   = optLangFlag "to" pgf opts
          let typ  = optType pgf opts
@@ -551,7 +544,7 @@ pgfCommands = Map.fromList [
        "by the flag. The target format is png, unless overridden by the",
        "flag -format."
        ],
-     exec = \ (Env pgf mos) opts es -> do
+     exec = getEnv $ \ opts es (Env pgf mos) -> do
          let debug = isOpt "v" opts
          let file = valStrOpts "file" "" opts
          let outp = valStrOpts "output" "dot" opts
@@ -599,7 +592,7 @@ pgfCommands = Map.fromList [
        "by the flag. The target format is png, unless overridden by the",
        "flag -format."
        ],
-     exec = \ (Env pgf mos) opts es -> do
+     exec = getEnv $ \ opts es (Env pgf mos) -> do
          let lang = optLang pgf opts
          let gvOptions = GraphvizOptions {noLeaves = isOpt "noleaves" opts && not (isOpt "showleaves" opts),
                                           noFun = isOpt "nofun" opts || not (isOpt "showfun" opts),
@@ -660,7 +653,7 @@ pgfCommands = Map.fromList [
        "flag -format.",
        "With option -mk, use for showing library style function names of form 'mkC'."
        ],
-     exec = \ (Env pgf mos) opts es ->
+     exec = getEnv $ \ opts es (Env pgf mos) ->
        if isOpt "mk" opts
        then return $ fromString $ unlines $ map (tree2mk pgf) es
        else if isOpt "api" opts
@@ -708,7 +701,7 @@ pgfCommands = Map.fromList [
        "If a whole expression is given it prints the expression with refined",
        "metavariables and the type of the expression."
        ],
-     exec = \ (Env pgf mos) opts arg -> do
+     exec = getEnv $ \ opts arg (Env pgf mos) -> do
        case arg of
          [EFun id] -> case Map.lookup id (funs (abstract pgf)) of
                         Just fd -> do putStrLn $ render (ppFun id fd)
@@ -740,6 +733,8 @@ pgfCommands = Map.fromList [
      })
   ]
  where
+   getEnv exec opts ts = liftSIO . exec opts ts =<< getPGFEnv
+
    par pgf opts s = case optOpenTypes opts of
                   []        -> [parse_ pgf lang (optType pgf opts) (Just dp) s | lang <- optLangs pgf opts]
                   open_typs -> [parseWithRecovery pgf lang (optType pgf opts) open_typs (Just dp) s | lang <- optLangs pgf opts]
diff --git a/src/compiler/GF/Command/Commands2.hs b/src/compiler/GF/Command/Commands2.hs
index 3bdbb0501..67eb21fc3 100644
--- a/src/compiler/GF/Command/Commands2.hs
+++ b/src/compiler/GF/Command/Commands2.hs
@@ -1,5 +1,6 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
 module GF.Command.Commands2 (
-  PGFEnv,pgf,concs,pgfEnv,emptyPGFEnv,allCommands,
+  PGFEnv,HasPGFEnv(..),pgf,concs,pgfEnv,emptyPGFEnv,pgfCommands,
   options, flags,
   ) where
 import Prelude hiding (putStrLn)
@@ -19,13 +20,11 @@ import qualified PGF as H
 --import GF.Compile.ExampleBased
 --import GF.Infra.Option (noOptions, readOutputFormat, outputFormatsExpl)
 --import GF.Infra.UseIO(writeUTF8File)
---import GF.Infra.SIO
+import GF.Infra.SIO(MonadSIO,liftSIO)
 --import GF.Data.ErrM ----
 import GF.Command.Abstract
 --import GF.Command.Messages
 import GF.Command.CommandInfo
-import GF.Command.Help
-import GF.Command.CommonCommands
 --import GF.Text.Lexing
 --import GF.Text.Clitics
 --import GF.Text.Transliterations
@@ -53,12 +52,13 @@ data PGFEnv = Env {pgf::Maybe C.PGF,concs::Map.Map C.ConcName C.Concr}
 pgfEnv pgf = Env (Just pgf) (C.languages pgf)
 emptyPGFEnv = Env Nothing Map.empty
 
-instance TypeCheckArg PGFEnv where
-  typeCheckArg env e = Right e -- no type checker available !!
+class (Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
 
+instance Monad m => TypeCheckArg m where
+  typeCheckArg = return -- no type checker available !!
 
-allCommands :: Map.Map String (CommandInfo PGFEnv)
-allCommands = extend commonCommands [
+pgfCommands :: HasPGFEnv m => Map.Map String (CommandInfo m)
+pgfCommands = Map.fromList [
 {-
   ("aw", emptyCommandInfo {
      longname = "align_words",
@@ -140,57 +140,6 @@ allCommands = extend commonCommands [
        mkEx "ca -lang=Fin -clitics=ko,ni \"nukkuuko minun vaimoni\" | p  -- to parse Finnish"
        ]
      }),
-
-  ("cc", emptyCommandInfo {
-     longname = "compute_concrete",
-     syntax = "cc (-all | -table | -unqual)? TERM",
-     synopsis = "computes concrete syntax term using a source grammar",
-     explanation = unlines [
-       "Compute TERM by concrete syntax definitions. Uses the topmost",
-       "module (the last one imported) to resolve constant names.",
-       "N.B.1 You need the flag -retain when importing the grammar, if you want",
-       "the definitions to be retained after compilation.",
-       "N.B.2 The resulting term is not a tree in the sense of abstract syntax",
-       "and hence not a valid input to a Tree-expecting command.",
-       "This command must be a line of its own, and thus cannot be a part",
-       "of a pipe."
-       ],
-     options = [
-       ("all","pick all strings (forms and variants) from records and tables"),
-       ("list","all strings, comma-separated on one line"),
-       ("one","pick the first strings, if there is any, from records and tables"),
-       ("table","show all strings labelled by parameters"),
-       ("unqual","hide qualifying module names")
-       ],
-     needsTypeCheck = False
-     }),
--}
-{-
-  ("dg",  emptyCommandInfo {
-     longname = "dependency_graph",
-     syntax = "dg (-only=MODULES)?",
-     synopsis = "print module dependency graph",
-     explanation = unlines [
-       "Prints the dependency graph of source modules.",
-       "Requires that import has been done with the -retain flag.",
-       "The graph is written in the file _gfdepgraph.dot",
-       "which can be further processed by Graphviz (the system command 'dot').",
-       "By default, all modules are shown, but the -only flag restricts them",
-       "by a comma-separated list of patterns, where 'name*' matches modules",
-       "whose name has prefix 'name', and other patterns match modules with",
-       "exactly the same name. The graphical conventions are:",
-       "  solid box = abstract, solid ellipse = concrete, dashed ellipse = other",
-       "  solid arrow empty head = of, solid arrow = **, dashed arrow = open",
-       "  dotted arrow = other dependency"
-       ],
-     flags = [
-       ("only","list of modules included (default: all), literally or by prefix*")
-       ],
-     examples = [
-       mkEx "dg -only=SyntaxEng,Food*  -- shows only SyntaxEng, and those with prefix Food"
-       ],
-     needsTypeCheck = False
-     }),
 -}
 {-
   ("eb", emptyCommandInfo {
@@ -269,7 +218,7 @@ allCommands = extend commonCommands [
      examples = [
        mkEx "ga                     -- all trees in the startcat",
        mkEx "ga -cat=NP -number=16  -- 16 trees in the category NP"],
-     exec = needPGF $ \ env@(pgf,_) opts _ ->
+     exec = needPGF $ \ opts _ env@(pgf,_) ->
             let ts = map fst (C.generateAll pgf cat)
                 cat = optCat pgf opts
             in returnFromCExprs (takeOptNum opts ts),
@@ -306,7 +255,6 @@ allCommands = extend commonCommands [
        returnFromExprs $ take (optNumInf opts) ts
      }),
 -}
-  helpCommand allCommands,
   ("i", emptyCommandInfo {
      longname = "import",
      synopsis = "import a grammar from a compiled .pgf file",
@@ -346,8 +294,8 @@ allCommands = extend commonCommands [
        ],
      examples = [
        mkEx "l -lang=LangSwe,LangNor no_Utt   -- linearize tree to LangSwe and LangNor"],
-     exec = needPGF $ \ env opts ->
-                      return . fromStrings . cLins env opts . map cExpr
+     exec = needPGF $ \ opts ts env ->
+                      return . fromStrings . cLins env opts $ map cExpr ts
      }),
 {-
   ("l", emptyCommandInfo {
@@ -470,7 +418,7 @@ allCommands = extend commonCommands [
      examples = [
          mkEx "p  \"this fish is fresh\" | l -lang=Swe  -- try parsing with all languages and translate the successful parses to Swedish"
        ],
-     exec = needPGF $ \ env opts -> return . cParse env opts . toStrings
+     exec = needPGF $ \ opts ts env -> return . cParse env opts $ toStrings ts
      })
 {-
   ("p", emptyCommandInfo {
@@ -657,76 +605,6 @@ allCommands = extend commonCommands [
        mkEx ("tq -from=Eng -to=Swe (AdjCN (PositA ?2) (UseN ?))  -- only trees of this form")
        ]
      }),
-
-  ("sd", emptyCommandInfo {
-     longname = "show_dependencies",
-     syntax = "sd QUALIFIED_CONSTANT+",
-     synopsis = "show all constants that the given constants depend on",
-     explanation = unlines [
-       "Show recursively all qualified constant names, by tracing back the types and definitions",
-       "of each constant encountered, but just listing every name once.",
-       "This command requires a source grammar to be in scope, imported with 'import -retain'.",
-       "Notice that the accuracy is better if the modules are compiled with the flag -optimize=noexpand.",
-       "This command must be a line of its own, and thus cannot be a part of a pipe."
-       ],
-     options = [
-       ("size","show the size of the source code for each constants (number of constructors)")
-       ],
-     examples = [
-       mkEx "sd ParadigmsEng.mkV ParadigmsEng.mkN  -- show all constants on which mkV and mkN depend",
-       mkEx "sd -size ParadigmsEng.mkV    -- show all constants on which mkV depends, together with size"
-       ],
-     needsTypeCheck = False
-     }),
--}
-{-
-  ("so", emptyCommandInfo {
-     longname = "show_operations",
-     syntax = "so (-grep=STRING)* TYPE?",
-     synopsis = "show all operations in scope, possibly restricted to a value type",
-     explanation = unlines [
-       "Show the names and type signatures of all operations available in the current resource.",
-       "This command requires a source grammar to be in scope, imported with 'import -retain'.",
-       "The operations include the parameter constructors that are in scope.",
-       "The optional TYPE filters according to the value type.",
-       "The grep STRINGs filter according to other substrings of the type signatures.",
-       "This command must be a line of its own, and thus cannot be a part",
-       "of a pipe."
-       ],
-     flags = [
-       ("grep","substring used for filtering (the command can have many of these)")
-       ],
-     options = [
-       ("raw","show the types in computed forms (instead of category names)")
-       ],
-     needsTypeCheck = False
-     }),
-
-  ("ss", emptyCommandInfo {
-     longname = "show_source",
-     syntax = "ss (-strip)? (-save)? MODULE*",
-     synopsis = "show the source code of modules in scope, possibly just headers",
-     explanation = unlines [
-       "Show compiled source code, i.e. as it is included in GF object files.",
-       "This command requires a source grammar to be in scope, imported with 'import -retain'.",
-       "The optional MODULE arguments cause just these modules to be shown.",
-       "The -size and -detailedsize options show code size as the number of constructor nodes.",
-       "This command must be a line of its own, and thus cannot be a part of a pipe."
-       ],
-     options = [
-       ("detailedsize", "instead of code, show the sizes of all judgements and modules"),
-       ("save", "save each MODULE in file MODULE.gfh instead of printing it on terminal"),
-       ("size", "instead of code, show the sizes of all modules"),
-       ("strip","show only type signatures of oper's and lin's, not their definitions")
-       ],
-     examples = [
-       mkEx "ss                         -- print complete current source grammar on terminal",
-       mkEx "ss -strip -save MorphoFin  -- print the headers in file MorphoFin.gfh"
-       ],
-     needsTypeCheck = False
-     }),
--}
-{-
   ("vd", emptyCommandInfo {
      longname = "visualize_dependency",
      synopsis = "show word dependency tree graphically",
@@ -1205,7 +1083,8 @@ cExpr e =
     Just (f,es) -> C.mkApp (H.showCId f) (map cExpr es)
     _ -> error "GF.Command.Commands2.cExpr"
 
-needPGF exec (Env mb_pgf cncs) opts ts =
-  case mb_pgf of
-    Just pgf -> exec (pgf,cncs) opts ts
-    _ -> fail "Import a grammar before using this command"
+needPGF exec opts ts =
+  do Env mb_pgf cncs <- getPGFEnv
+     case mb_pgf of
+       Just pgf -> liftSIO $ exec opts ts (pgf,cncs)
+       _ -> fail "Import a grammar before using this command"
diff --git a/src/compiler/GF/Command/CommonCommands.hs b/src/compiler/GF/Command/CommonCommands.hs
index e835d78d7..8774c0a8d 100644
--- a/src/compiler/GF/Command/CommonCommands.hs
+++ b/src/compiler/GF/Command/CommonCommands.hs
@@ -19,8 +19,8 @@ import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..))
 
 extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased
 
-commonCommands :: Map.Map String (CommandInfo env)
-commonCommands = Map.fromList [
+commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m)
+commonCommands = fmap (mapCommandExec liftSIO) $ Map.fromList [
   ("!", emptyCommandInfo {
      synopsis = "system command: escape to system shell",
      syntax   = "! SYSTEMCOMMAND",
@@ -104,7 +104,7 @@ commonCommands = Map.fromList [
        mkEx "rf -file=Ara.gf | ps -from_utf8 -env=quotes -from_arabic -- convert UTF8 to transliteration",
        mkEx "ps -to=chinese.trans \"abc\"      -- apply transliteration defined in file chinese.trans"
        ],
-     exec = \_ opts x -> do
+     exec = \opts x-> do
                let (os,fs) = optsAndFlags opts
                trans <- optTranslit opts
 
@@ -139,7 +139,7 @@ commonCommands = Map.fromList [
       mkEx "se utf8   -- set encoding to utf8 (default)"
       ],
      needsTypeCheck = False,
-     exec = \ _ opts ts ->
+     exec = \ opts ts ->
        case words (toString ts) of
          [c] -> do let cod = renameEncoding c
                    restricted $ changeConsoleEncoding cod
@@ -150,7 +150,7 @@ commonCommands = Map.fromList [
      longname = "system_pipe",
      synopsis = "send argument to a system command",
      syntax   = "sp -command=\"SYSTEMCOMMAND\", alt. ? SYSTEMCOMMAND",
-     exec = \_ opts arg -> do
+     exec = \opts arg -> do
        let syst = optComm opts  -- ++ " " ++ tmpi
        {-
        let tmpi = "_tmpi" ---
@@ -171,12 +171,12 @@ commonCommands = Map.fromList [
      longname = "to_trie",
      syntax = "to_trie",
      synopsis = "combine a list of trees into a trie",
-     exec = \ _ _ -> return . fromString . trie
+     exec = \ _ ts -> return . fromString $ trie ts
     }),
   ("ut", emptyCommandInfo {
      longname = "unicode_table",
      synopsis = "show a transliteration table for a unicode character set",
-     exec = \_ opts _ -> do
+     exec = \opts _ -> do
          let t = concatMap prOpt (take 1 opts)
          let out = maybe "no such transliteration" characterTable $ transliteration t
          return $ fromString out,
@@ -185,7 +185,7 @@ commonCommands = Map.fromList [
   ("wf", emptyCommandInfo {
      longname = "write_file",
      synopsis = "send string or tree to a file",
-     exec = \_ opts arg -> do
+     exec = \opts arg-> do
          let file = valStrOpts "file" "_gftmp" opts
          if isOpt "append" opts
            then restricted $ appendFile file (toString arg)
diff --git a/src/compiler/GF/Command/Help.hs b/src/compiler/GF/Command/Help.hs
index a1a4716ee..2a736088d 100644
--- a/src/compiler/GF/Command/Help.hs
+++ b/src/compiler/GF/Command/Help.hs
@@ -12,7 +12,7 @@ commandHelpAll' allCommands opts = unlines $
 
 commandHelp' opts = if isOpt "t2t" opts then commandHelpTags else commandHelp
 
-commandHelp :: Bool -> (String,CommandInfo env) -> String
+--commandHelp :: Bool -> (String,CommandInfo env) -> String
 commandHelp full (co,info) = unlines . compact $ [
   co ++ optionally (", " ++) (longname info),
   synopsis info] ++ if full then [
@@ -26,7 +26,7 @@ commandHelp full (co,info) = unlines . compact $ [
 
 -- for printing with txt2tags formatting
 
-commandHelpTags :: Bool -> (String,CommandInfo env) -> String
+--commandHelpTags :: Bool -> (String,CommandInfo env) -> String
 commandHelpTags full (co,info) = unlines . compact $ [
   "#VSPACE","",
   "===="++hdrname++"====",
@@ -75,7 +75,7 @@ helpCommand allCommands =
        ("license","show copyright and license information"),
        ("t2t","output help in txt2tags format")
        ],
-     exec = \_ opts ts ->
+     exec = \opts ts ->
        let
         msg = case ts of
           _ | isOpt "changes" opts -> changesMsg
diff --git a/src/compiler/GF/Command/Interpreter.hs b/src/compiler/GF/Command/Interpreter.hs
index 8650b4002..92310048c 100644
--- a/src/compiler/GF/Command/Interpreter.hs
+++ b/src/compiler/GF/Command/Interpreter.hs
@@ -1,67 +1,57 @@
 module GF.Command.Interpreter (
-  CommandEnv,pgfenv,commands,commandmacros,expmacros,
-  mkCommandEnv,
---emptyCommandEnv,
+  CommandEnv(..),mkCommandEnv,
   interpretCommandLine,
---interpretPipe,
   getCommandOp
   ) where
-import Prelude hiding (putStrLn)
-
 import GF.Command.CommandInfo
 import GF.Command.Abstract
 import GF.Command.Parse
---import PGF
 import PGF.Internal(Expr(..))
---import PGF.Morphology
-import GF.Infra.SIO(putStrLn,putStrLnFlush)
+import GF.Infra.UseIO(putStrLnE)
 
 import GF.Text.Pretty(render)
 import Control.Monad(when)
---import Control.Monad.Error()
 import qualified Data.Map as Map
 
-data CommandEnv env = CommandEnv {
-  pgfenv        :: env,
-  commands      :: Map.Map String (CommandInfo env),
+data CommandEnv m = CommandEnv {
+  commands      :: Map.Map String (CommandInfo m),
   commandmacros :: Map.Map String CommandLine,
   expmacros     :: Map.Map String Expr
   }
 
 --mkCommandEnv :: PGFEnv -> CommandEnv
-mkCommandEnv env cmds = CommandEnv env cmds Map.empty Map.empty
+mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty
 
 --interpretCommandLine :: CommandEnv -> String -> SIO ()
 interpretCommandLine env line =
   case readCommandLine line of
     Just []    -> return ()
     Just pipes -> mapM_ (interpretPipe env) pipes
-    Nothing    -> putStrLnFlush "command not parsed"
+    Nothing    -> putStrLnE "command not parsed"
 
 interpretPipe env cs = do
-     Piped v@(_,s) <- intercs void cs
-     putStrLnFlush s
+     Piped v@(_,s) <- intercs cs void
+     putStrLnE s
      return ()
   where
-   intercs treess [] = return treess
-   intercs (Piped (trees,_)) (c:cs) = do
-     treess2 <- interc trees c
-     intercs treess2 cs
-   interc es comm@(Command co opts arg) = case co of
-     '%':f -> case Map.lookup f (commandmacros env) of
-       Just css ->
-         case getCommandTrees env False arg es of
-           Right es -> do mapM_ (interpretPipe env) (appLine es css) 
-                          return void
-           Left msg -> do putStrLn ('\n':msg)
-                          return void
-       Nothing  -> do
-         putStrLn $ "command macro " ++ co ++ " not interpreted"
-         return void
-     _ -> interpret env es comm
-   appLine es = map (map (appCommand es))
+   intercs [] treess = return treess
+   intercs (c:cs) (Piped (trees,_)) = interc c trees >>= intercs cs
 
--- macro definition applications: replace ?i by (exps !! i)
+   interc comm@(Command co opts arg) es =
+     case co of
+       '%':f -> case Map.lookup f (commandmacros env) of
+         Just css ->
+           do es <- getCommandTrees env False arg es
+              mapM_ (interpretPipe env) (appLine es css)
+              return void
+         Nothing  -> do
+           putStrLnE $ "command macro " ++ co ++ " not interpreted"
+           return void
+       _ -> interpret env es comm
+
+   appLine = map . map . appCommand
+
+-- | macro definition applications: replace ?i by (exps !! i)
 appCommand :: [Expr] -> Command -> Command
 appCommand xs c@(Command i os arg) = case arg of
   AExpr e -> Command i os (AExpr (app e))
@@ -74,25 +64,22 @@ appCommand xs c@(Command i os arg) = case arg of
     EMeta i    -> xs !! i
     EFun x     -> EFun x
 
--- return the trees to be sent in pipe, and the output possibly printed
+-- | return the trees to be sent in pipe, and the output possibly printed
 --interpret :: CommandEnv -> [Expr] -> Command -> SIO CommandOutput
 interpret env trees comm = 
-  case getCommand env trees comm of
-    Left  msg               -> do putStrLn ('\n':msg)
-                                  return void
-    Right (info,opts,trees) -> do let cmdenv = pgfenv env
-                                  tss@(Piped (_,s)) <- exec info cmdenv opts trees
-                                  when (isOpt "tr" opts) $ putStrLn s
-                                  return tss
+  do (info,opts,trees) <- getCommand env trees comm
+     tss@(Piped (_,s)) <- exec info opts trees
+     when (isOpt "tr" opts) $ putStrLnE s
+     return tss
 
--- analyse command parse tree to a uniform datastructure, normalizing comm name
+-- | analyse command parse tree to a uniform datastructure, normalizing comm name
 --- the env is needed for macro lookup
 --getCommand :: CommandEnv -> [Expr] -> Command -> Either String (CommandInfo PGFEnv,[Option],[Expr])
-getCommand env es co@(Command c opts arg) = do
-  info <- getCommandInfo  env c
-  checkOpts info opts
-  es   <- getCommandTrees env (needsTypeCheck info) arg es
-  return (info,opts,es)
+getCommand env es co@(Command c opts arg) =
+  do info <- getCommandInfo  env c
+     checkOpts info opts
+     es <- getCommandTrees env (needsTypeCheck info) arg es
+     return (info,opts,es)
 
 --getCommandInfo :: CommandEnv -> String -> Either String (CommandInfo PGFEnv)
 getCommandInfo env cmd = 
@@ -100,7 +87,7 @@ getCommandInfo env cmd =
     Just info -> return info
     Nothing   -> fail $ "command not found: " ++ cmd
 
-checkOpts :: CommandInfo env -> [Option] -> Either String ()
+--checkOpts :: CommandInfo env -> [Option] -> Either String ()
 checkOpts info opts = 
   case
     [o | OOpt  o   <- opts, notElem o ("tr" : map fst (options info))] ++
@@ -114,12 +101,11 @@ checkOpts info opts =
 getCommandTrees env needsTypeCheck a es =
   case a of
     AMacro m -> case Map.lookup m (expmacros env) of
-                  Just e -> return [e]
-                  _      -> return [] 
+                  Just e -> one e
+                  _      -> return [] -- report error?
     AExpr e -> if needsTypeCheck
-                 then case typeCheckArg (pgfenv env) e of
-                        Left tcErr -> fail $ render tcErr
-                        Right e    -> return [e] -- ignore piped
-                 else return [e]
+               then one =<< typeCheckArg e
+               else one e
     ANoArg  -> return es  -- use piped
-
+  where
+    one e = return [e] -- ignore piped
diff --git a/src/compiler/GF/Command/SourceCommands.hs b/src/compiler/GF/Command/SourceCommands.hs
index 7c18f5033..0aedd5ddf 100644
--- a/src/compiler/GF/Command/SourceCommands.hs
+++ b/src/compiler/GF/Command/SourceCommands.hs
@@ -1,12 +1,12 @@
 -- | Commands requiring source grammar in env
-module GF.Command.SourceCommands(sourceCommands) where
+module GF.Command.SourceCommands(HasGrammar(..),sourceCommands) where
 import Prelude hiding (putStrLn)
 import qualified Prelude as P(putStrLn)
 import Data.List(nub,isInfixOf)
 import qualified Data.ByteString.UTF8 as UTF8(fromString)
 import qualified Data.Map as Map
 
-import GF.Infra.SIO
+import GF.Infra.SIO(MonadSIO(..),restricted)
 import GF.Infra.Option(noOptions)
 import GF.Data.Operations (chunks,err,raise)
 import GF.Text.Pretty(render)
@@ -25,6 +25,10 @@ import GF.Infra.CheckM(runCheck)
 import GF.Command.Abstract(Option(..),isOpt,listFlags,valueString,valStrOpts)
 import GF.Command.CommandInfo
 
+class (Monad m,MonadSIO m) => HasGrammar m where
+  getGrammar :: m Grammar
+
+sourceCommands :: HasGrammar m => Map.Map String (CommandInfo m)
 sourceCommands = Map.fromList [
   ("cc", emptyCommandInfo {
      longname = "compute_concrete",
@@ -152,9 +156,11 @@ sourceCommands = Map.fromList [
      })
   ]
   where
-    withStrings exec sgr opts = do exec sgr opts . toStrings
+    withStrings exec opts ts =
+      do sgr <- getGrammar
+         liftSIO (exec opts (toStrings ts) sgr)
 
-    compute_concrete sgr opts ws =
+    compute_concrete opts ws sgr =
       case runP pExp (UTF8.fromString s) of
         Left (_,msg) -> return $ pipeMessage msg
         Right t      -> return $ err pipeMessage
@@ -176,7 +182,7 @@ sourceCommands = Map.fromList [
             OOpt "qual"    -> pOpts style            Qualified   os
             _              -> pOpts style            q           os
 
-    show_deps sgr os xs = do
+    show_deps os xs sgr = do
           ops <- case xs of
              _:_ -> do
                let ts = [t | Right t <- map (runP pExp . UTF8.fromString) xs]
@@ -192,7 +198,7 @@ sourceCommands = Map.fromList [
                 | otherwise = unwords $ map prTerm ops
           return $ fromString printed
 
-    show_operations sgr os ts =
+    show_operations os ts sgr =
       case greatestResource sgr of
         Nothing -> return $ fromString "no source grammar in scope; did you import with -retain?"
         Just mo -> do
@@ -211,7 +217,7 @@ sourceCommands = Map.fromList [
           let printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs]
           return . fromString $ unlines [l | l <- printed, all (`isInfixOf` l) greps]
 
-    show_source sgr os ts = do
+    show_source os ts sgr = do
       let strip = if isOpt "strip" os then stripSourceGrammar else id
       let mygr = strip $ case ts of
             _:_ -> mGrammar [(i,m) | (i,m) <- modules sgr, elem (render i) ts]
@@ -236,7 +242,7 @@ sourceCommands = Map.fromList [
 
         _ -> return . fromString $ render mygr
 
-    dependency_graph sgr opts ws =
+    dependency_graph opts ws sgr =
       do let stop = case valStrOpts "only" "" opts of
                       "" -> Nothing
                       fs -> Just $ chunks ',' fs
diff --git a/src/compiler/GF/Data/Operations.hs b/src/compiler/GF/Data/Operations.hs
index 044dc06df..52632c163 100644
--- a/src/compiler/GF/Data/Operations.hs
+++ b/src/compiler/GF/Data/Operations.hs
@@ -20,7 +20,7 @@ module GF.Data.Operations (
 		   lookupErr,
 
 		   -- ** Error monad class
-		   ErrorMonad(..), checks, doUntil, --allChecks, checkAgain,
+		   ErrorMonad(..), checks, --doUntil, allChecks, checkAgain,
                    liftErr,
 		   
 		   -- ** Checking
@@ -363,10 +363,11 @@ 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"
+-}
\ No newline at end of file
diff --git a/src/compiler/GF/Data/Utilities.hs b/src/compiler/GF/Data/Utilities.hs
index 792f7aa4a..eac315508 100644
--- a/src/compiler/GF/Data/Utilities.hs
+++ b/src/compiler/GF/Data/Utilities.hs
@@ -16,7 +16,7 @@ module GF.Data.Utilities(module GF.Data.Utilities, module PGF.Utilities) where
 
 import Data.Maybe
 import Data.List
-import Control.Monad (MonadPlus(..),liftM)
+import Control.Monad (MonadPlus(..),liftM,when)
 import PGF.Utilities
 
 -- * functions on lists
@@ -136,6 +136,10 @@ mapBoth = map . apBoth
 whenMP :: MonadPlus m => Bool -> a -> m a
 whenMP b x = if b then return x else mzero
 
+whenM bm m = flip when m =<< bm
+
+repeatM m = whenM m (repeatM m)
+
 -- * functions on Maybes
 
 -- | Returns true if the argument is Nothing or Just []
diff --git a/src/compiler/GF/Infra/SIO.hs b/src/compiler/GF/Infra/SIO.hs
index e24a6cb35..3b6a4c3c1 100644
--- a/src/compiler/GF/Infra/SIO.hs
+++ b/src/compiler/GF/Infra/SIO.hs
@@ -1,9 +1,9 @@
 -- | Shell IO: a monad that can restrict acesss to arbitrary IO and has the
 -- ability to capture output that normally would be sent to stdout.
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, FlexibleInstances, FlexibleContexts #-}
 module GF.Infra.SIO(
        -- * The SIO monad
-       SIO,
+       SIO,MonadSIO(..),
        -- * Running SIO operations
        runSIO,hRunSIO,captureSIO,
        -- * Unrestricted, safe operations
@@ -25,12 +25,14 @@ module GF.Infra.SIO(
 import Prelude hiding (putStrLn,print)
 import Control.Applicative(Applicative(..))
 import Control.Monad(liftM,ap)
+import Control.Monad.Trans(MonadTrans(..))
 import System.IO(hPutStrLn,hFlush,stdout)
 import GF.System.Catch(try)
 import System.Process(system)
 import System.Environment(getEnv)
 import Control.Concurrent.Chan(newChan,writeChan,getChanContents)
 import GF.Infra.Concurrency(lazyIO)
+import GF.Infra.UseIO(Output(..))
 import qualified System.CPUTime as IO(getCPUTime)
 import qualified System.Directory as IO(getCurrentDirectory)
 import qualified System.Random as IO(newStdGen)
@@ -56,6 +58,19 @@ instance Monad SIO where
   return x = SIO (const (return x))
   SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
 
+instance Output SIO where
+  ePutStr = lift0 . ePutStr
+  ePutStrLn = lift0 . ePutStrLn
+  putStrLnE = putStrLnFlush
+--putStrE = --- !!!
+
+class MonadSIO m where liftSIO :: SIO a -> m a
+
+instance MonadSIO SIO where liftSIO = id
+
+instance (MonadTrans t,Monad m,MonadSIO m) => MonadSIO (t m) where
+  liftSIO = lift . liftSIO
+
 -- * Running SIO operations
 
 -- | Run normally
diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs
index 14120d811..ad0c75fd5 100644
--- a/src/compiler/GF/Infra/UseIO.hs
+++ b/src/compiler/GF/Infra/UseIO.hs
@@ -34,8 +34,9 @@ import System.CPUTime
 --import System.Cmd
 import Text.Printf
 --import Control.Applicative(Applicative(..))
-import Control.Monad
+import Control.Monad(when,liftM,foldM)
 import Control.Monad.Trans(MonadIO(..))
+import Control.Monad.State(StateT,lift)
 import Control.Exception(evaluate)
 
 --putIfVerb :: MonadIO io => Options -> String -> io ()
@@ -201,6 +202,13 @@ instance Output IOE where
   putStrLnE = liftIO . putStrLnE
   putStrE   = liftIO . putStrE
 -}
+
+instance Output m => Output (StateT s m) where
+  ePutStr = lift . ePutStr
+  ePutStrLn = lift . ePutStrLn
+  putStrE = lift . putStrE
+  putStrLnE = lift . putStrLnE
+
 --putPointE :: Verbosity -> Options -> String -> IO a -> IO a
 putPointE v opts msg act = do
   when (verbAtLeast opts v) $ putStrE msg
diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs
index 6e8cc6330..3d5f1695c 100644
--- a/src/compiler/GF/Interactive.hs
+++ b/src/compiler/GF/Interactive.hs
@@ -1,20 +1,21 @@
-{-# LANGUAGE ScopedTypeVariables, CPP #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, FlexibleInstances #-}
 -- | GF interactive mode
 module GF.Interactive (mainGFI,mainRunGFI,mainServerGFI) where
 import Prelude hiding (putStrLn,print)
 import qualified Prelude as P(putStrLn)
-import GF.Command.Interpreter(CommandEnv(..),pgfenv,commands,mkCommandEnv,interpretCommandLine)
+import GF.Command.Interpreter(CommandEnv(..),mkCommandEnv,interpretCommandLine)
 --import GF.Command.Importing(importSource,importGrammar)
-import GF.Command.Commands(flags,options,PGFEnv,pgf,pgfEnv,pgfCommands)
+import GF.Command.Commands(flags,options,PGFEnv,HasPGFEnv(..),pgf,pgfEnv,pgfCommands)
 import GF.Command.CommonCommands(commonCommands,extend)
-import GF.Command.SourceCommands(sourceCommands)
-import GF.Command.CommandInfo(mapCommandEnv)
+import GF.Command.SourceCommands
+--import GF.Command.CommandInfo(mapCommandEnv,liftCommandInfo)
 import GF.Command.Help(helpCommand)
 import GF.Command.Abstract
 import GF.Command.Parse(readCommandLine,pCommand)
 import GF.Data.Operations (Err(..),done)
+import GF.Data.Utilities(repeatM)
 import GF.Grammar hiding (Ident,isPrefixOf)
-import GF.Infra.UseIO(ioErrorText)
+import GF.Infra.UseIO(ioErrorText,putStrLnE)
 import GF.Infra.SIO
 import GF.Infra.Option
 import qualified System.Console.Haskeline as Haskeline
@@ -33,7 +34,7 @@ import qualified Text.ParserCombinators.ReadP as RP
 --import System.CPUTime(getCPUTime)
 import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
 import Control.Exception(SomeException,fromException,evaluate,try)
-import Control.Monad
+import Control.Monad.State
 import qualified GF.System.Signal as IO(runInterruptibly)
 #ifdef SERVER_MODE
 import GF.Server(server)
@@ -53,49 +54,58 @@ mainGFI opts files = do
   P.putStrLn welcome
   shell opts files
 
-shell opts files = loop opts =<< runSIO (importInEnv emptyGFEnv opts files)
+shell opts files = flip evalStateT emptyGFEnv $
+                   do mapStateT runSIO $ importInEnv opts files
+                      loop opts
 
 #ifdef SERVER_MODE
 -- | Run the GF Server (@gf -server@).
 -- The 'Int' argument is the port number for the HTTP service.
 mainServerGFI opts0 port files =
-    server jobs port root (execute1 opts)
-      =<< runSIO (importInEnv emptyGFEnv opts files)
+    server jobs port root execute1' . snd
+      =<< runSIO (runStateT (importInEnv opts files) emptyGFEnv)
   where
     root = flag optDocumentRoot opts
     opts = beQuiet opts0
     jobs = join (flag optJobs opts)
+
+    execute1' gfenv0 cmd =
+       do (quit,gfenv) <- runStateT (execute1 opts cmd) gfenv0
+          return $ if quit then Nothing else Just gfenv
 #else
 mainServerGFI opts files =
   error "GF has not been compiled with server mode support"
 #endif
 
 -- | Read end execute commands until it is time to quit
-loop :: Options -> GFEnv -> IO ()
-loop opts gfenv = maybe done (loop opts) =<< readAndExecute1 opts gfenv
+loop :: Options -> StateT GFEnv IO ()
+loop opts = repeatM $ readAndExecute1 opts
 
 -- | Read and execute one command, returning Just an updated environment for
 -- | the next command, or Nothing when it is time to quit
-readAndExecute1 :: Options -> GFEnv -> IO (Maybe GFEnv)
-readAndExecute1 opts gfenv =
-    runSIO . execute1 opts gfenv =<< readCommand opts gfenv
+readAndExecute1 :: Options -> StateT GFEnv IO Bool
+readAndExecute1 opts =
+    mapStateT runSIO . execute1 opts =<< readCommand opts
 
 -- | Read a command
-readCommand :: Options -> GFEnv -> IO String
-readCommand opts gfenv0 =
+readCommand :: Options -> StateT GFEnv IO String
+readCommand opts =
     case flag optMode opts of
-      ModeRun -> tryGetLine
-      _       -> fetchCommand gfenv0
+      ModeRun -> lift tryGetLine
+      _       -> lift . fetchCommand =<< get
+
+timeIt act =
+  do t1 <- liftSIO $ getCPUTime
+     a <-  act
+     t2 <- liftSIO $ getCPUTime
+     return (t2-t1,a)
 
 -- | Optionally show how much CPU time was used to run an IO action
-optionallyShowCPUTime :: Options -> SIO a -> SIO a
+optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a
 optionallyShowCPUTime opts act 
   | not (verbAtLeast opts Normal) = act
-  | otherwise = do t0 <- getCPUTime
-                   r <- act
-                   t1 <- getCPUTime
-                   let dt = t1-t0
-                   putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
+  | otherwise = do (dt,r) <- timeIt act
+                   liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
                    return r
 
 {-
@@ -107,106 +117,127 @@ loopOptNewCPU opts gfenv'
      return $ gfenv' {cputime = cpu'}
 -}
 
+type ShellM = StateT GFEnv SIO
+
 -- | Execute a given command, returning Just an updated environment for
 -- | the next command, or Nothing when it is time to quit
-execute1 :: Options -> GFEnv -> String -> SIO (Maybe GFEnv)
-execute1 opts gfenv0 s0 =
-  interruptible $ optionallyShowCPUTime opts $
-  case pwords s0 of
- -- special commands
-  {-"eh":w:_ -> do
-             cs <- readFile w >>= return . map words . lines
-             gfenv' <- foldM (flip (process False benv)) gfenv cs
-             loopNewCPU gfenv' -}
-    "q" :_   -> quit
-    "!" :ws  -> system_command ws
- -- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands
-    "eh":ws  -> eh ws
-    "i" :ws  -> import_ ws
- -- other special commands, working on GFEnv
-    "e" :_   -> empty
-    "dc":ws  -> define_command ws
-    "dt":ws  -> define_tree ws
-    "ph":_   -> print_history
-    "r" :_   -> reload_last
- -- ordinary commands, working on CommandEnv
-    _        -> do interpretCommandLine env s0
-                   continue gfenv
+execute1 :: Options -> String -> ShellM Bool
+execute1 opts s0 =
+  do modify $ \ gfenv0 -> gfenv0 {history = s0 : history gfenv0}
+     interruptible $ optionallyShowCPUTime opts $
+       case pwords s0 of
+      -- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands
+      -- special commands
+         "q" :_   -> quit
+         "!" :ws  -> system_command ws
+         "eh":ws  -> eh ws
+         "i" :ws  -> import_ ws
+      -- other special commands, working on GFEnv
+         "e" :_   -> empty
+         "dc":ws  -> define_command ws
+         "dt":ws  -> define_tree ws
+         "ph":_   -> print_history
+         "r" :_   -> reload_last
+      -- ordinary commands
+         _        -> do env <- gets commandenv
+                        interpretCommandLine env s0
+                        continue
   where
 --  loopNewCPU = fmap Just . loopOptNewCPU opts
-    continue = return . Just
-    stop = return Nothing
-    env = commandenv gfenv0
-    gfenv = gfenv0 {history = s0 : history gfenv0}
+    continue,stop :: ShellM Bool
+    continue = return True
+    stop = return False
+
     pwords s = case words s of
                  w:ws -> getCommandOp w :ws
                  ws -> ws
 
+    interruptible :: ShellM Bool -> ShellM Bool
     interruptible act =
-      either (\e -> printException e >> return (Just gfenv)) return
-        =<< runInterruptibly act 
+      do gfenv <- get
+         mapStateT (
+           either (\e -> printException e >> return (True,gfenv)) return
+             <=< runInterruptibly) act
 
   -- Special commands:
 
-    quit = do when (verbAtLeast opts Normal) $ putStrLn "See you."
+    quit = do when (verbAtLeast opts Normal) $ putStrLnE "See you."
               stop
 
-    system_command ws = do restrictedSystem $ unwords ws ; continue gfenv
+    system_command ws = do lift $ restrictedSystem $ unwords ws ; continue
 
+
+       {-"eh":w:_ -> do
+                  cs <- readFile w >>= return . map words . lines
+                  gfenv' <- foldM (flip (process False benv)) gfenv cs
+                  loopNewCPU gfenv' -}
     eh [w] = -- Ehhh? Reads commands from a file, but does not execute them
-      do cs <- restricted (readFile w) >>= return . map (interpretCommandLine env) . lines
-         continue gfenv
-    eh _   = do putStrLn "eh command not parsed"
-                continue gfenv
+      do env <- gets commandenv
+         cs <- lift $ restricted (readFile w) >>= return . map (interpretCommandLine env) . lines
+         continue
+    eh _   = do putStrLnE "eh command not parsed"
+                continue
 
     import_ args = 
-      do gfenv' <- case parseOptions args of
-                     Ok (opts',files) -> do
-                       curr_dir <- getCurrentDirectory
-                       lib_dir  <- getLibraryDirectory (addOptions opts opts')
-                       importInEnv gfenv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files
-                     Bad err -> do 
-                       putStrLn $ "Command parse error: " ++ err
-                       return gfenv
-         continue gfenv'
+      do case parseOptions args of
+           Ok (opts',files) -> do
+             curr_dir <- lift getCurrentDirectory
+             lib_dir  <- lift $ getLibraryDirectory (addOptions opts opts')
+             importInEnv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files
+             continue
+           Bad err ->
+             do putStrLnE $ "Command parse error: " ++ err
+                continue
+         continue
 
-    empty = continue $ gfenv { commandenv=emptyCommandEnv }
+    empty = do modify $ \ gfenv -> gfenv { commandenv=emptyCommandEnv }
+               continue
 
     define_command (f:ws) =
         case readCommandLine (unwords ws) of
-           Just comm -> continue $ gfenv {
-             commandenv = env {
-               commandmacros = Map.insert f comm (commandmacros env)
-               }
-             }
+           Just comm ->
+             do modify $
+                  \ gfenv ->
+                    let env = commandenv gfenv
+                    in gfenv {
+                         commandenv = env {
+                           commandmacros = Map.insert f comm (commandmacros env)
+                         }
+                       }
+                continue
            _ -> dc_not_parsed
     define_command _ = dc_not_parsed
 
-    dc_not_parsed = putStrLn "command definition not parsed" >> continue gfenv
+    dc_not_parsed = putStrLnE "command definition not parsed" >> continue
 
     define_tree (f:ws) =
         case readExpr (unwords ws) of
-          Just exp -> continue $ gfenv {
-            commandenv = env {
-              expmacros = Map.insert f exp (expmacros env)
-              }
-            }
+          Just exp ->
+           do modify $
+                \ gfenv ->
+                  let env = commandenv gfenv
+                  in gfenv { commandenv = env {
+                               expmacros = Map.insert f exp (expmacros env) } }
+              continue
           _ -> dt_not_parsed
     define_tree _ = dt_not_parsed
 
-    dt_not_parsed = putStrLn "value definition not parsed" >> continue gfenv
+    dt_not_parsed = putStrLnE "value definition not parsed" >> continue
 
-    print_history = mapM_ putStrLn (reverse (history gfenv0))>> continue gfenv
+    print_history =
+      do mapM_ putStrLnE . reverse . drop 1 . history =<< get
+         continue
 
     reload_last = do
+      gfenv0 <- get
       let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]]
       case imports of
         (s,ws):_ -> do
-          putStrLn $ "repeating latest import: " ++ s
+          putStrLnE $ "repeating latest import: " ++ s
           import_ ws
         _ -> do
-          putStrLn $ "no import in history"  
-          continue gfenv
+          putStrLnE $ "no import in history"
+          continue
 
 
 printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e)
@@ -226,20 +257,19 @@ fetchCommand gfenv = do
     Right Nothing  -> return "q"
     Right (Just s) -> return s
 
-importInEnv :: GFEnv -> Options -> [FilePath] -> SIO GFEnv
-importInEnv gfenv opts files
-    | flag optRetainResource opts =
-        do src <- importSource opts files
-           pgf <- lazySIO importPGF -- duplicates some work, better to link src
-           return $ gfenv {retain=True, commandenv = commandEnv src pgf }
-    | otherwise =
-        do pgf1 <- importPGF
-           return $ gfenv { retain=False,
-                            commandenv = commandEnv emptyGrammar pgf1 }
+importInEnv :: Options -> [FilePath] -> ShellM ()
+importInEnv opts files =
+  do pgf0 <- gets multigrammar
+     if flag optRetainResource opts
+      then do src <- lift $ importSource opts files
+              pgf <- lift . lazySIO $ importPGF pgf0 -- duplicates some work, better to link src
+              modify $ \ gfenv -> gfenv {retain=True, pgfenv = (src,pgfEnv pgf)}
+      else do pgf1 <- lift $ importPGF pgf0
+              modify $ \ gfenv->gfenv { retain=False,
+                                        pgfenv = (emptyGrammar,pgfEnv pgf1) }
   where
-    importPGF =
+    importPGF pgf0 =
       do let opts' = addOptions (setOptimization OptCSE False) opts
-             pgf0 = multigrammar (commandenv gfenv)
          pgf1 <- importGrammar pgf0 opts' files
          if (verbAtLeast opts Normal)
            then putStrLnFlush $
@@ -257,26 +287,31 @@ prompt env
   | retain env || abs == wildCId = "> "
   | otherwise      = showCId abs ++ "> "
   where
-    abs = abstractName (multigrammar (commandenv env))
+    abs = abstractName (multigrammar env)
+
+type CmdEnv = (Grammar,PGFEnv)
 
 data GFEnv = GFEnv {
     retain :: Bool,  -- grammar was imported with -retain flag
-    commandenv :: CommandEnv (Grammar,PGFEnv),
+    pgfenv :: CmdEnv,
+    commandenv :: CommandEnv ShellM,
     history    :: [String]
   }
 
 emptyGFEnv :: GFEnv
-emptyGFEnv = GFEnv False emptyCommandEnv [] {-0-}
+emptyGFEnv = GFEnv False (emptyGrammar,pgfEnv emptyPGF) emptyCommandEnv [] {-0-}
 
-commandEnv sgr pgf = mkCommandEnv (sgr,pgfEnv pgf) allCommands
-emptyCommandEnv = commandEnv emptyGrammar emptyPGF
+emptyCommandEnv = mkCommandEnv allCommands
 multigrammar = pgf . snd . pgfenv
 
 allCommands =
-  extend (fmap (mapCommandEnv snd) pgfCommands) [helpCommand allCommands]
-  `Map.union` (fmap (mapCommandEnv fst) sourceCommands)
+  extend pgfCommands [helpCommand allCommands]
+  `Map.union` sourceCommands
   `Map.union` commonCommands
 
+instance HasGrammar ShellM where getGrammar = gets (fst . pgfenv)
+instance HasPGFEnv ShellM where getPGFEnv = gets (snd . pgfenv)
+
 wordCompletion gfenv (left,right) = do
   case wc_type (reverse left) of
     CmplCmd pref
@@ -309,7 +344,7 @@ wordCompletion gfenv (left,right) = do
               Left (_ :: SomeException) -> ret (length pref) []
     _ -> ret 0 []
   where
-    pgf    = multigrammar cmdEnv
+    pgf    = multigrammar gfenv
     cmdEnv = commandenv gfenv
     optLang opts = valCIdOpts "lang" (head (languages pgf)) opts
     optType opts = 
diff --git a/src/compiler/GF/Interactive2.hs b/src/compiler/GF/Interactive2.hs
index d914c0f8b..97736e0b1 100644
--- a/src/compiler/GF/Interactive2.hs
+++ b/src/compiler/GF/Interactive2.hs
@@ -1,16 +1,19 @@
-{-# LANGUAGE ScopedTypeVariables, CPP #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, TypeSynonymInstances,FlexibleInstances #-}
 -- | GF interactive mode (with the C run-time system)
 module GF.Interactive2 (mainGFI,mainRunGFI{-,mainServerGFI-}) where
 import Prelude hiding (putStrLn,print)
 import qualified Prelude as P(putStrLn)
 import GF.Command.Interpreter(CommandEnv(..),commands,mkCommandEnv,interpretCommandLine)
 --import GF.Command.Importing(importSource,importGrammar)
-import GF.Command.Commands2(flags,options,PGFEnv,pgf,concs,pgfEnv,emptyPGFEnv,allCommands)
+import GF.Command.Commands2(flags,options,PGFEnv,HasPGFEnv(..),pgf,concs,pgfEnv,emptyPGFEnv,pgfCommands)
+import GF.Command.CommonCommands
+import GF.Command.Help(helpCommand)
 import GF.Command.Abstract
 import GF.Command.Parse(readCommandLine,pCommand)
 import GF.Data.Operations (Err(..),done)
+import GF.Data.Utilities(repeatM)
 
-import GF.Infra.UseIO(ioErrorText)
+import GF.Infra.UseIO(ioErrorText,putStrLnE)
 import GF.Infra.SIO
 import GF.Infra.Option
 import qualified System.Console.Haskeline as Haskeline
@@ -31,7 +34,8 @@ import qualified Text.ParserCombinators.ReadP as RP
 import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
 import System.FilePath(takeExtensions)
 import Control.Exception(SomeException,fromException,try)
-import Control.Monad
+--import Control.Monad
+import Control.Monad.State
 
 import qualified GF.System.Signal as IO(runInterruptibly)
 {-
@@ -55,7 +59,10 @@ mainGFI opts files = do
   P.putStrLn "This shell uses the C run-time system. See help for available commands."
   shell opts files
 
-shell opts files = loop opts =<< runSIO (importInEnv emptyGFEnv opts files)
+shell opts files = flip evalStateT emptyGFEnv $
+                   do mapStateT runSIO $ importInEnv opts files
+                      loop opts
+
 {-
 #ifdef SERVER_MODE
 -- | Run the GF Server (@gf -server@).
@@ -73,31 +80,34 @@ mainServerGFI opts files =
 #endif
 -}
 -- | Read end execute commands until it is time to quit
-loop :: Options -> GFEnv -> IO ()
-loop opts gfenv = maybe done (loop opts) =<< readAndExecute1 opts gfenv
+loop :: Options -> StateT GFEnv IO ()
+loop opts = repeatM $ readAndExecute1 opts
 
 -- | Read and execute one command, returning Just an updated environment for
 -- | the next command, or Nothing when it is time to quit
-readAndExecute1 :: Options -> GFEnv -> IO (Maybe GFEnv)
-readAndExecute1 opts gfenv =
-    runSIO . execute1 opts gfenv =<< readCommand opts gfenv
+readAndExecute1 :: Options -> StateT GFEnv IO Bool
+readAndExecute1 opts =
+    mapStateT runSIO . execute1 opts =<< readCommand opts
 
 -- | Read a command
-readCommand :: Options -> GFEnv -> IO String
-readCommand opts gfenv0 =
+readCommand :: Options -> StateT GFEnv IO String
+readCommand opts =
     case flag optMode opts of
-      ModeRun -> tryGetLine
-      _       -> fetchCommand gfenv0
+      ModeRun -> lift tryGetLine
+      _       -> lift . fetchCommand =<< get
+
+timeIt act =
+  do t1 <- liftSIO $ getCPUTime
+     a <-  act
+     t2 <- liftSIO $ getCPUTime
+     return (t2-t1,a)
 
 -- | Optionally show how much CPU time was used to run an IO action
-optionallyShowCPUTime :: Options -> SIO a -> SIO a
+optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a
 optionallyShowCPUTime opts act 
   | not (verbAtLeast opts Normal) = act
-  | otherwise = do t0 <- getCPUTime
-                   r <- act
-                   t1 <- getCPUTime
-                   let dt = t1-t0
-                   putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
+  | otherwise = do (dt,r) <- timeIt act
+                   liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
                    return r
 
 {-
@@ -105,112 +115,131 @@ loopOptNewCPU opts gfenv'
  | not (verbAtLeast opts Normal) = return gfenv'
  | otherwise = do 
      cpu' <- getCPUTime
-     putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
+     putStrLnE (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
      return $ gfenv' {cputime = cpu'}
 -}
 
+type ShellM = StateT GFEnv SIO
+
 -- | Execute a given command, returning Just an updated environment for
 -- | the next command, or Nothing when it is time to quit
-execute1 :: Options -> GFEnv -> String -> SIO (Maybe GFEnv)
-execute1 opts gfenv0 s0 =
-  interruptible $ optionallyShowCPUTime opts $
-  case pwords s0 of
- -- special commands, requiring source grammar in env
-  {-"eh":w:_ -> do
-             cs <- readFile w >>= return . map words . lines
-             gfenv' <- foldM (flip (process False benv)) gfenv cs
-             loopNewCPU gfenv' -}
-    "q" :_   -> quit
-    "!" :ws  -> system_command ws
-    "eh":ws  -> eh ws
-    "i" :ws  -> import_ ws
- -- other special commands, working on GFEnv
-    "e" :_   -> empty
-    "dc":ws  -> define_command ws
-    "dt":ws  -> define_tree ws
-    "ph":_   -> print_history
-    "r" :_   -> reload_last
- -- ordinary commands, working on CommandEnv
-    _        -> do interpretCommandLine env s0
-                   continue gfenv
+execute1 :: Options -> String -> ShellM Bool
+execute1 opts s0 =
+  do modify $ \ gfenv0 -> gfenv0 {history = s0 : history gfenv0}
+     interruptible $ optionallyShowCPUTime opts $
+       case pwords s0 of
+      -- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands
+      -- special commands
+         "q" :_   -> quit
+         "!" :ws  -> system_command ws
+         "eh":ws  -> eh ws
+         "i" :ws  -> import_ ws
+      -- other special commands, working on GFEnv
+         "e" :_   -> empty
+         "dc":ws  -> define_command ws
+         "dt":ws  -> define_tree ws
+         "ph":_   -> print_history
+         "r" :_   -> reload_last
+      -- ordinary commands
+         _        -> do env <- gets commandenv
+                        interpretCommandLine env s0
+                        continue
   where
 --  loopNewCPU = fmap Just . loopOptNewCPU opts
-    continue = return . Just
-    stop = return Nothing
-    env = commandenv gfenv0
---  sgr = grammar gfenv0
-    gfenv = gfenv0 {history = s0 : history gfenv0}
+    continue,stop :: ShellM Bool
+    continue = return True
+    stop = return False
+
     pwords s = case words s of
                  w:ws -> getCommandOp w :ws
                  ws -> ws
 
+    interruptible :: ShellM Bool -> ShellM Bool
     interruptible act =
-      either (\e -> printException e >> return (Just gfenv)) return
-        =<< runInterruptibly act 
+      do gfenv <- get
+         mapStateT (
+           either (\e -> printException e >> return (True,gfenv)) return
+             <=< runInterruptibly) act
 
   -- Special commands:
 
-    quit = do when (verbAtLeast opts Normal) $ putStrLn "See you."
+    quit = do when (verbAtLeast opts Normal) $ putStrLnE "See you."
               stop
 
-    system_command ws = do restrictedSystem $ unwords ws ; continue gfenv
+    system_command ws = do lift $ restrictedSystem $ unwords ws ; continue
 
+
+       {-"eh":w:_ -> do
+                  cs <- readFile w >>= return . map words . lines
+                  gfenv' <- foldM (flip (process False benv)) gfenv cs
+                  loopNewCPU gfenv' -}
     eh [w] = -- Ehhh? Reads commands from a file, but does not execute them
-      do cs <- restricted (readFile w) >>= return . map (interpretCommandLine env) . lines
-         continue gfenv
-    eh _   = do putStrLn "eh command not parsed"
-                continue gfenv
+      do env <- gets commandenv
+         cs <- lift $ restricted (readFile w) >>= return . map (interpretCommandLine env) . lines
+         continue
+    eh _   = do putStrLnE "eh command not parsed"
+                continue
 
     import_ args = 
-      do gfenv' <- case parseOptions args of
-                     Ok (opts',files) -> do
-                       curr_dir <- getCurrentDirectory
-                       lib_dir  <- getLibraryDirectory (addOptions opts opts')
-                       importInEnv gfenv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files
-                     Bad err -> do 
-                       putStrLn $ "Command parse error: " ++ err
-                       return gfenv
-         continue gfenv'
+      do case parseOptions args of
+           Ok (opts',files) -> do
+             curr_dir <- lift getCurrentDirectory
+             lib_dir  <- lift $ getLibraryDirectory (addOptions opts opts')
+             importInEnv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files
+             continue
+           Bad err ->
+             do putStrLnE $ "Command parse error: " ++ err
+                continue
+         continue
 
-    empty = continue $ gfenv {
-              commandenv=emptyCommandEnv --, grammar = ()
-             }
+    empty = do modify $ \ gfenv -> gfenv { commandenv=emptyCommandEnv }
+               continue
 
     define_command (f:ws) =
         case readCommandLine (unwords ws) of
-           Just comm -> continue $ gfenv {
-             commandenv = env {
-               commandmacros = Map.insert f comm (commandmacros env)
-               }
-             }
+           Just comm ->
+             do modify $
+                  \ gfenv ->
+                    let env = commandenv gfenv
+                    in gfenv {
+                         commandenv = env {
+                           commandmacros = Map.insert f comm (commandmacros env)
+                         }
+                       }
+                continue
            _ -> dc_not_parsed
     define_command _ = dc_not_parsed
 
-    dc_not_parsed = putStrLn "command definition not parsed" >> continue gfenv
+    dc_not_parsed = putStrLnE "command definition not parsed" >> continue
 
     define_tree (f:ws) =
         case H.readExpr (unwords ws) of
-          Just exp -> continue $ gfenv {
-            commandenv = env {
-              expmacros = Map.insert f exp (expmacros env)
-              }
-            }
+          Just exp ->
+           do modify $
+                \ gfenv ->
+                  let env = commandenv gfenv
+                  in gfenv { commandenv = env {
+                               expmacros = Map.insert f exp (expmacros env) } }
+              continue
           _ -> dt_not_parsed
     define_tree _ = dt_not_parsed
 
-    dt_not_parsed = putStrLn "value definition not parsed" >> continue gfenv
+    dt_not_parsed = putStrLnE "value definition not parsed" >> continue
 
-    print_history = mapM_ putStrLn (reverse (history gfenv0))>> continue gfenv
+    print_history =
+      do mapM_ putStrLnE . reverse . drop 1 . history =<< get
+         continue
 
     reload_last = do
+      gfenv0 <- get
       let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]]
       case imports of
         (s,ws):_ -> do
-          putStrLn $ "repeating latest import: " ++ s
+          putStrLnE $ "repeating latest import: " ++ s
           import_ ws
         _ -> do
-          putStrLn $ "no import in history"  
-          continue gfenv
+          putStrLnE $ "no import in history"
+          continue
 
 
 printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e)
@@ -230,27 +259,26 @@ fetchCommand gfenv = do
     Right Nothing  -> return "q"
     Right (Just s) -> return s
 
-importInEnv :: GFEnv -> Options -> [FilePath] -> SIO GFEnv
-importInEnv gfenv opts files =
+importInEnv :: Options -> [FilePath] -> ShellM ()
+importInEnv opts files =
   case files of
     _ | flag optRetainResource opts ->
-          do putStrLn "Flag -retain is not supported in this shell"
-             return gfenv
+          putStrLnE "Flag -retain is not supported in this shell"
     [file] | takeExtensions file == ".pgf" -> importPGF file
-    [] -> return gfenv
-    _ -> do putStrLn "Can only import one .pgf file"
-            return gfenv
+    [] -> done
+    _ -> do putStrLnE "Can only import one .pgf file"
   where
     importPGF file =
-      do case multigrammar (commandenv gfenv) of
-           Just _ -> putStrLnFlush "Discarding previous grammar"
+      do gfenv <- get
+         case multigrammar gfenv of
+           Just _ -> putStrLnE "Discarding previous grammar"
            _ -> done
-         pgf1 <- readPGF2 file
-         let gfenv' = gfenv { commandenv = commandEnv pgf1 }
+         pgf1 <- lift $ readPGF2 file
+         let gfenv' = gfenv { pgfenv = pgfEnv pgf1 }
          when (verbAtLeast opts Normal) $
-           let langs = Map.keys . concretes $ commandenv gfenv'
-           in putStrLnFlush . unwords $ "\nLanguages:":langs
-         return gfenv'
+           let langs = Map.keys . concretes $ gfenv'
+           in putStrLnE . unwords $ "\nLanguages:":langs
+         put gfenv'
 
 tryGetLine = do
   res <- try getLine
@@ -260,23 +288,31 @@ tryGetLine = do
 
 prompt env = abs ++ "> "
   where
-    abs = maybe "" C.abstractName (multigrammar (commandenv env))
+    abs = maybe "" C.abstractName (multigrammar env)
 
 data GFEnv = GFEnv {
 --grammar :: (), -- gfo grammar -retain
 --retain :: (),  -- grammar was imported with -retain flag
-  commandenv :: CommandEnv PGFEnv,
+  pgfenv :: PGFEnv,
+  commandenv :: CommandEnv ShellM,
   history    :: [String]
   }
 
 emptyGFEnv :: GFEnv
-emptyGFEnv = GFEnv {-() ()-} emptyCommandEnv [] {-0-}
+emptyGFEnv = GFEnv {-() ()-} emptyPGFEnv emptyCommandEnv [] {-0-}
 
-commandEnv pgf = mkCommandEnv (pgfEnv pgf) allCommands
-emptyCommandEnv = mkCommandEnv emptyPGFEnv allCommands
+emptyCommandEnv = mkCommandEnv allCommands
 multigrammar = pgf . pgfenv
 concretes = concs . pgfenv
 
+allCommands =
+  extend pgfCommands [helpCommand allCommands]
+  `Map.union` commonCommands
+
+instance HasPGFEnv ShellM where getPGFEnv = gets pgfenv
+
+-- ** Completion
+
 wordCompletion gfenv (left,right) = do
   case wc_type (reverse left) of
     CmplCmd pref
@@ -315,7 +351,7 @@ wordCompletion gfenv (left,right) = do
 
     _ -> ret 0 []
   where
-    mb_pgf = multigrammar cmdEnv
+    mb_pgf = multigrammar gfenv
     cmdEnv = commandenv gfenv
 {-
     optLang opts = valStrOpts "lang" (head $ Map.keys (concretes cmdEnv)) opts