From c86192273657fe17d4dfe246f0d850379b9e5866 Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 24 Aug 2004 11:49:46 +0000 Subject: [PATCH] some var parser bug fixes --- src/GF/CF/CanonToCF.hs | 12 ++++++------ src/GF/Shell.hs | 7 ++++--- src/GF/Shell/ShellCommands.hs | 2 +- src/GF/UseGrammar/Custom.hs | 1 + src/GF/UseGrammar/Parsing.hs | 6 +++++- src/GF/UseGrammar/Tokenize.hs | 5 +++++ src/HelpFile | 1 + src/HelpFile.hs | 1 + src/Makefile | 9 +++++---- 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