summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF.hs5
-rw-r--r--src/GF/CF/CFIdent.hs26
-rw-r--r--src/GF/Grammar/PrGrammar.hs2
-rw-r--r--src/GF/Shell/CommandL.hs2
-rw-r--r--src/GF/Shell/PShell.hs15
-rw-r--r--src/GF/UseGrammar/Tokenize.hs8
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]
+