diff options
| author | kr.angelov <kr.angelov@chalmers.se> | 2008-05-22 11:59:31 +0000 |
|---|---|---|
| committer | kr.angelov <kr.angelov@chalmers.se> | 2008-05-22 11:59:31 +0000 |
| commit | df0c4f81fa9c620d7c63af79c0b183a6beccf0bd (patch) | |
| tree | 0cdc80b29f8f5df0ad280f17be0ba9d46fbd948c /src-3.0/GF/Shell | |
| parent | 6394f3ccfbb9d14017393b433a38a3921f1083e5 (diff) | |
remove all files that aren't used in GF-3.0
Diffstat (limited to 'src-3.0/GF/Shell')
| -rw-r--r-- | src-3.0/GF/Shell/CommandL.hs | 198 | ||||
| -rw-r--r-- | src-3.0/GF/Shell/Commands.hs | 568 | ||||
| -rw-r--r-- | src-3.0/GF/Shell/HelpFile.hs | 723 | ||||
| -rw-r--r-- | src-3.0/GF/Shell/JGF.hs | 89 | ||||
| -rw-r--r-- | src-3.0/GF/Shell/PShell.hs | 174 | ||||
| -rw-r--r-- | src-3.0/GF/Shell/ShellCommands.hs | 246 | ||||
| -rw-r--r-- | src-3.0/GF/Shell/SubShell.hs | 66 | ||||
| -rw-r--r-- | src-3.0/GF/Shell/TeachYourself.hs | 87 |
8 files changed, 0 insertions, 2151 deletions
diff --git a/src-3.0/GF/Shell/CommandL.hs b/src-3.0/GF/Shell/CommandL.hs deleted file mode 100644 index efb6460b4..000000000 --- a/src-3.0/GF/Shell/CommandL.hs +++ /dev/null @@ -1,198 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : CommandL --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/08/17 15:13:55 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.21 $ --- --- (Description of the module) ------------------------------------------------------------------------------ - -module GF.Shell.CommandL where - -import GF.Data.Operations -import GF.Infra.UseIO - -import GF.Canon.CMacros -import GF.Grammar.Values (Tree) - -import GF.UseGrammar.GetTree -import GF.Compile.ShellState -import GF.Infra.Option -import GF.UseGrammar.Session -import GF.Shell.Commands -import GF.UseGrammar.Tokenize (wordsLits) - -import Data.Char -import Data.List (intersperse) -import Control.Monad (foldM) - -import GF.Text.UTF8 - --- | a line-based shell -initEditLoop :: CEnv -> IO () -> IO () -initEditLoop env resume = do - let env' = startEditEnv env - putStrLnFlush $ initEditMsg env' - let state = initSStateEnv env' - putStrLnFlush $ showCurrentState env' state - editLoop env' state resume - -editLoop :: CEnv -> SState -> IO () -> IO () -editLoop env state resume = do - putStrFlush "edit> " - c <- getCommand - if (isQuit c) then resume else do - (env',state') <- execCommand env c state - let package = case c of - CCEnvEmptyAndImport _ -> initEditMsgEmpty env' - _ -> showCurrentState env' state' - putStrLnFlush package - - editLoop env' state' resume - --- | execute a command script and return a tree -execCommandHistory :: CEnv -> String -> IO (CEnv,Tree) -execCommandHistory env s = do - let env' = startEditEnv env - let state = initSStateEnv env' - (env',state') <- foldM exec (env,state) $ lines s - return $ (env',treeSState state') - - where - - exec (env,state) l = do - let c = pCommand l - execCommand env c state - - - -getCommand :: IO Command -getCommand = do - s <- getLine - return $ pCommand s - --- | decodes UTF8 if u==True, i.e. if the grammar uses UTF8; --- used in the Java GUI, which always uses UTF8 -getCommandUTF :: Bool -> IO [(String,Command)] -getCommandUTF u = do - s <- getLine - return $ pCommandMsgs $ if u then decodeUTF8 s else s - -pCommandMsgs :: String -> [(String,Command)] -pCommandMsgs = map (pCommandMsg . unwords) . concatMap (chunks ";;" . words) . lines - -pCommand :: String -> Command -pCommand = snd . pCommandMsg - - -pCommandMsg :: String -> (String,Command) -pCommandMsg s = (m,pCommandWords $ words c) where - (m,c) = case s of - '[':s2 -> let (a,b) = span (/=']') s2 in (a,drop 1 b) - _ -> ("",s) - pCommandWords s = case s of - "n" : cat : _ -> CNewCat cat - "t" : ws -> CNewTree $ unwords ws - "g" : ws -> CRefineWithTree $ unwords ws -- example: *g*ive - "p" : ws -> CRefineParse $ unwords ws - "rc": i : _ -> CRefineWithClip (readIntArg i) - ">" : i : _ -> CAhead $ readIntArg i - ">" : [] -> CAhead 1 - "<" : i : _ -> CBack $ readIntArg i - "<" : [] -> CBack 1 - ">>" : _ -> CNextMeta - "<<" : _ -> CPrevMeta - "'" : _ -> CTop - "+" : _ -> CLast - "mp" : p -> CMovePosition (readIntList (unwords p)) - "ct" : p:q:_ -> CCopyPosition (readIntList p) (readIntList q) - "r" : f : _ -> CRefineWithAtom f - "w" : f:i : _ -> CWrapWithFun (f, readIntArg i) - "ch": f : _ -> CChangeHead f - "ph": f:i : _ -> CPeelHead (f, readIntArg i) - "x" : ws -> CAlphaConvert $ unwords ws - "s" : i : _ -> CSelectCand (readIntArg i) - "f" : "unstructured" : _ -> CRemoveOption showStruct --- hmmm - "f" : "structured" : _ -> CAddOption showStruct --- hmmm - "f" : s : _ -> CAddOption (filterString s) - "u" : i : _ -> CUndo (readIntArg i) - "u" : _ -> CUndo 1 - "d" : _ -> CDelete - "ac" : _ -> CAddClip - "pc": i : _ -> CRemoveClip (readIntArg i) - "c" : s : _ -> CTermCommand s - "a" : _ -> CRefineRandom --- *a*leatoire - "m" : _ -> CMenu - "ml" : s : _ -> changeMenuLanguage s - "ms" : s : _ -> changeMenuSize s - "mt" : s : _ -> changeMenuTyped s - "v" : _ -> CView - "q" : _ -> CQuit - "h" : _ -> CHelp initEditMsg - - "i" : file: _ -> CCEnvImport file - "e" : [] -> CCEnvEmpty - "e" : file: _ -> CCEnvEmptyAndImport file - - "open" : f: _ -> CCEnvOpenTerm f - "openstring": f: _ -> CCEnvOpenString f - - "on" :lang: _ -> CCEnvOn lang - "off":lang: _ -> CCEnvOff lang - "pfile" :f:_ -> CCEnvRefineParse f - "tfile" :f:_ -> CCEnvRefineWithTree f - "save":l:f:_ -> CCEnvSave l f - --- openstring file --- pfile file --- tfile file --- on lang --- off lang - - "gf": comm -> CCEnvGFShell (unwords comm) - - [] -> CVoid - _ -> CError - --- | well, this lists the commands of the line-based editor -initEditMsg :: CEnv -> String -initEditMsg env = unlines $ - "State-dependent editing commands are given in the menu:" : - " n [Cat] = new, r [Fun] = refine, w [Fun] [Int] = wrap,": - " ch [Fun] = change head, d = delete, s [Int] = select," : - " x [Var] [Var] = alpha convert." : - "Commands changing the environment:" : - " i [file] = import, e = empty." : - "Other commands:" : - " a = random, v = change view, u = undo, h = help, q = quit," : - " ml [Lang] = change menu language," : - " ms (short | long) = change menu command size," : - " mt (typed | untyped) = change menu item typing," : - " p [string] = refine by parsing, g [term] = refine by term," : - " > = down, < = up, ' = top, >> = next meta, << = previous meta." : ----- (" c [" ++ unwords (intersperse "|" allTermCommands) ++ "] = modify term") : ----- (" f [" ++ unwords (intersperse "|" allStringCommands) ++ "] = modify output") : - [] - -initEditMsgEmpty :: CEnv -> String -initEditMsgEmpty env = initEditMsg env +++++ unlines ( - "Start editing by n Cat selecting category\n\n" : - "-------------\n" : - ["n" +++ cat | (_,cat) <- newCatMenu env] - ) - -showCurrentState :: CEnv -> SState -> String -showCurrentState env' state' = - unlines (tr ++ ["",""] ++ msg ++ ["",""] ++ map fst menu) - where (tr,msg,menu) = displaySStateIn env' state' - --- | to read position; borrowed from Prelude; should be elsewhere -readIntList :: String -> [Int] -readIntList s = case [x | (x,t) <- reads s, ("","") <- lex t] of - [x] -> x - _ -> [] diff --git a/src-3.0/GF/Shell/Commands.hs b/src-3.0/GF/Shell/Commands.hs deleted file mode 100644 index 8699c2fe7..000000000 --- a/src-3.0/GF/Shell/Commands.hs +++ /dev/null @@ -1,568 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : Commands --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/10/06 10:02:33 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.42 $ --- --- temporary hacks for GF 2.0 --- --- Abstract command language for syntax editing. AR 22\/8\/2001. --- Most arguments are strings, to make it easier to receive them from e.g. Java. --- See "CommandsL" for a parser of a command language. ------------------------------------------------------------------------------ - -module GF.Shell.Commands where - -import GF.Data.Operations -import GF.Data.Zipper - -import qualified GF.Grammar.Grammar as G ---- Cat, Fun, Q, QC -import GF.Canon.GFC -import GF.Canon.CMacros -import GF.Grammar.Macros (qq)---- -import GF.Grammar.LookAbs -import GF.Canon.Look -import GF.Grammar.Values (loc2treeFocus,tree2exp)---- - -import GF.UseGrammar.GetTree -import GF.API -import GF.Compile.ShellState - -import qualified GF.Shell as Shell -import qualified GF.Shell.PShell as PShell -import qualified GF.Grammar.Macros as M -import GF.Grammar.PrGrammar -import GF.Compile.PGrammar -import GF.API.IOGrammar -import GF.Infra.UseIO -import GF.Text.Unicode - -import GF.CF.CF -import GF.CF.CFIdent (cat2CFCat, cfCat2Cat) -import GF.CF.PPrCF (prCFCat) -import GF.UseGrammar.Linear -import GF.UseGrammar.Randomized -import GF.UseGrammar.Editing -import GF.UseGrammar.Session -import GF.UseGrammar.Custom - -import qualified GF.Infra.Ident as I -import GF.Infra.Option -import GF.Data.Str (sstr) ---- -import GF.Text.UTF8 ---- - -import System.Random (StdGen, mkStdGen, newStdGen) -import Control.Monad (liftM2, foldM) -import Data.List (intersperse) - ---- temporary hacks for GF 2.0 - --- Abstract command language for syntax editing. AR 22/8/2001 --- Most arguments are strings, to make it easier to receive them from e.g. Java. --- See CommandsL for a parser of a command language. - -data Command = - CNewCat String - | CNewTree String - | CAhead Int - | CBack Int - | CNextMeta - | CPrevMeta - | CTop - | CLast - | CMovePosition [Int] - | CCopyPosition [Int] [Int] - | CRefineWithTree String - | CRefineWithClip Int - | CRefineWithAtom String - | CRefineParse String - | CWrapWithFun (String,Int) - | CChangeHead String - | CPeelHead (String,Int) - | CAlphaConvert String - | CRefineRandom - | CSelectCand Int - | CTermCommand String - | CAddOption Option - | CRemoveOption Option - | CDelete - | CAddClip - | CRemoveClip Int - | CUndo Int - | CView - | CMenu - | CQuit - | CHelp (CEnv -> String) -- ^ help message depends on grammar and interface - | CError -- ^ syntax error in command - | CVoid -- ^ empty command, e.g. just \<enter\> - - | CCEnvImport String -- ^ |-- commands affecting 'CEnv' - | CCEnvEmptyAndImport String -- ^ | - | CCEnvOpenTerm String -- ^ | - | CCEnvOpenString String -- ^ | - | CCEnvEmpty -- ^ | - - | CCEnvOn String -- ^ | - | CCEnvOff String -- ^ | - - | CCEnvGFShell String -- ^ |========== - - | CCEnvRefineWithTree String -- ^ |-- other commands using 'IO' - | CCEnvRefineParse String -- ^ | - | CCEnvSave String FilePath -- ^ |========== - -isQuit :: Command -> Bool -isQuit CQuit = True -isQuit _ = False - --- | an abstract environment type -type CEnv = ShellState - -grammarCEnv :: CEnv -> StateGrammar -grammarCEnv = firstStateGrammar - -canCEnv :: CEnv -> CanonGrammar -canCEnv = canModules - -concreteCEnv, abstractCEnv :: StateGrammar -> I.Ident -concreteCEnv = cncId -abstractCEnv = absId - -stdGenCEnv :: CEnv -> SState -> StdGen -stdGenCEnv env s = mkStdGen (length (displayJustStateIn env s) * 31 +11) --- - -initSStateEnv :: CEnv -> SState -initSStateEnv env = case getOptVal (stateOptions sgr) gStartCat of - Just cat -> action2commandNext (newCat gr (abs, I.identC cat)) initSState - _ -> initSState - where - sgr = firstStateGrammar env - abs = absId sgr - gr = stateGrammarST sgr - --- | the main function -execCommand :: CEnv -> Command -> SState -> IO (CEnv,SState) -execCommand env c s = case c of - --- these commands do need IO - CCEnvImport file -> useIOE (env,s) $ do - st <- shellStateFromFiles optss env file - return (st,s) - - CCEnvEmptyAndImport file -> useIOE (emptyShellState, initSState) $ do - st <- shellStateFromFiles optss emptyShellState file - return (startEditEnv st,initSState) - - CCEnvEmpty -> do - return (startEditEnv emptyShellState, initSState) - - CCEnvGFShell command -> do - let hs = Shell.initHState env - let cs = PShell.pCommandLines hs command - (msg,(env',_)) <- Shell.execLines False cs hs - return (env', changeMsg msg s) ---- - - CCEnvOpenTerm file -> do - c <- readFileIf file - let (fs,t) = envAndTerm file c ----- (env',_) <- execCommand env (CCEnvGFShell fs) s --TODO; next deprec ----- env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs - let env' = env ---- - return (env', execECommand env' (CNewTree t) s) - - CCEnvOpenString file -> do - c <- readFileIf file - let (fs,t) = envAndTerm file c ----- (env',_) <- execCommand env (CCEnvGFShell fs) s --TODO; next deprec ----- env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs - let env' = env ---- - return (env', execECommand env' (CRefineParse t) s) - - CCEnvOn name -> return (languageOn (language name) env,s) - CCEnvOff name -> return (languageOff (language name) env,s) - - CCEnvSave lang file -> do - let str = optLinearizeTreeVal opts (stateGrammarOfLang env (language lang)) $ treeSState s - writeFile file str - let msg = ["wrote file" +++ file] - return (env,changeMsg msg s) - --- this command is improved by the use of IO - CRefineRandom -> do - g <- newStdGen - return (env, action2commandNext (refineRandom g 41 cgr) s) - --- these commands use IO - CCEnvRefineWithTree file -> do - str <- readFileIf file - execCommand env (CRefineWithTree str) s - CCEnvRefineParse file -> do - str <- readFileIf file - execCommand env (CRefineParse str) s - --- other commands don't need IO; they are available in the fudget - c -> return (env, execECommand env c s) - - where - gr = grammarCEnv env - cgr = canCEnv env - opts = globalOptions env - optss = addOption beSilent opts - - -- format for documents: - -- GF commands of form "-- command", then term or text - envAndTerm f s = - (unwords (intersperse ";;" fs), unlines ss) where - (fs,ss) = span isImport (lines s) - isImport l = take 2 l == "--" - - -execECommand :: CEnv -> Command -> ECommand -execECommand env c = case c of - CNewCat cat -> action2commandNext $ \x -> do - cat' <- string2cat sgr cat - s' <- newCat cgr cat' x - uniqueRefinements cgr s' - CNewTree s -> action2commandNext $ \x -> do - t <- string2treeErr gr s - s' <- newTree t x - uniqueRefinements cgr s' - CAhead n -> action2command (goAheadN n) - CBack n -> action2command (goBackN n) - CTop -> action2command $ return . goRoot - CLast -> action2command $ goLast - CMovePosition p -> action2command $ goPosition p - CNextMeta -> action2command goNextNewMeta - CPrevMeta -> action2command goPrevNewMeta - CRefineWithAtom s -> action2commandNext $ \x -> do - t <- string2ref gr s - s' <- refineWithAtom der cgr t x - uniqueRefinements cgr s' - CWrapWithFun (f,i) -> action2commandKeep $ wrapWithFun cgr (qualif f, i) - CChangeHead f -> action2commandKeep $ changeFunHead cgr (qualif f) - CPeelHead (f,i) -> action2commandKeep $ peelFunHead cgr (qualif f,i) - - CAlphaConvert s -> action2commandKeep $ \x -> - string2varPair s >>= \xy -> alphaConvert cgr xy x - - CRefineWithTree s -> action2commandNext $ \x -> - (string2treeInState gr s x >>= - \t -> refineWithTree der cgr t x) - CRefineWithClip i -> \s -> - let et = getNumberedClip i s - in (case et of - Ok t -> refineByTrees der cgr [t] s - Bad m -> changeMsg [m] s) - CCopyPosition p q -> action2command $ \s -> do - s1 <- goPosition p s - let t = actTree s1 - s2 <- goPosition q s1 - let compat = actVal s1 == actVal s2 - if compat - then refineWithTree der cgr t s2 - else return s - - CRefineParse str -> \s -> - let cat = cat2CFCat (qualifTop sgr (actCat (stateSState s))) - ts = parseAny agrs cat str - in (if null ts ---- debug - then withMsg ["parse failed in cat" +++ prCFCat cat] - else id) - (refineByTrees der cgr ts) s - - CRefineRandom -> \s -> action2commandNext - (refineRandom (stdGenCEnv env s) 41 cgr) s - - CSelectCand i -> selectCand cgr i - - CTermCommand c -> case c of - "reindex" -> \s -> - replaceByTermCommand der gr c (actTree (stateSState s)) s - "paraphrase" -> \s -> - replaceByTermCommand der gr c (actTree (stateSState s)) s ----- "transfer" -> action2commandNext $ ----- transferSubTree (stateTransferFun sgr) gr - "generate" -> \s -> - replaceByTermCommand der gr c (actTree (stateSState s)) s - _ -> replaceByEditCommand gr c - - CAddOption o -> changeStOptions (addOption o) - CRemoveOption o -> changeStOptions (removeOption o) - CDelete -> action2commandKeep $ deleteSubTree cgr - CAddClip -> \s -> (addtoClip (actTree (stateSState s))) s - CRemoveClip n -> \s -> (removeClip n) s - CUndo n -> undoCommand n - CMenu -> \s -> changeMsg (menuState env s) s - CView -> changeView - CHelp h -> changeMsg [h env] - CVoid -> id - _ -> changeMsg ["command not yet implemented"] - where - sgr = firstStateGrammar env - agrs = allActiveGrammars env - cgr = canCEnv env - gr = grammarCEnv env - der = maybe True not $ caseYesNo (globalOptions env) noDepTypes - -- if there are dep types, then derived refs; deptypes is the default - abs = absId sgr - qualif = string2Fun gr - --- - - -string2varPair :: String -> Err (I.Ident,I.Ident) -string2varPair s = case words s of - x : y : [] -> liftM2 (,) (string2ident x) (string2ident y) - _ -> Bad "expected format 'x y'" - - -startEditEnv :: CEnv -> CEnv -startEditEnv env = addGlobalOptions (options [sizeDisplay "short"]) env - --- | seen on display -cMenuDisplay :: String -> Command -cMenuDisplay s = CAddOption (menuDisplay s) - -newCatMenu :: CEnv -> [(Command, String)] -newCatMenu env = [(CNewCat (prQIdent c), printname env initSState c) | - (c,[]) <- allCatsOf (canCEnv env)] - -mkRefineMenu :: CEnv -> SState -> [(Command,String)] -mkRefineMenu env sstate = [(c,s) | (c,(s,_)) <- mkRefineMenuAll env sstate] - -mkRefineMenuAll :: CEnv -> SState -> [(Command,(String,String))] -mkRefineMenuAll env sstate = - case (refinementsState cgr state, candsSState sstate, wrappingsState cgr state) of - ([],[],wraps) -> - [(CWrapWithFun (prQIdent_ f, i), prWrap "w" "Wrap" fit) - | fit@((f,i),_) <- wraps] ++ - [(CChangeHead (prQIdent_ f), prChangeHead f) - | f <- headChangesState cgr state] ++ - [(CPeelHead (prQIdent_ f, i), prPeel "ph" "PeelHead" fi) - | fi@(f,i) <- peelingsState cgr state] ++ - [(CDelete, (ifShort "d" "Delete", "d"))] ++ - [(CAddClip, (ifShort "ac" "AddClip", "ac"))] - (refs,[],_) -> - [(CRefineWithAtom (prRefinement f), prRef t) | t@(f,_) <- refs] ++ - [(CRefineWithClip i, prClip i t) | (i,t) <- possClipsSState gr sstate] - (_,cands,_) -> - [(CSelectCand i, prCand (t,i)) | (t,i) <- zip cands [0..]] - - where - prRef (f,(t,_)) = - (ifShort "r" "Refine" +++ prOrLinRef f +++ ifTyped (":" +++ prt_ t), - "r" +++ prRefinement f) - prClip i t = - (ifShort "rc" "Paste" +++ prOrLinTree t, - "rc" +++ show i) - prChangeHead f = - (ifShort "ch" "ChangeHead" +++ prOrLinFun f, - "ch" +++ prQIdent_ f) - prWrap sh lg ((f,i),t) = - (ifShort sh lg +++ prOrLinFun f +++ ifTyped (":" +++ prt t) +++ - ifShort (show i) (prBracket (show i)), - sh +++ prQIdent_ f +++ show i) - prPeel sh lg (f,i) = - (ifShort sh lg +++ prOrLinFun f +++ - ifShort (show i) (prBracket (show i)), - sh +++ prQIdent_ f +++ show i) - prCand (t,i) = - (ifShort ("s" +++ prOrLinExp t) ("Select" +++ prOrLinExp t),"s" +++ show i) - - gr = grammarCEnv env - cgr = canCEnv env - state = stateSState sstate - opts = addOptions (optsSState sstate) (globalOptions env) - ifOpt f v a b = case getOptVal opts f of - Just s | s == v -> a - _ -> b - ifShort = ifOpt sizeDisplay "short" - ifTyped t = ifOpt typeDisplay "typed" t "" - prOrLinExp t = err (const $ prt_ t) prOrLinTree $ annotateInState cgr t state - prOrLinRef t = case t of - G.Q m f -> printname env sstate (m,f) - G.QC m f -> printname env sstate (m,f) - _ -> prt_ t - prOrLinFun = printname env sstate - prOrLinTree t = case getOptVal opts menuDisplay of - Just "Abs" -> prt_ $ tree2exp t ---- prTermOpt opts $ tree2exp t - Just lang -> prQuotedString $ lin lang t - _ -> prTermOpt opts $ tree2exp t - lin lang t = optLinearizeTreeVal opts (stateGrammarOfLang env (language lang)) t - --- there are three orthogonal parameters: Abs/[conc], short/long, typed/untyped --- the default is Abs, long, untyped; the Menus menu changes the parameter - -emptyMenuItem :: (Command, (String, String)) -emptyMenuItem = (CVoid,("","")) - - - ----- allStringCommands = snd $ customInfo customStringCommand -termCommandMenu :: [(Command,String)] -termCommandMenu = [(CTermCommand s, s) | s <- allTermCommands] - -allTermCommands :: [String] -allTermCommands = snd $ customInfo customEditCommand - -stringCommandMenu :: [(Command,String)] -stringCommandMenu = [] - -displayCommandMenu :: CEnv -> [(Command,String)] -displayCommandMenu env = - [(CAddOption (menuDisplay s), s) | s <- "Abs" : langs] ++ - [(CAddOption (sizeDisplay s), s) | s <- ["short", "long"]] ++ - [(fo nostripQualif, s) | (fo,s) <- [(CAddOption,"qualified"), - (CRemoveOption,"unqualified")]] ++ - [(CAddOption (typeDisplay s), s) | s <- ["typed", "untyped"]] - where - langs = map prLanguage $ allLanguages env - -{- ---- - -stringCommandMenu = - (CAddOption showStruct, "structured") : - (CRemoveOption showStruct, "unstructured") : - [(CAddOption (filterString s), s) | s <- allStringCommands] --} - -changeMenuLanguage, changeMenuSize, changeMenuTyped :: String -> Command -changeMenuLanguage s = CAddOption (menuDisplay s) -changeMenuSize s = CAddOption (sizeDisplay s) -changeMenuTyped s = CAddOption (typeDisplay s) - -menuState :: CEnv -> SState -> [String] -menuState env = map snd . mkRefineMenu env - -prState :: State -> [String] -prState s = prMarkedTree (loc2treeMarked s) - -displayJustStateIn :: CEnv -> SState -> String -displayJustStateIn env state = case displaySStateIn env state of - (t,msg,_) -> unlines (t ++ ["",""] ++ msg) --- ad hoc for CommandF - -displaySStateIn :: CEnv -> SState -> ([String],[String],[(String,String)]) -displaySStateIn env state = (tree',msg,menu) where - (tree,msg,menu) = displaySState env state - grs = allStateGrammars env - lang = (viewSState state) `mod` (length grs + 3) - tree' = (tree : exp : linAll ++ separ (linAll ++ [tree])) !! lang - opts = addOptions (optsSState state) -- state opts override - (addOption (markLin markOptFocus) (globalOptions env)) - lin g = linearizeState fudWrap opts g zipper - exp = return $ tree2string $ loc2tree zipper - zipper = stateSState state - linAll = map lin grs - separ = singleton . map unlines . intersperse [replicate 72 '*'] - --- | the Boolean is a temporary hack to have two parallel GUIs -displaySStateJavaX :: Bool -> CEnv -> SState -> String -> String -displaySStateJavaX isNew env state m = encodeUTF8 $ mkUnicode $ - unlines $ tagXML "gfedit" $ concat [ - if null m then [] else tagXML "hmsg" [m], - tagXML "linearizations" (concat - [tagAttrXML "lin" ("lang", prLanguage lang) ss | (lang,ss) <- lins]), - tagXML "tree" tree, - tagXML "message" msg, - tagXML "menu" (tagsXML "item" menu') - ] - where - (tree,msg,menu) = displaySState env state - menu' = [tagXML "show" [unicode s] ++ tagXML "send" [c] | (s,c) <- menu] - (ls,grs) = unzip $ lgrs - lgrs = allActiveStateGrammarsWithNames env - lins = (langAbstract, exp) : linAll - opts = addOptions (optsSState state) -- state opts override - (addOption (markLin mark) (globalOptions env)) - lin (n,gr) = (n, map uni $ linearizeState noWrap opts gr zipper) where - uni = optDecodeUTF8 gr - exp = prprTree $ loc2tree zipper - zipper = stateSState state - linAll = map lin lgrs - gr = firstStateGrammar env - mark = markOptXML -- markOptJava - - unicode = case getOptVal opts menuDisplay of - Just lang -> optDecodeUTF8 (stateGrammarOfLang env (language lang)) - _ -> id - --- | the env is UTF8 if the display language is --- --- should be independent -isCEnvUTF8 :: CEnv -> SState -> Bool -isCEnvUTF8 env st = maybe False id $ do - lang <- getOptVal opts menuDisplay - co <- getOptVal (stateOptions (stateGrammarOfLang env (language lang))) uniCoding - return $ co == "utf8" - where - opts = addOptions (optsSState st) (globalOptions env) - -langAbstract, langXML :: I.Ident -langAbstract = language "Abstract" -langXML = language "XML" - -linearizeState :: (String -> [String]) -> Options -> GFGrammar -> State -> [String] -linearizeState wrap opts gr = - wrap . strop . unt . optLinearizeTreeVal opts gr . loc2treeFocus - - where - unt = customOrDefault (stateOptions gr) useUntokenizer customUntokenizer gr - strop = maybe id ($ gr) $ customAsOptVal opts filterString customStringCommand - br = oElem showStruct opts - -noWrap, fudWrap :: String -> [String] -noWrap = lines -fudWrap = lines . wrapLines 0 --- - -displaySState :: CEnv -> SState -> ([String],[String],[(String,String)]) -displaySState env state = - (prState (stateSState state), msgSState state, menuSState env state) - -menuSState :: CEnv -> SState -> [(String,String)] -menuSState env state = if null cs then [("[NO ALTERNATIVE]","")] else cs - where - cs = [(s,c) | (_,(s,c)) <- mkRefineMenuAll env state] - -printname :: CEnv -> SState -> G.Fun -> String -printname env state f = case getOptVal opts menuDisplay of - Just "Abs" -> prQIdent_ f - Just lang -> printn lang f - _ -> prQIdent_ f ---- prTermOpt opts (qq f) - where - opts = addOptions (optsSState state) (globalOptions env) - printn lang f = err id (ifNull (prQIdent_ f) (sstr . head)) $ do - t <- lookupPrintname gr mf - strsFromTerm t - where - sgr = stateGrammarOfLang env (language lang) - gr = grammar sgr - mf = ciq (cncId sgr) (snd f) - --- * XML printing; does not belong here! - -tagsXML :: String -> [[String]] -> [String] -tagsXML t = concatMap (tagXML t) - -tagAttrXML :: String -> (String, String) -> [String] -> [String] -tagAttrXML t av ss = mkTagAttrXML t av : map (indent 2) ss ++ [mkEndTagXML t] - -tagXML :: String -> [String] -> [String] -tagXML t ss = mkTagXML t : map (indent 2) ss ++ [mkEndTagXML t] - -mkTagXML :: String -> String -mkTagXML t = '<':t ++ ">" - -mkEndTagXML :: String -> String -mkEndTagXML t = mkTagXML ('/':t) - -mkTagAttrsXML :: String -> [(String, String)] -> String -mkTagAttrsXML t avs = '<':t +++ unwords [a++"="++v | (a,v) <- avs] ++">" - -mkTagAttrXML :: String -> (String, String) -> String -mkTagAttrXML t av = mkTagAttrsXML t [av] - diff --git a/src-3.0/GF/Shell/HelpFile.hs b/src-3.0/GF/Shell/HelpFile.hs deleted file mode 100644 index 43fae7c42..000000000 --- a/src-3.0/GF/Shell/HelpFile.hs +++ /dev/null @@ -1,723 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.Shell.HelpFile --- Maintainer : Aarne Ranta --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/12 10:03:34 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.9 $ --- --- Help on shell commands. Generated from HelpFile by 'make help'. --- PLEASE DON'T EDIT THIS FILE. ------------------------------------------------------------------------------ - - -module GF.Shell.HelpFile where - -import GF.Data.Operations - -txtHelpFileSummary = - unlines $ map (concat . take 1 . lines) $ paragraphs txtHelpFile - -txtHelpCommand c = - case lookup c [(takeWhile (/=',') p,p) | p <- paragraphs txtHelpFile] of - Just s -> s - _ -> "Command not found." - -txtHelpFile = - "\n-- GF help file updated for GF 2.6, 17/6/2006." ++ - "\n-- *: Commands and options marked with * are currently not implemented." ++ - "\n--" ++ - "\n-- Each command has a long and a short name, options, and zero or more" ++ - "\n-- arguments. Commands are sorted by functionality. The short name is" ++ - "\n-- given first." ++ - "\n" ++ - "\n-- Type \"h -all\" for full help file, \"h <CommandName>\" for full help on a command. " ++ - "\n" ++ - "\n-- commands that change the state" ++ - "\n" ++ - "\ni, import: i File" ++ - "\n Reads a grammar from File and compiles it into a GF runtime grammar." ++ - "\n Files \"include\"d in File are read recursively, nubbing repetitions." ++ - "\n If a grammar with the same language name is already in the state," ++ - "\n it is overwritten - but only if compilation succeeds. " ++ - "\n The grammar parser depends on the file name suffix:" ++ - "\n .gf normal GF source" ++ - "\n .gfc canonical GF" ++ - "\n .gfr precompiled GF resource " ++ - "\n .gfcm multilingual canonical GF" ++ - "\n .gfe example-based grammar files (only with the -ex option)" ++ - "\n .gfwl multilingual word list (preprocessed to abs + cncs)" ++ - "\n .ebnf Extended BNF format" ++ - "\n .cf Context-free (BNF) format" ++ - "\n .trc TransferCore format" ++ - "\n options:" ++ - "\n -old old: parse in GF<2.0 format (not necessary)" ++ - "\n -v verbose: give lots of messages " ++ - "\n -s silent: don't give error messages" ++ - "\n -src from source: ignore precompiled gfc and gfr files" ++ - "\n -gfc from gfc: use compiled modules whenever they exist" ++ - "\n -retain retain operations: read resource modules (needed in comm cc) " ++ - "\n -nocf don't build old-style context-free grammar (default without HOAS)" ++ - "\n -docf do build old-style context-free grammar (default with HOAS)" ++ - "\n -nocheckcirc don't eliminate circular rules from CF " ++ - "\n -cflexer build an optimized parser with separate lexer trie" ++ - "\n -noemit do not emit code (default with old grammar format)" ++ - "\n -o do emit code (default with new grammar format)" ++ - "\n -ex preprocess .gfe files if needed" ++ - "\n -prob read probabilities from top grammar file (format --# prob Fun Double)" ++ - "\n -treebank read a treebank file to memory (xml format)" ++ - "\n flags:" ++ - "\n -abs set the name used for abstract syntax (with -old option)" ++ - "\n -cnc set the name used for concrete syntax (with -old option)" ++ - "\n -res set the name used for resource (with -old option)" ++ - "\n -path use the (colon-separated) search path to find modules" ++ - "\n -optimize select an optimization to override file-defined flags" ++ - "\n -conversion select parsing method (values strict|nondet)" ++ - "\n -probs read probabilities from file (format (--# prob) Fun Double)" ++ - "\n -preproc use a preprocessor on each source file" ++ - "\n -noparse read nonparsable functions from file (format --# noparse Funs) " ++ - "\n examples:" ++ - "\n i English.gf -- ordinary import of Concrete" ++ - "\n i -retain german/ParadigmsGer.gf -- import of Resource to test" ++ - "\n" ++ - "\nr, reload: r" ++ - "\n Executes the previous import (i) command." ++ - "\n " ++ - "\nrl, remove_language: rl Language" ++ - "\n Takes away the language from the state." ++ - "\n" ++ - "\ne, empty: e" ++ - "\n Takes away all languages and resets all global flags." ++ - "\n" ++ - "\nsf, set_flags: sf Flag*" ++ - "\n The values of the Flags are set for Language. If no language" ++ - "\n is specified, the flags are set globally." ++ - "\n examples:" ++ - "\n sf -nocpu -- stop showing CPU time" ++ - "\n sf -lang=Swe -- make Swe the default concrete" ++ - "\n" ++ - "\ns, strip: s" ++ - "\n Prune the state by removing source and resource modules." ++ - "\n" ++ - "\ndc, define_command Name Anything" ++ - "\n Add a new defined command. The Name must star with '%'. Later," ++ - "\n if 'Name X' is used, it is replaced by Anything where #1 is replaced" ++ - "\n by X. " ++ - "\n Restrictions: Currently at most one argument is possible, and a defined" ++ - "\n command cannot appear in a pipe. " ++ - "\n To see what definitions are in scope, use help -defs." ++ - "\n examples:" ++ - "\n dc %tnp p -cat=NP -lang=Eng #1 | l -lang=Swe -- translate NPs" ++ - "\n %tnp \"this man\" -- translate and parse" ++ - "\n" ++ - "\ndt, define_term Name Tree" ++ - "\n Add a constant for a tree. The constant can later be called by" ++ - "\n prefixing it with '$'. " ++ - "\n Restriction: These terms are not yet usable as a subterm. " ++ - "\n To see what definitions are in scope, use help -defs." ++ - "\n examples:" ++ - "\n p -cat=NP \"this man\" | dt tm -- define tm as parse result" ++ - "\n l -all $tm -- linearize tm in all forms" ++ - "\n" ++ - "\n-- commands that give information about the state" ++ - "\n" ++ - "\npg, print_grammar: pg" ++ - "\n Prints the actual grammar (overridden by the -lang=X flag)." ++ - "\n The -printer=X flag sets the format in which the grammar is" ++ - "\n written." ++ - "\n N.B. since grammars are compiled when imported, this command" ++ - "\n generally does not show the grammar in the same format as the" ++ - "\n source. In particular, the -printer=latex is not supported. " ++ - "\n Use the command tg -printer=latex File to print the source " ++ - "\n grammar in LaTeX." ++ - "\n options:" ++ - "\n -utf8 apply UTF8-encoding to the grammar" ++ - "\n flags: " ++ - "\n -printer" ++ - "\n -lang" ++ - "\n -startcat -- The start category of the generated grammar." ++ - "\n Only supported by some grammar printers." ++ - "\n examples:" ++ - "\n pg -printer=cf -- show the context-free skeleton" ++ - "\n" ++ - "\npm, print_multigrammar: pm" ++ - "\n Prints the current multilingual grammar in .gfcm form." ++ - "\n (Automatically executes the strip command (s) before doing this.)" ++ - "\n options:" ++ - "\n -utf8 apply UTF8 encoding to the tokens in the grammar" ++ - "\n -utf8id apply UTF8 encoding to the identifiers in the grammar" ++ - "\n examples:" ++ - "\n pm | wf Letter.gfcm -- print the grammar into the file Letter.gfcm" ++ - "\n pm -printer=graph | wf D.dot -- then do 'dot -Tps D.dot > D.ps'" ++ - "\n" ++ - "\nvg, visualize_graph: vg" ++ - "\n Show the dependency graph of multilingual grammar via dot and gv." ++ - "\n" ++ - "\npo, print_options: po" ++ - "\n Print what modules there are in the state. Also" ++ - "\n prints those flag values in the current state that differ from defaults." ++ - "\n" ++ - "\npl, print_languages: pl" ++ - "\n Prints the names of currently available languages." ++ - "\n" ++ - "\npi, print_info: pi Ident" ++ - "\n Prints information on the identifier." ++ - "\n" ++ - "\n-- commands that execute and show the session history" ++ - "\n" ++ - "\neh, execute_history: eh File" ++ - "\n Executes commands in the file." ++ - "\n" ++ - "\nph, print_history; ph" ++ - "\n Prints the commands issued during the GF session." ++ - "\n The result is readable by the eh command." ++ - "\n examples:" ++ - "\n ph | wf foo.hist\" -- save the history into a file" ++ - "\n" ++ - "\n-- linearization, parsing, translation, and computation" ++ - "\n" ++ - "\nl, linearize: l PattList? Tree" ++ - "\n Shows all linearization forms of Tree by the actual grammar" ++ - "\n (which is overridden by the -lang flag). " ++ - "\n The pattern list has the form [P, ... ,Q] where P,...,Q follow GF " ++ - "\n syntax for patterns. All those forms are generated that match with the" ++ - "\n pattern list. Too short lists are filled with variables in the end." ++ - "\n Only the -table flag is available if a pattern list is specified." ++ - "\n HINT: see GF language specification for the syntax of Pattern and Term." ++ - "\n You can also copy and past parsing results." ++ - "\n options: " ++ - "\n -struct bracketed form" ++ - "\n -table show parameters (not compatible with -record, -all)" ++ - "\n -record record, i.e. explicit GF concrete syntax term (not compatible with -table, -all)" ++ - "\n -all show all forms and variants (not compatible with -record, -table)" ++ - "\n -multi linearize to all languages (can be combined with the other options)" ++ - "\n flags:" ++ - "\n -lang linearize in this grammar" ++ - "\n -number give this number of forms at most" ++ - "\n -unlexer filter output through unlexer" ++ - "\n examples:" ++ - "\n l -lang=Swe -table -- show full inflection table in Swe" ++ - "\n" ++ - "\np, parse: p String" ++ - "\n Shows all Trees returned for String by the actual" ++ - "\n grammar (overridden by the -lang flag), in the category S (overridden" ++ - "\n by the -cat flag)." ++ - "\n options for batch input:" ++ - "\n -lines parse each line of input separately, ignoring empty lines" ++ - "\n -all as -lines, but also parse empty lines" ++ - "\n -prob rank results by probability" ++ - "\n -cut stop after first lexing result leading to parser success" ++ - "\n -fail show strings whose parse fails prefixed by #FAIL" ++ - "\n -ambiguous show strings that have more than one parse prefixed by #AMBIGUOUS" ++ - "\n options for selecting parsing method:" ++ - "\n -fcfg parse using a fast variant of MCFG (default is no HOAS in grammar)" ++ - "\n -old parse using an overgenerating CFG (default if HOAS in grammar)" ++ - "\n -cfg parse using a much less overgenerating CFG" ++ - "\n -mcfg parse using an even less overgenerating MCFG" ++ - "\n Note: the first time parsing with -cfg, -mcfg, and -fcfg may take a long time" ++ - "\n options that only work for the -old default parsing method:" ++ - "\n -n non-strict: tolerates morphological errors" ++ - "\n -ign ignore unknown words when parsing" ++ - "\n -raw return context-free terms in raw form" ++ - "\n -v verbose: give more information if parsing fails" ++ - "\n flags:" ++ - "\n -cat parse in this category" ++ - "\n -lang parse in this grammar" ++ - "\n -lexer filter input through this lexer" ++ - "\n -parser use this parsing strategy" ++ - "\n -number return this many results at most" ++ - "\n examples:" ++ - "\n p -cat=S -mcfg \"jag \228r gammal\" -- parse an S with the MCFG" ++ - "\n rf examples.txt | p -lines -- parse each non-empty line of the file" ++ - "\n" ++ - "\nat, apply_transfer: at (Module.Fun | Fun)" ++ - "\n Transfer a term using Fun from Module, or the topmost transfer" ++ - "\n module. Transfer modules are given in the .trc format. They are" ++ - "\n shown by the 'po' command." ++ - "\n flags:" ++ - "\n -lang typecheck the result in this lang instead of default lang" ++ - "\n examples:" ++ - "\n p -lang=Cncdecimal \"123\" | at num2bin | l -- convert dec to bin" ++ - "\n" ++ - "\ntb, tree_bank: tb" ++ - "\n Generate a multilingual treebank from a list of trees (default) or compare" ++ - "\n to an existing treebank." ++ - "\n options:" ++ - "\n -c compare to existing xml-formatted treebank" ++ - "\n -trees return the trees of the treebank" ++ - "\n -all show all linearization alternatives (branches and variants)" ++ - "\n -table show tables of linearizations with parameters" ++ - "\n -record show linearization records" ++ - "\n -xml wrap the treebank (or comparison results) with XML tags" ++ - "\n -mem write the treebank in memory instead of a file TODO" ++ - "\n examples:" ++ - "\n gr -cat=S -number=100 | tb -xml | wf tb.xml -- random treebank into file" ++ - "\n rf tb.xml | tb -c -- compare-test treebank from file" ++ - "\n rf old.xml | tb -trees | tb -xml -- create new treebank from old" ++ - "\n" ++ - "\nut, use_treebank: ut String" ++ - "\n Lookup a string in a treebank and return the resulting trees." ++ - "\n Use 'tb' to create a treebank and 'i -treebank' to read one from" ++ - "\n a file." ++ - "\n options:" ++ - "\n -assocs show all string-trees associations in the treebank" ++ - "\n -strings show all strings in the treebank" ++ - "\n -trees show all trees in the treebank" ++ - "\n -raw return the lookup result as string, without typechecking it" ++ - "\n flags:" ++ - "\n -treebank use this treebank (instead of the latest introduced one)" ++ - "\n examples:" ++ - "\n ut \"He adds this to that\" | l -multi -- use treebank lookup as parser in translation" ++ - "\n ut -assocs | grep \"ComplV2\" -- show all associations with ComplV2" ++ - "\n" ++ - "\ntt, test_tokenizer: tt String" ++ - "\n Show the token list sent to the parser when String is parsed." ++ - "\n HINT: can be useful when debugging the parser." ++ - "\n flags: " ++ - "\n -lexer use this lexer" ++ - "\n examples:" ++ - "\n tt -lexer=codelit \"2*(x + 3)\" -- a favourite lexer for program code" ++ - "\n" ++ - "\ng, grep: g String1 String2" ++ - "\n Grep the String1 in the String2. String2 is read line by line," ++ - "\n and only those lines that contain String1 are returned." ++ - "\n flags:" ++ - "\n -v return those lines that do not contain String1." ++ - "\n examples:" ++ - "\n pg -printer=cf | grep \"mother\" -- show cf rules with word mother" ++ - "\n" ++ - "\ncc, compute_concrete: cc Term" ++ - "\n Compute a term by concrete syntax definitions. Uses the topmost" ++ - "\n resource module (the last in listing by command po) to resolve " ++ - "\n constant names. " ++ - "\n N.B. You need the flag -retain when importing the grammar, if you want " ++ - "\n the oper definitions to be retained after compilation; otherwise this" ++ - "\n command does not expand oper constants." ++ - "\n N.B.' The resulting Term is not a term in the sense of abstract syntax," ++ - "\n and hence not a valid input to a Tree-demanding command." ++ - "\n flags:" ++ - "\n -table show output in a similar readable format as 'l -table'" ++ - "\n -res use another module than the topmost one" ++ - "\n examples:" ++ - "\n cc -res=ParadigmsFin (nLukko \"hyppy\") -- inflect \"hyppy\" with nLukko" ++ - "\n" ++ - "\nso, show_operations: so Type" ++ - "\n Show oper operations with the given value type. Uses the topmost " ++ - "\n resource module to resolve constant names. " ++ - "\n N.B. You need the flag -retain when importing the grammar, if you want " ++ - "\n the oper definitions to be retained after compilation; otherwise this" ++ - "\n command does not find any oper constants." ++ - "\n N.B.' The value type may not be defined in a supermodule of the" ++ - "\n topmost resource. In that case, use appropriate qualified name." ++ - "\n flags:" ++ - "\n -res use another module than the topmost one" ++ - "\n examples:" ++ - "\n so -res=ParadigmsFin ResourceFin.N -- show N-paradigms in ParadigmsFin" ++ - "\n" ++ - "\nt, translate: t Lang Lang String" ++ - "\n Parses String in Lang1 and linearizes the resulting Trees in Lang2." ++ - "\n flags:" ++ - "\n -cat" ++ - "\n -lexer" ++ - "\n -parser" ++ - "\n examples:" ++ - "\n t Eng Swe -cat=S \"every number is even or odd\"" ++ - "\n" ++ - "\ngr, generate_random: gr Tree?" ++ - "\n Generates a random Tree of a given category. If a Tree" ++ - "\n argument is given, the command completes the Tree with values to" ++ - "\n the metavariables in the tree. " ++ - "\n options:" ++ - "\n -prob use probabilities (works for nondep types only)" ++ - "\n -cf use a very fast method (works for nondep types only)" ++ - "\n flags:" ++ - "\n -cat generate in this category" ++ - "\n -lang use the abstract syntax of this grammar" ++ - "\n -number generate this number of trees (not impl. with Tree argument)" ++ - "\n -depth use this number of search steps at most" ++ - "\n examples:" ++ - "\n gr -cat=Query -- generate in category Query" ++ - "\n gr (PredVP ? (NegVG ?)) -- generate a random tree of this form" ++ - "\n gr -cat=S -tr | l -- gererate and linearize" ++ - "\n" ++ - "\ngt, generate_trees: gt Tree?" ++ - "\n Generates all trees up to a given depth. If the depth is large," ++ - "\n a small -alts is recommended. If a Tree argument is given, the" ++ - "\n command completes the Tree with values to the metavariables in" ++ - "\n the tree." ++ - "\n options:" ++ - "\n -metas also return trees that include metavariables" ++ - "\n -all generate all (can be infinitely many, lazily)" ++ - "\n -lin linearize result of -all (otherwise, use pipe to linearize)" ++ - "\n flags:" ++ - "\n -depth generate to this depth (default 3)" ++ - "\n -atoms take this number of atomic rules of each category (default unlimited)" ++ - "\n -alts take this number of alternatives at each branch (default unlimited)" ++ - "\n -cat generate in this category" ++ - "\n -nonub don't remove duplicates (faster, not effective with -mem)" ++ - "\n -mem use a memorizing algorithm (often faster, usually more memory-consuming)" ++ - "\n -lang use the abstract syntax of this grammar" ++ - "\n -number generate (at most) this number of trees (also works with -all)" ++ - "\n -noexpand don't expand these categories (comma-separated, e.g. -noexpand=V,CN)" ++ - "\n -doexpand only expand these categories (comma-separated, e.g. -doexpand=V,CN)" ++ - "\n examples:" ++ - "\n gt -depth=10 -cat=NP -- generate all NP's to depth 10 " ++ - "\n gt (PredVP ? (NegVG ?)) -- generate all trees of this form" ++ - "\n gt -cat=S -tr | l -- generate and linearize" ++ - "\n gt -noexpand=NP | l -mark=metacat -- the only NP is meta, linearized \"?0 +NP\"" ++ - "\n gt | l | p -lines -ambiguous | grep \"#AMBIGUOUS\" -- show ambiguous strings" ++ - "\n" ++ - "\nma, morphologically_analyse: ma String" ++ - "\n Runs morphological analysis on each word in String and displays" ++ - "\n the results line by line." ++ - "\n options:" ++ - "\n -short show analyses in bracketed words, instead of separate lines" ++ - "\n -status show just the work at success, prefixed with \"*\" at failure" ++ - "\n flags:" ++ - "\n -lang" ++ - "\n examples:" ++ - "\n wf Bible.txt | ma -short | wf Bible.tagged -- analyse the Bible" ++ - "\n" ++ - "\n" ++ - "\n-- elementary generation of Strings and Trees" ++ - "\n" ++ - "\nps, put_string: ps String" ++ - "\n Returns its argument String, like Unix echo." ++ - "\n HINT. The strength of ps comes from the possibility to receive the " ++ - "\n argument from a pipeline, and altering it by the -filter flag." ++ - "\n flags:" ++ - "\n -filter filter the result through this string processor " ++ - "\n -length cut the string after this number of characters" ++ - "\n examples:" ++ - "\n gr -cat=Letter | l | ps -filter=text -- random letter as text" ++ - "\n" ++ - "\npt, put_tree: pt Tree" ++ - "\n Returns its argument Tree, like a specialized Unix echo." ++ - "\n HINT. The strength of pt comes from the possibility to receive " ++ - "\n the argument from a pipeline, and altering it by the -transform flag." ++ - "\n flags:" ++ - "\n -transform transform the result by this term processor" ++ - "\n -number generate this number of terms at most" ++ - "\n examples:" ++ - "\n p \"zero is even\" | pt -transform=solve -- solve ?'s in parse result" ++ - "\n" ++ - "\n* st, show_tree: st Tree" ++ - "\n Prints the tree as a string. Unlike pt, this command cannot be" ++ - "\n used in a pipe to produce a tree, since its output is a string." ++ - "\n flags:" ++ - "\n -printer show the tree in a special format (-printer=xml supported)" ++ - "\n" ++ - "\nwt, wrap_tree: wt Fun" ++ - "\n Wraps the tree as the sole argument of Fun." ++ - "\n flags:" ++ - "\n -c compute the resulting new tree to normal form" ++ - "\n" ++ - "\nvt, visualize_tree: vt Tree" ++ - "\n Shows the abstract syntax tree via dot and gv (via temporary files" ++ - "\n grphtmp.dot, grphtmp.ps)." ++ - "\n flags:" ++ - "\n -c show categories only (no functions)" ++ - "\n -f show functions only (no categories)" ++ - "\n -g show as graph (sharing uses of the same function)" ++ - "\n -o just generate the .dot file" ++ - "\n examples:" ++ - "\n p \"hello world\" | vt -o | wf my.dot ;; ! open -a GraphViz my.dot" ++ - "\n -- This writes the parse tree into my.dot and opens the .dot file" ++ - "\n -- with another application without generating .ps." ++ - "\n" ++ - "\n-- subshells" ++ - "\n" ++ - "\nes, editing_session: es" ++ - "\n Opens an interactive editing session." ++ - "\n N.B. Exit from a Fudget session is to the Unix shell, not to GF. " ++ - "\n options:" ++ - "\n -f Fudget GUI (necessary for Unicode; only available in X Window System)" ++ - "\n" ++ - "\nts, translation_session: ts" ++ - "\n Translates input lines from any of the actual languages to all other ones." ++ - "\n To exit, type a full stop (.) alone on a line." ++ - "\n N.B. Exit from a Fudget session is to the Unix shell, not to GF. " ++ - "\n HINT: Set -parser and -lexer locally in each grammar." ++ - "\n options:" ++ - "\n -f Fudget GUI (necessary for Unicode; only available in X Windows)" ++ - "\n -lang prepend translation results with language names" ++ - "\n flags:" ++ - "\n -cat the parser category" ++ - "\n examples:" ++ - "\n ts -cat=Numeral -lang -- translate numerals, show language names" ++ - "\n" ++ - "\ntq, translation_quiz: tq Lang Lang" ++ - "\n Random-generates translation exercises from Lang1 to Lang2," ++ - "\n keeping score of success." ++ - "\n To interrupt, type a full stop (.) alone on a line." ++ - "\n HINT: Set -parser and -lexer locally in each grammar." ++ - "\n flags:" ++ - "\n -cat" ++ - "\n examples:" ++ - "\n tq -cat=NP TestResourceEng TestResourceSwe -- quiz for NPs" ++ - "\n" ++ - "\ntl, translation_list: tl Lang Lang" ++ - "\n Random-generates a list of ten translation exercises from Lang1" ++ - "\n to Lang2. The number can be changed by a flag." ++ - "\n HINT: use wf to save the exercises in a file." ++ - "\n flags:" ++ - "\n -cat" ++ - "\n -number" ++ - "\n examples:" ++ - "\n tl -cat=NP TestResourceEng TestResourceSwe -- quiz list for NPs" ++ - "\n" ++ - "\nmq, morphology_quiz: mq" ++ - "\n Random-generates morphological exercises," ++ - "\n keeping score of success." ++ - "\n To interrupt, type a full stop (.) alone on a line." ++ - "\n HINT: use printname judgements in your grammar to" ++ - "\n produce nice expressions for desired forms." ++ - "\n flags:" ++ - "\n -cat" ++ - "\n -lang" ++ - "\n examples:" ++ - "\n mq -cat=N -lang=TestResourceSwe -- quiz for Swedish nouns" ++ - "\n" ++ - "\nml, morphology_list: ml" ++ - "\n Random-generates a list of ten morphological exercises," ++ - "\n keeping score of success. The number can be changed with a flag." ++ - "\n HINT: use wf to save the exercises in a file." ++ - "\n flags:" ++ - "\n -cat" ++ - "\n -lang" ++ - "\n -number" ++ - "\n examples:" ++ - "\n ml -cat=N -lang=TestResourceSwe -- quiz list for Swedish nouns" ++ - "\n" ++ - "\n" ++ - "\n-- IO related commands" ++ - "\n" ++ - "\nrf, read_file: rf File" ++ - "\n Returns the contents of File as a String; error if File does not exist." ++ - "\n" ++ - "\nwf, write_file: wf File String" ++ - "\n Writes String into File; File is created if it does not exist." ++ - "\n N.B. the command overwrites File without a warning." ++ - "\n" ++ - "\naf, append_file: af File" ++ - "\n Writes String into the end of File; File is created if it does not exist." ++ - "\n" ++ - "\n* tg, transform_grammar: tg File" ++ - "\n Reads File, parses as a grammar, " ++ - "\n but instead of compiling further, prints it. " ++ - "\n The environment is not changed. When parsing the grammar, the same file" ++ - "\n name suffixes are supported as in the i command." ++ - "\n HINT: use this command to print the grammar in " ++ - "\n another format (the -printer flag); pipe it to wf to save this format." ++ - "\n flags:" ++ - "\n -printer (only -printer=latex supported currently)" ++ - "\n" ++ - "\n* cl, convert_latex: cl File" ++ - "\n Reads File, which is expected to be in LaTeX form." ++ - "\n Three environments are treated in special ways:" ++ - "\n \\begGF - \\end{verbatim}, which contains GF judgements," ++ - "\n \\begTGF - \\end{verbatim}, which contains a GF expression (displayed)" ++ - "\n \\begInTGF - \\end{verbatim}, which contains a GF expressions (inlined)." ++ - "\n Moreover, certain macros should be included in the file; you can" ++ - "\n get those macros by applying 'tg -printer=latex foo.gf' to any grammar" ++ - "\n foo.gf. Notice that the same File can be imported as a GF grammar," ++ - "\n consisting of all the judgements in \\begGF environments." ++ - "\n HINT: pipe with 'wf Foo.tex' to generate a new Latex file." ++ - "\n" ++ - "\nsa, speak_aloud: sa String" ++ - "\n Uses the Flite speech generator to produce speech for String." ++ - "\n Works for American English spelling. " ++ - "\n examples:" ++ - "\n h | sa -- listen to the list of commands" ++ - "\n gr -cat=S | l | sa -- generate a random sentence and speak it aloud" ++ - "\n" ++ - "\nsi, speech_input: si" ++ - "\n Uses an ATK speech recognizer to get speech input. " ++ - "\n flags:" ++ - "\n -lang: The grammar to use with the speech recognizer." ++ - "\n -cat: The grammar category to get input in." ++ - "\n -language: Use acoustic model and dictionary for this language." ++ - "\n -number: The number of utterances to recognize." ++ - "\n" ++ - "\nh, help: h Command?" ++ - "\n Displays the paragraph concerning the command from this help file." ++ - "\n Without the argument, shows the first lines of all paragraphs." ++ - "\n options" ++ - "\n -all show the whole help file" ++ - "\n -defs show user-defined commands and terms" ++ - "\n -FLAG show the values of FLAG (works for grammar-independent flags)" ++ - "\n examples:" ++ - "\n h print_grammar -- show all information on the pg command" ++ - "\n" ++ - "\nq, quit: q" ++ - "\n Exits GF." ++ - "\n HINT: you can use 'ph | wf history' to save your session." ++ - "\n" ++ - "\n!, system_command: ! String" ++ - "\n Issues a system command. No value is returned to GF." ++ - "\n example:" ++ - "\n ! ls" ++ - "\n" ++ - "\n?, system_command: ? String" ++ - "\n Issues a system command that receives its arguments from GF pipe" ++ - "\n and returns a value to GF." ++ - "\n example:" ++ - "\n h | ? 'wc -l' | p -cat=Num" ++ - "\n" ++ - "\n" ++ - "\n-- Flags. The availability of flags is defined separately for each command." ++ - "\n" ++ - "\n-cat, category in which parsing is performed." ++ - "\n The default is S." ++ - "\n" ++ - "\n-depth, the search depth in e.g. random generation." ++ - "\n The default depends on application." ++ - "\n" ++ - "\n-filter, operation performed on a string. The default is identity." ++ - "\n -filter=identity no change" ++ - "\n -filter=erase erase the text" ++ - "\n -filter=take100 show the first 100 characters" ++ - "\n -filter=length show the length of the string" ++ - "\n -filter=text format as text (punctuation, capitalization)" ++ - "\n -filter=code format as code (spacing, indentation)" ++ - "\n" ++ - "\n-lang, grammar used when executing a grammar-dependent command." ++ - "\n The default is the last-imported grammar." ++ - "\n" ++ - "\n-language, voice used by Festival as its --language flag in the sa command. " ++ - "\n The default is system-dependent. " ++ - "\n" ++ - "\n-length, the maximum number of characters shown of a string. " ++ - "\n The default is unlimited." ++ - "\n" ++ - "\n-lexer, tokenization transforming a string into lexical units for a parser." ++ - "\n The default is words." ++ - "\n -lexer=words tokens are separated by spaces or newlines" ++ - "\n -lexer=literals like words, but GF integer and string literals recognized" ++ - "\n -lexer=vars like words, but \"x\",\"x_...\",\"$...$\" as vars, \"?...\" as meta" ++ - "\n -lexer=chars each character is a token" ++ - "\n -lexer=code use Haskell's lex" ++ - "\n -lexer=codevars like code, but treat unknown words as variables, ?? as meta " ++ - "\n -lexer=textvars like text, but treat unknown words as variables, ?? as meta " ++ - "\n -lexer=text with conventions on punctuation and capital letters" ++ - "\n -lexer=codelit like code, but treat unknown words as string literals" ++ - "\n -lexer=textlit like text, but treat unknown words as string literals" ++ - "\n -lexer=codeC use a C-like lexer" ++ - "\n -lexer=ignore like literals, but ignore unknown words" ++ - "\n -lexer=subseqs like ignore, but then try all subsequences from longest" ++ - "\n" ++ - "\n-number, the maximum number of generated items in a list. " ++ - "\n The default is unlimited." ++ - "\n" ++ - "\n-optimize, optimization on generated code." ++ - "\n The default is share for concrete, none for resource modules." ++ - "\n Each of the flags can have the suffix _subs, which performs" ++ - "\n common subexpression elimination after the main optimization." ++ - "\n Thus, -optimize=all_subs is the most aggressive one. The _subs" ++ - "\n strategy only works in GFC, and applies therefore in concrete but" ++ - "\n not in resource modules." ++ - "\n -optimize=share share common branches in tables" ++ - "\n -optimize=parametrize first try parametrize then do share with the rest" ++ - "\n -optimize=values represent tables as courses-of-values" ++ - "\n -optimize=all first try parametrize then do values with the rest" ++ - "\n -optimize=none no optimization" ++ - "\n" ++ - "\n-parser, parsing strategy. The default is chart. If -cfg or -mcfg are" ++ - "\n selected, only bottomup and topdown are recognized." ++ - "\n -parser=chart bottom-up chart parsing" ++ - "\n -parser=bottomup a more up to date bottom-up strategy" ++ - "\n -parser=topdown top-down strategy" ++ - "\n -parser=old an old bottom-up chart parser" ++ - "\n" ++ - "\n-printer, format in which the grammar is printed. The default is" ++ - "\n gfc. Those marked with M are (only) available for pm, the rest" ++ - "\n for pg." ++ - "\n -printer=gfc GFC grammar" ++ - "\n -printer=gf GF grammar" ++ - "\n -printer=old old GF grammar" ++ - "\n -printer=cf context-free grammar, with profiles" ++ - "\n -printer=bnf context-free grammar, without profiles" ++ - "\n -printer=lbnf labelled context-free grammar for BNF Converter" ++ - "\n -printer=plbnf grammar for BNF Converter, with precedence levels" ++ - "\n *-printer=happy source file for Happy parser generator (use lbnf!)" ++ - "\n -printer=haskell abstract syntax in Haskell, with transl to/from GF" ++ - "\n -printer=haskell_gadt abstract syntax GADT in Haskell, with transl to/from GF" ++ - "\n -printer=morpho full-form lexicon, long format" ++ - "\n *-printer=latex LaTeX file (for the tg command)" ++ - "\n -printer=fullform full-form lexicon, short format" ++ - "\n *-printer=xml XML: DTD for the pg command, object for st" ++ - "\n -printer=old old GF: file readable by GF 1.2" ++ - "\n -printer=stat show some statistics of generated GFC" ++ - "\n -printer=probs show probabilities of all functions" ++ - "\n -printer=gsl Nuance GSL speech recognition grammar" ++ - "\n -printer=jsgf Java Speech Grammar Format" ++ - "\n -printer=jsgf_sisr_old Java Speech Grammar Format with semantic tags in " ++ - "\n SISR WD 20030401 format" ++ - "\n -printer=srgs_abnf SRGS ABNF format" ++ - "\n -printer=srgs_abnf_non_rec SRGS ABNF format, without any recursion." ++ - "\n -printer=srgs_abnf_sisr_old SRGS ABNF format, with semantic tags in" ++ - "\n SISR WD 20030401 format" ++ - "\n -printer=srgs_xml SRGS XML format" ++ - "\n -printer=srgs_xml_non_rec SRGS XML format, without any recursion." ++ - "\n -printer=srgs_xml_prob SRGS XML format, with weights" ++ - "\n -printer=srgs_xml_sisr_old SRGS XML format, with semantic tags in" ++ - "\n SISR WD 20030401 format" ++ - "\n -printer=vxml Generate a dialogue system in VoiceXML." ++ - "\n -printer=slf a finite automaton in the HTK SLF format" ++ - "\n -printer=slf_graphviz the same automaton as slf, but in Graphviz format" ++ - "\n -printer=slf_sub a finite automaton with sub-automata in the " ++ - "\n HTK SLF format" ++ - "\n -printer=slf_sub_graphviz the same automaton as slf_sub, but in " ++ - "\n Graphviz format" ++ - "\n -printer=fa_graphviz a finite automaton with labelled edges" ++ - "\n -printer=regular a regular grammar in a simple BNF" ++ - "\n -printer=unpar a gfc grammar with parameters eliminated" ++ - "\n -printer=functiongraph abstract syntax functions in 'dot' format" ++ - "\n -printer=typegraph abstract syntax categories in 'dot' format" ++ - "\n -printer=transfer Transfer language datatype (.tr file format)" ++ - "\n -printer=cfg-prolog M cfg in prolog format (also pg)" ++ - "\n -printer=gfc-prolog M gfc in prolog format (also pg)" ++ - "\n -printer=gfcm M gfcm file (default for pm)" ++ - "\n -printer=graph M module dependency graph in 'dot' (graphviz) format" ++ - "\n -printer=header M gfcm file with header (for GF embedded in Java)" ++ - "\n -printer=js M JavaScript type annotator and linearizer" ++ - "\n -printer=mcfg-prolog M mcfg in prolog format (also pg)" ++ - "\n -printer=missing M the missing linearizations of each concrete" ++ - "\n" ++ - "\n-startcat, like -cat, but used in grammars (to avoid clash with keyword cat)" ++ - "\n" ++ - "\n-transform, transformation performed on a syntax tree. The default is identity." ++ - "\n -transform=identity no change" ++ - "\n -transform=compute compute by using definitions in the grammar" ++ - "\n -transform=nodup return the term only if it has no constants duplicated" ++ - "\n -transform=nodupatom return the term only if it has no atomic constants duplicated" ++ - "\n -transform=typecheck return the term only if it is type-correct" ++ - "\n -transform=solve solve metavariables as derived refinements" ++ - "\n -transform=context solve metavariables by unique refinements as variables" ++ - "\n -transform=delete replace the term by metavariable" ++ - "\n" ++ - "\n-unlexer, untokenization transforming linearization output into a string." ++ - "\n The default is unwords." ++ - "\n -unlexer=unwords space-separated token list (like unwords)" ++ - "\n -unlexer=text format as text: punctuation, capitals, paragraph <p>" ++ - "\n -unlexer=code format as code (spacing, indentation)" ++ - "\n -unlexer=textlit like text, but remove string literal quotes" ++ - "\n -unlexer=codelit like code, but remove string literal quotes" ++ - "\n -unlexer=concat remove all spaces" ++ - "\n -unlexer=bind like identity, but bind at \"&+\"" ++ - "\n" ++ - "\n-mark, marking of parts of tree in linearization. The default is none." ++ - "\n -mark=metacat append \"+CAT\" to every metavariable, showing its category" ++ - "\n -mark=struct show tree structure with brackets" ++ - "\n -mark=java show tree structure with XML tags (used in gfeditor)" ++ - "\n" ++ - "\n-coding, Some grammars are in UTF-8, some in isolatin-1." ++ - "\n If the letters \228 (a-umlaut) and \246 (o-umlaut) look strange, either" ++ - "\n change your terminal to isolatin-1, or rewrite the grammar with" ++ - "\n 'pg -utf8'. For Windows you also may have to change your font to TrueType." ++ - "\n" ++ - "\n-- *: Commands and options marked with * are not currently implemented." ++ - [] diff --git a/src-3.0/GF/Shell/JGF.hs b/src-3.0/GF/Shell/JGF.hs deleted file mode 100644 index 0ff678809..000000000 --- a/src-3.0/GF/Shell/JGF.hs +++ /dev/null @@ -1,89 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : JGF --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/06/03 22:44:36 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.13 $ --- --- GF editing session controlled by e.g. a Java program. AR 16\/11\/2001 ------------------------------------------------------------------------------ - -module GF.Shell.JGF where - -import GF.Data.Operations -import GF.Infra.UseIO -import GF.Text.Unicode - -import GF.API.IOGrammar -import GF.Infra.Option -import GF.Compile.ShellState -import GF.UseGrammar.Session -import GF.Shell.Commands -import GF.Shell.CommandL -import GF.Text.UTF8 - -import Control.Monad (foldM) -import System - - - --- GF editing session controlled by e.g. a Java program. AR 16/11/2001 - --- | the Boolean is a temporary hack to have two parallel GUIs -sessionLineJ :: Bool -> ShellState -> IO () -sessionLineJ isNew env = do - putStrLnFlush $ initEditMsgJavaX env - let env' = addGlobalOptions (options [sizeDisplay "short",beSilent]) env - editLoopJnewX isNew env' (initSState) - --- | this is the real version, with XML --- --- the Boolean is a temporary hack to have two parallel GUIs -editLoopJnewX :: Bool -> CEnv -> SState -> IO () -editLoopJnewX isNew env state = do - mscs <- getCommandUTF (isCEnvUTF8 env state) ---- - let (ms,cs) = unzip mscs - m = unlines ms --- ? - if null cs - then editLoopJnewX isNew env state - else - case cs of - [CQuit] -> return () - _ -> do - (env',state') <- foldM exec (env,state) cs - let inits = initAndEditMsgJavaX isNew env' state' m - let - package = case last cs of - CCEnvImport _ -> inits - CCEnvEmptyAndImport _ -> inits - CCEnvOpenTerm _ -> inits - CCEnvOpenString _ -> inits - CCEnvEmpty -> initEditMsgJavaX env' - _ -> displaySStateJavaX isNew env' state' m - putStrLnFlush package - editLoopJnewX isNew env' state' - where - exec (env,state) c = do - execCommand env c state - -welcome :: String -welcome = - "An experimental GF Editor for Java." ++ - "(c) Kristofer Johannisson, Janna Khegai, and Aarne Ranta 2002 under CNU GPL." - -initEditMsgJavaX :: CEnv -> String -initEditMsgJavaX env = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfinit" $ - tagsXML "newcat" [["n" +++ cat] | (_,cat) <- newCatMenu env] ++ - tagXML "topic" [abstractName env] ++ - tagXML "language" [prLanguage langAbstract] ++ - concat [tagAttrXML "language" ("file",file) [prLanguage lang] | - (file,lang) <- zip (allGrammarFileNames env) (allLanguages env)] - - -initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String -> String -initAndEditMsgJavaX isNew env state m = - initEditMsgJavaX env ++++ displaySStateJavaX isNew env state m diff --git a/src-3.0/GF/Shell/PShell.hs b/src-3.0/GF/Shell/PShell.hs deleted file mode 100644 index 68cb4d629..000000000 --- a/src-3.0/GF/Shell/PShell.hs +++ /dev/null @@ -1,174 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : PShell --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/10/06 14:21:34 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.28 $ --- --- parsing GF shell commands. AR 11\/11\/2001 ------------------------------------------------------------------------------ - -module GF.Shell.PShell where - -import GF.Data.Operations -import GF.Infra.UseIO -import GF.Compile.ShellState -import GF.Shell.ShellCommands -import GF.Shell -import GF.Infra.Option -import GF.Compile.PGrammar (pzIdent, pTrm) --- (string2formsAndTerm) -import GF.API -import GF.System.Arch (fetchCommand) -import GF.UseGrammar.Tokenize (wordsLits) - -import Data.Char (isDigit, isSpace) -import System.IO.Error - --- parsing GF shell commands. AR 11/11/2001 - --- | getting a sequence of command lines as input -getCommandLines :: HState -> IO (String,[CommandLine]) -getCommandLines st = do - s <- fetchCommand "> " - return (s,pCommandLines st s) - -getCommandLinesBatch :: HState -> IO (String,[CommandLine]) -getCommandLinesBatch st = do - s <- catch getLine (\e -> if isEOFError e then return "q" else ioError e) - return $ (s,pCommandLines st s) - -pCommandLines :: HState -> String -> [CommandLine] -pCommandLines st = - map (pCommandLine st) . concatMap (chunks ";;" . wordsLits) . lines - --- | Remove single or double quotes around a string -unquote :: String -> String -unquote (x:xs@(_:_)) | x `elem` "\"'" && x == last xs = init xs -unquote s = s - -pCommandLine :: HState -> [String] -> CommandLine -pCommandLine st (c@('%':_):args) = pCommandLine st $ resolveShMacro st c args -pCommandLine st (dc:c:def) | abbrevCommand dc == "dc" = ((CDefineCommand c def, noOptions),AUnit,[]) -pCommandLine st s = pFirst (chks s) where - pFirst cos = case cos of - (c,os,[a]) : cs -> ((c,os), a, pCont cs) - _ -> ((CVoid,noOptions), AError "no parse", []) - pCont cos = case cos of - (c,os,_) : cs -> (c,os) : pCont cs - _ -> [] - chks = map (pCommandOpt st) . chunks "|" - -pCommandOpt :: HState -> [String] -> (Command, Options, [CommandArg]) -pCommandOpt _ (w:ws) = let - (os, co) = getOptions "-" ws - (comm, args) = pCommand (abbrevCommand w:co) - in - (comm, os, args) -pCommandOpt _ s = (CVoid, noOptions, [AError "no parse"]) - -pInputString :: String -> [CommandArg] -pInputString s = case s of - ('"':_:_) | last s == '"' -> [AString (read s)] - _ -> [AError "illegal string"] - --- | command @rl@ can be written @remove_language@ etc. -abbrevCommand :: String -> String -abbrevCommand = hds . words . map u2sp where - u2sp c = if c=='_' then ' ' else c - hds s = case s of - [w@[_,_]] -> w - _ -> map head s - -pCommand :: [String] -> (Command, [CommandArg]) -pCommand ws = case ws of - - "i" : f : [] -> aUnit (CImport (unquote f)) - "rl" : l : [] -> aUnit (CRemoveLanguage (language l)) - "e" : [] -> aUnit CEmptyState - "cm" : a : [] -> aUnit (CChangeMain (Just (pzIdent a))) - "cm" : [] -> aUnit (CChangeMain Nothing) - "s" : [] -> aUnit CStripState - "tg" : f : [] -> aUnit (CTransformGrammar f) - "cl" : f : [] -> aUnit (CConvertLatex f) - - "ph" : [] -> aUnit CPrintHistory - "dt" : f : t -> aTerm (CDefineTerm (unquote f)) t - - "l" : s -> aTermLi CLinearize s - - "p" : s -> aString CParse s - "t" : i:o: s -> aString (CTranslate (language i) (language o)) s - "gr" : [] -> aUnit CGenerateRandom - "gr" : t -> aTerm CGenerateRandom t - "gt" : [] -> aUnit CGenerateTrees - "gt" : t -> aTerm CGenerateTrees t - "pt" : s -> aTerm CPutTerm s - "wt" : f : s -> aTerm (CWrapTerm (pzIdent f)) s - "at" : f : s -> aTerm (CApplyTransfer (pmIdent f)) s - "ma" : s -> aString CMorphoAnalyse s - "tt" : s -> aString CTestTokenizer s - "cc" : s -> aUnit $ CComputeConcrete $ unwords s - "so" : s -> aUnit $ CShowOpers $ unwords s - "tb" : [] -> aUnit CTreeBank - "ut" : s -> aString CLookupTreebank s - - "tq" : i:o:[] -> aUnit (CTranslationQuiz (language i) (language o)) - "tl":i:o:[] -> aUnit (CTranslationList (language i) (language o)) - "mq" : [] -> aUnit CMorphoQuiz - "ml" : [] -> aUnit CMorphoList - - "wf" : f : s -> aString (CWriteFile (unquote f)) s - "af" : f : s -> aString (CAppendFile (unquote f)) s - "rf" : f : [] -> aUnit (CReadFile (unquote f)) - "sa" : s -> aString CSpeakAloud s - "si" : [] -> aUnit CSpeechInput - "ps" : s -> aString CPutString s - "st" : s -> aTerm CShowTerm s - "!" : s -> aUnit (CSystemCommand (unwords s)) - "?" : s : x -> aString (CSystemCommand (unquote s)) x - "sc" : s -> aUnit (CSystemCommand (unwords s)) - "g" : f : s -> aString (CGrep (unquote f)) s - - "sf" : l : [] -> aUnit (CSetLocalFlag (language l)) - "sf" : [] -> aUnit CSetFlag - - "pg" : [] -> aUnit CPrintGrammar - "pi" : c : [] -> aUnit $ CPrintInformation (pzIdent c) - - "pj" : [] -> aUnit CPrintGramlet - "pxs" : [] -> aUnit CPrintCanonXMLStruct - "px" : [] -> aUnit CPrintCanonXML - "pm" : [] -> aUnit CPrintMultiGrammar - "vg" : [] -> aUnit CShowGrammarGraph - "vt" : s -> aTerm CShowTreeGraph s - "sg" : [] -> aUnit CPrintSourceGrammar - "po" : [] -> aUnit CPrintGlobalOptions - "pl" : [] -> aUnit CPrintLanguages - "h" : c : [] -> aUnit $ CHelp (Just (abbrevCommand c)) - "h" : [] -> aUnit $ CHelp Nothing - - "q" : [] -> aImpure ICQuit - "eh" : f : [] -> aImpure (ICExecuteHistory f) - n : [] | all isDigit n -> aImpure (ICEarlierCommand (readIntArg n)) - - "es" : [] -> aImpure ICEditSession - "ts" : [] -> aImpure ICTranslateSession - "r" : [] -> aImpure ICReload - _ -> (CVoid, []) - - where - aString c ss = (c, pInputString (unwords ss)) - aTerm c ss = (c, [ASTrm $ unwords ss]) ---- [ASTrms [s2t (unwords ss)]]) - aUnit c = (c, [AUnit]) - aImpure = aUnit . CImpure - - aTermLi c ss = (c [], [ASTrm $ unwords ss]) - ---- (c forms, [ASTrms [term]]) where - ---- (forms,term) = ([], s2t (unwords ss)) ----string2formsAndTerm(unwords ss) - pmIdent m = case span (/='.') m of - (k,_:f) -> (Just (pzIdent k), pzIdent f) - _ -> (Nothing,pzIdent m) diff --git a/src-3.0/GF/Shell/ShellCommands.hs b/src-3.0/GF/Shell/ShellCommands.hs deleted file mode 100644 index 70238817b..000000000 --- a/src-3.0/GF/Shell/ShellCommands.hs +++ /dev/null @@ -1,246 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : ShellCommands --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/11/14 16:03:41 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.46 $ --- --- The datatype of shell commands and the list of their options. ------------------------------------------------------------------------------ - -module GF.Shell.ShellCommands where - -import qualified GF.Infra.Ident as I -import GF.Compile.ShellState -import GF.UseGrammar.Custom -import GF.Grammar.PrGrammar - -import GF.Infra.Option -import GF.Data.Operations -import GF.Infra.Modules - -import Data.Char (isDigit) -import Control.Monad (mplus) - --- shell commands and their options --- moved to separate module and added option check: AR 27/5/2004 ---- TODO: single source for ---- (1) command interpreter (2) option check (3) help file - -data Command = - CImport FilePath - | CRemoveLanguage Language - | CEmptyState - | CChangeMain (Maybe I.Ident) - | CStripState - | CTransformGrammar FilePath - | CConvertLatex FilePath - - | CDefineCommand String [String] - | CDefineTerm String - - | CLinearize [()] ---- parameters - | CParse - | CTranslate Language Language - | CGenerateRandom - | CGenerateTrees - | CTreeBank - | CPutTerm - | CWrapTerm I.Ident - | CApplyTransfer (Maybe I.Ident, I.Ident) - | CMorphoAnalyse - | CTestTokenizer - | CComputeConcrete String - | CShowOpers String - - | CLookupTreebank - - | CTranslationQuiz Language Language - | CTranslationList Language Language - | CMorphoQuiz - | CMorphoList - - | CReadFile FilePath - | CWriteFile FilePath - | CAppendFile FilePath - | CSpeakAloud - | CSpeechInput - | CPutString - | CShowTerm - | CSystemCommand String - | CGrep String - - | CSetFlag - | CSetLocalFlag Language - - | CPrintGrammar - | CPrintGlobalOptions - | CPrintLanguages - | CPrintInformation I.Ident - | CPrintMultiGrammar - | CPrintSourceGrammar - | CShowGrammarGraph - | CShowTreeGraph - | CPrintGramlet - | CPrintCanonXML - | CPrintCanonXMLStruct - | CPrintHistory - | CHelp (Maybe String) - - | CImpure ImpureCommand - - | CVoid - --- to isolate the commands that are executed on top level -data ImpureCommand = - ICQuit - | ICExecuteHistory FilePath - | ICEarlierCommand Int - | ICEditSession - | ICTranslateSession - | ICReload - -type CommandOpt = (Command, Options) - --- the top-level option warning action - -checkOptions :: ShellState -> (Command,Options) -> IO () -checkOptions sh (co, Opts opts) = do - let (_,s) = errVal ([],"option check failed") $ mapErr check opts - if (null s) then return () - else putStr "WARNING: " >> putStrLn s - where - check = isValidOption sh co - -isValidOption :: ShellState -> Command -> Option -> Err () -isValidOption st co op = case op of - Opt (o,[]) -> - testErr (elem o $ optsOf co) ("invalid option:" +++ prOpt op) - Opt (o,[x]) -> do - testErr (elem o (flagsOf co)) ("invalid flag:" +++ o) - testValidFlag st co o x - _ -> Bad $ "impossible option" +++ prOpt op - where - optsOf co = ("tr" :) $ fst $ optionsOfCommand co - flagsOf co = snd $ optionsOfCommand co - -testValidFlag :: ShellState -> Command -> OptFunId -> String -> Err () -testValidFlag st co f x = case f of - "cat" -> testIn (map prQIdent_ (allCategories st)) - "lang" -> testIn (map prt (allLanguages st)) - "transfer" -> testIn (map prt (allTransfers st)) - "res" -> testIn (map prt (allResources (srcModules st))) - "number" -> testN - "printer" -> case co of - CPrintGrammar -> testInc customGrammarPrinter - CPrintMultiGrammar -> testInc customMultiGrammarPrinter - CSetFlag -> testInc customGrammarPrinter `mplus` - testInc customMultiGrammarPrinter - "lexer" -> testInc customTokenizer - "unlexer" -> testInc customUntokenizer - "depth" -> testN - "rawtrees"-> testN - "parser" -> testInc customParser - -- hack for the -newer parsers: (to be changed in the future) - -- `mplus` testIn (words "mcfg mcfg-bottomup mcfg-topdown cfg cfg-bottomup cfg-topdown bottomup topdown") - -- if not(null x) && head x `elem` "mc" then return () else Bad "" - "alts" -> testN - "transform" -> testInc customTermCommand - "filter" -> testInc customStringCommand - "length" -> testN - "optimize"-> testIn $ words "parametrize values all share none" - "conversion" -> testIn $ words "strict nondet finite finite2 finite3 singletons finite-strict finite-singletons" - _ -> return () - where - testInc ci = - let vs = snd (customInfo ci) in testIn vs - testIn vs = - if elem x vs - then return () - else Bad ("flag:" +++ f +++ "invalid value:" +++ x ++++ - "possible values:" +++ unwords vs) - testN = - if all isDigit x - then return () - else Bad ("flag:" +++ f +++ "invalid value:" +++ x ++++ - "expected integer") - - -optionsOfCommand :: Command -> ([String],[String]) -optionsOfCommand co = case co of - CSetFlag -> - both "utf8 table struct record all multi" - "cat lang lexer parser number depth rawtrees unlexer optimize path conversion printer" - CImport _ -> - both "old v s src make gfc retain docf nocf nocheckcirc cflexer noemit o make ex prob treebank" - "abs cnc res path optimize conversion cat preproc probs noparse" - CRemoveLanguage _ -> none - CEmptyState -> none - CStripState -> none - CTransformGrammar _ -> flags "printer" - CConvertLatex _ -> none - CLinearize _ -> both "utf8 table struct record all multi" "lang number unlexer mark" - CParse -> - both "ambiguous fail cut new newer old overload cfg mcfg fcfg n ign raw v lines all prob" - "cat lang lexer parser number rawtrees" - CTranslate _ _ -> opts "cat lexer parser" - CGenerateRandom -> both "cf prob" "cat lang number depth atoms noexpand doexpand" - CGenerateTrees -> both "metas" "atoms depth alts cat lang number noexpand doexpand" - CPutTerm -> flags "transform number" - CTreeBank -> opts "c xml trees all table record" - CLookupTreebank -> both "assocs raw strings trees" "treebank" - CWrapTerm _ -> opts "c" - CApplyTransfer _ -> flags "lang transfer" - CMorphoAnalyse -> both "short status" "lang" - CTestTokenizer -> flags "lexer" - CComputeConcrete _ -> both "table" "res" - CShowOpers _ -> flags "res" - - CTranslationQuiz _ _ -> flags "cat" - CTranslationList _ _ -> flags "cat number" - CMorphoQuiz -> flags "cat lang" - CMorphoList -> flags "cat lang number" - - CReadFile _ -> none - CWriteFile _ -> none - CAppendFile _ -> none - CSpeakAloud -> flags "language" - CSpeechInput -> flags "lang cat language number" - - CPutString -> both "utf8" "filter length" - CShowTerm -> flags "printer" - CShowTreeGraph -> opts "c f g o" - CSystemCommand _ -> none - CGrep _ -> opts "v" - - CPrintGrammar -> both "utf8" "printer lang startcat" - CPrintMultiGrammar -> both "utf8 utf8id" "printer" - CPrintSourceGrammar -> both "utf8" "printer" - - CHelp _ -> opts "all alts atoms coding defs filter length lexer unlexer printer probs transform depth number cat" - - CImpure ICEditSession -> both "f" "file" - CImpure ICTranslateSession -> both "f langs" "cat" - - _ -> none - -{- - CSetLocalFlag Language - CPrintGlobalOptions - CPrintLanguages - CPrintInformation I.Ident - CPrintGramlet - CPrintCanonXML - CPrintCanonXMLStruct - CPrintHistory - CVoid --} - where - flags fs = ([],words fs) - opts fs = (words fs,[]) - both os fs = (words os,words fs) - none = ([],[]) diff --git a/src-3.0/GF/Shell/SubShell.hs b/src-3.0/GF/Shell/SubShell.hs deleted file mode 100644 index 5ef0459e5..000000000 --- a/src-3.0/GF/Shell/SubShell.hs +++ /dev/null @@ -1,66 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : SubShell --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/21 16:46:12 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.9 $ --- --- (Description of the module) ------------------------------------------------------------------------------ - -module GF.Shell.SubShell where - -import GF.Data.Operations -import GF.Infra.UseIO -import GF.Compile.ShellState -import GF.Infra.Option -import GF.API - -import GF.Shell.CommandL -import GF.System.ArchEdit - -import Data.List - --- AR 20/4/2000 -- 12/11/2001 - -editSession :: Options -> ShellState -> IO () -editSession opts st - | oElem makeFudget opts = fudlogueEdit font st' - | otherwise = initEditLoop st' (return ()) - where - st' = addGlobalOptions opts st - font = maybe myUniFont mkOptFont $ getOptVal opts useFont - -myUniFont :: String -myUniFont = "-mutt-clearlyu-medium-r-normal--0-0-100-100-p-0-iso10646-1" - -mkOptFont :: String -> String -mkOptFont = id - -translateSession :: Options -> ShellState -> IO () -translateSession opts st = do - let grs = allStateGrammars st - cat = firstCatOpts opts (firstStateGrammar st) - trans s = unlines $ - if oElem showLang opts then - sort $ [l +++ ":" +++ s | (l,s) <- zip (map (prIdent . cncId) grs) - (translateBetweenAll grs cat s)] - else translateBetweenAll grs cat s - translateLoop opts trans - -translateLoop :: Options -> (String -> String) -> IO () -translateLoop opts trans = do - let fud = oElem makeFudget opts - font = maybe myUniFont mkOptFont $ getOptVal opts useFont - if fud then fudlogueWrite font trans else loopLine - where - loopLine = do - putStrFlush "trans> " - s <- getLine - if s == "." then return () else do - putStrLnFlush $ trans s - loopLine diff --git a/src-3.0/GF/Shell/TeachYourself.hs b/src-3.0/GF/Shell/TeachYourself.hs deleted file mode 100644 index 7e5a8afe2..000000000 --- a/src-3.0/GF/Shell/TeachYourself.hs +++ /dev/null @@ -1,87 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : TeachYourself --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/21 16:46:13 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.7 $ --- --- translation and morphology quiz. AR 10\/5\/2000 -- 12\/4\/2002 ------------------------------------------------------------------------------ - -module GF.Shell.TeachYourself where - -import GF.Compile.ShellState -import GF.API -import GF.UseGrammar.Linear -import GF.Grammar.PrGrammar - -import GF.Infra.Option -import GF.System.Arch (myStdGen) -import GF.Data.Operations -import GF.Infra.UseIO - -import System.Random --- (randoms) --- bad import for hbc -import System - --- translation and morphology quiz. AR 10/5/2000 -- 12/4/2002 - -teachTranslation :: Options -> GFGrammar -> GFGrammar -> IO () -teachTranslation opts ig og = do - tts <- transTrainList opts ig og infinity - let qas = [ (q, mkAnswer as) | (q,as) <- tts] - teachDialogue qas "Welcome to GF Translation Quiz." - -transTrainList :: - Options -> GFGrammar -> GFGrammar -> Integer -> IO [(String,[String])] -transTrainList opts ig og number = do - ts <- randomTreesIO (addOption beSilent opts) ig (fromInteger number) - return $ map mkOne $ ts - where - cat = firstCatOpts opts ig - mkOne t = (norml (linearize ig t),map (norml . linearize og) (homonyms ig cat t)) - - -teachMorpho :: Options -> GFGrammar -> IO () -teachMorpho opts ig = useIOE () $ do - tts <- morphoTrainList opts ig infinity - let qas = [ (q, mkAnswer as) | (q,as) <- tts] - ioeIO $ teachDialogue qas "Welcome to GF Morphology Quiz." - -morphoTrainList :: Options -> GFGrammar -> Integer -> IOE [(String,[String])] -morphoTrainList opts ig number = do - ts <- ioeIO $ randomTreesIO (addOption beSilent opts) ig (fromInteger number) - gen <- ioeIO $ myStdGen (fromInteger number) - mkOnes gen ts - where - mkOnes gen (t:ts) = do - psss <- ioeErr $ allLinTables True gr cnc t - let pss = concat $ map snd $ concat psss - let (i,gen') = randomR (0, length pss - 1) gen - (ps,ss) <- ioeErr $ pss !? i - (_,ss0) <- ioeErr $ pss !? 0 - let bas = unwords ss0 --- concat $ take 1 ss0 - more <- mkOnes gen' ts - return $ (bas +++ ":" +++ unwords (map prt_ ps), return (unwords ss)) : more - mkOnes gen [] = return [] - - gr = grammar ig - cnc = cncId ig - --- | compare answer to the list of right answers, increase score and give feedback -mkAnswer :: [String] -> String -> (Integer, String) -mkAnswer as s = if (elem (norml s) as) - then (1,"Yes.") - else (0,"No, not" +++ s ++ ", but" ++++ unlines as) - - -norml :: String -> String -norml = unwords . words - --- | the maximal number of precompiled quiz problems -infinity :: Integer -infinity = 123 - |
