about summary refs log tree commit diff
path: root/third_party/bazel/rules_haskell/examples/vector/Data/Vector/Fusion/Bundle/Size.hs
blob: e90cf373202dbaff24ecd5d2d388e9c160f65815 (plain) (blame)
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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
-- |
-- Module      : Data.Vector.Fusion.Bundle.Size
-- Copyright   : (c) Roman Leshchinskiy 2008-2010
-- License     : BSD-style
--
-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
-- Stability   : experimental
-- Portability : portable
--
-- Size hints for streams.
--

module Data.Vector.Fusion.Bundle.Size (
  Size(..), clampedSubtract, smaller, larger, toMax, upperBound, lowerBound
) where

import Data.Vector.Fusion.Util ( delay_inline )

-- | Size hint
data Size = Exact Int          -- ^ Exact size
          | Max   Int          -- ^ Upper bound on the size
          | Unknown            -- ^ Unknown size
        deriving( Eq, Show )

instance Num Size where
  Exact m + Exact n = checkedAdd Exact m n
  Exact m + Max   n = checkedAdd Max m n

  Max   m + Exact n = checkedAdd Max m n
  Max   m + Max   n = checkedAdd Max m n

  _       + _       = Unknown


  Exact m - Exact n = checkedSubtract Exact m n
  Exact m - Max   _ = Max   m

  Max   m - Exact n = checkedSubtract Max m n
  Max   m - Max   _ = Max   m
  Max   m - Unknown = Max   m

  _       - _       = Unknown


  fromInteger n     = Exact (fromInteger n)

  (*)    = error "vector: internal error * for Bundle.size isn't defined"
  abs    = error "vector: internal error abs for Bundle.size isn't defined"
  signum = error "vector: internal error signum for Bundle.size isn't defined"

{-# INLINE checkedAdd #-}
checkedAdd :: (Int -> Size) -> Int -> Int -> Size
checkedAdd con m n
    -- Note: we assume m and n are >= 0.
  | r < m || r < n =
      error $ "Data.Vector.Fusion.Bundle.Size.checkedAdd: overflow: " ++ show r
  | otherwise = con r
  where
    r = m + n

{-# INLINE checkedSubtract #-}
checkedSubtract :: (Int -> Size) -> Int -> Int -> Size
checkedSubtract con m n
  | r < 0 =
      error $ "Data.Vector.Fusion.Bundle.Size.checkedSubtract: underflow: " ++ show r
  | otherwise = con r
  where
    r = m - n

-- | Subtract two sizes with clamping to 0, for drop-like things
{-# INLINE clampedSubtract #-}
clampedSubtract :: Size -> Size -> Size
clampedSubtract (Exact m) (Exact n) = Exact (max 0 (m - n))
clampedSubtract (Max   m) (Exact n)
  | m <= n = Exact 0
  | otherwise = Max (m - n)
clampedSubtract (Exact m) (Max   _) = Max m
clampedSubtract (Max   m) (Max   _) = Max m
clampedSubtract _         _ = Unknown

-- | Minimum of two size hints
smaller :: Size -> Size -> Size
{-# INLINE smaller #-}
smaller (Exact m) (Exact n) = Exact (delay_inline min m n)
smaller (Exact m) (Max   n) = Max   (delay_inline min m n)
smaller (Exact m) Unknown   = Max   m
smaller (Max   m) (Exact n) = Max   (delay_inline min m n)
smaller (Max   m) (Max   n) = Max   (delay_inline min m n)
smaller (Max   m) Unknown   = Max   m
smaller Unknown   (Exact n) = Max   n
smaller Unknown   (Max   n) = Max   n
smaller Unknown   Unknown   = Unknown

-- | Maximum of two size hints
larger :: Size -> Size -> Size
{-# INLINE larger #-}
larger (Exact m) (Exact n)             = Exact (delay_inline max m n)
larger (Exact m) (Max   n) | m >= n    = Exact m
                           | otherwise = Max   n
larger (Max   m) (Exact n) | n >= m    = Exact n
                           | otherwise = Max   m
larger (Max   m) (Max   n)             = Max   (delay_inline max m n)
larger _         _                     = Unknown

-- | Convert a size hint to an upper bound
toMax :: Size -> Size
toMax (Exact n) = Max n
toMax (Max   n) = Max n
toMax Unknown   = Unknown

-- | Compute the minimum size from a size hint
lowerBound :: Size -> Int
lowerBound (Exact n) = n
lowerBound _         = 0

-- | Compute the maximum size from a size hint if possible
upperBound :: Size -> Maybe Int
upperBound (Exact n) = Just n
upperBound (Max   n) = Just n
upperBound Unknown   = Nothing