1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
module GF.Command.Interpreter (
CommandEnv (..),
mkCommandEnv,
emptyCommandEnv,
interpretCommandLine,
interpretPipe,
getCommandOp
) where
import GF.Command.Commands
import GF.Command.Abstract
import GF.Command.Parse
import PGF
import PGF.Data
import PGF.Macros
import GF.System.Signal
import GF.Infra.UseIO
import GF.Data.ErrM ----
import qualified Data.Map as Map
data CommandEnv = CommandEnv {
multigrammar :: PGF,
commands :: Map.Map String CommandInfo,
commandmacros :: Map.Map String CommandLine,
expmacros :: Map.Map String Tree
}
mkCommandEnv :: PGF -> CommandEnv
mkCommandEnv pgf = CommandEnv pgf (allCommands pgf) Map.empty Map.empty
emptyCommandEnv :: CommandEnv
emptyCommandEnv = mkCommandEnv emptyPGF
interpretCommandLine :: CommandEnv -> String -> IO ()
interpretCommandLine env line =
case readCommandLine line of
Just [] -> return ()
Just pipes -> do res <- runInterruptibly (mapM_ (interpretPipe env) pipes)
case res of
Left ex -> putStrLnFlush (show ex)
Right x -> return x
Nothing -> putStrLnFlush "command not parsed"
interpretPipe env cs = do
v@(_,s) <- intercs ([],"") cs
putStrLnFlush s
return v
where
intercs treess [] = return treess
intercs (trees,_) (c:cs) = do
treess2 <- interc trees c
intercs treess2 cs
interc es comm@(Command co _ arg) = case co of
'%':f -> case Map.lookup f (commandmacros env) of
Just css -> do
mapM_ (interpretPipe env) (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 :: [Tree] -> Command -> Command
appCommand xs c@(Command i os arg) = case arg of
ATree e -> Command i os (ATree (app e))
_ -> c
where
app e = case e of
Meta i -> xs !! i
Fun f as -> Fun f (map app as)
Abs x b -> Abs x (app b)
-- return the trees to be sent in pipe, and the output possibly printed
interpret :: CommandEnv -> [Tree] -> 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 ([],[])
where
optTrace = if isOpt "tr" opts then putStrLn else const (return ())
(co,opts,trees) = getCommand env comm trees0
comms = commands env
checkOpts info =
case
[o | OOpt o <- opts, notElem o ("tr" : map fst (options info))] ++
[o | OFlag o _ <- opts, notElem o (map fst (flags info))]
of
[] -> return ()
[o] -> putStrLn $ "option not interpreted: " ++ o
os -> putStrLn $ "options not interpreted: " ++ unwords os
-- analyse command parse tree to a uniform datastructure, normalizing comm name
--- the env is needed for macro lookup
getCommand :: CommandEnv -> Command -> [Tree] -> (String,[Option],[Tree])
getCommand env co@(Command c opts arg) ts =
(getCommandOp c,opts,getCommandArg env arg ts)
getCommandArg :: CommandEnv -> Argument -> [Tree] -> [Tree]
getCommandArg env a ts = case a of
AMacro m -> case Map.lookup m (expmacros env) of
Just t -> [t]
_ -> []
ATree t -> [t] -- ignore piped
ANoArg -> ts -- use piped
-- abbreviation convention from gf commands
getCommandOp s = case break (=='_') s of
(a:_,_:b:_) -> [a,b] -- axx_byy --> ab
_ -> case s of
[a,b] -> s -- ab --> ab
a:_ -> [a] -- axx --> a
|
