diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs index cebe4ef28..51b434395 100644 --- a/src/GF/Command/Interpreter.hs +++ b/src/GF/Command/Interpreter.hs @@ -1,26 +1,92 @@ module GF.Command.Interpreter where -import GF.Command.AbsGFShell +import GF.Command.AbsGFShell hiding (Tree) +import GF.Command.PPrTree import GF.Command.ParGFShell import GF.GFCC.API +import GF.GFCC.Macros +import GF.GFCC.AbsGFCC ---- -import GF.Command.ErrM +import GF.Command.ErrM ---- - -interpretCommandLine :: MultiGrammar -> CommandLine -> IO () -interpretCommandLine gr line = case line of - CEmpty -> return () - CLine pipes -> mapM_ interPipe pipes +interpretCommandLine :: MultiGrammar -> String -> IO () +interpretCommandLine gr line = case (pCommandLine (myLexer line)) of + Ok CEmpty -> return () + Ok (CLine pipes) -> mapM_ interPipe pipes + _ -> putStrLn "command not parsed" where interPipe (PComm cs) = do - ts <- intercs [] cs - mapM_ (putStrLn . showTree) ts - intercs trees [] = return trees - intercs trees (c:cs) = do - trees2 <- interc trees c - intercs trees2 cs + (_,s) <- intercs ([],"") cs + putStrLn s + intercs treess [] = return treess + intercs (trees,_) (c:cs) = do + treess2 <- interc trees c + intercs treess2 cs interc = interpret gr -interpret :: MultiGrammar -> [Tree] -> Command -> IO [Tree] -interpret gr trees comm = case (trees,command comm) of - _ -> return trees ---- +-- return the trees to be sent in pipe, and the output possibly printed +interpret :: MultiGrammar -> [Tree] -> Command -> IO ([Tree],String) +interpret mgr trees0 comm = do + tss@(_,s) <- exec co + optTrace s + return tss + where + exec co = case co of + "l" -> return $ fromStrings $ map lin $ trees + "p" -> return $ fromTrees $ concatMap par $ toStrings $ trees + "gr" -> do + ts <- generateRandom mgr optCat + return $ fromTrees $ take optNum ts + _ -> return (trees,"command not interpreted") + + (co,opts,trees) = getCommand comm trees0 + + lin t = unlines [linearize mgr lang t | lang <- optLangs] + par s = concat [parse mgr lang optCat s | lang <- optLangs] + + optLangs = case valIdOpts "lang" "" opts of + "" -> languages mgr + lang -> [lang] + optCat = valIdOpts "cat" (lookAbsFlag gr (cid "startcat")) opts + optNum = valIntOpts "number" 1 opts + optTrace = if isOpt "tr" opts then putStrLn else const (return ()) + gr = gfcc mgr + + fromTrees ts = (ts,unlines (map showTree ts)) + fromStrings ss = (map tStr ss, unlines ss) + toStrings ts = [s | DTr [] (AS s) [] <- ts] + tStr s = DTr [] (AS s) [] + +valIdOpts :: String -> String -> [Option] -> String +valIdOpts flag def opts = case valOpts flag (VId (Ident def)) opts of + VId (Ident v) -> v + _ -> def + +valIntOpts :: String -> Integer -> [Option] -> Int +valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of + VInt v -> v + _ -> def + +valOpts :: String -> Value -> [Option] -> Value +valOpts flag def opts = case lookup flag flags of + Just v -> v + _ -> def + where + flags = [(f,v) | OFlag (Ident f) v <- opts] + +isOpt :: String -> [Option] -> Bool +isOpt o opts = elem o [x | OOpt (Ident x) <- opts] + +-- analyse command parse tree to a uniform datastructure, normalizing comm name +getCommand :: Command -> [Tree] -> (String,[Option],[Tree]) +getCommand co ts = case co of + Comm (Ident c) opts (ATree t) -> (getOp c,opts,[tree2exp t]) -- ignore piped + CNoarg (Ident c) opts -> (getOp c,opts,ts) -- use piped + where + -- abbreviation convention from gf + getOp s = case break (=='_') s of + (a:_,_:b:_) -> [a,b] -- axx_byy --> ab + _ -> case s of + [a,b] -> s -- ab --> ab + a:_ -> [a] -- axx --> a + diff --git a/src/GF/Command/PPrTree.hs b/src/GF/Command/PPrTree.hs index 555f88a3a..aa383b18b 100644 --- a/src/GF/Command/PPrTree.hs +++ b/src/GF/Command/PPrTree.hs @@ -1,4 +1,4 @@ -module GF.Command.PPrTree (pTree, prExp) where +module GF.Command.PPrTree (pTree, prExp, tree2exp) where import GF.GFCC.AbsGFCC import GF.GFCC.Macros @@ -17,7 +17,7 @@ tree2exp t = case t of TAbs xs t -> DTr (map i2i xs ++ ys) f ts where DTr ys f ts = tree2exp t TId c -> tree (AC (i2i c)) [] TInt i -> tree (AI i) [] --- TStr s + TStr s -> tree (AS s) [] -- TFloat d -> where i2i (Ident s) = CId s diff --git a/src/GF/Devel/Shell.hs b/src/GF/Devel/Shell.hs index f0aaf193b..9e6536087 100644 --- a/src/GF/Devel/Shell.hs +++ b/src/GF/Devel/Shell.hs @@ -1,7 +1,7 @@ module Main where +import GF.Command.Interpreter import GF.GFCC.API -import System.Random (newStdGen) import System (getArgs) import Data.Char (isDigit) @@ -18,14 +18,15 @@ loop :: MultiGrammar -> IO () loop grammar = do s <- getLine if s == "q" then return () else do - treat grammar s + interpretCommandLine grammar s loop grammar printHelp grammar = do putStrLn $ "languages: " ++ unwords (languages grammar) putStrLn $ "categories: " ++ unwords (categories grammar) - putStrLn commands +--- putStrLn commands +{- obsolete commands = unlines [ "Commands:", @@ -64,4 +65,5 @@ treat mgr s = case words s of prlinonly t prlinonly t = mapM_ (lin t) $ langs read1 s = if all isDigit s then read s else 1 +-}