[project @ 2001-06-28 14:15:04 by simonmar]
[packages/pretty.git] / GHC / ByteArr.lhs
1 % -----------------------------------------------------------------------------
2 % $Id: ByteArr.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
3 %
4 % (c) The University of Glasgow, 1994-2000
5 %
6
7 \section[GHC.ByteArr]{Module @GHC.ByteArr@}
8
9 Byte-arrays are flat arrays of non-pointers only.
10
11 \begin{code}
12 {-# OPTIONS -fno-implicit-prelude #-}
13
14 module GHC.ByteArr where
15
16 import {-# SOURCE #-} GHC.Err ( error )
17 import GHC.Num
18 import GHC.Arr
19 import GHC.Float
20 import GHC.ST
21 import GHC.Base
22 \end{code}
23
24 %*********************************************************
25 %*                                                      *
26 \subsection{The @Array@ types}
27 %*                                                      *
28 %*********************************************************
29
30 \begin{code}
31 data Ix ix => ByteArray ix              = ByteArray        ix ix ByteArray#
32 data Ix ix => MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)
33
34 instance CCallable (ByteArray ix)
35 instance CCallable (MutableByteArray RealWorld ix)
36         -- Note the RealWorld!  You can only ccall with MutableByteArray args
37         -- which are in the real world.  When this was missed out, the result
38         -- was that a CCallOpId had a free tyvar, and since the compiler doesn't
39         -- expect that it didn't get zonked or substituted.  Bad news.
40
41 instance Eq (MutableByteArray s ix) where
42         MutableByteArray _ _ arr1# == MutableByteArray _ _ arr2#
43                 = sameMutableByteArray# arr1# arr2#
44 \end{code}
45
46 %*********************************************************
47 %*                                                      *
48 \subsection{Operations on mutable arrays}
49 %*                                                      *
50 %*********************************************************
51
52 \begin{code}
53 newCharArray, newIntArray, newFloatArray, newDoubleArray
54          :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
55
56 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
57 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
58 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
59 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
60
61 newCharArray (l,u) = ST $ \ s# ->
62     case rangeSize (l,u)          of { I# n# ->
63     case (newByteArray# (cHAR_SCALE n#) s#) of { (# s2#, barr# #) ->
64     (# s2#, MutableByteArray l u barr# #) }}
65
66 newIntArray (l,u) = ST $ \ s# ->
67     case rangeSize (l,u)          of { I# n# ->
68     case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
69     (# s2#, MutableByteArray l u barr# #) }}
70
71 newWordArray (l,u) = ST $ \ s# ->
72     case rangeSize (l,u)          of { I# n# ->
73     case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
74     (# s2#, MutableByteArray l u barr# #) }}
75
76 newFloatArray (l,u) = ST $ \ s# ->
77     case rangeSize (l,u)          of { I# n# ->
78     case (newByteArray# (fLOAT_SCALE n#) s#) of { (# s2#, barr# #) ->
79     (# s2#, MutableByteArray l u barr# #) }}
80
81 newDoubleArray (l,u) = ST $ \ s# ->
82     case rangeSize (l,u)          of { I# n# ->
83     case (newByteArray# (dOUBLE_SCALE n#) s#) of { (# s2#, barr# #) ->
84     (# s2#, MutableByteArray l u barr# #) }}
85
86 #include "config.h"
87
88   -- Char arrays really contain only 8-bit bytes for compatibility.
89 cHAR_SCALE   n = 1# *# n
90 wORD_SCALE   n = (case SIZEOF_VOID_P :: Int of I# x -> x *# n)
91 dOUBLE_SCALE n = (case SIZEOF_DOUBLE :: Int of I# x -> x *# n)
92 fLOAT_SCALE  n = (case SIZEOF_FLOAT  :: Int of I# x -> x *# n)
93
94 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char 
95 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
96 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
97 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
98
99 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
100 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
101 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
102 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
103
104 readCharArray (MutableByteArray l u barr#) n = ST $ \ s# ->
105     case (index (l,u) n)                of { I# n# ->
106     case readCharArray# barr# n# s#     of { (# s2#, r# #) ->
107     (# s2#, C# r# #) }}
108
109 readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
110     case (index (l,u) n)                of { I# n# ->
111     case readIntArray# barr# n# s#      of { (# s2#, r# #) ->
112     (# s2#, I# r# #) }}
113
114 readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
115     case (index (l,u) n)                of { I# n# ->
116     case readFloatArray# barr# n# s#    of { (# s2#, r# #) ->
117     (# s2#, F# r# #) }}
118
119 readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
120     case (index (l,u) n)                of { I# n# ->
121     case readDoubleArray# barr# n# s#   of { (# s2#, r# #) ->
122     (# s2#, D# r# #) }}
123
124 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
125 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char 
126 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
127 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
128 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
129
130 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
131 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
132 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
133 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
134
135 indexCharArray (ByteArray l u barr#) n
136   = case (index (l,u) n)                of { I# n# ->
137     case indexCharArray# barr# n#       of { r# ->
138     (C# r#)}}
139
140 indexIntArray (ByteArray l u barr#) n
141   = case (index (l,u) n)                of { I# n# ->
142     case indexIntArray# barr# n#        of { r# ->
143     (I# r#)}}
144
145 indexFloatArray (ByteArray l u barr#) n
146   = case (index (l,u) n)                of { I# n# ->
147     case indexFloatArray# barr# n#      of { r# ->
148     (F# r#)}}
149
150 indexDoubleArray (ByteArray l u barr#) n
151   = case (index (l,u) n)                of { I# n# ->
152     case indexDoubleArray# barr# n#     of { r# ->
153     (D# r#)}}
154
155 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () 
156 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s () 
157 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () 
158 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () 
159
160 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
161 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
162 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
163 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
164
165 writeCharArray (MutableByteArray l u barr#) n (C# ele) = ST $ \ s# ->
166     case index (l,u) n                      of { I# n# ->
167     case writeCharArray# barr# n# ele s#    of { s2#   ->
168     (# s2#, () #) }}
169
170 writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
171     case index (l,u) n                      of { I# n# ->
172     case writeIntArray# barr# n# ele s#     of { s2#   ->
173     (# s2#, () #) }}
174
175 writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
176     case index (l,u) n                      of { I# n# ->
177     case writeFloatArray# barr# n# ele s#   of { s2#   ->
178     (# s2#, () #) }}
179
180 writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
181     case index (l,u) n                      of { I# n# ->
182     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
183     (# s2#, () #) }}
184 \end{code}