mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
term macro help
This commit is contained in:
aarne
@@ -114,14 +114,21 @@ allCommands pgf = Map.fromList [
|
||||
}),
|
||||
("dt", emptyCommandInfo {
|
||||
longname = "define_tree",
|
||||
syntax = "dt IDENT (TREE | STRING)", -- | '<' COMMANDLINE)",
|
||||
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 '<'.",
|
||||
"The defining value can also come from a command, preceded by \"<\".",
|
||||
"If the command gives many values, the first one is selected.",
|
||||
"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."
|
||||
],
|
||||
examples = [
|
||||
("dt ex \"hello world\" -- define ex as string"),
|
||||
("dt ex UseN man_N -- define ex as string"),
|
||||
("dt ex < p -cat=NP \"the man in the car\" -- define ex as parse result"),
|
||||
("l -lang=LangSwe %ex | ps -to_utf8 -- linearize the tree ex")
|
||||
]
|
||||
}),
|
||||
("e", emptyCommandInfo {
|
||||
|
||||
@@ -3,6 +3,7 @@ module GF.Command.Interpreter (
|
||||
mkCommandEnv,
|
||||
emptyCommandEnv,
|
||||
interpretCommandLine,
|
||||
interpretPipe,
|
||||
getCommandOp
|
||||
) where
|
||||
|
||||
@@ -36,15 +37,17 @@ interpretCommandLine :: CommandEnv -> String -> IO ()
|
||||
interpretCommandLine env line =
|
||||
case readCommandLine line of
|
||||
Just [] -> return ()
|
||||
Just pipes -> do res <- runInterruptibly (mapM_ interPipe pipes)
|
||||
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"
|
||||
where
|
||||
interPipe cs = do
|
||||
(_,s) <- intercs ([],"") cs
|
||||
|
||||
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
|
||||
@@ -52,7 +55,7 @@ interpretCommandLine env line =
|
||||
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)
|
||||
mapM_ (interpretPipe env) (appLine (getCommandArg env arg es) css)
|
||||
return ([],[]) ---- return ?
|
||||
_ -> do
|
||||
putStrLn $ "command macro " ++ co ++ " not interpreted"
|
||||
|
||||
494
src-3.0/GFI.hs
494
src-3.0/GFI.hs
@@ -1,237 +1,257 @@
|
||||
module GFI (mainGFI) where
|
||||
|
||||
import GF.Command.Interpreter
|
||||
import GF.Command.Importing
|
||||
import GF.Command.Commands
|
||||
import GF.Command.Abstract
|
||||
import GF.Command.Parse
|
||||
import GF.Data.ErrM
|
||||
import GF.Grammar.API -- for cc command
|
||||
import GF.Infra.UseIO
|
||||
import GF.Infra.Option
|
||||
import GF.System.Readline
|
||||
|
||||
import PGF
|
||||
import PGF.Data
|
||||
import PGF.Macros
|
||||
import PGF.ExprSyntax (readExp)
|
||||
|
||||
import Data.Char
|
||||
import Data.List(isPrefixOf)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Text.ParserCombinators.ReadP as RP
|
||||
import System.Cmd
|
||||
import System.CPUTime
|
||||
import Control.Exception
|
||||
|
||||
import Data.Version
|
||||
import Paths_gf
|
||||
|
||||
mainGFI :: Options -> [FilePath] -> IO ()
|
||||
mainGFI opts files = do
|
||||
putStrLn welcome
|
||||
gfenv <- importInEnv emptyGFEnv opts files
|
||||
loop opts gfenv
|
||||
return ()
|
||||
|
||||
loop :: Options -> GFEnv -> IO GFEnv
|
||||
loop opts gfenv0 = do
|
||||
let env = commandenv gfenv0
|
||||
let sgr = sourcegrammar gfenv0
|
||||
setCompletionFunction (Just (wordCompletion (commandenv gfenv0)))
|
||||
s <- fetchCommand (prompt env)
|
||||
let gfenv = gfenv0 {history = s : history gfenv0}
|
||||
let loopNewCPU gfenv' = do
|
||||
cpu' <- getCPUTime
|
||||
putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
|
||||
loop opts $ gfenv' {cputime = cpu'}
|
||||
let
|
||||
pwords = case words s of
|
||||
w:ws -> getCommandOp w :ws
|
||||
ws -> ws
|
||||
case pwords of
|
||||
-- special commands, requiring source grammar in env
|
||||
"!":ws -> do
|
||||
system $ unwords ws
|
||||
loopNewCPU gfenv
|
||||
"cc":ws -> do
|
||||
let
|
||||
(style,term) = case ws of
|
||||
('-':w):ws2 -> (pTermPrintStyle w, ws2)
|
||||
_ -> (TermPrintDefault, ws)
|
||||
case pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr of ---- pipe!
|
||||
Ok x -> putStrLn (showTerm style x)
|
||||
Bad s -> putStrLn s
|
||||
loopNewCPU gfenv
|
||||
"i":args -> do
|
||||
gfenv' <- case parseOptions args of
|
||||
Ok (opts',files) -> importInEnv gfenv (addOptions opts opts') files
|
||||
Bad err -> do putStrLn $ "Command parse error: " ++ err
|
||||
return gfenv
|
||||
loopNewCPU gfenv'
|
||||
|
||||
-- other special commands, working on GFEnv
|
||||
"e":_ -> loopNewCPU $ gfenv {
|
||||
commandenv=emptyCommandEnv, sourcegrammar = emptyGrammar
|
||||
}
|
||||
|
||||
"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
|
||||
|
||||
-- ordinary commands, working on CommandEnv
|
||||
_ -> do
|
||||
interpretCommandLine env s
|
||||
loopNewCPU gfenv
|
||||
|
||||
importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv
|
||||
importInEnv gfenv opts files
|
||||
| flag optRetainResource opts =
|
||||
do src <- importSource (sourcegrammar gfenv) opts files
|
||||
return $ gfenv {sourcegrammar = src}
|
||||
| otherwise =
|
||||
do let opts' = addOptions (setOptimization OptCSE False) opts
|
||||
pgf0 = multigrammar (commandenv gfenv)
|
||||
pgf1 <- importGrammar pgf0 opts' files
|
||||
putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1
|
||||
return $ gfenv { commandenv = mkCommandEnv pgf1 }
|
||||
|
||||
welcome = unlines [
|
||||
" ",
|
||||
" * * * ",
|
||||
" * * ",
|
||||
" * * ",
|
||||
" * ",
|
||||
" * ",
|
||||
" * * * * * * * ",
|
||||
" * * * ",
|
||||
" * * * * * * ",
|
||||
" * * * ",
|
||||
" * * * ",
|
||||
" ",
|
||||
"This is GF version "++showVersion version++". ",
|
||||
"Some things may work. "
|
||||
]
|
||||
|
||||
prompt env = absname ++ "> " where
|
||||
absname = case abstractName (multigrammar env) of
|
||||
"_" -> "" --- created by new Ident handling 22/5/2008
|
||||
n -> n
|
||||
|
||||
data GFEnv = GFEnv {
|
||||
sourcegrammar :: Grammar, -- gfo grammar -retain
|
||||
commandenv :: CommandEnv,
|
||||
history :: [String],
|
||||
cputime :: Integer
|
||||
}
|
||||
|
||||
emptyGFEnv :: GFEnv
|
||||
emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] 0
|
||||
|
||||
|
||||
wordCompletion cmdEnv line prefix p =
|
||||
case wc_type (take p line) of
|
||||
CmplCmd pref
|
||||
-> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
|
||||
CmplStr (Just (Command _ opts _)) s
|
||||
-> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optCat opts)))
|
||||
case mb_state0 of
|
||||
Right state0 -> let ws = words (take (length s - length prefix) s)
|
||||
state = foldl nextState state0 ws
|
||||
compls = getCompletions state prefix
|
||||
in ret ' ' (Map.keys compls)
|
||||
Left _ -> ret ' ' []
|
||||
CmplOpt (Just (Command n _ _)) pref
|
||||
-> case Map.lookup n (commands cmdEnv) of
|
||||
Just inf -> do let flg_compls = ['-':flg | (flg,_) <- flags inf, isPrefixOf pref flg]
|
||||
opt_compls = ['-':opt | (opt,_) <- options inf, isPrefixOf pref opt]
|
||||
ret (if null flg_compls then ' ' else '=')
|
||||
(flg_compls++opt_compls)
|
||||
Nothing -> ret ' ' []
|
||||
CmplIdent (Just (Command "i" _ _)) _ -- HACK: file name completion for command i
|
||||
-> filenameCompletionFunction prefix
|
||||
CmplIdent _ pref
|
||||
-> do mb_abs <- try (evaluate (abstract pgf))
|
||||
case mb_abs of
|
||||
Right abs -> ret ' ' [name | cid <- Map.keys (funs abs), let name = prCId cid, isPrefixOf pref name]
|
||||
Left _ -> ret ' ' []
|
||||
_ -> ret ' ' []
|
||||
where
|
||||
pgf = multigrammar cmdEnv
|
||||
optLang opts = valIdOpts "lang" (head (languages pgf)) opts
|
||||
optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
|
||||
|
||||
ret c [x] = return [x++[c]]
|
||||
ret _ xs = return xs
|
||||
|
||||
|
||||
data CompletionType
|
||||
= CmplCmd Ident
|
||||
| CmplStr (Maybe Command) String
|
||||
| CmplOpt (Maybe Command) Ident
|
||||
| CmplIdent (Maybe Command) Ident
|
||||
deriving Show
|
||||
|
||||
wc_type :: String -> CompletionType
|
||||
wc_type = cmd_name
|
||||
where
|
||||
cmd_name cs =
|
||||
let cs1 = dropWhile isSpace cs
|
||||
in go cs1 cs1
|
||||
where
|
||||
go x [] = CmplCmd x
|
||||
go x (c:cs)
|
||||
| isIdent c = go x cs
|
||||
| otherwise = cmd x cs
|
||||
|
||||
cmd x [] = ret CmplIdent x "" 0
|
||||
cmd _ ('|':cs) = cmd_name cs
|
||||
cmd _ (';':cs) = cmd_name cs
|
||||
cmd x ('"':cs) = str x cs cs
|
||||
cmd x ('-':cs) = option x cs cs
|
||||
cmd x (c :cs)
|
||||
| isIdent c = ident x (c:cs) cs
|
||||
| otherwise = cmd x cs
|
||||
|
||||
option x y [] = ret CmplOpt x y 1
|
||||
option x y (c:cs)
|
||||
| isIdent c = option x y cs
|
||||
| otherwise = cmd x cs
|
||||
|
||||
ident x y [] = ret CmplIdent x y 0
|
||||
ident x y (c:cs)
|
||||
| isIdent c = ident x y cs
|
||||
| otherwise = cmd x cs
|
||||
|
||||
str x y [] = ret CmplStr x y 1
|
||||
str x y ('\"':cs) = cmd x cs
|
||||
str x y ('\\':c:cs) = str x y cs
|
||||
str x y (c:cs) = str x y cs
|
||||
|
||||
ret f x y d = f cmd y
|
||||
where
|
||||
x1 = take (length x - length y - d) x
|
||||
x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=') x1
|
||||
|
||||
cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
|
||||
[x] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
isIdent c = c == '_' || c == '\'' || isAlphaNum c
|
||||
module GFI (mainGFI) where
|
||||
|
||||
import GF.Command.Interpreter
|
||||
import GF.Command.Importing
|
||||
import GF.Command.Commands
|
||||
import GF.Command.Abstract
|
||||
import GF.Command.Parse
|
||||
import GF.Data.ErrM
|
||||
import GF.Grammar.API -- for cc command
|
||||
import GF.Infra.UseIO
|
||||
import GF.Infra.Option
|
||||
import GF.System.Readline
|
||||
|
||||
import PGF
|
||||
import PGF.Data
|
||||
import PGF.Macros
|
||||
import PGF.ExprSyntax (readExp)
|
||||
|
||||
import Data.Char
|
||||
import Data.List(isPrefixOf)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Text.ParserCombinators.ReadP as RP
|
||||
import System.Cmd
|
||||
import System.CPUTime
|
||||
import Control.Exception
|
||||
|
||||
import Data.Version
|
||||
import Paths_gf
|
||||
|
||||
mainGFI :: Options -> [FilePath] -> IO ()
|
||||
mainGFI opts files = do
|
||||
putStrLn welcome
|
||||
gfenv <- importInEnv emptyGFEnv opts files
|
||||
loop opts gfenv
|
||||
return ()
|
||||
|
||||
loop :: Options -> GFEnv -> IO GFEnv
|
||||
loop opts gfenv0 = do
|
||||
let env = commandenv gfenv0
|
||||
let sgr = sourcegrammar gfenv0
|
||||
setCompletionFunction (Just (wordCompletion (commandenv gfenv0)))
|
||||
s <- fetchCommand (prompt env)
|
||||
let gfenv = gfenv0 {history = s : history gfenv0}
|
||||
let loopNewCPU gfenv' = do
|
||||
cpu' <- getCPUTime
|
||||
putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
|
||||
loop opts $ gfenv' {cputime = cpu'}
|
||||
let
|
||||
pwords = case words s of
|
||||
w:ws -> getCommandOp w :ws
|
||||
ws -> ws
|
||||
case pwords of
|
||||
-- special commands, requiring source grammar in env
|
||||
"!":ws -> do
|
||||
system $ unwords ws
|
||||
loopNewCPU gfenv
|
||||
"cc":ws -> do
|
||||
let
|
||||
(style,term) = case ws of
|
||||
('-':w):ws2 -> (pTermPrintStyle w, ws2)
|
||||
_ -> (TermPrintDefault, ws)
|
||||
case pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr of ---- pipe!
|
||||
Ok x -> putStrLnFlush (showTerm style x)
|
||||
Bad s -> putStrLnFlush s
|
||||
loopNewCPU gfenv
|
||||
"i":args -> do
|
||||
gfenv' <- case parseOptions args of
|
||||
Ok (opts',files) -> importInEnv gfenv (addOptions opts opts') files
|
||||
Bad err -> do
|
||||
putStrLn $ "Command parse error: " ++ err
|
||||
return gfenv
|
||||
loopNewCPU gfenv'
|
||||
|
||||
-- other special commands, working on GFEnv
|
||||
"e":_ -> loopNewCPU $ gfenv {
|
||||
commandenv=emptyCommandEnv, sourcegrammar = emptyGrammar
|
||||
}
|
||||
|
||||
"dc":f:ws -> do
|
||||
case readCommandLine (unwords ws) of
|
||||
Just comm -> loopNewCPU $ gfenv {
|
||||
commandenv = env {
|
||||
commandmacros = Map.insert f comm (commandmacros env)
|
||||
}
|
||||
}
|
||||
_ -> putStrLnFlush "command definition not parsed" >> loopNewCPU gfenv
|
||||
|
||||
"dt":f:"<":ws -> do
|
||||
case readCommandLine (unwords ws) of
|
||||
Just [pip] -> do
|
||||
ip <- interpretPipe env pip
|
||||
case ip of
|
||||
(exp:es,_) -> do
|
||||
if null es then return () else
|
||||
putStrLnFlush $ "ambiguous definition, selected the first one"
|
||||
loopNewCPU $ gfenv {
|
||||
commandenv = env {
|
||||
expmacros = Map.insert f exp (expmacros env)
|
||||
}
|
||||
}
|
||||
_ -> putStrLnFlush "no value given in definition" >> loopNewCPU gfenv
|
||||
_ -> putStrLnFlush "value 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)
|
||||
}
|
||||
}
|
||||
_ -> putStrLnFlush "value definition not parsed" >> loopNewCPU gfenv
|
||||
|
||||
"ph":_ -> mapM_ putStrLnFlush (reverse (history gfenv0)) >> loopNewCPU gfenv
|
||||
"q":_ -> putStrLnFlush "See you." >> return gfenv
|
||||
|
||||
-- ordinary commands, working on CommandEnv
|
||||
_ -> do
|
||||
interpretCommandLine env s
|
||||
loopNewCPU gfenv
|
||||
|
||||
importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv
|
||||
importInEnv gfenv opts files
|
||||
| flag optRetainResource opts =
|
||||
do src <- importSource (sourcegrammar gfenv) opts files
|
||||
return $ gfenv {sourcegrammar = src}
|
||||
| otherwise =
|
||||
do let opts' = addOptions (setOptimization OptCSE False) opts
|
||||
cenv0 = commandenv gfenv
|
||||
pgf0 = multigrammar cenv0
|
||||
pgf1 <- importGrammar pgf0 opts' files
|
||||
putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1
|
||||
return $ gfenv { commandenv = (mkCommandEnv pgf1)
|
||||
{commandmacros = commandmacros cenv0, expmacros = expmacros cenv0}}
|
||||
--- return $ gfenv { commandenv = cenv0 {multigrammar = pgf1} } -- WHY NOT
|
||||
|
||||
welcome = unlines [
|
||||
" ",
|
||||
" * * * ",
|
||||
" * * ",
|
||||
" * * ",
|
||||
" * ",
|
||||
" * ",
|
||||
" * * * * * * * ",
|
||||
" * * * ",
|
||||
" * * * * * * ",
|
||||
" * * * ",
|
||||
" * * * ",
|
||||
" ",
|
||||
"This is GF version "++showVersion version++". ",
|
||||
"Some things may work. "
|
||||
]
|
||||
|
||||
prompt env = absname ++ "> " where
|
||||
absname = case abstractName (multigrammar env) of
|
||||
"_" -> "" --- created by new Ident handling 22/5/2008
|
||||
n -> n
|
||||
|
||||
data GFEnv = GFEnv {
|
||||
sourcegrammar :: Grammar, -- gfo grammar -retain
|
||||
commandenv :: CommandEnv,
|
||||
history :: [String],
|
||||
cputime :: Integer
|
||||
}
|
||||
|
||||
emptyGFEnv :: GFEnv
|
||||
emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] 0
|
||||
|
||||
|
||||
wordCompletion cmdEnv line prefix p =
|
||||
case wc_type (take p line) of
|
||||
CmplCmd pref
|
||||
-> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
|
||||
CmplStr (Just (Command _ opts _)) s
|
||||
-> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optCat opts)))
|
||||
case mb_state0 of
|
||||
Right state0 -> let ws = words (take (length s - length prefix) s)
|
||||
state = foldl nextState state0 ws
|
||||
compls = getCompletions state prefix
|
||||
in ret ' ' (Map.keys compls)
|
||||
Left _ -> ret ' ' []
|
||||
CmplOpt (Just (Command n _ _)) pref
|
||||
-> case Map.lookup n (commands cmdEnv) of
|
||||
Just inf -> do let flg_compls = ['-':flg | (flg,_) <- flags inf, isPrefixOf pref flg]
|
||||
opt_compls = ['-':opt | (opt,_) <- options inf, isPrefixOf pref opt]
|
||||
ret (if null flg_compls then ' ' else '=')
|
||||
(flg_compls++opt_compls)
|
||||
Nothing -> ret ' ' []
|
||||
CmplIdent (Just (Command "i" _ _)) _ -- HACK: file name completion for command i
|
||||
-> filenameCompletionFunction prefix
|
||||
CmplIdent _ pref
|
||||
-> do mb_abs <- try (evaluate (abstract pgf))
|
||||
case mb_abs of
|
||||
Right abs -> ret ' ' [name | cid <- Map.keys (funs abs), let name = prCId cid, isPrefixOf pref name]
|
||||
Left _ -> ret ' ' []
|
||||
_ -> ret ' ' []
|
||||
where
|
||||
pgf = multigrammar cmdEnv
|
||||
optLang opts = valIdOpts "lang" (head (languages pgf)) opts
|
||||
optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
|
||||
|
||||
ret c [x] = return [x++[c]]
|
||||
ret _ xs = return xs
|
||||
|
||||
|
||||
data CompletionType
|
||||
= CmplCmd Ident
|
||||
| CmplStr (Maybe Command) String
|
||||
| CmplOpt (Maybe Command) Ident
|
||||
| CmplIdent (Maybe Command) Ident
|
||||
deriving Show
|
||||
|
||||
wc_type :: String -> CompletionType
|
||||
wc_type = cmd_name
|
||||
where
|
||||
cmd_name cs =
|
||||
let cs1 = dropWhile isSpace cs
|
||||
in go cs1 cs1
|
||||
where
|
||||
go x [] = CmplCmd x
|
||||
go x (c:cs)
|
||||
| isIdent c = go x cs
|
||||
| otherwise = cmd x cs
|
||||
|
||||
cmd x [] = ret CmplIdent x "" 0
|
||||
cmd _ ('|':cs) = cmd_name cs
|
||||
cmd _ (';':cs) = cmd_name cs
|
||||
cmd x ('"':cs) = str x cs cs
|
||||
cmd x ('-':cs) = option x cs cs
|
||||
cmd x (c :cs)
|
||||
| isIdent c = ident x (c:cs) cs
|
||||
| otherwise = cmd x cs
|
||||
|
||||
option x y [] = ret CmplOpt x y 1
|
||||
option x y (c:cs)
|
||||
| isIdent c = option x y cs
|
||||
| otherwise = cmd x cs
|
||||
|
||||
ident x y [] = ret CmplIdent x y 0
|
||||
ident x y (c:cs)
|
||||
| isIdent c = ident x y cs
|
||||
| otherwise = cmd x cs
|
||||
|
||||
str x y [] = ret CmplStr x y 1
|
||||
str x y ('\"':cs) = cmd x cs
|
||||
str x y ('\\':c:cs) = str x y cs
|
||||
str x y (c:cs) = str x y cs
|
||||
|
||||
ret f x y d = f cmd y
|
||||
where
|
||||
x1 = take (length x - length y - d) x
|
||||
x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=') x1
|
||||
|
||||
cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
|
||||
[x] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
isIdent c = c == '_' || c == '\'' || isAlphaNum c
|
||||
|
||||
Reference in New Issue
Block a user