reorganize the directories under src, and rescue the JavaScript interpreter from deprecated

1 files changed, 0 insertions, 363 deletions

diff --git a/src/GFI.hs b/src/GFI.hs
deleted file mode 100644
index 2ea22efa6..000000000
--- a/src/GFI.hs
+++ /dev/null
@@ -1,363 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables, CPP #-}
-module GFI (mainGFI,mainRunGFI) where
-
-import GF.Command.Interpreter
-import GF.Command.Importing
-import GF.Command.Commands
-import GF.Command.Abstract
-import GF.Command.Parse
-import GF.Data.ErrM
-import GF.Grammar hiding (Ident)
-import GF.Grammar.Parser (runP, pExp)
-import GF.Compile.Rename
-import GF.Compile.Concrete.Compute (computeConcrete)
-import GF.Compile.Concrete.TypeCheck (inferLType)
-import GF.Infra.Dependencies
-import GF.Infra.CheckM
-import GF.Infra.UseIO
-import GF.Infra.Option
-import GF.Infra.Modules (greatestResource)
-import GF.System.Readline
-
-import GF.Text.Coding
-import GF.Compile.Coding
-
-import PGF
-import PGF.Data
-import PGF.Macros
-
-import Data.Char
-import Data.Maybe
-import Data.List(isPrefixOf)
-import qualified Data.Map as Map
-import qualified Data.ByteString.Char8 as BS
-import qualified Text.ParserCombinators.ReadP as RP
-import System.Cmd
-import System.CPUTime
-import System.Directory
-import Control.Exception
-import Control.Monad
-import Data.Version
-import GF.System.Signal
---import System.IO.Error (try)
-#ifdef mingw32_HOST_OS
-import System.Win32.Console
-import System.Win32.NLS
-#endif
-
-import Paths_gf
-
-mainRunGFI :: Options -> [FilePath] -> IO ()
-mainRunGFI opts files = do
-  let opts1 = addOptions (modifyFlags (\f -> f{optVerbosity=Quiet})) opts
-  gfenv <- emptyGFEnv
-  gfenv <- importInEnv gfenv opts1 files
-  loop opts1 gfenv
-  return ()
-
-mainGFI :: Options -> [FilePath] -> IO ()
-mainGFI opts files = do
-  putStrLn welcome
-  gfenv <- emptyGFEnv
-  gfenv <- importInEnv gfenv opts files
-  loop opts gfenv
-  return ()
-
-loopOptNewCPU opts gfenv' 
- | not (verbAtLeast opts Normal) = return gfenv'
- | otherwise = do 
-     cpu' <- getCPUTime
-     putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
-     return $ gfenv' {cputime = cpu'}
-
-loop :: Options -> GFEnv -> IO GFEnv
-loop opts gfenv0 = do
-  let loopNewCPU = loopOptNewCPU opts
-  let isv = verbAtLeast opts Normal
-  let ifv act = if isv then act else return ()
-  let env = commandenv gfenv0
-  let sgr = sourcegrammar gfenv0
-  setCompletionFunction (Just (wordCompletion gfenv0))
-  let fetch = case flag optMode opts of
-        ModeRun -> tryGetLine
-        _ -> fetchCommand (prompt env)
-  s0 <- fetch 
-  let gfenv = gfenv0 {history = s0 : history gfenv0}
-  let 
-    enc = encode gfenv
-    s = decode gfenv s0
-    pwords = case words s of
-      w:ws -> getCommandOp w :ws
-      ws -> ws
-  
-  -- special commands, requiring source grammar in env
-
-  case pwords of
-
-      "q":_  -> ifv (putStrLn "See you.") >> return gfenv
-
-      _ -> do
-        r <- runInterruptibly $ case pwords of
-
-          "!":ws -> do
-             system $ unwords ws
-             loopNewCPU gfenv
-          "cc":ws -> do
-             let
-               pOpts style q ("-table"  :ws) = pOpts TermPrintTable   q           ws
-               pOpts style q ("-all"    :ws) = pOpts TermPrintAll     q           ws
-               pOpts style q ("-default":ws) = pOpts TermPrintDefault q           ws
-               pOpts style q ("-unqual" :ws) = pOpts style            Unqualified ws
-               pOpts style q ("-qual"   :ws) = pOpts style            Qualified   ws
-               pOpts style q             ws  = (style,q,unwords ws)
-               
-               (style,q,s) = pOpts TermPrintDefault Qualified (tail (words s0))
-
-               checkComputeTerm gr t = do
-                 mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr
-                 ((t,_),_) <- runCheck $ do t <- renameSourceTerm gr mo t
-                                            inferLType gr [] t
-                 computeConcrete sgr t
-
-             case runP pExp (BS.pack s) of
-               Left (_,msg) -> putStrLn msg
-               Right t      -> case checkComputeTerm sgr (codeTerm (decode gfenv) t) of
-                                 Ok  x -> putStrLn $ enc (showTerm style q x)
-                                 Bad s -> putStrLn $ enc s
-             loopNewCPU gfenv
-          "dg":ws -> do
-             writeFile "_gfdepgraph.dot" (depGraph sgr)
-             putStrLn "wrote graph in file _gfdepgraph.dot"
-             loopNewCPU gfenv
-          "i":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
-              loopNewCPU gfenv'
-
-  -- other special commands, working on GFEnv
-          "e":_ -> loopNewCPU $ gfenv {
-             commandenv=emptyCommandEnv, sourcegrammar = emptySourceGrammar
-             }
-
-          "dc":f:ws -> do
-             case readCommandLine (unwords ws) of
-               Just comm -> loopNewCPU $ gfenv {
-                 commandenv = env {
-                   commandmacros = Map.insert f comm (commandmacros env)
-                   }
-                 }
-               _ -> putStrLn "command definition not parsed" >> loopNewCPU gfenv
-
-          "dt":f:ws -> do
-             case readExpr (unwords ws) of
-               Just exp -> loopNewCPU $ gfenv {
-                 commandenv = env {
-                   expmacros = Map.insert f exp (expmacros env)
-                   }
-                 }
-               _ -> putStrLn "value definition not parsed" >> loopNewCPU gfenv
-
-          "ph":_ -> 
-            mapM_ (putStrLn . enc) (reverse (history gfenv0)) >> loopNewCPU gfenv
-          "se":c:_ -> 
-             case lookup c encodings of
-               Just cod -> do
-#ifdef mingw32_HOST_OS
-                              case c of
-                                'c':'p':c -> case reads c of
-                                               [(cp,"")] -> setConsoleCP cp >> setConsoleOutputCP cp
-                                               _         -> return ()
-                                "utf8"    -> setConsoleCP 65001 >> setConsoleOutputCP 65001
-                                _         -> return ()
-#endif
-                              loopNewCPU $ gfenv {coding = cod}
-               Nothing  -> do putStrLn "unknown encoding"
-                              loopNewCPU gfenv
-
-  -- ordinary commands, working on CommandEnv
-          _ -> do
-            interpretCommandLine enc env s
-            loopNewCPU gfenv
---        gfenv' <- return $ either (const gfenv) id r
-        gfenv' <- either (\e -> (print e >> return gfenv)) return r
-        loop opts gfenv'
-
-importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv
-importInEnv gfenv opts files
-    | flag optRetainResource opts =
-        do src <- importSource (sourcegrammar gfenv) opts files
-           return $ gfenv {sourcegrammar = src}
-    | otherwise =
-        do let opts' = addOptions (setOptimization OptCSE False) opts
-               pgf0 = multigrammar (commandenv gfenv)
-           pgf1 <- importGrammar pgf0 opts' files
-           if (verbAtLeast opts Normal)
-             then putStrLnFlush $ unwords $ "\nLanguages:" : map showCId (languages pgf1)
-             else return ()
-           return $ gfenv { commandenv = mkCommandEnv (coding gfenv) pgf1 }
-
-tryGetLine = do
-  res <- try getLine
-  case res of
-   Left (e :: SomeException) -> return "q"
-   Right l -> return l
-
-welcome = unlines [
-  "                              ",
-  "         *  *  *              ",
-  "      *           *           ",
-  "    *               *         ",
-  "   *                          ",
-  "   *                          ",
-  "   *        * * * * * *       ",
-  "   *        *         *       ",
-  "    *       * * * *  *        ",
-  "      *     *      *          ",
-  "         *  *  *              ",
-  "                              ",
-  "This is GF version "++showVersion version++". ",
-  "License: see help -license.   ",
-  "Differences from GF 2.9: see help -changes.",
-  "Bug reports: http://code.google.com/p/grammatical-framework/issues/list"
-  ]
-
-prompt env 
-  | abs == wildCId = "> "
-  | otherwise      = showCId abs ++ "> "
-  where
-    abs = abstractName (multigrammar env)
-
-data GFEnv = GFEnv {
-  sourcegrammar :: SourceGrammar, -- gfo grammar -retain
-  commandenv :: CommandEnv,
-  history    :: [String],
-  cputime    :: Integer,
-  coding     :: Encoding
-  }
-
-emptyGFEnv :: IO GFEnv
-emptyGFEnv = do
-#ifdef mingw32_HOST_OS
-  codepage <- getACP
-  let coding = fromMaybe UTF_8 (lookup ("cp"++show codepage) encodings)
-#else
-  let coding = UTF_8
-#endif
-  return $ GFEnv emptySourceGrammar (mkCommandEnv coding emptyPGF) [] 0 coding
-
-encode = encodeUnicode . coding 
-decode = decodeUnicode . coding
-
-wordCompletion gfenv line0 prefix0 p =
-  case wc_type (take p line) of
-    CmplCmd pref
-      -> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
-    CmplStr (Just (Command _ opts _)) s
-      -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optType opts)))
-            case mb_state0 of
-              Right state0 -> let ws     = words (take (length s - length prefix) s)
-                              in case loop state0 ws of
-                                   Nothing    -> ret ' ' []
-                                   Just state -> let compls = getCompletions state prefix
-                                                 in ret ' ' (map (encode gfenv) (Map.keys compls))
-              Left (_ :: SomeException) -> ret ' ' []
-    CmplOpt (Just (Command n _ _)) pref
-      -> case Map.lookup n (commands cmdEnv) of
-           Just inf -> do let flg_compls = ['-':flg | (flg,_) <- flags   inf, isPrefixOf pref flg]
-                              opt_compls = ['-':opt | (opt,_) <- options inf, isPrefixOf pref opt]
-                          ret (if null flg_compls then ' ' else '=')
-                              (flg_compls++opt_compls)
-           Nothing  -> ret ' ' []
-    CmplIdent (Just (Command "i" _ _)) _        -- HACK: file name completion for command i
-      -> filenameCompletionFunction prefix
-    CmplIdent _ pref
-      -> do mb_abs <- try (evaluate (abstract pgf))
-            case mb_abs of
-              Right abs -> ret ' ' [name | cid <- Map.keys (funs abs), let name = showCId cid, isPrefixOf pref name]
-              Left (_ :: SomeException) -> ret ' ' []
-    _ -> ret ' ' []
-  where
-    line   = decode gfenv line0
-    prefix = decode gfenv prefix0
-
-    pgf    = multigrammar cmdEnv
-    cmdEnv = commandenv gfenv
-    optLang opts = valCIdOpts "lang" (head (languages pgf)) opts
-    optType opts = 
-      let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts
-      in case readType str of
-           Just ty -> ty
-           Nothing -> error ("Can't parse '"++str++"' as type")
-
-    loop ps []     = Just ps
-    loop ps (t:ts) = case nextState ps t of
-                       Left  es -> Nothing
-                       Right ps -> loop ps ts
-
-    ret c [x] = return [x++[c]]
-    ret _ xs  = return xs
-
-
-data CompletionType
-  = CmplCmd                   Ident
-  | CmplStr   (Maybe Command) String
-  | CmplOpt   (Maybe Command) Ident
-  | CmplIdent (Maybe Command) Ident
-  deriving Show
-
-wc_type :: String -> CompletionType
-wc_type = cmd_name
-  where
-    cmd_name cs =
-      let cs1 = dropWhile isSpace cs
-      in go cs1 cs1
-      where
-        go x []       = CmplCmd x
-        go x (c:cs)
-          | isIdent c = go x cs
-          | otherwise = cmd x cs
-
-    cmd x []       = ret CmplIdent x "" 0
-    cmd _ ('|':cs) = cmd_name cs
-    cmd _ (';':cs) = cmd_name cs
-    cmd x ('"':cs) = str x cs cs
-    cmd x ('-':cs) = option x cs cs
-    cmd x (c  :cs)
-      | isIdent c  = ident x (c:cs) cs
-      | otherwise  = cmd x cs
-
-    option x y []       = ret CmplOpt x y 1
-    option x y ('=':cs) = optValue x y cs
-    option x y (c  :cs)
-      | isIdent c       = option x y cs
-      | otherwise       = cmd x cs
-      
-    optValue x y ('"':cs) = str x y cs
-    optValue x y cs       = cmd x cs
-
-    ident x y []     = ret CmplIdent x y 0
-    ident x y (c:cs)
-      | isIdent c    = ident x y cs
-      | otherwise    = cmd x cs
-
-    str x y []          = ret CmplStr x y 1
-    str x y ('\"':cs)   = cmd x cs
-    str x y ('\\':c:cs) = str x y cs
-    str x y (c:cs)      = str x y cs
-
-    ret f x y d = f cmd y
-      where
-        x1 = take (length x - length y - d) x
-        x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1
-        
-        cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
-	        [x] -> Just x
-                _   -> Nothing
-
-    isIdent c = c == '_' || c == '\'' || isAlphaNum c