monadiccp 0.5 → 0.5.1

raw patch · 4 files changed

+29/−18 lines, 4 files

Files

• Control/CP/Herbrand/Herbrand.hs +22/−16
• Control/CP/Herbrand/PrologTerm.hs +5/−1
• Control/CP/SearchTree.hs +1/−0
• monadiccp.cabal +1/−1

@@ -18,11 +18,15 @@  -- |Herbrand terms -type VarId = Int+-- type VarId = Int -class HTerm t where-  mkVar    :: VarId -> t-  isVar    :: t   -> Maybe VarId+class Ord (VarId t) => HTerm t where+  type VarId t :: *+  data VarSupply t :: *+  varSupply :: VarSupply t+  supplyVar :: VarSupply t -> (t, VarSupply t)+  mkVar    :: VarId t -> t+  isVar    :: t   -> Maybe (VarId t)   children :: t -> ([t], [t] -> t)   nonvar_unify         :: (MonadState (HState t m) m) => t -> t -> m Bool@@ -50,15 +54,15 @@  -- |State -type Heap t m   = Map VarId (Binding t m)+type Heap t m   = Map (VarId t) (Binding t m)  data Binding t m -  = VAR VarId 		-- | indirection to other variable-  | NONVAR t 		-- | bound to term-  | ACTION (m Bool)	-- | attributed variable, with given action+  = VAR (VarId t)	-- ^ indirection to other variable+  | NONVAR t 		-- ^ bound to term+  | ACTION (m Bool)	-- ^ attributed variable, with given action -data HState t m = HState {var_supply :: VarId-                         ,heap       :: Heap t m+data HState t m = HState { var_supply :: VarSupply t+                         , heap       :: Heap t m                          }  updateState :: (HTerm t, MonadState (HState t m) m) => (HState t m -> HState t m) -> m ()@@ -78,15 +82,17 @@   newvar  = newvarH  -initState = HState 0 Data.Map.empty+initState :: HTerm t => HState t m+initState = HState varSupply Data.Map.empty  -- New variable  newvarH :: (HTerm t,MonadState (HState t m) m) => m t newvarH = do state <- get-             let varid = var_supply state-             put state{var_supply = varid + 1}-             return $ mkVar varid+             let vs = var_supply state+             let (var,vs') = supplyVar vs+             put state{var_supply = vs'}+             return  var  {- Representatin of variables    --------------------------@@ -127,7 +133,7 @@ m1 `andM` m2  = m1 >>= \b -> if b then m2 else return b   -- | bind a variable to a term-bindt :: (HTerm t, MonadState (HState t m) m) => VarId -> t -> m Bool+bindt :: (HTerm t, MonadState (HState t m) m) => VarId t -> t -> m Bool bindt v t  = do r <- lookupVar v                 updater v (NONVAR t)                 case r of@@ -135,7 +141,7 @@                   Nothing              -> success  -- | alias one variable to another-bindv :: (HTerm t, MonadState (HState t m) m) => VarId -> VarId -> m Bool+bindv :: (HTerm t, MonadState (HState t m) m) => VarId t -> VarId t -> m Bool bindv v1 v2  = do r1 <- lookupVar v1                   r2 <- lookupVar v2                   case (r1,r2) of

@@ -9,10 +9,14 @@  import Control.CP.Herbrand.Herbrand -data PrologTerm = PTerm String [PrologTerm] | PVar VarId+data PrologTerm = PTerm String [PrologTerm] | PVar Int      deriving Eq  instance HTerm PrologTerm where+  type VarId PrologTerm = Int+  newtype VarSupply PrologTerm = VSPT Int+  supplyVar (VSPT n)  = (mkVar n, VSPT (n+1))+  varSupply       = VSPT 0   mkVar           = PVar   isVar (PVar v)  = Just v   isVar _         = Nothing

@@ -144,6 +144,7 @@   exists  =  NewVar   label   =  Label + ------------------------------------------------------------------------------- ----------------------------------- Sugar ------------------------------------- -------------------------------------------------------------------------------

@@ -1,5 +1,5 @@ Name:                monadiccp-Version:             0.5+Version:             0.5.1 Description:         Monadic Constraint Programming framework License:             BSD3 License-file:        LICENSE