Switch to new options handling.

This changes lots of stuff, let me know if it broke anything.

Comments:

- We use a local hacked version of GetOpt that allows long forms of commands to start with a single dash. This breaks other parts of GetOpt. For example, arguments to short options now require a =, and does not allo pace after the option character.

- The new command parsing is currently only used for the program command line, pragmas and the arguments for the 'i' shell command.

- I made a quick hack for the options for showTerm, which currently makes it impossible to use the print style flags for cc. This will be replaced by a facility for parsing command-specific options.

- The verbosity handling is broken in some places. I will fix that in a later patch.

src-3.0/GF/Compile/BackOpt.hs

@@ -15,10 +15,11 @@
 -- following advice of Josef Svenningsson
 -----------------------------------------------------------------------------
 
-module GF.Compile.BackOpt (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where
+module GF.Compile.BackOpt (shareModule, OptSpec) where
 
 import GF.Grammar.Grammar
 import GF.Infra.Ident
+import GF.Infra.Option
 import qualified GF.Grammar.Macros as C
 import GF.Grammar.PrGrammar (prt)
 import GF.Data.Operations
@@ -26,25 +27,7 @@ import Data.List
 import qualified GF.Infra.Modules as M
 import qualified Data.ByteString.Char8 as BS
 
-type OptSpec = [Integer] ---
-
-doOptFactor :: OptSpec -> Bool
-doOptFactor opt = elem 2 opt
-
-doOptValues :: OptSpec -> Bool
-doOptValues opt = elem 3 opt
-
-shareOpt :: OptSpec
-shareOpt = []
-
-paramOpt :: OptSpec
-paramOpt = [2]
-
-valOpt :: OptSpec
-valOpt = [3]
-
-allOpt :: OptSpec
-allOpt = [2,3]
+type OptSpec = [Optimization]
 
 shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
 shareModule opt (i,m) = case m of
@@ -59,31 +42,8 @@ shareInfo _ i = i
 
 -- the function putting together optimizations
 shareOptim :: OptSpec -> Ident -> Term -> Term
-shareOptim opt c 
-  | doOptFactor opt && doOptValues opt = values . factor c 0
-  | doOptFactor opt = share . factor c 0
-  | doOptValues opt = values    
-  | otherwise = share
-
--- we need no counter to create new variable names, since variables are 
--- local to tables (only true in GFC) ---
-
-share :: Term -> Term
-share t = case t of
-  T ty@(TComp _) cs -> shareT ty [(p, share v) | (p, v) <- cs]
-  _ -> C.composSafeOp share t
-
- where
-   shareT ty = finalize ty . groupC . sortC
- 
-   sortC :: [(Patt,Term)] -> [(Patt,Term)]
-   sortC = sortBy $ \a b -> compare (snd a) (snd b)
-
-   groupC :: [(Patt,Term)] -> [[(Patt,Term)]]
-   groupC = groupBy $ \a b -> snd a == snd b
-
-   finalize :: TInfo -> [[(Patt,Term)]] -> Term
-   finalize ty css = TSh ty [(map fst ps, t) | ps@((_,t):_) <- css]
+shareOptim opt c =   (if OptValues      `elem` opt then values     else id)
+                   . (if OptParametrize `elem` opt then factor c 0 else id)
 
 -- do even more: factor parametric branches
 

src-3.0/GF/Compile/GetGrammar.hs

@@ -39,15 +39,17 @@ import System.Cmd (system)
 
 getSourceModule :: Options -> FilePath -> IOE SourceModule
 getSourceModule opts file0 = do
-  file <- case getOptVal opts usePreprocessor of
-    Just p -> do
-      let tmp = "_gf_preproc.tmp"
-          cmd = p +++ file0 ++ ">" ++ tmp
-      ioeIO $ system cmd
-      -- ioeIO $ putStrLn $ "preproc" +++ cmd
-      return tmp
-    _ -> return file0
+  file <- foldM runPreprocessor file0 (moduleFlag optPreprocessors opts)
   string    <- readFileIOE file
   let tokens = myLexer string
   mo1  <- ioeErr $ pModDef tokens
   ioeErr $ transModDef mo1
+
+-- FIXME: should use System.IO.openTempFile
+runPreprocessor :: FilePath -> String -> IOE FilePath
+runPreprocessor file0 p =
+    do let tmp = "_gf_preproc.tmp"
+           cmd = p +++ file0 ++ ">" ++ tmp
+       ioeIO $ system cmd
+       -- ioeIO $ putStrLn $ "preproc" +++ cmd
+       return tmp

src-3.0/GF/Compile/GrammarToGFCC.hs

@@ -61,16 +61,15 @@ addParsers gfcc = gfcc { D.concretes = Map.map conv (D.concretes gfcc) }
 
 canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> SourceGrammar -> D.GFCC
 canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = 
-  (if (oElem (iOpt "show_canon") opts) then trace (prGrammar cgr) else id) $
+  (if dump opts DumpCanon then trace (prGrammar cgr) else id) $
      D.GFCC an cns gflags abs cncs 
  where
   -- abstract
   an  = (i2i a)
   cns = map (i2i . fst) cms
   abs = D.Abstr aflags funs cats catfuns
-  gflags = Map.fromList [(mkCId fg,x) | Just x <- [getOptVal opts (aOpt fg)]] 
-                                          where fg = "firstlang"
-  aflags = Map.fromList [(mkCId f,x) | Opt (f,[x]) <- M.flags abm]
+  gflags = Map.empty
+  aflags = Map.fromList [(mkCId f,x) | (f,x) <- moduleOptionsGFO (M.flags abm)]
   mkDef pty = case pty of
     Yes t -> mkExp t
     _ -> CM.primNotion
@@ -90,9 +89,9 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) =
       (lang,D.Concr flags lins opers lincats lindefs printnames params fcfg)
     where
       js = tree2list (M.jments mo)
