move GFC and GFI

1 files changed, 82 insertions, 0 deletions

diff --git a/src-3.0/GFI.hs b/src-3.0/GFI.hs
new file mode 100644
index 000000000..0efbd420e
--- /dev/null
+++ b/src-3.0/GFI.hs
@@ -0,0 +1,82 @@
+module 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.System.Readline (fetchCommand)
+import GF.Infra.Option ---- Haskell's option lib
+
+import System.CPUTime
+
+
+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
+  s <- fetchCommand (prompt env)
+  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' <- getCPUTime
+  putStrLn (show ((cpu' - cputime gfenv) `div` 1000000000) ++ " msec")
+  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 = absname ++ "> " where
+  absname = case abstractName (multigrammar env) of
+    "_" -> ""  --- created by new Ident handling 22/5/2008
+    n   -> n
+
+data GFEnv = GFEnv {
+  commandenv :: CommandEnv,
+  history    :: [String],
+  cputime    :: Integer
+  }