summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoraarne <unknown>2003-11-03 16:27:55 +0000
committeraarne <unknown>2003-11-03 16:27:55 +0000
commit94326929b144913642121bef8f8ecc98feb992e7 (patch)
tree07d59cc33cbef2ac79c6f3f573b9718c51322e7a
parent2728e6e7ceec92c7f781368b4a523b37e5dee3b9 (diff)
Fixed several things, e.g. tokenizer.
-rw-r--r--src/GF.hs5
-rw-r--r--src/GF/API.hs3
-rw-r--r--src/GF/CF/CFIdent.hs21
-rw-r--r--src/GF/CF/CanonToCF.hs18
-rw-r--r--src/GF/Canon/Look.hs2
-rw-r--r--src/GF/Compile/Compile.hs20
-rw-r--r--src/GF/Compile/ShellState.hs19
-rw-r--r--src/GF/Grammar/PrGrammar.hs18
-rw-r--r--src/GF/Infra/Modules.hs3
-rw-r--r--src/GF/Infra/Option.hs5
-rw-r--r--src/GF/Infra/ReadFiles.hs10
-rw-r--r--src/GF/Shell/CommandL.hs2
-rw-r--r--src/GF/Shell/Commands.hs28
-rw-r--r--src/GF/Text/Text.hs26
-rw-r--r--src/GF/UseGrammar/GetTree.hs6
-rw-r--r--src/GF/UseGrammar/Linear.hs8
-rw-r--r--src/GF/UseGrammar/Tokenize.hs6
-rw-r--r--src/Today.hs2
18 files changed, 133 insertions, 69 deletions
diff --git a/src/GF.hs b/src/GF.hs
index a75f4ee0c..122d52766 100644
--- a/src/GF.hs
+++ b/src/GF.hs
@@ -14,6 +14,7 @@ import UTF8
import Today (today)
import Arch
import System (getArgs)
+import Monad (foldM)
-- AR 19/4/2000 -- 11/11/2001
@@ -24,8 +25,8 @@ main = do
java = oElem forJava os
putStrLn $ if java then encodeUTF8 welcomeMsg else welcomeMsg
st <- case fs of
- f:_ -> useIOE emptyShellState (shellStateFromFiles os emptyShellState f)
- _ -> return emptyShellState
+ _ -> useIOE emptyShellState $ foldM (shellStateFromFiles os) emptyShellState fs
+ --- _ -> return emptyShellState
if null fs then return () else putCPU
if java then sessionLineJ st else do
gfInteract (initHState st)
diff --git a/src/GF/API.hs b/src/GF/API.hs
index db2e4a066..927c9683c 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -177,9 +177,10 @@ optLinearizeTree opts gr t = case getOptVal opts transferFun of
lin mk
| oElem showRecord opts = liftM prt . linearizeNoMark g c
- | otherwise = return . linTree2string mk g c
+ | otherwise = return . untok . linTree2string mk g c
g = grammar gr
c = cncId gr
+ untok = customOrDefault opts useUntokenizer customUntokenizer gr
{- ----
untoksl . lin where
diff --git a/src/GF/CF/CFIdent.hs b/src/GF/CF/CFIdent.hs
index ab86b8bd4..02343bfb7 100644
--- a/src/GF/CF/CFIdent.hs
+++ b/src/GF/CF/CFIdent.hs
@@ -56,23 +56,17 @@ type Profile = [([[Int]],[Int])]
mkCFFun :: Atom -> CFFun
mkCFFun t = CFFun (t,[])
-{- ----
-getCFLiteral :: String -> Maybe (CFCat, CFFun)
-getCFLiteral s = case lookupLiteral' s of
- Ok (c, lit) -> Just (cat2CFCat c, mkCFFun lit)
- _ -> Nothing
--}
-
varCFFun :: Ident -> CFFun
varCFFun = mkCFFun . AV
consCFFun :: CIdent -> CFFun
consCFFun = mkCFFun . AC
-{- ----
-string2CFFun :: String -> CFFun
-string2CFFun = consCFFun . Ident
--}
+stringCFFun :: String -> CFFun
+stringCFFun = mkCFFun . AS
+
+intCFFun :: Int -> CFFun
+intCFFun = mkCFFun . AI . toInteger
cfFun2String :: CFFun -> String
cfFun2String (CFFun (f,_)) = prt f
@@ -110,6 +104,11 @@ catVarCF = ident2CFCat (mkCIdent "_" "#Var") (identC "_") ----
cat2CFCat :: (Ident,Ident) -> CFCat
cat2CFCat = uncurry idents2CFCat
+---- literals
+cfCatString = string2CFCat "Predef" "String"
+cfCatInt = string2CFCat "Predef" "Int"
+
+
{- ----
uCFCat :: CFCat
diff --git a/src/GF/CF/CanonToCF.hs b/src/GF/CF/CanonToCF.hs
index 6f7dc6d6b..6651b0100 100644
--- a/src/GF/CF/CanonToCF.hs
+++ b/src/GF/CF/CanonToCF.hs
@@ -27,8 +27,9 @@ canon2cf opts gr c = do
let mms = [(a, tree2list (M.jments m)) | m <- cncs]
rules0 <- liftM concat $ mapM (uncurry (cnc2cfCond opts)) mms
let rules = filter (not . isCircularCF) rules0 ---- temporarily here
- let predef = const [] ---- mkCFPredef cfcats
- return $ CF (groupCFRules rules, predef)
+ let grules = groupCFRules rules
+ let predef = mkCFPredef $ map fst grules
+ return $ CF (grules, predef)
cnc2cfCond :: Options -> Ident -> [(Ident,Info)] -> Err [CFRule]
cnc2cfCond opts m gr =
@@ -144,14 +145,9 @@ term2CFItems m t = errIn "forming cf items" $ case t of
---- ??
_ -> prtBad "cannot extract record field from" arg
-{- Proof + 1 @ 4 catVarCF :: CFCat
-PNonterm CIdent Integer Label Bool -- cat, position, part/bind, whether arg
-
-
mkCFPredef :: [CFCat] -> CFPredef
mkCFPredef cats s =
- [(cat, metaCFFun) | TM _ _ <- [s], cat <- cats] ++
- [(cat, varCFFun x) | TV x <- [s], cat <- cats] ++
- [(cat, lit) | TL t <- [s], Just (cat,lit) <- [getCFLiteral t]] ++
- [(cat, lit) | TI i <- [s], Just (cat,lit) <- [getCFLiteral (show i)]] ---
--}
+ [(cat, metaCFFun) | TM _ _ <- [s], cat <- cats] ++
+ [(cat, varCFFun x) | TV x <- [s], cat <- cats] ++
+ [(cfCatString, stringCFFun t) | TL t <- [s]] ++
+ [(cfCatInt, intCFFun t) | TI t <- [s]]
diff --git a/src/GF/Canon/Look.hs b/src/GF/Canon/Look.hs
index 4318239b6..2126edd60 100644
--- a/src/GF/Canon/Look.hs
+++ b/src/GF/Canon/Look.hs
@@ -144,6 +144,8 @@ ccompute cnc = comp []
Con c xs -> liftM (Con c) $ mapM compt xs
+ K (KS []) -> return E --- should not be needed
+
_ -> return t
where
compt = comp g xs
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index 4822cf2b4..a1b1758fb 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -47,15 +47,27 @@ batchCompileOld f = compileOld defOpts f
defOpts = options [beVerbose, emitCode]
-- compile with one module as starting point
+-- command-line options override options (marked by --#) in the file
+-- As for path: if it is read from file, the file path is prepended to each name.
+-- If from command line, it is used as it is.
compileModule :: Options -> ShellState -> FilePath ->
IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)]))
-compileModule opts st file = do
- let ps = pathListOpts opts
+compileModule opts1 st0 file = do
+ opts0 <- ioeIO $ getOptionsFromFile file
+ let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
+ let opts = addOptions opts1 opts0
+ let ps0 = pathListOpts opts
+ let fpath = justInitPath file
+ let ps = if useFileOpt
+ then (map (prefixPathName fpath) ps0)
+ else ps0
ioeIO $ print ps ----
let putp = putPointE opts
- let rfs = readFiles st
- files <- getAllFiles ps rfs file
+ let st = st0 --- if useFileOpt then emptyShellState else st0
+ let rfs = readFiles st
+ let file' = if useFileOpt then justFileName file else file -- to find file itself
+ files <- getAllFiles ps rfs file'
ioeIO $ print files ----
let names = map (fileBody . justFileName) files
ioeIO $ print names ----
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 51e05abd0..ad1566f1f 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -70,7 +70,8 @@ data StateGrammar = StGr {
grammar :: CanonGrammar,
cf :: CF,
---- parser :: StaticParserInfo,
- morpho :: Morpho
+ morpho :: Morpho,
+ loptions :: Options
}
emptyStateGrammar = StGr {
@@ -78,14 +79,15 @@ emptyStateGrammar = StGr {
cncId = identC "#EMPTY", ---
grammar = M.emptyMGrammar,
cf = emptyCF,
- morpho = emptyMorpho
+ morpho = emptyMorpho,
+ loptions = noOptions
}
-- analysing shell grammar into parts
stateGrammarST = grammar
stateCF = cf
stateMorpho = morpho
-stateOptions _ = noOptions ----
+stateOptions = loptions ----
cncModuleIdST = stateGrammarST
@@ -122,16 +124,17 @@ updateShellState opts sh (gr,(sgr,rts)) = do
| (c,co) <- cats, let tc = cat2val co c]
let deps = True ---- not $ null $ allDepCats cgr
let binds = [] ---- allCatsWithBind cgr
+ let src = M.updateMGrammar (srcModules sh) sgr
return $ ShSt {
abstract = abstr0,
concrete = concr0,
concretes = zip concrs concrs,
canModules = cgr,
- srcModules = M.updateMGrammar (srcModules sh) sgr,
+ srcModules = src,
cfs = zip concrs cfs,
morphos = zip concrs (repeat emptyMorpho),
- gloptions = opts, ---- -- global options
+ gloptions = options (M.allFlags src), ---- canModules
readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
absCats = csi,
statistics = [StDepTypes deps,StBoundVars binds]
@@ -194,7 +197,8 @@ stateGrammarOfLang st l = StGr {
cncId = l,
grammar = canModules st, ---- only those needed for l
cf = maybe emptyCF id (lookup l (cfs st)),
- morpho = maybe emptyMorpho id (lookup l (morphos st))
+ morpho = maybe emptyMorpho id (lookup l (morphos st)),
+ loptions = gloptions st ---- only the own ones!
}
grammarOfLang st = stateGrammarST . stateGrammarOfLang st
@@ -218,7 +222,8 @@ stateAbstractGrammar st = StGr {
cncId = identC "#Cnc", ---
grammar = canModules st, ---- only abstarct ones
cf = emptyCF,
- morpho = emptyMorpho
+ morpho = emptyMorpho,
+ loptions = gloptions st ----
}
diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs
index 03197ea02..607b766da 100644
--- a/src/GF/Grammar/PrGrammar.hs
+++ b/src/GF/Grammar/PrGrammar.hs
@@ -9,6 +9,8 @@ import qualified PrintGFC as C
import qualified AbsGFC as A
import Values
import GrammarToSource
+
+import Option
import Ident
import Str
@@ -97,13 +99,6 @@ prMarkedTree = prf 1 where
prTree :: Tree -> [String]
prTree = prMarkedTree . mapTr (\n -> (n,False))
---- to get rig of brackets
-prRefinement :: Term -> String
-prRefinement t = case t of
- Q m c -> prQIdent (m,c)
- QC m c -> prQIdent (m,c)
- _ -> prt t
-
-- a pretty-printer for parsable output
tree2string = unlines . prprTree
@@ -187,3 +182,12 @@ prExp e = case e of
pr2 e = case e of
App _ _ -> prParenth $ prExp e
_ -> pr1 e
+
+-- option -strip strips qualifications
+prTermOpt opts = if oElem nostripQualif opts then prt else prExp
+
+--- to get rid of brackets in the editor
+prRefinement t = case t of
+ Q m c -> prQIdent (m,c)
+ QC m c -> prQIdent (m,c)
+ _ -> prt t
diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs
index ed3e2db83..5d2e0fd15 100644
--- a/src/GF/Infra/Modules.hs
+++ b/src/GF/Infra/Modules.hs
@@ -63,6 +63,9 @@ updateModule (Module mt ms fs me ops js) i t =
replaceJudgements :: Module i f t -> BinTree (i,t) -> Module i f t
replaceJudgements (Module mt ms fs me ops _) js = Module mt ms fs me ops js
+allFlags :: MGrammar i f a -> [f]
+allFlags gr = concat $ map flags $ reverse [m | (_, ModMod m) <- modules gr]
+
data MainGrammar i = MainGrammar {
mainAbstract :: i ,
mainConcretes :: [MainConcreteSpec i]
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index 59e9f352a..100ded735 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -59,6 +59,9 @@ addOption o (Opts os) = iOpts (o:os)
addOptions (Opts os) os0 = foldr addOption os0 os
+concatOptions :: [Options] -> Options
+concatOptions = foldr addOptions noOptions
+
removeOption :: Option -> Options -> Options
removeOption o (Opts os) = iOpts (filter (/=o) os)
@@ -152,6 +155,8 @@ doTrace = iOpt "tr"
noCPU = iOpt "nocpu"
doCompute = iOpt "c"
optimizeCanon = iOpt "opt"
+stripQualif = iOpt "strip"
+nostripQualif = iOpt "nostrip"
-- mainly for stand-alone
useUnicode = iOpt "unicode"
diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs
index bc2706b49..285665747 100644
--- a/src/GF/Infra/ReadFiles.hs
+++ b/src/GF/Infra/ReadFiles.hs
@@ -2,11 +2,13 @@ module ReadFiles where
import Arch (selectLater, modifiedFiles, ModTime)
+import Option
import Operations
import UseIO
import System
import Char
import Monad
+import List
-- make analysis for GF grammar modules. AR 11/6/2003
@@ -122,6 +124,14 @@ lexs s = x:xs where
(x,y) = head $ lex s
xs = if null y then [] else lexs y
+-- options can be passed to the compiler by comments in --#, in the main file
+
+getOptionsFromFile :: FilePath -> IO Options
+getOptionsFromFile file = do
+ s <- readFileIf file
+ let ls = filter (isPrefixOf "--#") $ lines s
+ return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
+
-- old GF tolerated newlines in quotes. No more supported!
fixNewlines s = case s of
'"':cs -> '"':mk cs
diff --git a/src/GF/Shell/CommandL.hs b/src/GF/Shell/CommandL.hs
index dcf62d44b..c3d159574 100644
--- a/src/GF/Shell/CommandL.hs
+++ b/src/GF/Shell/CommandL.hs
@@ -51,7 +51,7 @@ getCommandUTF = do
pCommand = pCommandWords . words where
pCommandWords s = case s of
- "n" : cat : _ -> CNewCat (strings2Cat cat)
+ "n" : cat : _ -> CNewCat cat
"t" : ws -> CNewTree $ unwords ws
"g" : ws -> CRefineWithTree $ unwords ws -- *g*ive
"p" : ws -> CRefineParse $ unwords ws
diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs
index 649afb682..aac758ae7 100644
--- a/src/GF/Shell/Commands.hs
+++ b/src/GF/Shell/Commands.hs
@@ -6,9 +6,10 @@ import Zipper
import qualified Grammar as G ---- Cat, Fun, Q, QC
import GFC
import CMacros
+import Macros (qq)----
import LookAbs
import Look
-import Values (loc2treeFocus)----
+import Values (loc2treeFocus,tree2exp)----
import GetTree
import API
@@ -46,7 +47,7 @@ import List (intersperse)
-- See CommandsL for a parser of a command language.
data Command =
- CNewCat G.Cat
+ CNewCat String
| CNewTree String
| CAhead Int
| CBack Int
@@ -201,7 +202,8 @@ execCommand env c s = case c of
execECommand :: CEnv -> Command -> ECommand
execECommand env c = case c of
CNewCat cat -> action2commandNext $ \x -> do
- s' <- newCat cgr cat x
+ cat' <- string2cat sgr cat
+ s' <- newCat cgr cat' x
uniqueRefinements cgr s'
CNewTree s -> action2commandNext $ \x -> do
t <- string2treeErr gr s
@@ -271,6 +273,7 @@ execECommand env c = case c of
gr = grammarCEnv env
der = maybe True not $ caseYesNo (globalOptions env) noDepTypes
-- if there are dep types, then derived refs; deptypes is the default
+ abs = absId sgr
--
@@ -285,7 +288,7 @@ string2varPair s = case words s of
cMenuDisplay :: String -> Command
cMenuDisplay s = CAddOption (menuDisplay s)
-newCatMenu env = [(CNewCat c, printname env initSState c) |
+newCatMenu env = [(CNewCat (prQIdent c), printname env initSState c) |
(c,[]) <- allCatsOf (canCEnv env)]
mkRefineMenu :: CEnv -> SState -> [(Command,String)]
@@ -302,8 +305,7 @@ mkRefineMenuAll env sstate =
[(CAddClip, (ifShort "ac" "AddClip", "ac"))]
(refs,[],_) ->
[(CRefineWithAtom (prRefinement f), prRef t) | t@(f,_) <- refs] ++
- [(CRefineWithClip i, prClip i t e) | (i,t) <- possClipsSState gr sstate,
- let e = tree2string t]
+ [(CRefineWithClip i, prClip i t) | (i,t) <- possClipsSState gr sstate]
(_,cands,_) ->
[(CSelectCand i, prCand (t,i)) | (t,i) <- zip cands [0..]]
@@ -311,8 +313,8 @@ mkRefineMenuAll env sstate =
prRef (f,t) =
(ifShort "r" "Refine" +++ prOrLinRef f +++ ifTyped (":" +++ prt t),
"r" +++ prRefinement f)
- prClip i t e =
- (ifShort "rc" "Paste" +++ prOrLinTree t e,
+ prClip i t =
+ (ifShort "rc" "Paste" +++ prOrLinTree t,
"rc" +++ show i)
prChangeHead f =
(ifShort "ch" "ChangeHead" +++ prOrLinFun f,
@@ -339,10 +341,10 @@ mkRefineMenuAll env sstate =
G.QC m f -> printname env sstate (m,f)
_ -> prt t
prOrLinFun = printname env sstate
- prOrLinTree t e = case getOptVal opts menuDisplay of
- Just "Abs" -> e
+ prOrLinTree t = case getOptVal opts menuDisplay of
+ Just "Abs" -> prTermOpt opts $ tree2exp t
Just lang -> prQuotedString $ lin lang t
- _ -> e
+ _ -> prTermOpt opts $ tree2exp t
lin lang t = optLinearizeTreeVal opts (stateGrammarOfLang env (language lang)) t
-- there are three orthogonal parameters: Abs/[conc], short/long, typed/untyped
@@ -364,6 +366,8 @@ displayCommandMenu :: CEnv -> [(Command,String)]
displayCommandMenu env =
[(CAddOption (menuDisplay s), s) | s <- "Abs" : langs] ++
[(CAddOption (sizeDisplay s), s) | s <- ["short", "long"]] ++
+ [(fo nostripQualif, s) | (fo,s) <- [(CAddOption,"qualified"),
+ (CRemoveOption,"unqualified")]] ++
[(CAddOption (typeDisplay s), s) | s <- ["typed", "untyped"]]
where
langs = map prLanguage $ allLanguages env
@@ -456,7 +460,7 @@ printname :: CEnv -> SState -> G.Fun -> String
printname env state f = case getOptVal opts menuDisplay of
Just "Abs" -> prQIdent f
Just lang -> printn lang f
- _ -> prQIdent f
+ _ -> prTermOpt opts (qq f)
where
opts = addOptions (optsSState state) (globalOptions env)
printn lang f = err id (ifNull (prQIdent f) (sstr . head)) $ do
diff --git a/src/GF/Text/Text.hs b/src/GF/Text/Text.hs
index 08e897a9b..2fbf97fd3 100644
--- a/src/GF/Text/Text.hs
+++ b/src/GF/Text/Text.hs
@@ -31,15 +31,23 @@ formatAsText = unwords . format . cap . words where
para = (=="<p>")
formatAsCode :: String -> String
-formatAsCode = unwords . format . words where
- format ws = case ws of
- p : w : ww | parB p -> format ((p ++ w') : ww') where (w':ww') = format (w:ww)
- w : p : ww | par p -> format ((w ++ p') : ww') where (p':ww') = format (p:ww)
- w : ww -> w : format ww
- [] -> []
- parB = flip elem (map singleton "([{")
- parE = flip elem (map singleton "}])")
- par t = parB t || parE t
+formatAsCode = rend 0 . words where
+ -- render from BNF Converter
+ rend i ss = case ss of
+ "[" :ts -> cons "[" $ rend i ts
+ "(" :ts -> cons "(" $ rend i ts
+ "{" :ts -> cons "{" $ new (i+1) $ rend (i+1) ts
+ "}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts
+ "}" :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts
+ ";" :ts -> cons ";" $ new i $ rend i ts
+ t : "," :ts -> cons t $ space "," $ rend i ts
+ t : ")" :ts -> cons t $ cons ")" $ rend i ts
+ t : "]" :ts -> cons t $ cons "]" $ rend i ts
+ t :ts -> space t $ rend i ts
+ _ -> ""
+ cons s t = s ++ t
+ new i s = '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s
+ space t s = if null s then t else t ++ " " ++ s
performBinds :: String -> String
performBinds = unwords . format . words where
diff --git a/src/GF/UseGrammar/GetTree.hs b/src/GF/UseGrammar/GetTree.hs
index 9b545c7dd..9ad91c21f 100644
--- a/src/GF/UseGrammar/GetTree.hs
+++ b/src/GF/UseGrammar/GetTree.hs
@@ -44,3 +44,9 @@ string2ref gr s =
if elem '.' s
then return $ uncurry G.Q $ strings2Fun s
else return $ G.Vr $ identC s
+
+string2cat :: StateGrammar -> String -> Err G.Cat
+string2cat gr s =
+ if elem '.' s
+ then return $ strings2Fun s
+ else return $ curry id (absId gr) (identC s)
diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs
index 929273562..a46200b36 100644
--- a/src/GF/UseGrammar/Linear.hs
+++ b/src/GF/UseGrammar/Linear.hs
@@ -12,7 +12,7 @@ import LookAbs
import MMacros
import TypeCheck (annotate) ----
import Str
-import Unlex
+import Text
----import TypeCheck -- to annotate
import Operations
@@ -105,10 +105,14 @@ linLab0 = L (identC "s")
sTables2strs :: [[([Patt],[Str])]] -> [[Str]]
sTables2strs = map snd . concat
--- from this, to get a list of strings --- customize unlexer
+-- from this, to get a list of strings
strs2strings :: [[Str]] -> [String]
strs2strings = map unlex
+-- this is just unwords; use an unlexer from Text to postprocess
+unlex :: [Str] -> String
+unlex = performBinds . concat . map sstr . take 1 ----
+
-- finally, a top-level function to get a string from an expression
linTree2string :: Marker -> CanonGrammar -> Ident -> A.Tree -> String
linTree2string mk gr m e = err id id $ do
diff --git a/src/GF/UseGrammar/Tokenize.hs b/src/GF/UseGrammar/Tokenize.hs
index dd0879931..ac28276f5 100644
--- a/src/GF/UseGrammar/Tokenize.hs
+++ b/src/GF/UseGrammar/Tokenize.hs
@@ -21,7 +21,11 @@ tokVars :: String -> [CFTok]
tokVars = map mkCFTokVar . words
mkCFTok :: String -> CFTok
-mkCFTok s = tS s ---- if (isLiteral s) then (mkLit s) else (tS s)
+mkCFTok s = case s of
+ '"' :cs@(_:_) -> tL $ init cs
+ '\'':cs@(_:_) -> tL $ init cs --- 's Gravenhage
+ _:_ | all isDigit s -> tI s
+ _ -> tS s
mkCFTokVar :: String -> CFTok
mkCFTokVar s = case s of
diff --git a/src/Today.hs b/src/Today.hs
index 09acfaae2..9053efb0d 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Fri Oct 24 16:27:10 CEST 2003"
+module Today where today = "Mon Nov 3 17:53:59 CET 2003"