1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
module Parser where
import Data.Char
import Control.Monad
import PGF(PGF,Morpho,lookupMorpho,functionType,unType)
import SusanneFormat
newtype P a = P {runP :: PGF -> Morpho -> [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
Nothing -> Nothing
Just (ts,x) -> runP (g x) pgf morpho 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))
match tag_spec = P (\pgf morpho ts ->
case ts of
(t@(Phrase tag1 mods1 fn1 _ _):ts)
| tag == tag1 &&
all (flip elem mods1) mods &&
(null fn || fn == fn1) -> Just (ts,t)
(t@(Word _ tag1 _ _):ts)
| tag == tag1 -> Just (ts,t)
_ -> Nothing)
where
(f,_) = readTag (Word "<match>" undefined undefined undefined) tag_spec
Phrase tag mods fn _ _ = f []
many1 f = do
x <- f
xs <- many f
return (x:xs)
many f =
do x <- f
xs <- many f
return (x:xs)
`mplus`
do return []
inside tag_spec p = P (\pgf morpho 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
Just ([],x) -> Just (ts,x)
_ -> Nothing
_ -> Nothing)
where
(f,_) = readTag (Word "<match>" undefined undefined undefined) tag_spec
Phrase tag mods fn _ _ = f []
insideOpt tag_spec p = P (\pgf morpho 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
Just ([],x) -> Just (ts,x)
_ -> Just (ts,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 ->
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)
where
hasCat pgf f cat =
case functionType pgf f of
Just ty -> case unType ty of
(_,cat1,_) -> cat1 == cat
Nothing -> False
opt f =
do x <- f
return (Just x)
`mplus`
do return Nothing
|
