some var parser bug fixes

This commit is contained in:
aarne
2004-08-24 11:49:46 +00:00
parent 9e05ef01aa
commit 9d404ba7a4
13 changed files with 40 additions and 17 deletions

View File

@@ -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!
ThoseNumNP n = nameNounPhrase {s = \\c => "those" ++ n.s ! c} ; --- Pl; Gen!
TheseNumNP n = nameNounPhrasePl {s = \\c => "these" ++ n.s ! c} ;
ThoseNumNP n = nameNounPhrasePl {s = \\c => "those" ++ n.s ! c} ;
EverybodyNP = nameNounPhrase (nameReg "everybody") ;
SomebodyNP = nameNounPhrase (nameReg "somebody") ;

View File

@@ -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.

View File

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

View File

@@ -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 ;

View File

@@ -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

View File

@@ -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

View File

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

View File

@@ -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)

View File

@@ -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

View File

@@ -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)

View File

@@ -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

View File

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

View File

@@ -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