Commit 46d58c9c authored by Jan Rasmus Tikovsky 's avatar Jan Rasmus Tikovsky

Moved typeclass Curry from external Prelude to KICS2 runtime

parent 5fc7788b
......@@ -28,36 +28,6 @@ isTrue# :: Bool -> Bool
isTrue# x = x
#endif
-- ---------------------------------------------------------------------------
-- Curry types
-- ---------------------------------------------------------------------------
-- Class for Curry types
class (Show a, Read a, NonDet a, Generable a, NormalForm a, Unifiable a)
=> Curry a where
-- implementation of strict equalit (==) for a data type
(=?=) :: a -> a -> Cover -> ConstStore -> C_Bool
(=?=) = error "(==) is undefined"
-- implementation of less-or-equal (<=) for a data type
(<?=) :: a -> a -> Cover -> ConstStore -> C_Bool
(<?=) = error "(<=) is undefined"
instance Curry (PrimData a) where
(=?=) = error "(==) is undefined for primitive data"
(<?=) = error "(<=) is undefined for primitive data"
instance (Curry t0, Curry t1) => Curry (Func t0 t1) where
(=?=) = error "(==) is undefined for functions"
(<?=) = error "(<=) is undefined for functions"
instance Curry t0 => Curry (C_IO t0) where
(=?=) = error "(==) is undefined for IO actions"
(<?=) = error "(<=) is undefined for IO actions"
instance NonDet b => Curry (a -> b) where
(=?=) = error "(==) is undefined for functions"
(<?=) = error "(<=) is undefined for functions"
-- -----------------------------------------------------------------------------
-- Int representation
-- -----------------------------------------------------------------------------
......@@ -914,64 +884,6 @@ exceptionHandlers s cd cs hndl =
-- Functions on Integer and Nat added from PrimTypes
-- -----------------------------------------------------------------------------
instance Curry Nat where
(=?=) (Choice_Nat cd i x y) z d cs = narrow cd i (((x =?= z) d) cs) (((y =?= z) d) cs)
(=?=) (Choices_Nat cd i xs) y d cs = narrows cs cd i (\x -> ((x =?= y) d) cs) xs
(=?=) (Guard_Nat cd c e) y d cs = guardCons cd c (((e =?= y) d) (addCs c cs))
(=?=) (Fail_Nat cd info) _ _ _ = failCons cd info
(=?=) z (Choice_Nat cd i x y) d cs = narrow cd i (((z =?= x) d) cs) (((z =?= y) d) cs)
(=?=) y (Choices_Nat cd i xs) d cs = narrows cs cd i (\x -> ((y =?= x) d) cs) xs
(=?=) y (Guard_Nat cd c e) d cs = guardCons cd c (((y =?= e) d) (addCs c cs))
(=?=) _ (Fail_Nat cd info) _ _ = failCons cd info
(=?=) IHi IHi d cs = C_True
(=?=) (O x1) (O y1) d cs = ((x1 =?= y1) d) cs
(=?=) (I x1) (I y1) d cs = ((x1 =?= y1) d) cs
(=?=) _ _ d _ = C_False
(<?=) (Choice_Nat cd i x y) z d cs = narrow cd i (((x <?= z) d) cs) (((y <?= z) d) cs)
(<?=) (Choices_Nat cd i xs) y d cs = narrows cs cd i (\x -> ((x <?= y) d) cs) xs
(<?=) (Guard_Nat cd c e) y d cs = guardCons cd c (((e <?= y) d) (addCs c cs))
(<?=) (Fail_Nat cd info) _ _ _ = failCons cd info
(<?=) z (Choice_Nat cd i x y) d cs = narrow cd i (((z <?= x) d) cs) (((z <?= y) d) cs)
(<?=) y (Choices_Nat cd i xs) d cs = narrows cs cd i (\x -> ((y <?= x) d) cs) xs
(<?=) y (Guard_Nat cd c e) d cs = guardCons cd c (((y <?= e) d) (addCs c cs))
(<?=) _ (Fail_Nat cd info) _ _ = failCons cd info
(<?=) IHi IHi d cs = C_True
(<?=) IHi (O _) _ _ = C_True
(<?=) IHi (I _) _ _ = C_True
(<?=) (O x1) (O y1) d cs = ((x1 <?= y1) d) cs
(<?=) (O _) (I _) _ _ = C_True
(<?=) (I x1) (I y1) d cs = ((x1 <?= y1) d) cs
(<?=) _ _ d _ = C_False
instance Curry BinInt where
(=?=) (Choice_BinInt cd i x y) z d cs = narrow cd i (((x =?= z) d) cs) (((y =?= z) d) cs)
(=?=) (Choices_BinInt cd i xs) y d cs = narrows cs cd i (\x -> ((x =?= y) d) cs) xs
(=?=) (Guard_BinInt cd c e) y d cs = guardCons cd c (((e =?= y) d) (addCs c cs))
(=?=) (Fail_BinInt cd info) _ _ _ = failCons cd info
(=?=) z (Choice_BinInt cd i x y) d cs = narrow cd i (((z =?= x) d) cs) (((z =?= y) d) cs)
(=?=) y (Choices_BinInt cd i xs) d cs = narrows cs cd i (\x -> ((y =?= x) d) cs) xs
(=?=) y (Guard_BinInt cd c e) d cs = guardCons cd c (((y =?= e) d) (addCs c cs))
(=?=) _ (Fail_BinInt cd info) _ _ = failCons cd info
(=?=) (Neg x1) (Neg y1) d cs = ((x1 =?= y1) d) cs
(=?=) Zero Zero d cs = C_True
(=?=) (Pos x1) (Pos y1) d cs = ((x1 =?= y1) d) cs
(=?=) _ _ d _ = C_False
(<?=) (Choice_BinInt cd i x y) z d cs = narrow cd i (((x <?= z) d) cs) (((y <?= z) d) cs)
(<?=) (Choices_BinInt cd i xs) y d cs = narrows cs cd i (\x -> ((x <?= y) d) cs) xs
(<?=) (Guard_BinInt cd c e) y d cs = guardCons cd c (((e <?= y) d) (addCs c cs))
(<?=) (Fail_BinInt cd info) _ _ _ = failCons cd info
(<?=) z (Choice_BinInt cd i x y) d cs = narrow cd i (((z <?= x) d) cs) (((z <?= y) d) cs)
(<?=) y (Choices_BinInt cd i xs) d cs = narrows cs cd i (\x -> ((y <?= x) d) cs) xs
(<?=) y (Guard_BinInt cd c e) d cs = guardCons cd c (((y <?= e) d) (addCs c cs))
(<?=) _ (Fail_BinInt cd info) _ _ = failCons cd info
(<?=) (Neg x1) (Neg y1) d cs = ((x1 <?= y1) d) cs
(<?=) (Neg _) Zero _ _ = C_True
(<?=) (Neg _) (Pos _) _ _ = C_True
(<?=) Zero Zero d cs = C_True
(<?=) Zero (Pos _) _ _ = C_True
(<?=) (Pos x1) (Pos y1) d cs = ((x1 <?= y1) d) cs
(<?=) _ _ d _ = C_False
d_C_cmpNat :: Nat -> Nat -> Cover -> ConstStore -> C_Ordering
d_C_cmpNat x1 x2 cd cs = case x1 of
IHi -> d_C__casept_33 x2 cd cs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment