msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

fixes in parsing

Browse Source
This commit is contained in:
aarne
2004-06-22 12:33:31 +00:00
parent 2bdc8b877f
commit f28e0f16c3
9 changed files with 36 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
grammars/prelude/Prelude.gf
View File

@@ -1,6 +1,6 @@
-- language-independent prelude facilities
resource Prelude = {
resource Prelude = open (Predef=Predef) in {
oper
-- to construct records and tables

7
lib/resource-0.6/abstract/Combinations.gf
View File

@@ -210,7 +210,7 @@ fun
PredV : V -> VG ; -- "walk", "doesn't walk"
PredPassV : V -> VG ; -- "is seen", "is not seen"
PredTV : TV -> NP -> VG ; -- "sees John", "doesn't see John"
PredVS : VS -> S -> VG ; -- "says that I run", "doesn't say..."
PredVS : VS -> S -> VG ; -- "says that I run", "doesn't say..."
PredVV : VV -> VG -> VG ; -- "can run", "can't run", "tries to run"
PredV3 : V3 -> NP -> NP -> VG ; -- "prefers wine to beer"
@@ -222,6 +222,7 @@ fun
PosVG,NegVG : VG -> VP ; --
--!
--3 Adverbs
--
@@ -239,7 +240,7 @@ fun
--
PredVP : NP -> VP -> S ; -- "John walks"
PosSlashTV,NegSlashTV : NP -> TV -> Slash ; -- "John sees", "John doesn's see"
PosSlashTV,NegSlashTV : NP -> TV -> Slash ; -- "John sees", "John doesn't see"
OneVP : VP -> S ; -- "one walks"
ThereNP : NP -> S ; -- "there is a bar","there are 86 bars"
@@ -259,7 +260,7 @@ fun
FunIP : Fun -> IP -> IP ; -- "the mother of whom"
NounIPOne, NounIPMany : CN -> IP ; -- "which car", "which cars"
QuestVP : NP -> VP -> Qu; -- "does John walk"; "doesn't John walk"
QuestVP : NP -> VP -> Qu ; -- "does John walk"; "doesn't John walk"
IntVP : IP -> VP -> Qu ; -- "who walks"
IntSlash : IP -> Slash -> Qu ; -- "whom does John see"
QuestAdv : IAdv -> NP -> VP -> Qu ; -- "why do you walk"

1
lib/resource-0.6/swedish/CombinationsSwe.gf
View File

@@ -114,6 +114,7 @@ lin
CNthatS = nounThatSentence ;
PredVP = predVerbPhrase ;
PosVG = predVerbGroup True ;
NegVG = predVerbGroup False ;

5
src/GF/API.hs
View File

@@ -201,9 +201,10 @@ optLinearizeTree opts0 gr t = case getOptVal opts transferFun of
lin mk
| oElem showRecord opts = liftM prt . linearizeNoMark g c
| oElem tableLin opts = liftM (unlines . map untok . prLinTable) .
| oElem tableLin opts = liftM (unlines . map untok . prLinTable True) .
allLinTables g c
| oElem showAll opts = liftM (unlines . map untok . prLinTable False) .
allLinTables g c
| oElem showAll opts = return . unlines . linTree2strings mk g c
| otherwise = return . unlines . optIntOrOne . linTree2strings mk g c
g = grammar gr
c = cncId gr

22
src/GF/CF/Profile.hs
View File

@@ -56,20 +56,16 @@ tree2term (CFTree (cff@(CFFun (fun,pro)), (_,trees))) = case fun of
then Bad "arity error"
else return xs'
where xs' = [t | t@(ITerm _ _) <- xs]
unif [] = return $ IMeta
unif xs@(ITerm fp@(f,_) xx : ts) = do
let hs = [h | ITerm (h,_) _ <- ts]
testErr (all (==f) hs) -- if fails, hs must be nonempty
("unification expects" +++ prt f +++ "but found" +++ prt (head hs))
xx' <- mapM unifArg [0 .. length xx - 1]
return $ ITerm fp xx'
unif xs = case [t | t@(ITerm _ _) <- xs] of
[] -> return $ IMeta
(ITerm fp@(f,_) xx : ts) -> do
let hs = [h | ITerm (h,_) _ <- ts, h /= f]
testErr (null hs) -- if fails, hs must be nonempty
("unification expects" +++ prt f +++ "but found" +++ prt (head hs))
xx' <- mapM unifArg [0 .. length xx - 1]
return $ ITerm fp xx'
where
unifArg i = tryUnif [zz !! i | ITerm _ zz <- xs]
tryUnif xx = case [t | t@(ITerm _ _) <- xx] of
[] -> return IMeta
x:xs -> if all (==x) xs
then return x
else Bad "failed to unify"
unifArg i = unif [zz !! i | ITerm _ zz <- xs]
mkBinds (xss,_) = mapM mkBind xss
mkBind xs = do

1
src/GF/Infra/Option.hs
View File

@@ -230,6 +230,7 @@ flagDepth = aOpt "depth"
flagAlts = aOpt "alts"
flagLength = aOpt "length"
flagNumber = aOpt "number"
flagRawtrees = aOpt "rawtrees"
caseYesNo :: Options -> OptFun -> Maybe Bool
caseYesNo opts f = do

7
src/GF/Shell/ShellCommands.hs
View File

@@ -105,6 +105,7 @@ testValidFlag st f x = case f of
"lexer" -> testInc customTokenizer
"unlexer" -> testInc customUntokenizer
"depth" -> testN
"rawtrees"-> testN
"parser" -> testInc customParser
"alts" -> testN
"transform" -> testInc customTermCommand
@@ -129,14 +130,14 @@ testValidFlag st f x = case f of
optionsOfCommand :: Command -> ([String],[String])
optionsOfCommand co = case co of
CImport _ -> both "old v s opt src retain nocf nocheckcirc cflexer"
"abs cnc res"
"abs cnc res path"
CRemoveLanguage _ -> none
CEmptyState -> none
CStripState -> none
CTransformGrammar _ -> flags "printer"
CConvertLatex _ -> none
CLinearize _ -> both "table struct record" "lang number unlexer"
CParse -> both "new n ign raw v" "cat lang lexer parser number"
CLinearize _ -> both "table struct record all" "lang number unlexer"
CParse -> both "new n ign raw v" "cat lang lexer parser number rawtrees"
CTranslate _ _ -> opts "cat lexer parser"
CGenerateRandom -> flags "cat lang number depth"
CGenerateTrees -> both "metas" "depth alts cat lang number"

9
src/GF/UseGrammar/Linear.hs
View File

@@ -161,10 +161,11 @@ allLinTables gr c t = do
gets (ps,t) = liftM (curry id ps . cc . map str2strings) $ strsFromTerm t
cc = concat . intersperse ["/"]
prLinTable :: [[(Label,[([Patt],[String])])]] -> [String]
prLinTable = concatMap prOne . concat where
prOne (lab,pss) = prt lab : map pr pss ----
pr (ps,ss) = unwords (map prt_ ps) +++ ":" +++ unwords ss
prLinTable :: Bool -> [[(Label,[([Patt],[String])])]] -> [String]
prLinTable pars = concatMap prOne . concat where
prOne (lab,pss) = (if pars then ((prt lab) :) else id) (map pr pss) ----
pr (ps,ss) = (if pars then ((unwords (map prt_ ps) +++ ":") +++)
else id) (unwords ss)
{-
-- the value is a list of strs

9
src/GF/UseGrammar/Parsing.hs
View File

@@ -71,7 +71,14 @@ trees2trms opts sg cn as ts0 info = do
ts1 <- return (map cf2trm0 ts0) ----- should not need annot
mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated; often fails
_ -> do
(ts1,ss) <- checkErr $ mapErrN 10 postParse ts0
let num = optIntOrN opts flagRawtrees 99999
let (ts01,rest) = splitAt num ts0
if null rest then return ()
else checkWarn ("Warning: only" +++ show num +++ "raw parses out of" +++
show (length ts0) +++
"considered; use -rawtrees=<Int> to see more"
)
(ts1,ss) <- checkErr $ mapErrN 10 postParse ts01
if null ts1 then raise ss else return ()
ts2 <- mapM (checkErr . annotate gr . refreshMetas [] . trExp) ts1 ----
if forgive then return ts2 else do