-instance Eq SMRep where
- (SpecialisedRep k1 a1 b1 _) == (SpecialisedRep k2 a2 b2 _) = (tagOf_SMSpecRepKind k1) _EQ_ (tagOf_SMSpecRepKind k2)
- && a1 == a2 && b1 == b2
- (GenericRep a1 b1 _) == (GenericRep a2 b2 _) = a1 == a2 && b1 == b2
- (BigTupleRep a1) == (BigTupleRep a2) = a1 == a2
- (MuTupleRep a1) == (MuTupleRep a2) = a1 == a2
- (DataRep a1) == (DataRep a2) = a1 == a2
- a == b = (tagOf_SMRep a) _EQ_ (tagOf_SMRep b)
-
-ltSMRepHdr :: SMRep -> SMRep -> Bool
-a `ltSMRepHdr` b = (tagOf_SMRep a) _LT_ (tagOf_SMRep b)
-
-instance Ord SMRep where
- -- ToDo: cmp-ify? This instance seems a bit weird (WDP 94/10)
- rep1 <= rep2 = rep1 < rep2 || rep1 == rep2
- rep1 < rep2
- = let tag1 = tagOf_SMRep rep1
- tag2 = tagOf_SMRep rep2
- in
- if tag1 _LT_ tag2 then True
- else if tag1 _GT_ tag2 then False
- else {- tags equal -} rep1 `lt` rep2
- where
- (SpecialisedRep k1 a1 b1 _) `lt` (SpecialisedRep k2 a2 b2 _) =
- t1 _LT_ t2 || (t1 _EQ_ t2 && (a1 < a2 || (a1 == a2 && b1 < b2)))
- where t1 = tagOf_SMSpecRepKind k1
- t2 = tagOf_SMSpecRepKind k2
- (GenericRep a1 b1 _) `lt` (GenericRep a2 b2 _) = a1 < a2 || (a1 == a2 && b1 < b2)
- (BigTupleRep a1) `lt` (BigTupleRep a2) = a1 < a2
- (MuTupleRep a1) `lt` (MuTupleRep a2) = a1 < a2
- (DataRep a1) `lt` (DataRep a2) = a1 < a2
- a `lt` b = True
-
-tagOf_SMSpecRepKind SpecRep = (ILIT(1) :: FAST_INT)
-tagOf_SMSpecRepKind ConstantRep = ILIT(2)
-tagOf_SMSpecRepKind CharLikeRep = ILIT(3)
-tagOf_SMSpecRepKind IntLikeRep = ILIT(4)
-
-tagOf_SMRep (StaticRep _ _) = (ILIT(1) :: FAST_INT)
-tagOf_SMRep (SpecialisedRep k _ _ _) = ILIT(2)
-tagOf_SMRep (GenericRep _ _ _) = ILIT(3)
-tagOf_SMRep (BigTupleRep _) = ILIT(4)
-tagOf_SMRep (DataRep _) = ILIT(5)
-tagOf_SMRep DynamicRep = ILIT(6)
-tagOf_SMRep BlackHoleRep = ILIT(7)
-tagOf_SMRep PhantomRep = ILIT(8)
-tagOf_SMRep (MuTupleRep _) = ILIT(9)
-
-instance Text SMRep where
- showsPrec d rep
- = showString (case rep of
- StaticRep _ _ -> "STATIC"
- SpecialisedRep kind _ _ SMNormalForm -> "SPEC_N"
- SpecialisedRep kind _ _ SMSingleEntry -> "SPEC_S"
- SpecialisedRep kind _ _ SMUpdatable -> "SPEC_U"
- GenericRep _ _ SMNormalForm -> "GEN_N"
- GenericRep _ _ SMSingleEntry -> "GEN_S"
- GenericRep _ _ SMUpdatable -> "GEN_U"
- BigTupleRep _ -> "TUPLE"
- DataRep _ -> "DATA"
- DynamicRep -> "DYN"
- BlackHoleRep -> "BH"
- PhantomRep -> "INREGS"
- MuTupleRep _ -> "MUTUPLE")
-
-instance Outputable SMRep where
- ppr rep = text (show rep)
-
-getSMInfoStr :: SMRep -> String
-getSMInfoStr (StaticRep _ _) = "STATIC"
-getSMInfoStr (SpecialisedRep ConstantRep _ _ _) = "CONST"
-getSMInfoStr (SpecialisedRep CharLikeRep _ _ _) = "CHARLIKE"
-getSMInfoStr (SpecialisedRep IntLikeRep _ _ _) = "INTLIKE"
-getSMInfoStr (SpecialisedRep SpecRep _ _ SMNormalForm) = "SPEC_N"
-getSMInfoStr (SpecialisedRep SpecRep _ _ SMSingleEntry) = "SPEC_S"
-getSMInfoStr (SpecialisedRep SpecRep _ _ SMUpdatable) = "SPEC_U"
-getSMInfoStr (GenericRep _ _ SMNormalForm) = "GEN_N"
-getSMInfoStr (GenericRep _ _ SMSingleEntry) = "GEN_S"
-getSMInfoStr (GenericRep _ _ SMUpdatable) = "GEN_U"
-getSMInfoStr (BigTupleRep _) = "TUPLE"
-getSMInfoStr (DataRep _ ) = "DATA"
-getSMInfoStr DynamicRep = "DYN"
-getSMInfoStr BlackHoleRep = panic "getSMInfoStr.BlackHole"
-getSMInfoStr PhantomRep = "INREGS"
-getSMInfoStr (MuTupleRep _) = "MUTUPLE"
-
-getSMInitHdrStr :: SMRep -> String
-getSMInitHdrStr (SpecialisedRep IntLikeRep _ _ _) = "SET_INTLIKE"
-getSMInitHdrStr (SpecialisedRep SpecRep _ _ _) = "SET_SPEC"
-getSMInitHdrStr (GenericRep _ _ _) = "SET_GEN"
-getSMInitHdrStr (BigTupleRep _) = "SET_TUPLE"
-getSMInitHdrStr (DataRep _ ) = "SET_DATA"
-getSMInitHdrStr DynamicRep = "SET_DYN"
-getSMInitHdrStr BlackHoleRep = "SET_BH"
-#ifdef DEBUG
-getSMInitHdrStr (StaticRep _ _) = panic "getSMInitHdrStr.Static"
-getSMInitHdrStr PhantomRep = panic "getSMInitHdrStr.Phantom"
-getSMInitHdrStr (MuTupleRep _) = panic "getSMInitHdrStr.Mutuple"
-getSMInitHdrStr (SpecialisedRep ConstantRep _ _ _) = panic "getSMInitHdrStr.Constant"
-getSMInitHdrStr (SpecialisedRep CharLikeRep _ _ _) = panic "getSMInitHdrStr.CharLike"