From d91d8043e0b15af229e9aa1c223dc348e24e4d63 Mon Sep 17 00:00:00 2001 From: aarne Date: Wed, 21 Dec 2005 19:46:48 +0000 Subject: [PATCH] parsing escaped strings from command line fixed --- src/GF.hs | 5 ++++- src/GF/CF/CFIdent.hs | 26 +++++++++++++++++++++++--- src/GF/Grammar/PrGrammar.hs | 2 +- src/GF/Shell/CommandL.hs | 2 +- src/GF/Shell/PShell.hs | 15 ++------------- src/GF/UseGrammar/Tokenize.hs | 8 +++++--- 6 files changed, 36 insertions(+), 22 deletions(-) diff --git a/src/GF.hs b/src/GF.hs index 92e1dd204..a54327257 100644 --- a/src/GF.hs +++ b/src/GF.hs @@ -104,7 +104,10 @@ helpMsg = unlines [ " -make batch-compile files", " -noemit do not emit code 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 = diff --git a/src/GF/CF/CFIdent.hs b/src/GF/CF/CFIdent.hs index 0cf793827..df12be0f8 100644 --- a/src/GF/CF/CFIdent.hs +++ b/src/GF/CF/CFIdent.hs @@ -30,7 +30,8 @@ module GF.CF.CFIdent (-- * Tokens and categories -- * CF Tokens string2CFTok, str2cftoks, -- * Comparisons - compatToks, compatTok, compatCFFun, compatCF + compatToks, compatTok, compatCFFun, compatCF, + wordsLits ) where import GF.Data.Operations @@ -41,7 +42,7 @@ import GF.Canon.AbsGFC import GF.Grammar.Macros (ident2label) import GF.Grammar.PrGrammar import GF.Data.Str -import Data.Char (toLower, toUpper) +import Data.Char (toLower, toUpper, isSpace) import Data.List (intersperse) -- | this type should be abstract @@ -204,7 +205,7 @@ string2CFTok :: String -> CFTok string2CFTok = tS str2cftoks :: Str -> [CFTok] -str2cftoks = map tS . words . sstr +str2cftoks = map tS . wordsLits . sstr -- 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 alts u = case u of TC (c:s) -> [toLower c : s, toUpper c : s] + TL s -> [s, prQuotedString s] _ -> [prCFTok u] -- | 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 = (==) 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 diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs index 4c35089f3..ad65f452b 100644 --- a/src/GF/Grammar/PrGrammar.hs +++ b/src/GF/Grammar/PrGrammar.hs @@ -217,7 +217,7 @@ instance Print Atom where prt (AtC f) = prQIdent f prt (AtM i) = prt i prt (AtV i) = prt i - prt (AtL s) = s + prt (AtL s) = prQuotedString s prt (AtI i) = show i prt (AtF i) = show i prt_ (AtC (_,f)) = prt f diff --git a/src/GF/Shell/CommandL.hs b/src/GF/Shell/CommandL.hs index 3697c85db..0dc103e33 100644 --- a/src/GF/Shell/CommandL.hs +++ b/src/GF/Shell/CommandL.hs @@ -25,7 +25,7 @@ import GF.Compile.ShellState import GF.Infra.Option import GF.UseGrammar.Session import GF.Shell.Commands -import GF.Shell.PShell (wordsLits) +import GF.UseGrammar.Tokenize (wordsLits) import Data.Char import Data.List (intersperse) diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs index 77264fee9..aba743503 100644 --- a/src/GF/Shell/PShell.hs +++ b/src/GF/Shell/PShell.hs @@ -23,6 +23,7 @@ import GF.Infra.Option import GF.Compile.PGrammar (pzIdent, pTrm) --- (string2formsAndTerm) import GF.API import GF.System.Arch (fetchCommand) +import GF.UseGrammar.Tokenize (wordsLits) import Data.Char (isDigit, isSpace) import System.IO.Error @@ -44,18 +45,6 @@ pCommandLines :: HState -> String -> [CommandLine] pCommandLines st = 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 unquote :: String -> String 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 s = case s of - ('"':_:_) -> [AString (init (tail s))] + ('"':_:_) | last s == '"' -> [AString (read s)] _ -> [AError "illegal string"] -- | command @rl@ can be written @remove_language@ etc. diff --git a/src/GF/UseGrammar/Tokenize.hs b/src/GF/UseGrammar/Tokenize.hs index 91f7f0c61..d16fdf32f 100644 --- a/src/GF/UseGrammar/Tokenize.hs +++ b/src/GF/UseGrammar/Tokenize.hs @@ -22,7 +22,8 @@ module GF.UseGrammar.Tokenize ( tokWords, lexText, lexC2M, lexC2M', lexTextLiteral, - lexIgnore + lexIgnore, + wordsLits ) where import GF.Data.Operations @@ -39,7 +40,7 @@ tokWords :: String -> [CFTok] tokWords = map tS . words tokLits :: String -> [CFTok] -tokLits = map mkCFTok . mergeStr . words where +tokLits = map mkCFTok . mergeStr . wordsLits where mergeStr ss = case ss of w@(c:cs):rest | elem c "\'\"" && c /= last w -> getStr [w] rest w :rest -> w : mergeStr rest @@ -50,7 +51,7 @@ tokLits = map mkCFTok . mergeStr . words where [] -> reverse v tokVars :: String -> [CFTok] -tokVars = map mkCFTokVar . words +tokVars = map mkCFTokVar . wordsLits isFloat s = case s of c:cs | isDigit c -> isFloat cs @@ -208,3 +209,4 @@ lexIgnore isKnown = concatMap mkOne where | isKnown s = [t] | otherwise = [] mkOne t = [t] +