diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 100bba24f..f2c835ff1 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE PatternGuards, TypeSynonymInstances, FlexibleInstances #-} module GF.Command.Commands ( - PGFEnv,pgfEnv,allCommands, + PGFEnv,pgf,mos,pgfEnv,allCommands, options,flags, ) where import Prelude hiding (putStrLn) @@ -49,13 +48,13 @@ import Data.List (sort) --import System.Random (newStdGen) ---- -type PGFEnv = (PGF, Map.Map Language Morpho) +data PGFEnv = Env {pgf::PGF,mos::Map.Map Language Morpho} -pgfEnv pgf = (pgf,mos) +pgfEnv pgf = Env pgf mos where mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf] instance TypeCheckArg PGFEnv where - typeCheckArg (pgf,_) = either (Left . ppTcError) (Right . fst) . inferExpr pgf + typeCheckArg (Env pgf _) = either (Left . ppTcError) (Right . fst) . inferExpr pgf -- this list must no more be kept sorted by the command name allCommands :: Map.Map String (CommandInfo PGFEnv) @@ -71,7 +70,7 @@ allCommands = extend commonCommands [ "by the flag. The target format is postscript, unless overridden by the", "flag -format." ], - exec = \env@(pgf, mos) opts es -> do + exec = \ (Env pgf mos) opts es -> do let langs = optLangs pgf opts if isOpt "giza" opts then do @@ -210,7 +209,7 @@ allCommands = extend commonCommands [ ("lang","the language in which to parse"), ("probs","file with probabilities to rank the parses") ], - exec = \env@(pgf, mos) opts _ -> do + exec = \ env@(Env pgf mos) opts _ -> do let file = optFile opts pgf <- optProbs opts pgf let printer = if (isOpt "api" opts) then exprToAPI else (showExpr []) @@ -244,7 +243,7 @@ allCommands = extend commonCommands [ ("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 = \ (Env pgf mos) opts xs -> do pgf <- optProbs opts (optRestricted opts pgf) gen <- newStdGen let dp = valIntOpts "depth" 4 opts @@ -274,7 +273,7 @@ allCommands = extend commonCommands [ 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 = \ (Env pgf mos) opts xs -> do let pgfr = optRestricted opts pgf let dp = valIntOpts "depth" 4 opts let ts = case mexp xs of @@ -329,7 +328,7 @@ allCommands = extend commonCommands [ 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 = \ (Env pgf mos) opts -> return . fromStrings . optLins pgf opts, options = [ ("all", "show all forms and variants, one by line (cf. l -list)"), ("bracket","show tree structure with brackets and paths to nodes"), @@ -354,7 +353,7 @@ allCommands = extend commonCommands [ examples = [ mkEx "l -lang=LangSwe,LangNor -chunks ? a b (? c d)" ], - exec = \env@(pgf, mos) opts -> return . fromStrings . optLins pgf (opts ++ [OOpt "chunks"]), + exec = \ (Env pgf mos) opts -> return . fromStrings . optLins pgf (opts ++ [OOpt "chunks"]), options = [ ("treebank","show the tree and tag linearizations with language names") ] ++ stringOpOptions, @@ -395,7 +394,7 @@ allCommands = extend commonCommands [ longname = "morpho_quiz", synopsis = "start a morphology quiz", syntax = "mq (-cat=CAT)? (-probs=FILE)? TREE?", - exec = \env@(pgf, mos) opts xs -> do + exec = \ (Env pgf mos) opts xs -> do let lang = optLang pgf opts let typ = optType pgf opts pgf <- optProbs opts pgf @@ -423,7 +422,7 @@ allCommands = extend commonCommands [ "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 = \ (Env pgf mos) opts ts -> return . Piped $ fromParse opts (concat [map ((,) s) (par pgf opts s) | s <- toStrings ts]), flags = [ ("cat","target category of parsing"), @@ -490,7 +489,7 @@ allCommands = extend commonCommands [ 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 -> + exec = \ (Env pgf mos) opts -> returnFromExprs . takeOptNum opts . treeOps pgf opts, options = treeOpOptions undefined{-pgf-}, flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-} @@ -509,7 +508,7 @@ allCommands = extend commonCommands [ ("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 = \ (Env pgf mos) opts _ -> do let file = valStrOpts "file" "_gftmp" opts let exprs [] = ([],empty) exprs ((n,s):ls) | null s @@ -544,7 +543,7 @@ allCommands = extend commonCommands [ "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 = \ (Env pgf mos) opts ts -> do pgf <- optProbs opts pgf let tds = rankTreesByProbs pgf ts if isOpt "v" opts @@ -566,7 +565,7 @@ allCommands = extend commonCommands [ 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 = \ (Env pgf mos) opts xs -> do let from = optLangFlag "from" pgf opts let to = optLangFlag "to" pgf opts let typ = optType pgf opts @@ -669,7 +668,7 @@ allCommands = extend commonCommands [ "by the flag. The target format is png, unless overridden by the", "flag -format." ], - exec = \env@(pgf, mos) opts es -> do + exec = \ (Env pgf mos) opts es -> do let debug = isOpt "v" opts let file = valStrOpts "file" "" opts let outp = valStrOpts "output" "dot" opts @@ -717,7 +716,7 @@ allCommands = extend commonCommands [ "by the flag. The target format is png, unless overridden by the", "flag -format." ], - exec = \env@(pgf, mos) opts es -> do + exec = \ (Env pgf mos) opts es -> 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), @@ -778,7 +777,7 @@ allCommands = extend commonCommands [ "flag -format.", "With option -mk, use for showing library style function names of form 'mkC'." ], - exec = \env@(pgf, mos) opts es -> + exec = \ (Env pgf mos) opts es -> if isOpt "mk" opts then return $ fromString $ unlines $ map (tree2mk pgf) es else if isOpt "api" opts @@ -826,7 +825,7 @@ allCommands = extend commonCommands [ "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 = \ (Env pgf mos) opts arg -> do case arg of [EFun id] -> case Map.lookup id (funs (abstract pgf)) of Just fd -> do putStrLn $ render (ppFun id fd) @@ -986,7 +985,7 @@ allCommands = extend commonCommands [ [] -> pipeMessage "no trees found" _ -> fromExprs es - prGrammar env@(pgf,mos) opts + prGrammar (Env pgf mos) opts | isOpt "pgf" opts = do let pgf1 = if isOpt "opt" opts then optimizePGF pgf else pgf let outfile = valStrOpts "file" (showCId (abstractName pgf) ++ ".pgf") opts @@ -1008,12 +1007,12 @@ allCommands = extend commonCommands [ funsigs pgf = [(f,ty) | (f,(ty,_,_,_)) <- Map.assocs (funs (abstract pgf))] showFun (f,ty) = showCId f ++ " : " ++ showType [] ty ++ " ;" - morphos (pgf,mos) opts s = + morphos (Env pgf mos) opts s = [(s,morpho mos [] (\mo -> lookupMorpho mo s) la) | la <- optLangs pgf opts] morpho mos z f la = maybe z f $ Map.lookup la mos - optMorpho (pgf,mos) opts = morpho mos (error "no morpho") id (head (optLangs pgf opts)) + optMorpho (Env pgf mos) opts = morpho mos (error "no morpho") id (head (optLangs pgf opts)) optClitics opts = case valStrOpts "clitics" "" opts of "" -> [] diff --git a/src/compiler/GF/Command/Commands2.hs b/src/compiler/GF/Command/Commands2.hs index f5082b4f9..3bdbb0501 100644 --- a/src/compiler/GF/Command/Commands2.hs +++ b/src/compiler/GF/Command/Commands2.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE PatternGuards, TypeSynonymInstances, FlexibleInstances #-} module GF.Command.Commands2 ( - PGFEnv,pgfEnv,emptyPGFEnv,allCommands, + PGFEnv,pgf,concs,pgfEnv,emptyPGFEnv,allCommands, options, flags, ) where import Prelude hiding (putStrLn) @@ -19,8 +18,8 @@ import qualified PGF as H --import GF.Compile.ToAPI --import GF.Compile.ExampleBased --import GF.Infra.Option (noOptions, readOutputFormat, outputFormatsExpl) -import GF.Infra.UseIO(writeUTF8File) -import GF.Infra.SIO +--import GF.Infra.UseIO(writeUTF8File) +--import GF.Infra.SIO --import GF.Data.ErrM ---- import GF.Command.Abstract --import GF.Command.Messages @@ -29,7 +28,7 @@ import GF.Command.Help import GF.Command.CommonCommands --import GF.Text.Lexing --import GF.Text.Clitics -import GF.Text.Transliterations +--import GF.Text.Transliterations --import GF.Quiz --import GF.Command.TreeOperations ---- temporary place for typecheck and compute @@ -41,18 +40,18 @@ import GF.Data.Operations 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 GF.System.Process +--import GF.Text.Pretty --import Data.List (sort) import Control.Monad(mplus) --import Debug.Trace --import System.Random (newStdGen) ---- -type PGFEnv = (Maybe C.PGF, Map.Map C.ConcName C.Concr) +data PGFEnv = Env {pgf::Maybe C.PGF,concs::Map.Map C.ConcName C.Concr} -pgfEnv pgf = (Just pgf,C.languages pgf) :: PGFEnv -emptyPGFEnv = (Nothing,Map.empty) :: PGFEnv +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 !! @@ -1056,7 +1055,7 @@ allCommands = extend commonCommands [ file -> do probs <- restricted $ H.readProbabilitiesFromFile file pgf return (H.setProbabilities probs pgf) --} + optTranslit opts = case (valStrOpts "to" "" opts, valStrOpts "from" "" opts) of ("","") -> return id (file,"") -> do @@ -1065,7 +1064,7 @@ allCommands = extend commonCommands [ (_,file) -> do src <- restricted $ readFile file return $ transliterateWithFile file src True -{- + optFile opts = valStrOpts "file" "_gftmp" opts -} optCat pgf opts = valStrOpts "cat" (C.startCat pgf) opts @@ -1077,9 +1076,9 @@ allCommands = extend commonCommands [ Left tcErr -> error $ render (H.ppTcError tcErr) Right ty -> ty Nothing -> error ("Can't parse '"++str++"' as a type") --} + optComm opts = valStrOpts "command" "" opts -{- + optViewFormat opts = valStrOpts "format" "png" opts optViewGraph opts = valStrOpts "view" "open" opts optNum opts = valIntOpts "number" 1 opts @@ -1206,7 +1205,7 @@ cExpr e = Just (f,es) -> C.mkApp (H.showCId f) (map cExpr es) _ -> error "GF.Command.Commands2.cExpr" -needPGF exec (mb_pgf,cncs) opts ts = +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" diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs index a404e0567..57dfa5f57 100644 --- a/src/compiler/GF/Interactive.hs +++ b/src/compiler/GF/Interactive.hs @@ -5,7 +5,7 @@ import Prelude hiding (putStrLn,print) import qualified Prelude as P(putStrLn) import GF.Command.Interpreter(CommandEnv(..),pgfenv,commands,mkCommandEnv,interpretCommandLine) --import GF.Command.Importing(importSource,importGrammar) -import GF.Command.Commands(flags,options,PGFEnv,pgfEnv,allCommands) +import GF.Command.Commands(flags,options,PGFEnv,pgf,pgfEnv,allCommands) import GF.Command.Abstract import GF.Command.Parse(readCommandLine,pCommand) import GF.Data.Operations (Err(..),chunks,err,raise,done) @@ -415,7 +415,7 @@ emptyGFEnv = GFEnv emptyGrammar False emptyCommandEnv [] {-0-} commandEnv pgf = mkCommandEnv (pgfEnv pgf) allCommands emptyCommandEnv = commandEnv emptyPGF -multigrammar = fst . pgfenv +multigrammar = pgf . pgfenv wordCompletion gfenv (left,right) = do case wc_type (reverse left) of diff --git a/src/compiler/GF/Interactive2.hs b/src/compiler/GF/Interactive2.hs index ac7247a8d..ed850cb2b 100644 --- a/src/compiler/GF/Interactive2.hs +++ b/src/compiler/GF/Interactive2.hs @@ -5,7 +5,7 @@ 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,pgfEnv,emptyPGFEnv,allCommands) +import GF.Command.Commands2(flags,options,PGFEnv,pgf,concs,pgfEnv,emptyPGFEnv,allCommands) import GF.Command.Abstract import GF.Command.Parse(readCommandLine,pCommand) import GF.Data.Operations (Err(..),chunks,err,raise,done) @@ -420,8 +420,8 @@ emptyGFEnv = GFEnv {-() ()-} emptyCommandEnv [] {-0-} commandEnv pgf = mkCommandEnv (pgfEnv pgf) allCommands emptyCommandEnv = mkCommandEnv emptyPGFEnv allCommands -multigrammar = fst . pgfenv -concretes = snd . pgfenv +multigrammar = pgf . pgfenv +concretes = concs . pgfenv wordCompletion gfenv (left,right) = do case wc_type (reverse left) of