diff --git a/src-3.0/GF/Command/Abstract.hs b/src-3.0/GF/Command/Abstract.hs index 31858a1f9..2b9ce5d1d 100644 --- a/src-3.0/GF/Command/Abstract.hs +++ b/src-3.0/GF/Command/Abstract.hs @@ -25,6 +25,7 @@ data Value data Argument = AExp Exp | ANoArg + | AMacro Ident deriving (Eq,Ord,Show) valIdOpts :: String -> String -> [Option] -> String diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs index f442cfa22..6fd4a1fb2 100644 --- a/src-3.0/GF/Command/Commands.hs +++ b/src-3.0/GF/Command/Commands.hs @@ -89,7 +89,9 @@ allCommands pgf = Map.fromList [ "N.B.1 You need the flag -retain when importing the grammar, if you want", "the definitions to be retained after compilation.", "N.B.2 The resulting term is not a tree in the sense of abstract syntax", - "and hence not a valid input to a Tree-expecting command." + "and hence not a valid input to a Tree-expecting command.", + "This command must be a line of its own, and thus cannot be a part", + "of a pipe." ], options = [ ("all","pick all strings (forms and variants) from records and tables"), @@ -97,6 +99,31 @@ allCommands pgf = Map.fromList [ ("unqual","hide qualifying module names") ] }), + ("dc", emptyCommandInfo { + longname = "define_command", + syntax = "dc IDENT COMMANDLINE", + synopsis = "define a command macro", + explanation = unlines [ + "Defines IDENT as macro for COMMANDLINE, until IDENT gets redefined.", + "A call of the command has the form %IDENT. The command may take an", + "argument, which in COMMANDLINE is marked as ?0. Both strings and", + "trees can be arguments. Currently at most one argument is possible.", + "This command must be a line of its own, and thus cannot be a part", + "of a pipe." + ] + }), + ("dt", emptyCommandInfo { + longname = "define_tree", + syntax = "dt IDENT (TREE | STRING)", -- | '<' COMMANDLINE)", + synopsis = "define a tree or string macro", + explanation = unlines [ + "Defines IDENT as macro for TREE or STRING, until IDENT gets redefined.", + -- "The defining value can also come from a command, preceded by '<'.", + "A use of the macro has the form %IDENT. Currently this use cannot be", + "a subtree of another tree. This command must be a line of its own", + "and thus cannot be a part of a pipe." + ] + }), ("e", emptyCommandInfo { longname = "empty", synopsis = "empty the environment" diff --git a/src-3.0/GF/Command/Interpreter.hs b/src-3.0/GF/Command/Interpreter.hs index 9c0d32849..3e774a693 100644 --- a/src-3.0/GF/Command/Interpreter.hs +++ b/src-3.0/GF/Command/Interpreter.hs @@ -1,6 +1,7 @@ module GF.Command.Interpreter ( CommandEnv (..), mkCommandEnv, + emptyCommandEnv, interpretCommandLine, getCommandOp ) where @@ -19,12 +20,17 @@ import GF.Data.ErrM ---- import qualified Data.Map as Map data CommandEnv = CommandEnv { - multigrammar :: PGF, - commands :: Map.Map String CommandInfo + multigrammar :: PGF, + commands :: Map.Map String CommandInfo, + commandmacros :: Map.Map String CommandLine, + expmacros :: Map.Map String Exp } mkCommandEnv :: PGF -> CommandEnv -mkCommandEnv pgf = CommandEnv pgf (allCommands pgf) +mkCommandEnv pgf = CommandEnv pgf (allCommands pgf) Map.empty Map.empty + +emptyCommandEnv :: CommandEnv +emptyCommandEnv = mkCommandEnv emptyPGF interpretCommandLine :: CommandEnv -> String -> IO () interpretCommandLine env line = @@ -43,22 +49,42 @@ interpretCommandLine env line = intercs (trees,_) (c:cs) = do treess2 <- interc trees c intercs treess2 cs - interc = interpret env + interc es comm@(Command co _ arg) = case co of + '%':f -> case Map.lookup f (commandmacros env) of + Just css -> do + mapM_ interPipe (appLine (getCommandArg env arg es) css) + return ([],[]) ---- return ? + _ -> do + putStrLn $ "command macro " ++ co ++ " not interpreted" + return ([],[]) + _ -> interpret env es comm + appLine es = map (map (appCommand es)) + +-- macro definition applications: replace ?i by (exps !! i) +appCommand :: [Exp] -> Command -> Command +appCommand xs c@(Command i os arg) = case arg of + AExp e -> Command i os (AExp (app e)) + _ -> c + where + app e = case e of + EMeta i -> xs !! i + EApp f as -> EApp f (map app as) + EAbs x b -> EAbs x (app b) -- return the trees to be sent in pipe, and the output possibly printed interpret :: CommandEnv -> [Exp] -> Command -> IO CommandOutput interpret env trees0 comm = case lookCommand co comms of - Just info -> do - checkOpts info - tss@(_,s) <- exec info opts trees - optTrace s - return tss - _ -> do - putStrLn $ "command " ++ co ++ " not interpreted" - return ([],[]) + Just info -> do + checkOpts info + tss@(_,s) <- exec info opts trees + optTrace s + return tss + _ -> do + putStrLn $ "command " ++ co ++ " not interpreted" + return ([],[]) where optTrace = if isOpt "tr" opts then putStrLn else const (return ()) - (co,opts,trees) = getCommand comm trees0 + (co,opts,trees) = getCommand env comm trees0 comms = commands env checkOpts info = case @@ -70,10 +96,18 @@ interpret env trees0 comm = case lookCommand co comms of os -> putStrLn $ "options not interpreted: " ++ unwords os -- analyse command parse tree to a uniform datastructure, normalizing comm name -getCommand :: Command -> [Exp] -> (String,[Option],[Exp]) -getCommand co ts = case co of - Command c opts (AExp t) -> (getCommandOp c,opts,[t]) -- ignore piped - Command c opts ANoArg -> (getCommandOp c,opts,ts) -- use piped +--- the env is needed for macro lookup +getCommand :: CommandEnv -> Command -> [Exp] -> (String,[Option],[Exp]) +getCommand env co@(Command c opts arg) ts = + (getCommandOp c,opts,getCommandArg env arg ts) + +getCommandArg :: CommandEnv -> Argument -> [Exp] -> [Exp] +getCommandArg env a ts = case a of + AMacro m -> case Map.lookup m (expmacros env) of + Just t -> [t] + _ -> [] + AExp t -> [t] -- ignore piped + ANoArg -> ts -- use piped -- abbreviation convention from gf commands getCommandOp s = case break (=='_') s of diff --git a/src-3.0/GF/Command/Parse.hs b/src-3.0/GF/Command/Parse.hs index f209b713b..12c88464f 100644 --- a/src-3.0/GF/Command/Parse.hs +++ b/src-3.0/GF/Command/Parse.hs @@ -20,10 +20,10 @@ pCommandLine = RP.sepBy (RP.skipSpaces >> pPipe) (RP.skipSpaces >> RP.char ';') pPipe = RP.sepBy1 (RP.skipSpaces >> pCommand) (RP.skipSpaces >> RP.char '|') pCommand = do - cmd <- pIdent + cmd <- pIdent RP.<++ (RP.char '%' >> pIdent >>= return . ('%':)) RP.skipSpaces opts <- RP.sepBy pOption RP.skipSpaces - arg <- RP.option ANoArg (fmap AExp (pExp False)) + arg <- pArgument return (Command cmd opts arg) pOption = do @@ -38,3 +38,9 @@ pValue = do pFilename = liftM2 (:) (RP.satisfy isFileFirst) (RP.munch (not . isSpace)) where isFileFirst c = not (isSpace c) && not (isDigit c) + +pArgument = + RP.option ANoArg + (fmap AExp (pExp False) + RP.<++ + (RP.munch isSpace >> RP.char '%' >> fmap AMacro pIdent)) diff --git a/src-3.0/GFI.hs b/src-3.0/GFI.hs index e956d5c18..c9d9db0b3 100644 --- a/src-3.0/GFI.hs +++ b/src-3.0/GFI.hs @@ -14,6 +14,7 @@ import GF.System.Readline import PGF import PGF.Data import PGF.Macros +import PGF.ExprSyntax (readExp) import Data.Char import Data.List(isPrefixOf) @@ -26,7 +27,6 @@ import Control.Exception import Data.Version import Paths_gf - mainGFI :: Options -> [FilePath] -> IO () mainGFI opts files = do putStrLn welcome @@ -72,10 +72,26 @@ loop opts gfenv0 = do -- other special commands, working on GFEnv "e":_ -> loopNewCPU $ gfenv { - commandenv=env{multigrammar=emptyPGF}, sourcegrammar = emptyGrammar + commandenv=emptyCommandEnv, sourcegrammar = emptyGrammar } - ---- "eh":file:_ -> + "dc":f:ws -> do + case readCommandLine (unwords ws) of + Just comm -> loopNewCPU $ gfenv { + commandenv = env { + commandmacros = Map.insert f comm (commandmacros env) + } + } + _ -> putStrLn "command definition not parsed" >> loopNewCPU gfenv + + "dt":f:ws -> do + case readExp (unwords ws) of + Just exp -> loopNewCPU $ gfenv { + commandenv = env { + expmacros = Map.insert f exp (expmacros env) + } + } + _ -> putStrLn "value definition not parsed" >> loopNewCPU gfenv "ph":_ -> mapM_ putStrLn (reverse (history gfenv0)) >> loopNewCPU gfenv "q":_ -> putStrLn "See you." >> return gfenv