diff options
Diffstat (limited to 'treebanks/susanne/Parser.hs')
| -rw-r--r-- | treebanks/susanne/Parser.hs | 59 |
1 files changed, 35 insertions, 24 deletions
diff --git a/treebanks/susanne/Parser.hs b/treebanks/susanne/Parser.hs index 62e362a9f..f34bb3423 100644 --- a/treebanks/susanne/Parser.hs +++ b/treebanks/susanne/Parser.hs @@ -3,29 +3,30 @@ module Parser where import Data.Char import Control.Monad -import PGF(PGF,Morpho,lookupMorpho,functionType,unType) +import PGF2 import SusanneFormat +import Debug.Trace -newtype P a = P {runP :: PGF -> Morpho -> [ParseTree] -> Maybe ([ParseTree], a)} +newtype P a = P {runP :: PGF -> Concr -> [ParseTree] -> Maybe ([ParseTree], a)} instance Monad P where - return x = P (\pgf morpho ts -> Just (ts, x)) - f >>= g = P (\pgf morpho ts -> case runP f pgf morpho ts of + return x = P (\pgf cnc ts -> Just (ts, x)) + f >>= g = P (\pgf cnc ts -> case runP f pgf cnc ts of Nothing -> Nothing - Just (ts,x) -> runP (g x) pgf morpho ts) + Just (ts,x) -> runP (g x) pgf cnc ts) instance MonadPlus P where - mzero = P (\pgf morpho ts -> Nothing) - mplus f g = P (\pgf morpho ts -> mplus (runP f pgf morpho ts) (runP g pgf morpho ts)) + mzero = P (\pgf cnc ts -> Nothing) + mplus f g = P (\pgf cnc ts -> mplus (runP f pgf cnc ts) (runP g pgf cnc ts)) -match tag_spec = P (\pgf morpho ts -> +match convert tag_spec = P (\pgf cnc ts -> case ts of (t@(Phrase tag1 mods1 fn1 _ _):ts) | tag == tag1 && all (flip elem mods1) mods && - (null fn || fn == fn1) -> Just (ts,t) + (null fn || fn == fn1) -> Just (ts,convert pgf cnc t) (t@(Word _ tag1 _ _):ts) - | tag == tag1 -> Just (ts,t) + | tag == tag1 && null mods-> Just (ts,convert pgf cnc t) _ -> Nothing) where (f,_) = readTag (Word "<match>" undefined undefined undefined) tag_spec @@ -43,12 +44,12 @@ many f = `mplus` do return [] -inside tag_spec p = P (\pgf morpho ts -> +inside tag_spec p = P (\pgf cnc ts -> case ts of (t@(Phrase tag1 mods1 fn1 _ ts'):ts) | tag == tag1 && all (flip elem mods1) mods && - (null fn || fn == fn1) -> case runP p pgf morpho ts' of + (null fn || fn == fn1) -> case runP p pgf cnc ts' of Just ([],x) -> Just (ts,x) _ -> Nothing _ -> Nothing) @@ -56,35 +57,45 @@ inside tag_spec p = P (\pgf morpho ts -> (f,_) = readTag (Word "<match>" undefined undefined undefined) tag_spec Phrase tag mods fn _ _ = f [] -insideOpt tag_spec p = P (\pgf morpho ts -> +insideOpt convert tag_spec p = P (\pgf cnc ts -> case ts of (t@(Phrase tag1 mods1 fn1 _ ts'):ts) | tag == tag1 && all (flip elem mods1) mods && - (null fn || fn == fn1) -> case runP p pgf morpho ts' of + (null fn || fn == fn1) -> case runP p pgf cnc ts' of Just ([],x) -> Just (ts,x) - _ -> Just (ts,t) + _ -> Just (ts,convert pgf cnc t) _ -> Nothing) where (f,_) = readTag (Word "<match>" undefined undefined undefined) tag_spec Phrase tag mods fn _ _ = f [] -lemma tag cat an0 = P (\pgf morpho ts -> +lemma tag cat an0 = P (\pgf cnc ts -> case ts of - (t@(Word _ tag1 form _):ts) | tag == tag1 -> - case [f | (f,an) <- lookupMorpho morpho (map toLower form), hasCat pgf f cat, an == an0] of - [f] -> Just (ts,App f []) - _ -> Just (ts,t) - _ -> Nothing) + (t@(Word _ tag1 form _):ts) | tag == tag1 -> case runP (lookupForm cat an0 form) pgf cnc ts of + Nothing -> Just (ts,t) + x -> x + _ -> Nothing) + +lookupForm cat an0 form = P (\pgf cnc ts -> + case [f | (f,an,_) <- lookupMorpho cnc form, hasCat pgf f cat, an == an0] of + [] -> case [f | (f,an,_) <- lookupMorpho cnc (map toLower form), hasCat pgf f cat, an == an0] of + [f] -> Just (ts,App f []) + _ -> Nothing + [f] -> Just (ts,App f []) + _ -> Nothing) where hasCat pgf f cat = case functionType pgf f of - Just ty -> case unType ty of - (_,cat1,_) -> cat1 == cat - Nothing -> False + (DTyp _ cat1 _) -> cat1 == cat opt f = do x <- f return (Just x) `mplus` do return Nothing + +word tag = P (\pgf cnc ts -> + case ts of + ((Word _ tag1 form _):ts) | tag == tag1 -> Just (ts,form) + _ -> Nothing) |