1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
{-# LANGUAGE DatatypeContexts #-}
module ShouldFail where
infixr 1 `rangeOf`
data Ord a => SubRange a = SubRange (a, a) a
type IntSubRange = SubRange Int
subRangeValue :: SubRange a -> a
subRangeValue (SubRange (lower, upper) value) = value
subRange :: SubRange a -> (a, a)
subRange (SubRange r value) = r
newRange :: (Ord a, Show a) => (a, a) -> a -> SubRange a
newRange r value = checkRange (SubRange r value)
checkRange :: (Ord a, Show a) => SubRange a -> SubRange a
checkRange (SubRange (lower, upper) value)
= if (value < lower) || (value > upper) then
error ("### sub range error. range = " ++ show lower ++
".." ++ show upper ++ " value = " ++ show value ++ "\n")
else
SubRange (lower, upper) value
instance Eq a => Eq (SubRange a) where
(==) a b = subRangeValue a == subRangeValue b
instance (Ord a) => Ord (SubRange a) where
(<) = relOp (<)
(<=) = relOp (<=)
(>=) = relOp (>=)
(>) = relOp (>)
relOp :: Ord a => (a->a->Bool) -> SubRange a -> SubRange a -> Bool
relOp op a b = (subRangeValue a) `op` (subRangeValue b)
rangeOf :: (Ord a, Show a) => SubRange a -> SubRange a -> SubRange a
rangeOf a b = checkRange (SubRange (subRange b) (subRangeValue a))
showRange :: Show a => SubRange a -> String
showRange (SubRange (lower, upper) value)
= show value ++ " :" ++ show lower ++ ".." ++ show upper
showRangePair :: (Show a, Show b) => (SubRange a, SubRange b) -> String
showRangePair (a, b)
= "(" ++ showRange a ++ ", " ++ showRange b ++ ")"
showRangeTriple :: (Show a, Show b, Show c) =>
(SubRange a, SubRange b, SubRange c) -> String
showRangeTriple (a, b, c)
= "(" ++ showRange a ++ ", " ++ showRange b ++ ", " ++ showRange c ++ ")"
instance Num a => Num (SubRange a) where
negate = numSubRangeNegate
(+) = numSubRangeAdd
(-) = numSubRangeSubtract
(*) = numSubRangeMultiply
fromInteger a = SubRange (fromInteger a, fromInteger a) (fromInteger a)
numSubRangeNegate :: (Ord a, Show a, Num a) => SubRange a -> SubRange a
numSubRangeNegate (SubRange (lower, upper) value)
= checkRange (SubRange (lower, upper) (-value))
numSubRangeBinOp :: Num a => (a -> a -> a) ->
SubRange a -> SubRange a -> SubRange a
numSubRangeBinOp op a b
= SubRange (result, result) result
where
result = (subRangeValue a) `op` (subRangeValue b)
-- partain:
numSubRangeAdd, numSubRangeSubtract, numSubRangeMultiply :: Num a => SubRange a -> SubRange a -> SubRange a
numSubRangeAdd = numSubRangeBinOp (+)
numSubRangeSubtract = numSubRangeBinOp (-)
numSubRangeMultiply = numSubRangeBinOp (*)
unsignedBits :: Int -> (Int, Int)
unsignedBits n = (0, 2^n-1)
signedBits :: Int -> (Int, Int)
signedBits n = (-2^(n-1), 2^(n-1)-1)
si_n :: Int -> Int -> IntSubRange
si_n bits value = SubRange (signedBits bits) value
si8, si10, si16 :: Int -> IntSubRange
si8 = si_n 8
si10 = si_n 10
si16 = si_n 16
|
