some var parser bug fixes

6 files changed, 22 insertions, 11 deletions

diff --git a/src/GF/CF/CanonToCF.hs b/src/GF/CF/CanonToCF.hs
index d2e247360..915e11db2 100644
--- a/src/GF/CF/CanonToCF.hs
+++ b/src/GF/CF/CanonToCF.hs
@@ -73,7 +73,7 @@ mkCfRules m fun cat args (lab, itss) = mapM mkOneRule itss
       mkOne (A  c i) = mkOne (AB c 0 i)
       mkOne (AB _ b i) = (map mkB [0..b-1], [k | (k,(j,_,True)) <- nonterms, j==i])
         where
-          mkB j = [p | (p,(k, LV l,False)) <- nonterms, k == i, l == j]
+          mkB x = [k | (k,(j, LV y,False)) <- nonterms, j == i, y == x]
 
 -- intermediate data structure of CFItems with information for profiles
 data PreCFItem = 
@@ -143,10 +143,10 @@ term2CFItems m t = errIn "forming cf items" $ case t of
     tryMkCFTerm itss = return itss
 
     extrR arg lab = case (arg,lab) of
-      (Arg (A cat pos), l@(L _))  -> return [[PNonterm (cIQ cat) pos l True]]
-      (Arg (A cat pos), l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
-      (Arg (AB cat pos b), l@(L _))  -> return [[PNonterm (cIQ cat) pos l True]]
-      (Arg (AB cat pos b), l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
+      (Arg (A  cat pos),   l@(L _))  -> return [[PNonterm (cIQ cat) pos l True]]
+      (Arg (A  cat pos),   l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
+      (Arg (AB cat b pos), l@(L _))  -> return [[PNonterm (cIQ cat) pos l True]]
+      (Arg (AB cat b pos), l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
                                      ---- ??
       _   -> prtBad "cannot extract record field from" arg
     cIQ c = if isPredefCat c then CIQ cPredefAbs c else CIQ m c
@@ -158,7 +158,7 @@ mkCFPredef opts rules = (ruls, \s -> preds0 s ++ look s) where
                    else (rules,emptyTrie)
   preds0 s = 
     [(cat,         metaCFFun)     | TM _ _ <- [s], cat <- cats] ++
-    [(cat,         varCFFun x)    | TV x   <- [s], cat <- cats] ++
+    [(cat,         varCFFun x)    | TV x   <- [s], cat <- catVarCF : cats] ++
     [(cfCatString, stringCFFun t) | TL t   <- [s]]              ++
     [(cfCatInt,    intCFFun t)    | TI t   <- [s]]
   cats = map fst rules
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index cb6d3ff18..27ceb19e0 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -209,9 +209,10 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
 ---- deprec!  CSetLocalFlag lang -> changeState (addLocalOptions lang opts0) sa
 
   CHelp (Just c) -> returnArg   (AString (txtHelpCommand c)) sa
-  CHelp _
-    | oElem showAll opts  -> returnArg   (AString txtHelpFile) sa
-    | otherwise           -> returnArg   (AString txtHelpFileSummary) sa
+  CHelp _ -> case opts0 of
+    Opts [o] | o == showAll -> returnArg   (AString txtHelpFile) sa
+    Opts [o]        -> returnArg   (AString (txtHelpCommand ('-':prOpt o))) sa
+    _               -> returnArg   (AString txtHelpFileSummary) sa
 
   CPrintGrammar       -> returnArg (AString (optPrintGrammar opts gro)) sa
   CPrintGlobalOptions -> justOutput (putStrLn  $ prShellStateInfo st) sa
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index 999a452c9..bf0d114e1 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -164,7 +164,7 @@ optionsOfCommand co = case co of
   CPrintGrammar -> both "utf8" "printer lang"
   CPrintMultiGrammar -> both "utf8" "printer"
 
-  CHelp _ -> opts "all"
+  CHelp _ -> opts "all filter length lexer unlexer printer transform depth number"
 
   CImpure ICEditSession -> opts "f"
   CImpure ICTranslateSession -> both "f langs" "cat"
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index 035099acc..e7989de30 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -320,6 +320,7 @@ customTokenizer =
   ,(strCI "vars",      const $ tokVars)
   ,(strCI "chars",     const $ map (tS . singleton))
   ,(strCI "code",      const $ lexHaskell)
+  ,(strCI "codevars",  const $ (mkTokVars lexHaskell))
   ,(strCI "text",      const $ lexText)
   ,(strCI "unglue",    \gr -> map tS . decomposeWords (stateMorpho gr))
   ,(strCI "codelit",   lexHaskellLiteral . stateIsWord)
diff --git a/src/GF/UseGrammar/Parsing.hs b/src/GF/UseGrammar/Parsing.hs
index 1e736d24e..ba0669029 100644
--- a/src/GF/UseGrammar/Parsing.hs
+++ b/src/GF/UseGrammar/Parsing.hs
@@ -20,6 +20,7 @@ import Option
 import Custom
 import ShellState
 
+import PPrCF (prCFTree)
 import qualified ParseGFC as N
 
 import Operations
@@ -69,7 +70,10 @@ trees2trms opts sg cn as ts0 info = 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; often fails
+      checks [
+         mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated, often fails
+        ,checkWarn (unlines ("Raw CF trees:":(map prCFTree ts0))) >> return []
+        ]
     _ -> do
       let num = optIntOrN opts flagRawtrees 99999
       let (ts01,rest) = splitAt num ts0
diff --git a/src/GF/UseGrammar/Tokenize.hs b/src/GF/UseGrammar/Tokenize.hs
index 22d70a9b1..77c6222ac 100644
--- a/src/GF/UseGrammar/Tokenize.hs
+++ b/src/GF/UseGrammar/Tokenize.hs
@@ -35,6 +35,11 @@ mkCFTokVar s = case s of
   '$':xs@(_:_) -> if last s == '$' then tV (init xs) else tS s
   _            -> tS s
 
+mkTokVars :: (String -> [CFTok]) -> String -> [CFTok]
+mkTokVars tok = map tv . tok where
+  tv (TS s) = mkCFTokVar s
+  tv t = t
+
 mkLit :: String -> CFTok
 mkLit s = if (all isDigit s) then (tI s) else (tL s)