some var parser bug fixes

9 files changed, 29 insertions, 15 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)
 
diff --git a/src/HelpFile b/src/HelpFile
index 650870398..3e2b04335 100644
--- a/src/HelpFile
+++ b/src/HelpFile
@@ -418,6 +418,7 @@ q, quit: q
     -lexer=vars          like words, but "x","x_...","$...$" as vars, "?..." as meta
     -lexer=chars         each character is a token
     -lexer=code          use Haskell's lex
+    -lexer=codevars      like code, but "x", "x_..." as vars, "??" as meta
     -lexer=text          with conventions on punctuation and capital letters
     -lexer=codelit       like code, but treat unknown words as string literals
     -lexer=textlit       like text, but treat unknown words as string literals
diff --git a/src/HelpFile.hs b/src/HelpFile.hs
index 24d47221b..66be956fa 100644
--- a/src/HelpFile.hs
+++ b/src/HelpFile.hs
@@ -431,6 +431,7 @@ txtHelpFile =
   "\n    -lexer=vars          like words, but \"x\",\"x_...\",\"$...$\" as vars, \"?...\" as meta" ++
   "\n    -lexer=chars         each character is a token" ++
   "\n    -lexer=code          use Haskell's lex" ++
+  "\n    -lexer=codevars      like code, but \"x\", \"x_...\" as vars, \"??\" as meta" ++
   "\n    -lexer=text          with conventions on punctuation and capital letters" ++
   "\n    -lexer=codelit       like code, but treat unknown words as string literals" ++
   "\n    -lexer=textlit       like text, but treat unknown words as string literals" ++
diff --git a/src/Makefile b/src/Makefile
index 04432d768..77254c590 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -2,9 +2,10 @@ include config.mk
 
 
 GHMAKE=$(GHC) --make
+GHCXMAKE=ghcxmake
 GHCFLAGS=-package lang -package util -fglasgow-exts $(CPPFLAGS) $(LDFLAGS)
 GHCOPTFLAGS=-O $(GHCFLAGS)
-GHCFUDFLAG=-package Fudgets
+GHCFUDFLAG=
 JAVAFLAGS=-target 1.4 -source 1.4
 
 HUGSINCLUDE    =.:for-hugs:api:source:canonical:cf:grammar:infra:shell:useGrammar:compile:newparsing:trace:
@@ -45,9 +46,9 @@ ghc: nofud
 ghci: nofud-links ghci-nofud
 
 fud:
-	$(GHMAKE) $(GHCFLAGS) $(GHCINCLUDE) $(GHCFUDFLAG) GF.hs -o gf+
-	strip gf+
-	mv gf+ ../bin/
+	$(GHCXMAKE) $(GHCFLAGS) $(GHCINCLUDE) $(GHCFUDFLAG) GF.hs -o fgf
+	strip fgf
+	mv fgf ../bin/
 
 gft:
 	$(GHMAKE) $(GHCFLAGS) $(GHCINCLUDENOFUD) -itranslate translate/GFT.hs -o gft