GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-24 03:52:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

a new version of the conversion script for the Susanne corpus which covers a bit less than half of the data

Browse Source
This commit is contained in:
krasimir
2015-11-13 13:05:21 +00:00
parent b33ea36c18
commit 6011fbc033
4 changed files with 903 additions and 199 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
treebanks/susanne/Parser.hs
View File

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