53 lines
1.9 KiB
Haskell
53 lines
1.9 KiB
Haskell
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE MonadComprehensions #-}
|
|
|
|
module G1 (
|
|
module Grammar,
|
|
G1 (G1),
|
|
G1' (G1'),
|
|
links,
|
|
links',
|
|
gcs,
|
|
obl,
|
|
gcs',
|
|
obl',
|
|
LINK (LINK),
|
|
LINK' (LINK'),
|
|
OBL (OBL),
|
|
)where
|
|
|
|
import Control.Monad.Plus
|
|
import Control.Monad.Trans.State
|
|
import Grammar
|
|
import Node
|
|
import Weighted
|
|
import Prelude.Unicode
|
|
-- import Data.Foldable
|
|
|
|
data G1 τ κ = G1 { links :: WeightedList (LINK τ κ), gcs :: [Constraint τ κ], obl :: [OBL τ κ] }
|
|
|
|
instance (Eq τ) => WeightedGrammar τ κ (G1 τ κ) where
|
|
link g h d = [ (r, gcs g ++ cs) | LINK r p q cs <- links g, p h, q d ]
|
|
-- sat :: G1 τ κ -> Node τ κ -> Bool
|
|
-- sat g n = and [ r ∈ (roles n) | OBL p rs <- obl g, p (cat n), r <- rs ]
|
|
-- pass :: Grammar (WeightedT []) τ κ x => x -> Node τ κ -> Bool
|
|
-- pass g n = and [ sat g x | x <- preds n ]
|
|
pass g = all (sat g) . (pure <> preds)
|
|
where
|
|
sat g n = and [ r ∈ (roles n) | OBL p rs <- obl g, p (cat n), r <- rs ]
|
|
|
|
data G1' τ κ = G1' { links' :: WeightedT [] (LINK' τ κ), gcs' :: [Constraint' (WeightedT []) τ κ], obl' :: [OBL τ κ] }
|
|
|
|
instance (Eq τ) => Grammar' (WeightedT []) τ κ (G1' τ κ) where
|
|
link' g hs ds = [ (r, gcs' g ++ cs) | LINK' r p q cs <- links' g, any p hs, any q ds ]
|
|
-- sat' g n = and [ r ∈ (roles n) | OBL p rs <- obl' g, c <- (cat n), p c, r <- rs ]
|
|
|
|
|
|
-- instance (Eq τ, Eq κ) => Grammar (StateT Int (WeightedT [])) τ κ (G1 τ κ) where
|
|
-- link g h d = [ (r, gcs g ++ cs) | f <- links g, LINK r p q cs ← evalState f, p h, q d ]
|
|
|
|
data LINK τ κ = LINK τ (κ -> Bool) (κ -> Bool) [Constraint τ κ]
|
|
data LINK' τ κ = LINK' τ (κ -> Bool) (κ -> Bool) [Constraint' (WeightedT []) τ κ]
|
|
data OBL τ κ = OBL (κ -> Bool) [τ]
|