PTQ-0.0.4: src/P.hs
-----------------------------------------------------------------------------
-- |
-- Module : P
-- Copyright : (c) Masahiro Sakai 2007-2009
-- License : BSD3-style (see LICENSE)
--
-- Maintainer: masahiro.sakai@gmail.com
-- Stability : experimental
-- Portability : non-portable
{-# LANGUAGE TypeOperators, GADTs, EmptyDataDecls, MultiParamTypeClasses
, TypeSynonymInstances #-}
module P
( Sen
, IV
, CN
, Adj
, (:/)
, (://)
, Cat (..)
, cat_Sen
, cat_IV
, cat_CN
, cat_Adj
, T
, TV
, IAV
, cat_T
, cat_TV
, cat_IAV
, Det
, DTV
, TTV
, PP
, cat_Det
, cat_DTV
, cat_PP
, PronounNo
, P (..)
, PAny (..)
, F5
, F6
, F8 (..)
, F9 (..)
, F10 (..)
) where
import Expr
-----------------------------------------------------------------------------
infixl 1 :/
infixl 1 ://
-- 型レベルでの範疇の表現
data Sen -- 文。本来はtと書かれるけど小文字が使えないので
data IV -- 動詞句, 自動詞: walk
data CN -- 普通名詞(句): man
data Adj -- 形容詞? (定義が載っていなかった)
data (:/) a b
data (://) a b
-- 範疇を型レベルだけでなく値レベルでも表現
data Cat a where
Sen :: Cat Sen
IV :: Cat IV
CN :: Cat CN
Adj :: Cat Adj
(:/) :: Cat a -> Cat b -> Cat (a :/ b)
(://) :: Cat a -> Cat b -> Cat (a :// b)
cat_Sen = Sen
cat_IV = IV
cat_CN = CN
cat_Adj = Adj
type T = Sen :/ IV -- 名詞句, 固有名詞: John, he
type TV = IV :/ T -- 他動詞(句): find
type IAV = IV :/ IV -- 動詞句修飾の副詞(句): slowly
cat_T = cat_Sen :/ cat_IV
cat_TV = cat_IV :/ cat_T
cat_IAV = cat_IV :/ cat_IV
-- FIXME: 定義が載っていなかった範疇
type Det = T :/ CN -- 冠詞
type DTV = TV :/ T -- ditransitive verb : 名詞句を２つ取る他動詞
type TTV = TV :/ T -- to transitive verb : DTVと名詞句の順序が逆?
type PP = IV :/ TV -- prepositional phrase?: by John
cat_Det = cat_T :/ cat_CN
cat_DTV = cat_TV :/ cat_T
cat_PP = cat_IV :/ cat_TV
-----------------------------------------------------------------------------
type PronounNo = Int
-- 範疇がcである表現
data P c where
-- 基本表現
B :: Cat c -> String -> P c
He :: PronounNo -> P T
-- 統語規則
-- F1はないのね
F2 :: P Det -> P CN -> P T
F3 :: PronounNo -> P CN -> P Sen -> P CN
F4 :: P T -> P IV -> P Sen
F5 :: F5 c => P (c :/ T) -> P T -> P c
F6 :: F6 c a => P (c :/ a) -> P a -> P c
F7 :: P IAV -> P IV -> P IV
F8 :: F8 c => P c -> P c -> P c -- and
F9 :: F9 c => P c -> P c -> P c -- or
F10 :: F10 c => PronounNo -> P T -> P c -> P c -- 文の中への量化
F11 :: P T -> P IV -> P Sen
F12 :: P T -> P IV -> P Sen
F13 :: P T -> P IV -> P Sen
F14 :: P T -> P IV -> P Sen
F15 :: P T -> P IV -> P Sen
F16 :: P (IV :/ Sen) -> P Sen -> P IV
F17 :: P (IV :// IV) -> P IV -> P IV
-- F18はないのね
F19 :: P TV -> P IV
F20 :: P DTV -> P T -> P TV
F21 :: P DTV -> P T -> P TV
F22 :: P DTV -> P TTV
F23 :: P PP -> P TV -> P IV
F24 :: P (PP :/ T) -> P T -> P PP
F25 :: P TV -> P Adj
data PAny where
PAny :: P a -> PAny
class F5 c
instance F5 IV -- T5
instance F5 IAV -- T6
class F6 c a
instance F6 Sen Sen -- T9
instance F6 IV Adj -- T18
class F8 c where f8 :: Cat c
instance F8 Sen where f8 = cat_Sen
instance F8 IV where f8 = cat_IV
class F9 c where f9 :: Cat c
instance F9 Sen where f9 = cat_Sen
instance F9 IV where f9 = cat_IV
instance F9 T where f9 = cat_T
class F10 c where f10 :: Cat c
instance F10 Sen where f10 = cat_Sen
instance F10 CN where f10 = cat_CN
instance F10 IV where f10 = cat_IV
-----------------------------------------------------------------------------
-- Ughhh!!
instance Show (P c) where
showsPrec _ (B _ s) = showString s
showsPrec d (He n) = c1 d "He" n
showsPrec d (F2 x y) = c2 d "F2" x y
showsPrec d (F3 n x y) = c3 d "F3" n x y
showsPrec d (F4 x y) = c2 d "F4" x y
showsPrec d (F5 x y) = c2 d "F5" x y
showsPrec d (F6 x y) = c2 d "F6" x y
showsPrec d (F7 x y) = c2 d "F7" x y
showsPrec d (F8 x y) = c2 d "F8" x y
showsPrec d (F9 x y) = c2 d "F9" x y
showsPrec d (F10 n x y) = c3 d "F10" n x y
showsPrec d (F11 x y) = c2 d "F11" x y
showsPrec d (F12 x y) = c2 d "F12" x y
showsPrec d (F13 x y) = c2 d "F13" x y
showsPrec d (F14 x y) = c2 d "F14" x y
showsPrec d (F15 x y) = c2 d "F15" x y
showsPrec d (F16 x y) = c2 d "F16" x y
showsPrec d (F17 x y) = c2 d "F17" x y
showsPrec d (F19 x) = c1 d "F19" x
showsPrec d (F20 x y) = c2 d "F20" x y
showsPrec d (F21 x y) = c2 d "F21" x y
showsPrec d (F22 x) = c1 d "F22" x
showsPrec d (F23 x y) = c2 d "F23" x y
showsPrec d (F24 x y) = c2 d "F24" x y
showsPrec d (F25 x) = c1 d "F25" x
instance Show PAny where
showsPrec d (PAny p) = c1 d "PAny" p
c1 :: (Show x) => Int -> String -> x -> ShowS
c1 d con x =
showParen (d > app_prec) $
showString con
. showChar ' ' . showsPrec (app_prec+1) x
c2 :: (Show x, Show y) => Int -> String -> x -> y -> ShowS
c2 d con x y =
showParen (d > app_prec) $
showString con
. showChar ' ' . showsPrec (app_prec+1) x
. showChar ' ' . showsPrec (app_prec+1) y
c3 :: (Show x, Show y, Show z) => Int -> String -> x -> y -> z -> ShowS
c3 d con x y z =
showParen (d > app_prec) $
showString con
. showChar ' ' . showsPrec (app_prec+1) x
. showChar ' ' . showsPrec (app_prec+1) y
. showChar ' ' . showsPrec (app_prec+1) z
app_prec :: Int
app_prec = 10