ghc/lib/glaExts/ByteOps.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1994
   3 %
   4 \section[ByteOps]{Convert to/from ``bytes''; to support @Native@ class}
   5
   6 This mimics some code that comes with HBC.
   7
   8 \begin{code}
   9 module ByteOps (
  10         longToBytes,
  11         intToBytes,
  12         shortToBytes,
  13         floatToBytes,
  14         doubleToBytes,
  15
  16         bytesToLong,
  17         bytesToInt,
  18         bytesToShort,
  19         bytesToFloat,
  20         bytesToDouble
  21     ) where
  22
  23 import Cls
  24 import Core
  25 import IInt
  26 import IFloat
  27 import IDouble
  28 import List             ( (++), foldr )
  29 import Prel             ( chr )
  30 import PS               ( _PackedString, _unpackPS )
  31 import TyArray          ( Array(..) )
  32 import PreludeGlaST
  33 import Text
  34 \end{code}
  35
  36 \tr{xxxToBytes} prepends an \tr{xxx} to a byte stream.
  37 \tr{bytesToXxx} snaffles an \tr{xxx} from a byte stream,
  38 also returning the rest of the stream.
  39 \begin{code}
  40 type Bytes = [Char]
  41
  42 longToBytes    :: Int    -> Bytes -> Bytes
  43 intToBytes     :: Int    -> Bytes -> Bytes
  44 shortToBytes   :: Int    -> Bytes -> Bytes
  45 floatToBytes   :: Float  -> Bytes -> Bytes
  46 doubleToBytes  :: Double -> Bytes -> Bytes
  47
  48 bytesToLong    :: Bytes -> (Int,    Bytes)
  49 bytesToInt     :: Bytes -> (Int,    Bytes)
  50 bytesToShort   :: Bytes -> (Int,    Bytes)
  51 bytesToFloat   :: Bytes -> (Float,  Bytes)
  52 bytesToDouble  :: Bytes -> (Double, Bytes)
  53 \end{code}
  54
  55 Here we go.
  56 \begin{code}
  57 #define XXXXToBytes(type,xxxx,xxxx__) \
  58 xxxx i stream \
  59   = let \
  60         long_bytes      {- DANGEROUS! -} \
  61           = unsafePerformPrimIO ( \
  62                 {- Allocate a wad of memory to put the "long"'s bytes. \
  63                    Let's hope 32 bytes will be big enough. -} \
  64                 newCharArray (0::Int, 31)   `thenPrimIO` \ arr# -> \
  65  \
  66                 {- Call out to C to do the dirty deed: -} \
  67                 _casm_ ``%r = xxxx__ ((type)%0, (unsigned char *)%1);'' i arr# \
  68                         `thenPrimIO` \ num_bytes -> \
  69  \
  70                 unpack arr# 0 (num_bytes - 1) \
  71             ) \
  72     in \
  73     long_bytes ++ stream
  74
  75 XXXXToBytes(long,longToBytes,long2bytes__)
  76 XXXXToBytes(int,intToBytes,int2bytes__)
  77 XXXXToBytes(short,shortToBytes,short2bytes__)
  78 XXXXToBytes(float,floatToBytes,float2bytes__)
  79 XXXXToBytes(double,doubleToBytes,double2bytes__)
  80 \end{code}
  81
  82 \begin{code}
  83 unpack :: _MutableByteArray _RealWorld Int -> Int -> Int -> PrimIO [Char]
  84
  85 unpack arr# curr last
  86   = if curr > last then
  87         returnPrimIO []
  88     else
  89         readCharArray arr# curr     `thenPrimIO` \ ch ->
  90         unpack arr# (curr + 1) last `thenPrimIO` \ rest ->
  91         returnPrimIO (ch : rest)
  92 \end{code}
  93
  94 Now we go the other way.  The paranoia checking (absent) leaves
  95 something to be desired.  Really have to be careful on
  96 funny-sized things like \tr{shorts}...
  97 \begin{code}
  98 #define bytesToXXXX(htype,xxxx,alloc,read,xxxx__) \
  99 xxxx stream \
 100   = unsafePerformPrimIO ( \
 101         {- slam (up to) 32 bytes [random] from the stream into an array -} \
 102         newCharArray (0::Int, 31)   `thenPrimIO` \ arr# -> \
 103         pack arr# 0 31 stream       `seqPrimIO` \
 104  \
 105         {- make a one-element array to hold the result: -} \
 106         alloc (0::Int, 0)           `thenPrimIO` \ res# -> \
 107  \
 108         {- call the C to do the business: -} \
 109         _casm_ ``%r = xxxx__ ((P_)%0, (htype *) %1);'' arr# res# \
 110                 `thenPrimIO` \ num_bytes -> \
 111  \
 112         {- read the result out of "res#": -} \
 113         read res# (0::Int)  `thenPrimIO` \ i -> \
 114  \
 115         {- box the result and drop the number of bytes taken: -} \
 116         returnPrimIO (i, my_drop num_bytes stream) \
 117     )
 118
 119 bytesToXXXX(I_,bytesToLong,newIntArray,readIntArray,bytes2long__)
 120 bytesToXXXX(I_,bytesToInt,newIntArray,readIntArray,bytes2int__)
 121 bytesToXXXX(I_,bytesToShort,newIntArray,readIntArray,bytes2short__)
 122 bytesToXXXX(StgFloat,bytesToFloat,newFloatArray,readFloatArray,bytes2float__)
 123 bytesToXXXX(StgDouble,bytesToDouble,newDoubleArray,readDoubleArray,bytes2double__)
 124 \end{code}
 125
 126 \begin{code}
 127 pack :: _MutableByteArray _RealWorld Int -> Int -> Int -> [Char] -> PrimIO ()
 128
 129 pack arr# curr last from_bytes
 130   = if curr > last then
 131        returnPrimIO ()
 132     else
 133        case from_bytes of
 134          [] -> writeCharArray arr# curr (chr 0)
 135
 136          (from_byte : xs) ->
 137            writeCharArray arr# curr from_byte   `seqPrimIO`
 138            pack arr# (curr + 1) last xs
 139
 140 -- more cavalier than usual; we know there will be enough bytes:
 141
 142 my_drop :: Int -> [a] -> [a]
 143
 144 my_drop 0 xs     = xs
 145 --my_drop _  []   = []
 146 my_drop m (_:xs) = my_drop (m - 1) xs
 147 \end{code}