parsing escaped strings from command line fixed

This commit is contained in:
aarne
2005-12-21 19:46:48 +00:00
parent f4c5fcf44a
commit 89ec5b808b
6 changed files with 36 additions and 22 deletions

View File

@@ -104,7 +104,10 @@ helpMsg = unlines [
" -make batch-compile files", " -make batch-compile files",
" -noemit do not emit code when compiling", " -noemit do not emit code when compiling",
" -v be verbose when compiling", " -v be verbose when compiling",
"Also all flags for import (i) are interpreted; see 'help i'." "Also all flags for import (i) are interpreted; see 'help import'.",
"An example combination of flags is",
" gf -batch -nocpu -s",
"which suppresses all messages except the output and fatal errors."
] ]
welcomeMsg = welcomeMsg =

View File

@@ -30,7 +30,8 @@ module GF.CF.CFIdent (-- * Tokens and categories
-- * CF Tokens -- * CF Tokens
string2CFTok, str2cftoks, string2CFTok, str2cftoks,
-- * Comparisons -- * Comparisons
compatToks, compatTok, compatCFFun, compatCF compatToks, compatTok, compatCFFun, compatCF,
wordsLits
) where ) where
import GF.Data.Operations import GF.Data.Operations
@@ -41,7 +42,7 @@ import GF.Canon.AbsGFC
import GF.Grammar.Macros (ident2label) import GF.Grammar.Macros (ident2label)
import GF.Grammar.PrGrammar import GF.Grammar.PrGrammar
import GF.Data.Str import GF.Data.Str
import Data.Char (toLower, toUpper) import Data.Char (toLower, toUpper, isSpace)
import Data.List (intersperse) import Data.List (intersperse)
-- | this type should be abstract -- | this type should be abstract
@@ -204,7 +205,7 @@ string2CFTok :: String -> CFTok
string2CFTok = tS string2CFTok = tS
str2cftoks :: Str -> [CFTok] str2cftoks :: Str -> [CFTok]
str2cftoks = map tS . words . sstr str2cftoks = map tS . wordsLits . sstr
-- decide if two token lists look the same (in parser postprocessing) -- decide if two token lists look the same (in parser postprocessing)
@@ -217,6 +218,7 @@ compatTok _ (TM _ _) = True
compatTok t u = any (`elem` (alts t)) (alts u) where compatTok t u = any (`elem` (alts t)) (alts u) where
alts u = case u of alts u = case u of
TC (c:s) -> [toLower c : s, toUpper c : s] TC (c:s) -> [toLower c : s, toUpper c : s]
TL s -> [s, prQuotedString s]
_ -> [prCFTok u] _ -> [prCFTok u]
-- | decide if two CFFuns have the same function head (profiles may differ) -- | decide if two CFFuns have the same function head (profiles may differ)
@@ -229,3 +231,21 @@ compatCFFun (CFFun (f,_)) (CFFun (g,_)) = f == g
compatCF :: CFCat -> CFCat -> Bool compatCF :: CFCat -> CFCat -> Bool
----compatCF = (==) ----compatCF = (==)
compatCF (CFCat (CIQ _ c, l)) (CFCat (CIQ _ c', l')) = c==c' && l==l' compatCF (CFCat (CIQ _ c, l)) (CFCat (CIQ _ c', l')) = c==c' && l==l'
-- | Like 'words', but does not split on whitespace inside
-- double quotes.wordsLits :: String -> [String]
-- Also treats escaped quotes in quotes (AR 21/12/2005) by breaks
-- instead of break
wordsLits [] = []
wordsLits (c:cs) | isSpace c = wordsLits (dropWhile isSpace cs)
| c == '\'' || c == '"'
= let (l,rs) = breaks (==c) cs
rs' = drop 1 rs
in ([c]++l++[c]):wordsLits rs'
| otherwise = let (w,rs) = break isSpace cs
in (c:w):wordsLits rs
where
breaks c cs = case break c cs of
(l@(_:_),d:rs) | last l == '\\' ->
let (r,ts) = breaks c rs in (l++[d]++r, ts)
v -> v

View File

@@ -217,7 +217,7 @@ instance Print Atom where
prt (AtC f) = prQIdent f prt (AtC f) = prQIdent f
prt (AtM i) = prt i prt (AtM i) = prt i
prt (AtV i) = prt i prt (AtV i) = prt i
prt (AtL s) = s prt (AtL s) = prQuotedString s
prt (AtI i) = show i prt (AtI i) = show i
prt (AtF i) = show i prt (AtF i) = show i
prt_ (AtC (_,f)) = prt f prt_ (AtC (_,f)) = prt f

