Added French for new API. Started alpha conv. Fixed bugs.

4 files changed, 23 insertions, 10 deletions

diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index 64cb29680..c117c0335 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -241,8 +241,8 @@ customTokenizer =
   ,(strCI "code",      const $ lexHaskell)
   ,(strCI "text",      const $ lexText)
   ,(strCI "unglue",    \gr -> map tS . decomposeWords (stateMorpho gr))
-----  ,(strCI "codelit",   lexHaskellLiteral . stateIsWord)
-----  ,(strCI "textlit",   lexTextLiteral . stateIsWord)
+  ,(strCI "codelit",   lexHaskellLiteral . stateIsWord)
+  ,(strCI "textlit",   lexTextLiteral . stateIsWord)
   ,(strCI "codeC",     const $ lexC2M)
   ,(strCI "codeCHigh", const $ lexC2M' True)
 -- add your own tokenizers here
diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs
index e60f8da79..0bd053803 100644
--- a/src/GF/UseGrammar/Linear.hs
+++ b/src/GF/UseGrammar/Linear.hs
@@ -42,13 +42,17 @@ linearizeToRecord gr mk m = lin [] where
     xs' <- mapM (\ (i,x) -> lin (i:ts) x) $ zip [0..] xs
 
     r <- case at of
-      A.AtC f -> look f >>= comp xs'
+      A.AtC f -> lookf c t f >>= comp xs'
       A.AtL s -> return $ recS $ tK $ prt at
       A.AtI i -> return $ recS $ tK $ prt at
-      A.AtV x -> lookCat c >>= comp [tK (prt at)]
-      A.AtM m -> lookCat c >>= comp [tK (prt at)] 
+      A.AtV x -> lookCat c >>= comp [tK (prt_ at)]
+      A.AtM m -> lookCat c >>= comp [tK (prt_ at)] 
 
-    return $ fmk $ mkBinds binds r
+    r' <- case r of     -- to see stg in case the result is variants {}
+      FV [] -> lookCat c >>= comp [tK (prt_ t)]
+      _ -> return r
+
+    return $ fmk $ mkBinds binds r'
 
   look = lookupLin gr . redirectIdent m . rtQIdent
   comp = ccompute gr
@@ -60,6 +64,11 @@ linearizeToRecord gr mk m = lin [] where
   lookCat = return . errVal defLindef . look 
          ---- should always be given in the module
 
+  -- to show missing linearization as term
+  lookf c t f = case look f of
+    Ok h -> return h
+    _ -> lookCat c >>= comp [tK (prt_ t)]
+
 
 -- thus the special case:
 
diff --git a/src/GF/UseGrammar/Parsing.hs b/src/GF/UseGrammar/Parsing.hs
index b5b587c91..48b6ffac6 100644
--- a/src/GF/UseGrammar/Parsing.hs
+++ b/src/GF/UseGrammar/Parsing.hs
@@ -64,9 +64,10 @@ tokens2trms opts sg cn parser as = do
     _ | null ts0 -> checkWarn "No success in cf parsing" >> return []
     _ | raw      -> do
       ts1 <- return (map cf2trm0 ts0) ----- should not need annot
-      mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated
+      mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated; often fails
     _ -> do
-      (ts1,_) <- checkErr $ mapErr postParse ts0
+      (ts1,ss) <- checkErr $ mapErr postParse ts0
+      if null ts1 then raise ss else return ()
       ts2 <- mapM (checkErr . (annotate gr) . trExp) ts1 ---- 
       if forgive then return ts2 else do
         let tsss = [(t, allLinsOfTree gr cn t) | t <- ts2]
@@ -75,7 +76,7 @@ tokens2trms opts sg cn parser as = do
         if null ps 
            then raise $ "Failure in morphology." ++
                   if verb 
-                     then "\nPossible corrections: " +++++ 
+                     then "\nPossible corrections: " +++++
                           unlines (nub (map sstr (concatMap snd tsss)))
                      else ""
            else return ps
diff --git a/src/GF/UseGrammar/Tokenize.hs b/src/GF/UseGrammar/Tokenize.hs
index ac28276f5..b264075ba 100644
--- a/src/GF/UseGrammar/Tokenize.hs
+++ b/src/GF/UseGrammar/Tokenize.hs
@@ -129,6 +129,9 @@ unknown2string isKnown = map mkOne where
   mkOne t@(TC s) = if isKnown s then t else mkTL s
   mkOne t        = t
 
-lexTextLiteral    isKnown = unknown2string isKnown . lexText
+lexTextLiteral    isKnown = unknown2string (eitherUpper isKnown) . lexText
 lexHaskellLiteral isKnown = unknown2string isKnown . lexHaskell
 
+eitherUpper isKnown w@(c:cs) = isKnown (toLower c : cs) || isKnown (toUpper c : cs)
+eitherUpper isKnown w = isKnown w
+