-      flags   = Map.fromList [(mkCId f,x) | Opt (f,[x]) <- M.flags mo]
+      flags   = Map.fromList [(mkCId f,x) | (f,x) <- moduleOptionsGFO (M.flags mo)]
       opers   = Map.fromAscList [] -- opers will be created as optimization
-      utf     = if elem (Opt ("coding",["utf8"])) (M.flags mo) 
+      utf     = if moduleFlag optEncoding (moduleOptions (M.flags mo)) == UTF_8
                   then D.convertStringsInTerm decodeUTF8 else id
       lins    = Map.fromAscList 
         [(i2i f, utf (mkTerm tr))  | (f,CncFun _ (Yes tr) _) <- js]
@@ -227,14 +226,15 @@ reorder abs cg = M.MGrammar $
                  predefADefs ++ Look.allOrigInfos cg abs
        predefADefs = 
          [(c, AbsCat (Yes []) Nope) | c <- [cFloat,cInt,cString]]
-       aflags = nubFlags $ 
-         concat [M.flags mo | (_,mo) <- M.allModMod cg, M.isModAbs mo]
+       aflags = 
+         concatModuleOptions [M.flags mo | (_,mo) <- M.allModMod cg, M.isModAbs mo]
 
        cncs = sortIds [(lang, concr lang) | lang <- M.allConcretes cg abs]
