#define TYPEABLE_INSTANCE(Type,Cons) instance Typeable Type where {\ typeOf (Cons x) = typeOf x; } #define SHOW_INSTANCE(Type,Cons) instance Show Type where {\ showsPrec p (Cons x) = showsPrec p x; \ show (Cons x) = show x; } #define MAX(typ) (fromIntegral (maxBound :: (typ))) #define MIN(typ) (fromIntegral (minBound :: (typ))) #define ASSERT(x,typ) (if not (x) then error "Datatype \"typ\" out of bounds." else id) #define ASSERT_BOUNDS(var,typ) (ASSERT((var) <= MAX(typ) && (var) >= MIN(typ),typ)) #define MAP_ASSERT(typ,f) (map (\a -> ASSERT_BOUNDS(a,typ) ((f) a))) #define READ_INSTANCE(Type) instance Read Type where {\ readsPrec n str \ = map (\(n, str) -> (ASSERT_BOUNDS(n,Type) $ fromInteger n, str)) (readsPrec n str) ;} #define INTEGER_BINOP(x,y,op) ((op) (toInteger (x)) (toInteger (y))) #define SAFE_BINOP(op,Type,Cons) \ (op) (Cons x) (Cons y) = let z = INTEGER_BINOP(x,y,op) in ASSERT_BOUNDS(z,Type) (Cons ((op) (x) (y))) #define INTEGER_UNOP(x,op) ((op) (toInteger (x))) #define SAFE_UNOP(op,Type,Cons) \ (op) (Cons x) = let z = INTEGER_UNOP(x,op) in ASSERT_BOUNDS(z,Type) (Cons ((op) (x))) #define NUM_INSTANCE(Type,Cons) instance Num Type where { \ SAFE_BINOP((+),Type,Cons) ; \ SAFE_BINOP((-),Type,Cons) ; \ SAFE_BINOP((*),Type,Cons) ; \ SAFE_UNOP(negate,Type,Cons) ; \ SAFE_UNOP(abs,Type,Cons) ; \ SAFE_UNOP(signum,Type,Cons) ; \ fromInteger i = ASSERT_BOUNDS(i,Type) $ Cons $ fromInteger i; } #define ENUM_INSTANCE(Type,Cons) instance Enum Type where { \ succ (Cons y) = ASSERT(y < maxBound,Type) Cons $ succ y; \ pred (Cons y) = ASSERT(y > minBound,Type) Cons $ pred y; \ toEnum n = ASSERT_BOUNDS(n,Type) $ Cons $ toEnum n; \ fromEnum (Cons y) = fromEnum y; \ enumFrom (Cons y) = MAP_ASSERT(Type,Cons) $ enumFrom y; \ enumFromThen (Cons x) (Cons y) = MAP_ASSERT(Type,Cons) $ enumFromThen x y; \ enumFromTo (Cons x) (Cons y) = MAP_ASSERT(Type,Cons) $ enumFromTo x y; \ enumFromThenTo (Cons x) (Cons y) (Cons z) = map Cons $ enumFromThenTo x y z; } #define STANDARD_DERIVING deriving (Bits, Bounded, Eq, Integral, Ix, Ord, PrintfArg, Real, Storable) #define CHECKED_WRAPPER(Type,Cons,BaseType) newtype Type = Cons BaseType STANDARD_DERIVING; \ TYPEABLE_INSTANCE(Type,Cons); \ SHOW_INSTANCE(Type,Cons); \ READ_INSTANCE(Type); \ NUM_INSTANCE(Type,Cons); \ ENUM_INSTANCE(Type,Cons);