gistfile1.hs

-- Example translated from
-- DATR: A language for lexical knowledge representation
-- Roger Evans and Gerald Gazdar (1996)
-- http://acl.ldc.upenn.edu/J/J96/J96-2002.pdf

type Atom = String
newtype Transducer =
   Transducer (Transducer -- ^ context
               -> [Atom]  -- ^ input path
               -> [Atom]  -- ^ output path
              )

apply :: Transducer -> Transducer -> [Atom] -> [Atom]
apply (Transducer x) = x

apply_ :: Transducer -> [Atom] -> [Atom]
apply_ (Transducer x) = x z

-- | null transducer
z :: Transducer
z = Transducer $ const id

-- ---------------------------------------------------------------------
-- a small DATR lexicon
-- ---------------------------------------------------------------------

verb :: Transducer
verb = Transducer fn
  where
    fn ctx path =
      case path of
        ("syn":"cat":_) -> ["verb"]
        ("syn":"type":_) -> ["main"]
        ("mor":"present":"participle":xs) -> root xs ++ ["ing"]
        ("mor":"present":"tense":"sing":"three":xs) -> root xs ++ ["s"]
        ("mor":"present":xs) -> root xs
        ("mor":"past":xs) -> root xs ++ ["ed"]
        ("mor":"passive":xs) -> past xs
        ("mor":"form":xs) -> form xs
        xs -> error $ "verb has no match for " ++ show xs
      where
        global = apply_ ctx
        root xs = global ("mor":"root":xs)
        -- So this is nifty: we're looking up syntactic form from the global context
        -- eg, word1 or word2 below, and geting back a result like "past participle"
        -- and then plugging that into our "mor" path.  Cool, huh? Well OK maybe I'm
        -- not reacting to the the actually-interesting thing.
        --
        -- Thing that's supposed to be interesting about DATR is that it makes it easy
        -- to express things in terms of general pattern + lots of interesting exceptions
        -- but in somehow more powerful way than a simple hierarchy based approach,
        -- but I never thought hard enough about it to tease apart what's what, what the
        -- true heart of DATR is, so to speak. The machinery seems very much about this
        -- transducer-calling-transducer type pattern we see here, but maybe that's just
        -- incidental. What's the heart?
        form xs = global ("mor":global ("syn":"form":xs))
        past xs = global ("mor":"past":xs)

love :: Transducer
love = Transducer fn
  where
    fn _ ("mor":"root":_) = ["love"]
    fn ctx xs = apply verb ctx xs

word1 :: Transducer
word1 = Transducer fn
  where
    fn _ ("syn":"form":_) = ["present", "participle"]
    fn _ xs = apply love word1 xs

word2 :: Transducer
word2 = Transducer fn
  where
    fn _ ("syn":"form":_) = ["passive", "participle"]
    fn _ xs = apply love word2 xs


-- > apply_ word1 ["mor","form"]
-- ["love","ing"]
-- > apply_ word2 ["mor","form"]
-- ["love","ed"]