-       concr la = (nubFlags flags, 
+       concr la = (flags, 
                    sortIds (predefCDefs ++ jments)) where 
          jments = Look.allOrigInfos cg la
-         flags  = concat [M.flags mo | 
+         flags  = concatModuleOptions 
+                    [M.flags mo | 
                      (i,mo) <- mos, M.isModCnc mo, 
                      Just r <- [lookup i (M.allExtendSpecs cg la)]]
 
@@ -242,7 +242,6 @@ reorder abs cg = M.MGrammar $
            [(c, CncCat (Yes GM.defLinType) Nope Nope) | c <- [cInt,cFloat,cString]]
 
        sortIds = sortBy (\ (f,_) (g,_) -> compare f g) 
-       nubFlags = nubBy (\ (Opt (f,_)) (Opt (g,_)) -> f == g)
 
 
 -- one grammar per language - needed for symtab generation

src-3.0/GF/Compile/Optimize.hs

@@ -43,9 +43,6 @@ import Debug.Trace
 prtIf :: (Print a) => Bool -> a -> a
 prtIf b t = if b then trace (" " ++ prt t) t else t
 
--- experimental evaluation, option to import
-oEval = iOpt "eval"
-
 -- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
 
 type EEnv = () --- not used
@@ -55,28 +52,21 @@ optimizeModule :: Options -> ([(Ident,SourceModInfo)],EEnv) ->
                   (Ident,SourceModInfo) -> Err ((Ident,SourceModInfo),EEnv)
 optimizeModule opts mse@(ms,eenv) mo@(_,mi) = case mi of
   ModMod m0@(Module mt st fs me ops js) | 
-    st == MSComplete && isModRes m0 && not (oElem oEval oopts)-> do
+    st == MSComplete && isModRes m0 -> do
       (mo1,_) <- evalModule oopts mse mo
-      let 
-       mo2 = case optim of
-        "parametrize" -> shareModule paramOpt mo1  -- parametrization and sharing
-        "values"      -> shareModule valOpt mo1    -- tables as courses-of-values
-        "share"       -> shareModule shareOpt mo1  -- sharing of branches
-        "all"         -> shareModule allOpt mo1    -- first parametrize then values
-        "none"        -> mo1                       -- no optimization
-        _             -> mo1                       -- none; default for src
+      let mo2 = shareModule optim mo1
       return (mo2,eenv)
   _ -> evalModule oopts mse mo
  where
-   oopts = addOptions opts (iOpts (flagsModule mo))
-   optim = maybe "all" id $ getOptVal oopts useOptimizer
+   oopts = addOptions opts (moduleOptions (flagsModule mo))
+   optim = moduleFlag optOptimizations oopts
 
 evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> 
                Err ((Ident,SourceModInfo),EEnv)
 evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
 
   ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
-    _ | isModRes m0 && not (oElem oEval oopts) -> do
+    _ | isModRes m0 -> do
       let deps = allOperDependencies name js
       ids <- topoSortOpers deps
       MGrammar (mod' : _) <- foldM evalOp gr ids
@@ -112,17 +102,15 @@ evalResInfo oopts gr (c,info) = case info of
  where
    comp = if optres then computeConcrete gr else computeConcreteRec gr
    eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
-   optim = maybe "all" id $ getOptVal oopts useOptimizer
-   optres = case optim of
-     "noexpand" -> False
-     _ -> True
+   optim = moduleFlag optOptimizations oopts
+   optres = OptExpand `elem` optim
 
 
 evalCncInfo :: 
   Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err (Ident,Info)
 evalCncInfo opts gr cnc abs (c,info) = do
 
- seq (prtIf (oElem beVerbose opts) c) $ return ()
+ seq (prtIf (beVerbose opts) c) $ return ()
 
  errIn ("optimizing" +++ prt c) $ case info of
 
@@ -143,7 +131,7 @@ evalCncInfo opts gr cnc abs (c,info) = do
   CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr -> 
        eIn ("linearization in type" +++ prt (mkProd (cont,val,[])) ++++ "of function") $ do
     pde' <- case pde of
-      Yes de | notNewEval -> do
+      Yes de -> do
         liftM yes $ pEval ty de
 
       _ -> return pde
@@ -154,7 +142,6 @@ evalCncInfo opts gr cnc abs (c,info) = do
  where
    pEval = partEval opts gr
    eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
-   notNewEval = not (oElem oEval opts)
 
 -- | the main function for compiling linearizations
 partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term

src-3.0/GF/Compile/ReadFiles.hs

@@ -19,8 +19,9 @@
 -----------------------------------------------------------------------------
 
 module GF.Compile.ReadFiles 
-           ( getAllFiles,ModName,ModEnv,getOptionsFromFile,importsOfModule,
-             gfoFile,gfFile,isGFO ) where
+           ( getAllFiles,ModName,ModEnv,importsOfModule,
+             gfoFile,gfFile,isGFO,
+             getOptionsFromFile) where
 
 import GF.Infra.UseIO
 import GF.Infra.Option
@@ -48,9 +49,7 @@ getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
 getAllFiles opts ps env file = do
   -- read module headers from all files recursively
   ds <- liftM reverse $ get [] [] (justModuleName file)
-  if oElem beVerbose opts
-    then ioeIO $ putStrLn $ "all modules:" +++ show [name | (name,_,_,_,_) <- ds]
-    else return ()
+  ioeIO $ putIfVerb opts $ "all modules:" +++ show [name | (name,_,_,_,_) <- ds]
   return $ paths ds
   where
     -- construct list of paths to read
@@ -135,8 +134,8 @@ selectFormat opts mtenv mtgf mtgfo =
     (_,_,        Nothing) -> (CSRead,Nothing)  -- source does not exist
     _ -> (CSComp,Nothing)
   where
-    fromComp = oElem isCompiled opts -- i -gfo
-    fromSrc  = oElem fromSource opts
+    fromComp = flag optRecomp opts == NeverRecomp
+    fromSrc  = flag optRecomp opts == AlwaysRecomp
 
 
 -- internal module dep information
@@ -188,8 +187,9 @@ importsOfModule (MModule _ typ body) = modType typ (modBody body [])
 
 
 -- | options can be passed to the compiler by comments in @--#@, in the main file
-getOptionsFromFile ::  FilePath -> IO Options
+getOptionsFromFile :: FilePath -> IOE Options
 getOptionsFromFile file = do
-  s <- readFileIfStrict file
+  s <- ioeIO $ readFileIfStrict file
   let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s
-  return $ fst $ getOptions "-" $ map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
+      fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls
+  ioeErr $ liftM moduleOptions $ parseModuleOptions fs

src-3.0/GF/Compile/Rebuild.hs

@@ -23,6 +23,7 @@ import GF.Grammar.Macros
 
 import GF.Infra.Ident
 import GF.Infra.Modules
+import GF.Infra.Option
 import GF.Data.Operations
 
 import Data.List (nub)
@@ -76,7 +77,7 @@ rebuildModule ms mo@(i,mi) = do
                        ++ [oSimple i   | i <- map snd insts] ----
 
       --- check if me is incomplete
-      let fs1 = fs_ ++ fs                            -- new flags have priority
+      let fs1 = addModuleOptions fs fs_                           -- new flags have priority
       let js0 = [ci | ci@(c,_) <- tree2list js, isInherited incl c]
       let js1 = buildTree (tree2list js_ ++ js0)
       return $ ModMod $ Module mt0 stat' fs1 me ops1 js1