View File

@@ -25,7 +25,7 @@ import GF.Compile.ShellState
import GF.Infra.Option import GF.Infra.Option
import GF.UseGrammar.Session import GF.UseGrammar.Session
import GF.Shell.Commands import GF.Shell.Commands
import GF.Shell.PShell (wordsLits) import GF.UseGrammar.Tokenize (wordsLits)
import Data.Char import Data.Char
import Data.List (intersperse) import Data.List (intersperse)

View File

@@ -23,6 +23,7 @@ import GF.Infra.Option
import GF.Compile.PGrammar (pzIdent, pTrm) --- (string2formsAndTerm) import GF.Compile.PGrammar (pzIdent, pTrm) --- (string2formsAndTerm)
import GF.API import GF.API
import GF.System.Arch (fetchCommand) import GF.System.Arch (fetchCommand)
import GF.UseGrammar.Tokenize (wordsLits)
import Data.Char (isDigit, isSpace) import Data.Char (isDigit, isSpace)
import System.IO.Error import System.IO.Error
@@ -44,18 +45,6 @@ pCommandLines :: HState -> String -> [CommandLine]
pCommandLines st = pCommandLines st =
map (pCommandLine st) . concatMap (chunks ";;" . wordsLits) . lines map (pCommandLine st) . concatMap (chunks ";;" . wordsLits) . lines
-- | Like 'words', but does not split on whitespace inside
-- double quotes.
wordsLits :: String -> [String]
wordsLits [] = []
wordsLits (c:cs) | isSpace c = wordsLits (dropWhile isSpace cs)
| c == '\'' || c == '"'
= let (l,rs) = break (==c) cs
rs' = drop 1 rs
in ([c]++l++[c]):wordsLits rs'
| otherwise = let (w,rs) = break isSpace cs
in (c:w):wordsLits rs
-- | Remove single or double quotes around a string -- | Remove single or double quotes around a string
unquote :: String -> String unquote :: String -> String
unquote (x:xs@(_:_)) | x `elem` "\"'" && x == last xs = init xs unquote (x:xs@(_:_)) | x `elem` "\"'" && x == last xs = init xs
@@ -83,7 +72,7 @@ pCommandOpt _ s = (CVoid, noOptions, [AError "no parse"])
pInputString :: String -> [CommandArg] pInputString :: String -> [CommandArg]
pInputString s = case s of pInputString s = case s of
('"':_:_) -> [AString (init (tail s))] ('"':_:_) | last s == '"' -> [AString (read s)]
_ -> [AError "illegal string"] _ -> [AError "illegal string"]
-- | command @rl@ can be written @remove_language@ etc. -- | command @rl@ can be written @remove_language@ etc.

View File

@@ -22,7 +22,8 @@ module GF.UseGrammar.Tokenize ( tokWords,
lexText, lexText,
lexC2M, lexC2M', lexC2M, lexC2M',
lexTextLiteral, lexTextLiteral,
lexIgnore lexIgnore,
wordsLits
) where ) where
import GF.Data.Operations import GF.Data.Operations
@@ -39,7 +40,7 @@ tokWords :: String -> [CFTok]
tokWords = map tS . words tokWords = map tS . words
tokLits :: String -> [CFTok] tokLits :: String -> [CFTok]
tokLits = map mkCFTok . mergeStr . words where tokLits = map mkCFTok . mergeStr . wordsLits where
mergeStr ss = case ss of mergeStr ss = case ss of
w@(c:cs):rest | elem c "\'\"" && c /= last w -> getStr [w] rest w@(c:cs):rest | elem c "\'\"" && c /= last w -> getStr [w] rest
w :rest -> w : mergeStr rest w :rest -> w : mergeStr rest
@@ -50,7 +51,7 @@ tokLits = map mkCFTok . mergeStr . words where
[] -> reverse v [] -> reverse v
tokVars :: String -> [CFTok] tokVars :: String -> [CFTok]
tokVars = map mkCFTokVar . words tokVars = map mkCFTokVar . wordsLits
isFloat s = case s of isFloat s = case s of
c:cs | isDigit c -> isFloat cs c:cs | isDigit c -> isFloat cs
@@ -208,3 +209,4 @@ lexIgnore isKnown = concatMap mkOne where
| isKnown s = [t] | isKnown s = [t]
| otherwise = [] | otherwise = []
mkOne t = [t] mkOne t = [t]