diff options
| author | kr.angelov <kr.angelov@gmail.com> | 2012-10-01 08:52:54 +0000 |
|---|---|---|
| committer | kr.angelov <kr.angelov@gmail.com> | 2012-10-01 08:52:54 +0000 |
| commit | 6e3503bb7b6c9aac12711477b8a474ce41c1cd7a (patch) | |
| tree | ef55a8a965a4a09473bc9dad97a38ab13fc59c1b /examples/PennTreebank/Monad.hs | |
| parent | de679b400acdec70a42b09c525c4c8b4f7d33f09 (diff) | |
move examples/PennTreebank to /treebanks/PennTreebank
Diffstat (limited to 'examples/PennTreebank/Monad.hs')
| -rw-r--r-- | examples/PennTreebank/Monad.hs | 98 |
1 files changed, 0 insertions, 98 deletions
diff --git a/examples/PennTreebank/Monad.hs b/examples/PennTreebank/Monad.hs deleted file mode 100644 index 30fd1d7a0..000000000 --- a/examples/PennTreebank/Monad.hs +++ /dev/null @@ -1,98 +0,0 @@ -module Monad ( Rule(..), Grammar, grammar - , P, parse - , cat, word, lemma, inside, transform - , many, many1, opt - ) where - -import Data.Tree -import Data.Char -import qualified Data.Map as Map -import Control.Monad -import PGF hiding (Tree,parse) - -infix 1 :-> - - -data Rule t e = t :-> P t e e -type Grammar t e = t -> PGF -> Morpho -> [Tree t] -> e - -grammar :: (Ord t,Show t) => ([e] -> e) -> [Rule t e] -> Grammar t e -grammar def rules = gr - where - gr = \tag -> - case Map.lookup tag pmap of - Just f -> \pgf m ts -> case unP f gr pgf m ts of - Just (e,[]) -> e - _ -> case ts of - [Node w []] -> def [] - ts -> def [gr tag pgf m ts | Node tag ts <- ts] - Nothing -> \pgf m ts -> case ts of - [Node w []] -> def [] - ts -> def [gr tag pgf m ts | Node tag ts <- ts] - - pmap = Map.fromListWith mplus (map (\(t :-> r) -> (t,r)) rules) - - -newtype P t e a = P {unP :: Grammar t e -> PGF -> Morpho -> [Tree t] -> Maybe (a,[Tree t])} - -instance Monad (P t e) where - return x = P (\gr pgf m ts -> Just (x,ts)) - f >>= g = P (\gr pgf m ts -> case unP f gr pgf m ts of - Just (x,ts) -> unP (g x) gr pgf m ts - Nothing -> Nothing) - -instance MonadPlus (P t e) where - mzero = P (\gr pgf m ts -> Nothing) - mplus f g = P (\gr pgf m ts -> unP f gr pgf m ts `mplus` unP g gr pgf m ts) - - -parse :: Grammar t e -> PGF -> Morpho -> Tree t -> e -parse gr pgf morpho (Node tag ts) = gr tag pgf morpho ts - -cat :: Eq t => t -> P t e e -cat tag = P (\gr pgf morpho ts -> - case ts of - (Node tag1 ts1 : ts) | tag == tag1 -> Just (gr tag1 pgf morpho ts1,ts) - _ -> Nothing) - -word :: P t e t -word = P (\gr pgf morpho ts -> - case ts of - (Node w [] : ts) -> Just (w,ts) - _ -> Nothing) - -inside :: Eq t => t -> P t e a -> P t e a -inside tag f = P (\gr pgf morpho ts -> - case ts of - (Node tag1 ts1 : ts) | tag == tag1 -> case unP f gr pgf morpho ts1 of - Just (x,[]) -> Just (x,ts) - _ -> Nothing - _ -> Nothing) - -lemma :: String -> String -> P String e CId -lemma cat0 an0 = P (\gr pgf morpho ts -> - case ts of - (Node w [] : ts) -> case [lemma | (lemma, an1) <- lookupMorpho morpho (map toLower w) - , let cat1 = maybe "" (showType []) (functionType pgf lemma) - , cat0 == cat1 && an0 == an1] of - (id:_) -> Just (id,ts) - _ -> Nothing - _ -> Nothing) - -transform :: ([Tree t] -> [Tree t]) -> P t e () -transform f = P (\gr pgf morpho ts -> Just ((),f ts)) - -many :: P t e a -> P t e [a] -many f = do x <- f - xs <- many f - return (x:xs) - `mplus` - do return [] - -many1 :: P t e a -> P t e [a] -many1 f = do x <- f - xs <- many f - return (x:xs) - -opt :: P t e a -> a -> P t e a -opt f x = mplus f (return x) |
