some var parser bug fixes

lib/resource-0.6/english/StructuralEng.gf

@@ -39,8 +39,8 @@ concrete StructuralEng of Structural =
 
   ThisNP = nameNounPhrase (nameReg "this") ;
   ThatNP = nameNounPhrase (nameReg "that") ;
-  TheseNumNP n = nameNounPhrase {s = \\c => "these" ++ n.s ! c} ; --- Pl; Gen!
+  TheseNumNP n = nameNounPhrasePl {s = \\c => "these" ++ n.s ! c} ;
-  ThoseNumNP n = nameNounPhrase {s = \\c => "those" ++ n.s ! c} ; --- Pl; Gen!
+  ThoseNumNP n = nameNounPhrasePl {s = \\c => "those" ++ n.s ! c} ;
 
   EverybodyNP = nameNounPhrase (nameReg "everybody") ;
   SomebodyNP = nameNounPhrase (nameReg "somebody") ;

lib/resource-0.6/english/SyntaxEng.gf

@@ -47,6 +47,9 @@ oper
   nameNounPhrase : ProperName -> NounPhrase = \john -> 
     {s = \\c => john.s ! toCase c ; n = Sg ; p = P3} ;
 
+  nameNounPhrasePl : ProperName -> NounPhrase = \john -> 
+    {s = \\c => john.s ! toCase c ; n = Pl ; p = P3} ;
+
 -- The following construction has to be refined for genitive forms:
 -- "we two", "us two" are OK, but "our two" is not.
 

lib/resource-0.6/shallow/Shallow.gf

@@ -23,6 +23,9 @@ abstract Shallow = {
     Verb ;
     TV ;
     Adj ;
+    AdjDeg ; ----
+    Adj2 ;   ----
+    V3 ; ----
     N ;
     Noun ;
     CN ;

lib/resource-0.6/shallow/ShallowI.gf

@@ -18,6 +18,9 @@ incomplete concrete ShallowI of Shallow = open (Resource = Resource) in {
     Det = Resource.Det ;
     Prep = Resource.Prep ;
     Num = Resource.Num ;
+    AdjDeg = Resource.AdjDeg ;
+    Adj2 = Resource.Adj2 ;
+    V3 = Resource.V3 ;
 
   lin
     PhrS = Resource.IndicPhrase ;

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@(L _))  -> return [[PNonterm (cIQ cat) pos l True]]
-      (Arg (A cat pos), l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
+      (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 b pos), l@(L _))  -> return [[PNonterm (cIQ cat) pos l True]]
-      (Arg (AB cat pos b), l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
+      (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

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 _
+  CHelp _ -> case opts0 of
-    | oElem showAll opts  -> returnArg   (AString txtHelpFile) sa
+    Opts [o] | o == showAll -> returnArg   (AString txtHelpFile) sa
-    | otherwise           -> returnArg   (AString txtHelpFileSummary) 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

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"

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)

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

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)
 

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

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" ++

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+
+	$(GHCXMAKE) $(GHCFLAGS) $(GHCINCLUDE) $(GHCFUDFLAG) GF.hs -o fgf
-	strip gf+
+	strip fgf
-	mv gf+ ../bin/
+	mv fgf ../bin/
 
 gft:
 	$(GHMAKE) $(GHCFLAGS) $(GHCINCLUDENOFUD) -itranslate translate/GFT.hs -o gft