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
|
{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
module Main (main) where
import Data.List (group)
import Data.Bits
import Data.Word
import Control.Monad
import Unsafe.Coerce (unsafeCoerce#)
import GHC.Word
import GHC.Base
import GHC.Num.Integer
import qualified GHC.Num.Integer as I
exportInteger :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word
exportInteger = I.integerToMutableByteArray
exportIntegerAddr :: Integer -> Addr# -> Int# -> IO Word
exportIntegerAddr = I.integerToAddr
importInteger :: ByteArray# -> Word# -> Word# -> Int# -> Integer
importInteger ba off sz = I.integerFromByteArray sz ba off
importIntegerAddr :: Addr# -> Word# -> Int# -> IO Integer
importIntegerAddr a l = I.integerFromAddr l a
-- helpers
data MBA = MBA { unMBA :: !(MutableByteArray# RealWorld) }
data BA = BA { unBA :: !ByteArray# }
newByteArray :: Word# -> IO MBA
newByteArray sz = IO $ \s -> case newPinnedByteArray# (word2Int# sz) s of (# s, arr #) -> (# s, MBA arr #)
indexByteArray :: ByteArray# -> Word# -> Word8
indexByteArray a# n# = W8# (narrowWord8# (indexWord8Array# a# (word2Int# n#)))
-- indexMutableByteArray :: MutableByteArray# RealWorld -> Word# -> IO Word8
-- indexMutableByteArray a# n# = IO $ \s -> case readWord8Array# a# (word2Int# n#) s of (# s', v #) -> (# s', W# v #)
writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()
writeByteArray arr i (W8# w) = IO $ \s -> case writeWord8Array# arr i (extendWord8# w) s of s -> (# s, () #)
lengthByteArray :: ByteArray# -> Word
lengthByteArray ba = W# (int2Word# (sizeofByteArray# ba))
unpackByteArray :: ByteArray# -> [Word8]
unpackByteArray ba | n == 0 = []
| otherwise = [ indexByteArray ba i | W# i <- [0 .. n-1] ]
where
n = lengthByteArray ba
freezeByteArray :: MutableByteArray# RealWorld -> IO BA
freezeByteArray arr = IO $ \s -> case unsafeFreezeByteArray# arr s of (# s, arr #) -> (# s, BA arr #)
----------------------------------------------------------------------------
main :: IO ()
main = do
-- import/export primitives
print $ [ W# (I.integerSizeInBase# 2## x) | x <- [b1024,b*e,b,e,m,x,y,-1,0,1] ]
print $ [ W# (I.integerSizeInBase# 256## x) | x <- [b1024,b*e,b,e,m,x,y,-1,0,1] ]
BA ba <- do
MBA mba <- newByteArray 128##
forM_ (zip [0..127] [0x01..]) $ \(I# i, w) -> do
writeByteArray mba i w
let a = byteArrayContents# (unsafeCoerce# mba)
print =<< importIntegerAddr a 0## 1#
print =<< importIntegerAddr a 0## 0#
print =<< importIntegerAddr (plusAddr# a 22#) 1## 1#
print =<< importIntegerAddr (plusAddr# a 97#) 1## 0#
print =<< importIntegerAddr a 23## 1#
print =<< importIntegerAddr a 23## 0#
-- no-op
print =<< exportIntegerAddr 0 (plusAddr# a 0#) 1#
-- write into array
print =<< exportIntegerAddr b (plusAddr# a 5#) 1#
print =<< exportIntegerAddr e (plusAddr# a 50#) 0#
print =<< exportInteger m mba 85## 1#
print =<< exportInteger m mba 105## 0#
print =<< importIntegerAddr (plusAddr# a 85#) 17## 1#
print =<< importIntegerAddr (plusAddr# a 105#) 17## 0#
-- read back full array
print =<< importIntegerAddr a 128## 1#
print =<< importIntegerAddr a 128## 0#
freezeByteArray mba
print $ importInteger ba 0## 0## 1#
print $ importInteger ba 0## 0## 0#
print $ importInteger ba 5## 29## 1#
print $ importInteger ba 50## 29## 0#
print $ importInteger ba 0## 128## 1#
print $ importInteger ba 0## 128## 0#
return ()
where
b = 2988348162058574136915891421498819466320163312926952423791023078876139
e = 2351399303373464486466122544523690094744975233415544072992656881240319
m = 10^(40::Int)
x = 5328841272400314897981163497728751426
y = 32052182750761975518649228050096851724
b1024 = roll (map fromIntegral (take 128 [0x80::Int .. ]))
roll :: [Word8] -> Integer
roll = GHC.Base.foldr (\b a -> a `shiftL` 8 .|. fromIntegral b) 0
|
