From edd17b54f2aa805a78a889b4bd0d0ef513f08314 Mon Sep 17 00:00:00 2001 From: aarne Date: Thu, 6 Oct 2005 09:02:33 +0000 Subject: [PATCH] macro commands --- doc/gf-history.html | 4 ++ src/GF/GFModes.hs | 19 ++++----- src/GF/Infra/Option.hs | 6 ++- src/GF/Shell.hs | 75 +++++++++++++++++++++++++++++------ src/GF/Shell/Commands.hs | 9 +++-- src/GF/Shell/HelpFile.hs | 24 +++++++++-- src/GF/Shell/PShell.hs | 36 +++++++++-------- src/GF/Shell/ShellCommands.hs | 9 +++-- src/HelpFile | 20 +++++++++- 9 files changed, 151 insertions(+), 51 deletions(-) diff --git a/doc/gf-history.html b/doc/gf-history.html index f2b02d731..2c2bb526c 100644 --- a/doc/gf-history.html +++ b/doc/gf-history.html @@ -12,6 +12,10 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2 +6/10 (AR) New commands dc = define_command and +dt = define_tree to define macros in a GF session. +See help for details and examples. +

5/10 (AR) Printing missing linearization rules: diff --git a/src/GF/GFModes.hs b/src/GF/GFModes.hs index 4a29144d5..bf3e90f97 100644 --- a/src/GF/GFModes.hs +++ b/src/GF/GFModes.hs @@ -4,9 +4,9 @@ -- Stability : (stability) -- Portability : (portability) -- --- > CVS $Date: 2005/04/21 16:21:04 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.7 $ +-- > CVS $Date: 2005/10/06 10:02:33 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.8 $ -- -- (Description of the module) ----------------------------------------------------------------------------- @@ -30,7 +30,7 @@ import Data.Char (isSpace) gfInteract :: HState -> IO HState gfInteract st@(env,hist) = do -- putStrFlush "> " M.F 25/01-02 prompt moved to Arch. - (s,cs) <- getCommandLines + (s,cs) <- getCommandLines st case ifImpure cs of -- these are the three impure commands @@ -39,12 +39,12 @@ gfInteract st@(env,hist) = do return st Just (ICExecuteHistory file,_) -> do ss <- readFileIf file - let co = pCommandLines ss + let co = pCommandLines st ss st' <- execLinesH s co st gfInteract st' Just (ICEarlierCommand i,_) -> do let line = earlierCommandH st i - co = pCommandLine $ words line + co = pCommandLine st $ words line st' <- execLinesH line [co] st -- s would not work in execLinesH gfInteract st' @@ -69,7 +69,7 @@ gfInteract st@(env,hist) = do gfBatch :: HState -> IO HState gfBatch st@(sh,_) = do - (s,cs) <- getCommandLinesBatch + (s,cs) <- getCommandLinesBatch st if s == "q" then return st else do st' <- if all isSpace s then return st else do putVe "" @@ -90,9 +90,10 @@ putVerb st@(sh,_) s = if (oElem beSilent (globalOptions sh)) batchCompile :: Options -> FilePath -> IO () batchCompile os file = do let file' = mkGFC file + let st = initHState emptyShellState let s = "i -o" +++ (unwords $ map ('-':) $ words $ prOpts os) +++ file - let cs = pCommandLines s - execLines True cs (initHState emptyShellState) + let cs = pCommandLines st s + execLines True cs st return () mkGFC = reverse . ("cfg" ++) . dropWhile (/='.') . reverse diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index f00ecd63a..6fb9f9f2e 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/09/18 22:55:46 $ +-- > CVS $Date: 2005/10/06 10:02:33 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.31 $ +-- > CVS $Revision: 1.32 $ -- -- Options and flags used in GF shell commands and files. -- @@ -210,6 +210,7 @@ tableLin = iOpt "table" defaultLinOpts = [firstLin] useUTF8 = iOpt "utf8" showLang = iOpt "lang" +showDefs = iOpt "defs" withMetas = iOpt "metas" -- ** other @@ -221,6 +222,7 @@ beVerbose, showInfo, beSilent, emitCode, getHelp, stripQualif, nostripQualif, showAll, fromSource :: Option beVerbose = iOpt "v" +invertGrep = iOpt "v" --- same letter in unix showInfo = iOpt "i" beSilent = iOpt "s" emitCode = iOpt "o" diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 6e3b241c0..6e4cf45fd 100644 --- a/src/GF/Shell.hs +++ b/src/GF/Shell.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/05 20:02:19 $ +-- > CVS $Date: 2005/10/06 10:02:33 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.43 $ +-- > CVS $Revision: 1.44 $ -- -- GF shell command interpreter. ----------------------------------------------------------------------------- @@ -57,7 +57,7 @@ import GF.Data.Zipper ---- import GF.Data.Operations import GF.Infra.UseIO import GF.Text.UTF8 (encodeUTF8) - +import Data.Char (isDigit) ---- import qualified GrammarToGramlet as Gr ---- import qualified GrammarToCanonXML2 as Canon @@ -72,31 +72,67 @@ type CommandLine = (CommandOpt, CommandArg, [CommandOpt]) type SrcTerm = G.Term -- | history & CPU -type HState = (ShellState,([String],Integer)) +type HState = (ShellState,([String],Integer,ShMacros,ShTerms)) + +type ShMacros = [(String,[String])] -- dc %c = ... #1 ... #2 ... +type ShTerms = [(String,Tree)] -- dt $e = f ... type ShellIO = (HState, CommandArg) -> IO (HState, CommandArg) initHState :: ShellState -> HState -initHState st = (st,([],0)) +initHState st = (st,([],0,[],[])) cpuHState :: HState -> Integer -cpuHState (_,(_,i)) = i +cpuHState (_,(_,i,_,_)) = i optsHState :: HState -> Options optsHState (st,_) = globalOptions st putHStateCPU :: Integer -> HState -> HState -putHStateCPU cpu (st,(h,_)) = (st,(h,cpu)) +putHStateCPU cpu (st,(h,_,c,t)) = (st,(h,cpu,c,t)) updateHistory :: String -> HState -> HState -updateHistory s (st,(h,cpu)) = (st,(s:h,cpu)) +updateHistory s (st,(h,cpu,c,t)) = (st,(s:h,cpu,c,t)) + +addShMacro :: (String,[String]) -> HState -> HState +addShMacro m (st,(h,cpu,c,t)) = (st,(h,cpu,m:c,t)) + +addShTerm :: (String,Tree) -> HState -> HState +addShTerm m (st,(h,cpu,c,t)) = (st,(h,cpu,c,m:t)) + +resolveShMacro :: HState -> String -> [String] -> [String] +resolveShMacro st@(_,(_,_,cs,_)) c args = case lookup c cs of + Just def -> map subst def + _ -> [] ---- + where + subst s = case s of + "#1" -> unwords args + _ -> s + --- so far only one arg allowed - how to determine arg boundaries? +{- + subst s = case s of + '#':d@(_:_) | all isDigit d -> + let i = read d in if i > lg then s else args !! (i-1) -- #1 is first + _ -> s + lg = length args +-} + +lookupShTerm :: HState -> String -> Maybe Tree +lookupShTerm st@(_,(_,_,_,ts)) c = lookup c ts + +txtHelpMacros :: HState -> String +txtHelpMacros (_,(_,_,cs,ts)) = unlines $ + ["Defined commands:",""] ++ + [c +++ "=" +++ unwords def | (c,def) <- cs] ++ + ["","Defined terms:",""] ++ + [c +++ "=" +++ prt_ def | (c,def) <- ts] -- | empty command if index over earlierCommandH :: HState -> Int -> String -earlierCommandH (_,(h,_)) = ((h ++ repeat "") !!) +earlierCommandH (_,(h,_,_,_)) = ((h ++ repeat "") !!) execLinesH :: String -> [CommandLine] -> HState -> IO HState -execLinesH s cs hst@(st, (h, _)) = do +execLinesH s cs hst@(st, (h,_,_,_)) = do (_,st') <- execLines True cs hst cpu <- prOptCPU (optsHState st') (cpuHState hst) return $ putHStateCPU cpu $ updateHistory s st' @@ -125,7 +161,7 @@ execLine put (c@(co, os), arg, cs) (outps,st) = do -- | individual commands possibly piped: value returned; this is not a state monad execC :: CommandOpt -> ShellIO -execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of +execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case comm of CImport file | oElem fromExamples opts -> do es <- liftM nub $ getGFEFiles opts file @@ -151,6 +187,17 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of CPrintHistory -> (returnArg $ AString $ unlines $ reverse h) sa -- good to have here for piping; eh and ec must be done on outer level + CDefineCommand c args -> return (addShMacro (c,args) sh, AUnit) + CDefineTerm c -> do + let + a' = case a of + ASTrm _ -> s2t a + AString _ -> s2t a + _ -> a + case a' of + ATrms [trm] -> return (addShTerm (c,trm) sh, AUnit) + _ -> returnArg (AError "illegal term definition") sa + CLinearize [] | oElem showMulti opts -> changeArg (opTS2CommandArg (unlines. linearizeToAll @@ -277,7 +324,8 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of CHelp (Just c) -> returnArg (AString (txtHelpCommand c)) sa CHelp _ -> case opts0 of - Opts [o] | o == showAll -> returnArg (AString txtHelpFile) sa + Opts [o] | o == showAll -> returnArg (AString txtHelpFile) sa + Opts [o] | o == showDefs -> returnArg (AString (txtHelpMacros sh)) sa Opts [o] -> returnArg (AString (txtHelpCommand ('-':prOpt o))) sa _ -> returnArg (AString txtHelpFileSummary) sa @@ -312,6 +360,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of cgr = canModules st s2t a = case a of + ASTrm ('$':c) -> maybe (AError "undefined term") (ATrms . return) $ lookupShTerm sh c ASTrm s -> err AError (ATrms . return) $ string2treeErr gro s AString s -> err AError (ATrms . return) $ string2treeErr gro s _ -> a @@ -329,7 +378,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of then (putStrLn ("Warning: discontinuous category" +++ prt_ c)) else (return ()) - grep ms s = (if oElem beVerbose opts then not else id) $ grepv ms s --- -v + grep ms s = (if oElem invertGrep opts then not else id) $ grepv ms s --- -v grepv ms s = case s of _:cs -> isPrefixOf ms s || grepv ms cs _ -> isPrefixOf ms s diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs index b1160d151..8699c2fe7 100644 --- a/src/GF/Shell/Commands.hs +++ b/src/GF/Shell/Commands.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/08/17 15:13:55 $ +-- > CVS $Date: 2005/10/06 10:02:33 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.41 $ +-- > CVS $Revision: 1.42 $ -- -- temporary hacks for GF 2.0 -- @@ -162,8 +162,9 @@ execCommand env c s = case c of return (startEditEnv emptyShellState, initSState) CCEnvGFShell command -> do - let cs = PShell.pCommandLines command - (msg,(env',_)) <- Shell.execLines False cs (Shell.initHState env) + 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 diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs index 187e18740..3e41e0745 100644 --- a/src/GF/Shell/HelpFile.hs +++ b/src/GF/Shell/HelpFile.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/05 20:02:19 $ +-- > CVS $Date: 2005/10/06 10:02:34 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.14 $ +-- > CVS $Revision: 1.15 $ -- -- Help on shell commands. Generated from HelpFile by 'make help'. -- PLEASE DON'T EDIT THIS FILE. @@ -90,6 +90,23 @@ txtHelpFile = "\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. Currently at most one argument is possible. To see" ++ + "\n definitions 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\" | p -lang=Swe -- 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 '$'. It is not yet usable as a subterm. To see" ++ + "\n definitions 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" ++ @@ -445,7 +462,8 @@ txtHelpFile = "\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 -all show the whole help file" ++ + "\n -defs show user-defined commands and terms" ++ "\n examples:" ++ "\n h print_grammar -- show all information on the pg command" ++ "\n" ++ diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs index d01366728..aefd066d5 100644 --- a/src/GF/Shell/PShell.hs +++ b/src/GF/Shell/PShell.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/05 20:02:20 $ +-- > CVS $Date: 2005/10/06 10:02:34 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.26 $ +-- > CVS $Revision: 1.27 $ -- -- parsing GF shell commands. AR 11\/11\/2001 ----------------------------------------------------------------------------- @@ -30,18 +30,19 @@ import System.IO.Error -- parsing GF shell commands. AR 11/11/2001 -- | getting a sequence of command lines as input -getCommandLines :: IO (String,[CommandLine]) -getCommandLines = do +getCommandLines :: HState -> IO (String,[CommandLine]) +getCommandLines st = do s <- fetchCommand "> " - return (s,pCommandLines s) + return (s,pCommandLines st s) -getCommandLinesBatch :: IO (String,[CommandLine]) -getCommandLinesBatch = do +getCommandLinesBatch :: HState -> IO (String,[CommandLine]) +getCommandLinesBatch st = do s <- catch getLine (\e -> if isEOFError e then return "q" else ioError e) - return $ (s,pCommandLines s) + return $ (s,pCommandLines st s) -pCommandLines :: String -> [CommandLine] -pCommandLines = map pCommandLine . concatMap (chunks ";;" . wordsLits) . lines +pCommandLines :: HState -> String -> [CommandLine] +pCommandLines st = + map (pCommandLine st) . concatMap (chunks ";;" . wordsLits) . lines -- | Like 'words', but does not split on whitespace inside -- double quotes. @@ -60,23 +61,25 @@ unquote :: String -> String unquote (x:xs@(_:_)) | x `elem` "\"'" && x == last xs = init xs unquote s = s -pCommandLine :: [String] -> CommandLine -pCommandLine s = pFirst (chks s) where +pCommandLine :: HState -> [String] -> CommandLine +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 . chunks "|" + chks = map (pCommandOpt st) . chunks "|" -pCommandOpt :: [String] -> (Command, Options, [CommandArg]) -pCommandOpt (w:ws) = let +pCommandOpt :: HState -> [String] -> (Command, Options, [CommandArg]) +pCommandOpt st (c@('%':_):args) = pCommandOpt st $ resolveShMacro st c args +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"]) +pCommandOpt _ s = (CVoid, noOptions, [AError "no parse"]) pInputString :: String -> [CommandArg] pInputString s = case s of @@ -104,6 +107,7 @@ pCommand ws = case ws of "cl" : f : [] -> aUnit (CConvertLatex f) "ph" : [] -> aUnit CPrintHistory + "dt" : f : t -> aTerm (CDefineTerm (unquote f)) t "l" : s -> aTermLi CLinearize s diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs index c2d2b367b..b41dc0b69 100644 --- a/src/GF/Shell/ShellCommands.hs +++ b/src/GF/Shell/ShellCommands.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/05 20:02:20 $ +-- > CVS $Date: 2005/10/06 10:02:34 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.40 $ +-- > CVS $Revision: 1.41 $ -- -- The datatype of shell commands and the list of their options. ----------------------------------------------------------------------------- @@ -40,6 +40,9 @@ data Command = | CTransformGrammar FilePath | CConvertLatex FilePath + | CDefineCommand String [String] + | CDefineTerm String + | CLinearize [()] ---- parameters | CParse | CTranslate Language Language @@ -200,7 +203,7 @@ optionsOfCommand co = case co of CPrintMultiGrammar -> both "utf8 utf8id" "printer" CPrintSourceGrammar -> both "utf8" "printer" - CHelp _ -> opts "all filter length lexer unlexer printer transform depth number" + CHelp _ -> opts "all defs filter length lexer unlexer printer transform depth number" CImpure ICEditSession -> both "f" "file" CImpure ICTranslateSession -> both "f langs" "cat" diff --git a/src/HelpFile b/src/HelpFile index fb7d3cefd..f85107186 100644 --- a/src/HelpFile +++ b/src/HelpFile @@ -61,6 +61,23 @@ sf, set_flags: sf Flag* s, strip: s Prune the state by removing source and resource modules. +dc, define_command Name Anything + Add a new defined command. The Name must star with '%'. Later, + if 'Name X' is used, it is replaced by Anything where #1 is replaced + by X. Currently at most one argument is possible. To see + definitions in scope, use help -defs. + examples: + dc %tnp p -cat=NP -lang=Eng #1 | l -lang=Swe -- translate NPs + %tnp "this man" | p -lang=Swe -- translate and parse + +dt, define_term Name Tree + Add a constant for a tree. The constant can later be called by + prefixing it with '$'. It is not yet usable as a subterm. To see + definitions in scope, use help -defs. + examples: + p -cat=NP "this man" | dt tm -- define tm as parse result + l -all $tm -- linearize tm in all forms + -- commands that give information about the state pg, print_grammar: pg @@ -416,7 +433,8 @@ h, help: h Command? Displays the paragraph concerning the command from this help file. Without the argument, shows the first lines of all paragraphs. options - -all show the whole help file + -all show the whole help file + -defs show user-defined commands and terms examples: h print_grammar -- show all information on the pg command