git.iko.soy/Idris-dev
on 7afa310 help sign in
Idris-dev/src/Idris/Primitives.hs
761 lines 36 kB history raw
1{-# LANGUAGE RankNTypes, ScopedTypeVariables, PatternGuards #-}
3module Idris.Primitives(primitives, Prim(..)) where
5import Idris.AbsSyntax
7import IRTS.Lang
9import Idris.Core.TT
10import Idris.Core.Evaluate
11import Data.Bits
12import Data.Word
13import Data.Int
14import Data.Char
15import Data.Function (on)
16import Data.Vector.Unboxed (Vector)
17import qualified Data.Vector.Unboxed as V
19data Prim = Prim { p_name :: Name,
20 p_type :: Type,
21 p_arity :: Int,
22 p_def :: [Const] -> Maybe Const,
23 p_lexp :: (Int, PrimFn),
24 p_total :: Totality
25 }
27ty :: [Const] -> Const -> Type
28ty [] x = Constant x
29ty (t:ts) x = Bind (sMN 0 "T") (Pi (Constant t) (TType (UVar (-3)))) (ty ts x)
31total, partial, iopartial :: Totality
32total = Total []
33partial = Partial NotCovering
34iopartial = Partial ExternalIO
36primitives :: [Prim]
37primitives =
38 -- operators
39 [iCoerce (ITFixed IT8) (ITFixed IT16) "zext" zext LZExt,
40 iCoerce (ITFixed IT8) (ITFixed IT32) "zext" zext LZExt,
41 iCoerce (ITFixed IT8) (ITFixed IT64) "zext" zext LZExt,
42 iCoerce (ITFixed IT8) ITBig "zext" zext LZExt,
43 iCoerce (ITFixed IT8) ITNative "zext" zext LZExt,
44 iCoerce (ITFixed IT16) (ITFixed IT32) "zext" zext LZExt,
45 iCoerce (ITFixed IT16) (ITFixed IT64) "zext" zext LZExt,
46 iCoerce (ITFixed IT16) ITBig "zext" zext LZExt,
47 iCoerce (ITFixed IT16) ITNative "zext" zext LZExt,
48 iCoerce (ITFixed IT32) (ITFixed IT64) "zext" zext LZExt,
49 iCoerce (ITFixed IT32) ITBig "zext" zext LZExt,
50 iCoerce (ITFixed IT32) ITNative "zext" zext LZExt,
51 iCoerce (ITFixed IT64) ITBig "zext" zext LZExt,
52 iCoerce ITNative ITBig "zext" zext LZExt,
53 iCoerce ITNative (ITFixed IT64) "zext" zext LZExt,
54 iCoerce ITNative (ITFixed IT32) "zext" zext LZExt,
55 iCoerce ITNative (ITFixed IT16) "zext" zext LZExt,
56 iCoerce ITChar ITBig "zext" zext LZExt,
58 iCoerce (ITFixed IT8) (ITFixed IT16) "sext" sext LSExt,
59 iCoerce (ITFixed IT8) (ITFixed IT32) "sext" sext LSExt,
60 iCoerce (ITFixed IT8) (ITFixed IT64) "sext" sext LSExt,
61 iCoerce (ITFixed IT8) ITBig "sext" sext LSExt,
62 iCoerce (ITFixed IT8) ITNative "sext" sext LSExt,
63 iCoerce (ITFixed IT16) (ITFixed IT32) "sext" sext LSExt,
64 iCoerce (ITFixed IT16) (ITFixed IT64) "sext" sext LSExt,
65 iCoerce (ITFixed IT16) ITBig "sext" sext LSExt,
66 iCoerce (ITFixed IT16) ITNative "sext" sext LSExt,
67 iCoerce (ITFixed IT32) (ITFixed IT64) "sext" sext LSExt,
68 iCoerce (ITFixed IT32) ITBig "sext" sext LSExt,
69 iCoerce (ITFixed IT32) ITNative "sext" sext LSExt,
70 iCoerce (ITFixed IT64) ITBig "sext" sext LSExt,
71 iCoerce ITNative ITBig "sext" sext LSExt,
72 iCoerce ITNative ITBig "sext" sext LSExt,
73 iCoerce ITNative (ITFixed IT64) "sext" sext LSExt,
74 iCoerce ITNative (ITFixed IT32) "sext" sext LSExt,
75 iCoerce ITNative (ITFixed IT16) "sext" sext LSExt,
76 iCoerce ITChar ITBig "sext" sext LSExt,
78 iCoerce (ITFixed IT16) (ITFixed IT8) "trunc" trunc LTrunc,
79 iCoerce (ITFixed IT32) (ITFixed IT8) "trunc" trunc LTrunc,
80 iCoerce (ITFixed IT64) (ITFixed IT8) "trunc" trunc LTrunc,
81 iCoerce ITBig (ITFixed IT8) "trunc" trunc LTrunc,
82 iCoerce ITNative (ITFixed IT8) "trunc" trunc LTrunc,
83 iCoerce (ITFixed IT32) (ITFixed IT16) "trunc" trunc LTrunc,
84 iCoerce (ITFixed IT64) (ITFixed IT16) "trunc" trunc LTrunc,
85 iCoerce ITBig (ITFixed IT16) "trunc" trunc LTrunc,
86 iCoerce ITNative (ITFixed IT16) "trunc" trunc LTrunc,
87 iCoerce (ITFixed IT64) (ITFixed IT32) "trunc" trunc LTrunc,
88 iCoerce ITBig (ITFixed IT32) "trunc" trunc LTrunc,
89 iCoerce ITNative (ITFixed IT32) "trunc" trunc LTrunc,
90 iCoerce ITBig (ITFixed IT64) "trunc" trunc LTrunc,
91 iCoerce (ITFixed IT16) ITNative "trunc" trunc LTrunc,
92 iCoerce (ITFixed IT32) ITNative "trunc" trunc LTrunc,
93 iCoerce (ITFixed IT64) ITNative "trunc" trunc LTrunc,
94 iCoerce ITBig ITNative "trunc" trunc LTrunc,
95 iCoerce ITNative (ITFixed IT64) "trunc" trunc LTrunc,
96 iCoerce ITBig ITChar "trunc" trunc LTrunc,
98 Prim (sUN "prim__addFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType ATFloat)) 2 (fBin (+))
99 (2, LPlus ATFloat) total,
100 Prim (sUN "prim__subFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType ATFloat)) 2 (fBin (-))
101 (2, LMinus ATFloat) total,
102 Prim (sUN "prim__mulFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType ATFloat)) 2 (fBin (*))
103 (2, LTimes ATFloat) total,
104 Prim (sUN "prim__divFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType ATFloat)) 2 (fBin (/))
105 (2, LSDiv ATFloat) total,
106 Prim (sUN "prim__eqFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (==))
107 (2, LEq ATFloat) total,
108 Prim (sUN "prim__sltFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (<))
109 (2, LSLt ATFloat) total,
110 Prim (sUN "prim__slteFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (<=))
111 (2, LSLe ATFloat) total,
112 Prim (sUN "prim__sgtFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (>))
113 (2, LSGt ATFloat) total,
114 Prim (sUN "prim__sgteFloat") (ty [(AType ATFloat), (AType ATFloat)] (AType (ATInt ITNative))) 2 (bfBin (>=))
115 (2, LSGe ATFloat) total,
116 Prim (sUN "prim__concat") (ty [StrType, StrType] StrType) 2 (sBin (++))
117 (2, LStrConcat) total,
118 Prim (sUN "prim__eqString") (ty [StrType, StrType] (AType (ATInt ITNative))) 2 (bsBin (==))
119 (2, LStrEq) total,
120 Prim (sUN "prim__ltString") (ty [StrType, StrType] (AType (ATInt ITNative))) 2 (bsBin (<))
121 (2, LStrLt) total,
122 Prim (sUN "prim_lenString") (ty [StrType] (AType (ATInt ITNative))) 1 (p_strLen)
123 (1, LStrLen) total,
124 -- Conversions
125 Prim (sUN "prim__charToInt") (ty [(AType (ATInt ITChar))] (AType (ATInt ITNative))) 1 (c_charToInt)
126 (1, LChInt ITNative) total,
127 Prim (sUN "prim__intToChar") (ty [(AType (ATInt ITNative))] (AType (ATInt ITChar))) 1 (c_intToChar)
128 (1, LIntCh ITNative) total,
129 Prim (sUN "prim__strToFloat") (ty [StrType] (AType ATFloat)) 1 (c_strToFloat)
130 (1, LStrFloat) total,
131 Prim (sUN "prim__floatToStr") (ty [(AType ATFloat)] StrType) 1 (c_floatToStr)
132 (1, LFloatStr) total,
134 Prim (sUN "prim__floatExp") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatExp)
135 (1, LFExp) total,
136 Prim (sUN "prim__floatLog") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatLog)
137 (1, LFLog) total,
138 Prim (sUN "prim__floatSin") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatSin)
139 (1, LFSin) total,
140 Prim (sUN "prim__floatCos") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatCos)
141 (1, LFCos) total,
142 Prim (sUN "prim__floatTan") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatTan)
143 (1, LFTan) total,
144 Prim (sUN "prim__floatASin") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatASin)
145 (1, LFASin) total,
146 Prim (sUN "prim__floatACos") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatACos)
147 (1, LFACos) total,
148 Prim (sUN "prim__floatATan") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatATan)
149 (1, LFATan) total,
150 Prim (sUN "prim__floatSqrt") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatSqrt)
151 (1, LFSqrt) total,
152 Prim (sUN "prim__floatFloor") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatFloor)
153 (1, LFFloor) total,
154 Prim (sUN "prim__floatCeil") (ty [(AType ATFloat)] (AType ATFloat)) 1 (p_floatCeil)
155 (1, LFCeil) total,
156 Prim (sUN "prim__negFloat") (ty [(AType ATFloat)] (AType ATFloat)) 1 (c_negFloat)
157 (1, LFNegate) total,
159 Prim (sUN "prim__strHead") (ty [StrType] (AType (ATInt ITChar))) 1 (p_strHead)
160 (1, LStrHead) partial,
161 Prim (sUN "prim__strTail") (ty [StrType] StrType) 1 (p_strTail)
162 (1, LStrTail) partial,
163 Prim (sUN "prim__strCons") (ty [(AType (ATInt ITChar)), StrType] StrType) 2 (p_strCons)
164 (2, LStrCons) total,
165 Prim (sUN "prim__strIndex") (ty [StrType, (AType (ATInt ITNative))] (AType (ATInt ITChar))) 2 (p_strIndex)
166 (2, LStrIndex) partial,
167 Prim (sUN "prim__strRev") (ty [StrType] StrType) 1 (p_strRev)
168 (1, LStrRev) total,
169 Prim (sUN "prim__readString") (ty [PtrType] StrType) 1 (p_cantreduce)
170 (1, LReadStr) iopartial,
171 Prim (sUN "prim__vm") (ty [] PtrType) 0 (p_cantreduce)
172 (0, LVMPtr) total,
173 -- Streams
174 Prim (sUN "prim__stdin") (ty [] PtrType) 0 (p_cantreduce)
175 (0, LStdIn) iopartial,
176 Prim (sUN "prim__stdout") (ty [] PtrType) 0 (p_cantreduce)
177 (0, LStdOut) iopartial,
178 Prim (sUN "prim__stderr") (ty [] PtrType) 0 (p_cantreduce)
179 (0, LStdErr) iopartial,
180 Prim (sUN "prim__null") (ty [] PtrType) 0 (p_cantreduce)
181 (0, LNullPtr) total,
182 -- Managed pointer registration
183 Prim (sUN "prim__registerPtr") (ty [PtrType, AType (ATInt ITNative)] ManagedPtrType) 2 (p_cantreduce)
184 (2, LRegisterPtr) total,
185 -- Buffers
186 Prim (sUN "prim__allocate") (ty [AType (ATInt (ITFixed IT64))] BufferType) 1 (p_allocate)
187 (1, LAllocate) total,
188 Prim (sUN "prim__appendBuffer") (ty [BufferType, AType (ATInt (ITFixed IT64)), AType (ATInt (ITFixed IT64)), AType (ATInt (ITFixed IT64)), AType (ATInt (ITFixed IT64)), BufferType] BufferType) 6 (p_appendBuffer)
189 (6, LAppendBuffer) partial,
190 Prim (sUN "prim__systemInfo") (ty [AType (ATInt ITNative)] StrType) 1 (p_cantreduce)
191 (1, LSystemInfo) total
192 ] ++ concatMap intOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64, ITBig, ITNative, ITChar]
193 ++ concatMap vecOps vecTypes
194 ++ concatMap fixedOps [ITFixed IT8, ITFixed IT16, ITFixed IT32, ITFixed IT64] -- ITNative, ITChar, ATFloat ] ++ vecTypes
195 ++ vecBitcasts vecTypes
197vecTypes :: [IntTy]
198vecTypes = [ITVec IT8 16, ITVec IT16 8, ITVec IT32 4, ITVec IT64 2]
200intOps :: IntTy -> [Prim]
201intOps ity = intCmps ity ++ intArith ity ++ intConv ity
203intSCmps :: IntTy -> [Prim]
204intSCmps ity =
205 [ iCmp ity "slt" False (bCmp ity (sCmpOp ity (<))) (LSLt . ATInt) total
206 , iCmp ity "slte" False (bCmp ity (sCmpOp ity (<=))) (LSLe . ATInt) total
207 , iCmp ity "eq" False (bCmp ity (==)) (LEq . ATInt) total
208 , iCmp ity "sgte" False (bCmp ity (sCmpOp ity (>=))) (LSGe . ATInt) total
209 , iCmp ity "sgt" False (bCmp ity (sCmpOp ity (>))) (LSGt . ATInt) total
210 ]
212intCmps :: IntTy -> [Prim]
213intCmps ITNative = intSCmps ITNative
214intCmps ity =
215 intSCmps ity ++
216 [ iCmp ity "lt" False (bCmp ity (cmpOp ity (<))) LLt total
217 , iCmp ity "lte" False (bCmp ity (cmpOp ity (<=))) LLe total
218 , iCmp ity "gte" False (bCmp ity (cmpOp ity (>=))) LGe total
219 , iCmp ity "gt" False (bCmp ity (cmpOp ity (>))) LGt total
220 ]
222intArith :: IntTy -> [Prim]
223intArith ity =
224 [ iBinOp ity "add" (bitBin ity (+)) (LPlus . ATInt) total
225 , iBinOp ity "sub" (bitBin ity (-)) (LMinus . ATInt) total
226 , iBinOp ity "mul" (bitBin ity (*)) (LTimes . ATInt) total
227 , iBinOp ity "udiv" (bitBin ity div) LUDiv partial
228 , iBinOp ity "sdiv" (bsdiv ity) (LSDiv . ATInt) partial
229 , iBinOp ity "urem" (bitBin ity rem) LURem partial
230 , iBinOp ity "srem" (bsrem ity) (LSRem . ATInt) partial
231 , iBinOp ity "shl" (bitBin ity (\x y -> shiftL x (fromIntegral y))) LSHL total
232 , iBinOp ity "lshr" (bitBin ity (\x y -> shiftR x (fromIntegral y))) LLSHR total
233 , iBinOp ity "ashr" (bashr ity) LASHR total
234 , iBinOp ity "and" (bitBin ity (.&.)) LAnd total
235 , iBinOp ity "or" (bitBin ity (.|.)) LOr total
236 , iBinOp ity "xor" (bitBin ity (xor)) LXOr total
237 , iUnOp ity "compl" (bUn ity complement) LCompl total
238 ]
240intConv :: IntTy -> [Prim]
241intConv ity =
242 [ Prim (sUN $ "prim__toStr" ++ intTyName ity) (ty [AType . ATInt $ ity] StrType) 1 intToStr
243 (1, LIntStr ity) total
244 , Prim (sUN $ "prim__fromStr" ++ intTyName ity) (ty [StrType] (AType . ATInt $ ity)) 1 (strToInt ity)
245 (1, LStrInt ity) total
246 , Prim (sUN $ "prim__toFloat" ++ intTyName ity) (ty [AType . ATInt $ ity] (AType ATFloat)) 1 intToFloat
247 (1, LIntFloat ity) total
248 , Prim (sUN $ "prim__fromFloat" ++ intTyName ity) (ty [AType ATFloat] (AType . ATInt $ ity)) 1 (floatToInt ity)
249 (1, LFloatInt ity) total
250 ]
252vecCmps :: IntTy -> [Prim]
253vecCmps ity =
254 [ iCmp ity "slt" True (bCmp ity (<)) (LSLt . ATInt) total
255 , iCmp ity "slte" True (bCmp ity (<=)) (LSLe . ATInt) total
256 , iCmp ity "eq" True (bCmp ity (==)) (LEq . ATInt) total
257 , iCmp ity "sgte" True (bCmp ity (>=)) (LSGe . ATInt) total
258 , iCmp ity "sgt" True (bCmp ity (>)) (LSGt . ATInt) total
259 , iCmp ity "lt" True (bCmp ity (<)) LLt total
260 , iCmp ity "lte" True (bCmp ity (<=)) LLe total
261 , iCmp ity "gte" True (bCmp ity (>=)) LGe total
262 , iCmp ity "gt" True (bCmp ity (>)) LGt total
263 ]
265-- The TODOs in this function are documented as Issue #1617 on the issue tracker.
266--
267-- https://github.com/idris-lang/Idris-dev/issues/1617
268vecOps :: IntTy -> [Prim]
269vecOps ity@(ITVec elem count) =
270 [ Prim (sUN $ "prim__mk" ++ intTyName ity)
271 (ty (replicate count . AType . ATInt . ITFixed $ elem) (AType . ATInt $ ity))
272 count (mkVecCon elem count) (count, LMkVec elem count) total
273 , Prim (sUN $ "prim__index" ++ intTyName ity)
274 (ty [AType . ATInt $ ity, AType (ATInt (ITFixed IT32))] (AType . ATInt . ITFixed $ elem))
275 2 (mkVecIndex count) (2, LIdxVec elem count) partial -- TODO: Ensure this reduces
276 , Prim (sUN $ "prim__update" ++ intTyName ity)
277 (ty [AType . ATInt $ ity, AType (ATInt (ITFixed IT32)), AType . ATInt . ITFixed $ elem]
278 (AType . ATInt $ ity))
279 3 (mkVecUpdate elem count) (3, LUpdateVec elem count) partial -- TODO: Ensure this reduces
280 ] ++ intArith ity ++ vecCmps ity
282bitcastPrim :: ArithTy -> ArithTy -> (ArithTy -> [Const] -> Maybe Const) -> PrimFn -> Prim
283bitcastPrim from to impl prim =
284 Prim (sUN $ "prim__bitcast" ++ aTyName from ++ "_" ++ aTyName to) (ty [AType from] (AType to)) 1 (impl to)
285 (1, prim) total
287vecBitcasts :: [IntTy] -> [Prim]
288vecBitcasts tys = [bitcastPrim from to bitcastVec (LBitCast from to)
289 | from <- map ATInt vecTypes, to <- map ATInt vecTypes, from /= to]
291fixedOps :: IntTy -> [Prim]
292fixedOps ity@(ITFixed _) =
293 map appendFun endiannesses ++
294 map peekFun endiannesses
295 where
296 endiannesses = [ Native, LE, BE ]
297 tyName = intTyName ity
298 b64 = AType (ATInt (ITFixed IT64))
299 thisTy = AType $ ATInt ity
300 appendFun en = Prim (sUN $ "prim__append" ++ tyName ++ show en)
301 (ty [BufferType, b64, b64, thisTy] BufferType)
302 4 (p_append en) (4, LAppend ity en) partial
303 peekFun en = Prim (sUN $ "prim__peek" ++ tyName ++ show en)
304 (ty [BufferType, b64] thisTy)
305 2 (p_peek ity en) (2, LPeek ity en) partial
307mapHalf :: (V.Unbox a, V.Unbox b) => ((a, a) -> b) -> Vector a -> Vector b
308mapHalf f xs = V.generate (V.length xs `div` 2) (\i -> f (xs V.! (i*2), xs V.! (i*2+1)))
310mapDouble :: (V.Unbox a, V.Unbox b) => (Bool -> a -> b) -> Vector a -> Vector b
311mapDouble f xs = V.generate (V.length xs * 2) (\i -> f (i `rem` 2 == 0) (xs V.! (i `div` 2)))
313concatWord8 :: (Word8, Word8) -> Word16
314concatWord8 (high, low) = fromIntegral high .|. (fromIntegral low `shiftL` 8)
316concatWord16 :: (Word16, Word16) -> Word32
317concatWord16 (high, low) = fromIntegral high .|. (fromIntegral low `shiftL` 16)
319concatWord32 :: (Word32, Word32) -> Word64
320concatWord32 (high, low) = fromIntegral high .|. (fromIntegral low `shiftL` 32)
322truncWord16 :: Bool -> Word16 -> Word8
323truncWord16 True x = fromIntegral (x `shiftR` 8)
324truncWord16 False x = fromIntegral x
326truncWord32 :: Bool -> Word32 -> Word16
327truncWord32 True x = fromIntegral (x `shiftR` 16)
328truncWord32 False x = fromIntegral x
330truncWord64 :: Bool -> Word64 -> Word32
331truncWord64 True x = fromIntegral (x `shiftR` 32)
332truncWord64 False x = fromIntegral x
334bitcastVec :: ArithTy -> [Const] -> Maybe Const
335bitcastVec (ATInt (ITVec IT8 n)) [x@(B8V v)]
336 | V.length v == n = Just x
337bitcastVec (ATInt (ITVec IT16 n)) [B8V v]
338 | V.length v == n*2 = Just . B16V . mapHalf concatWord8 $ v
339bitcastVec (ATInt (ITVec IT32 n)) [B8V v]
340 | V.length v == n*4 = Just . B32V . mapHalf concatWord16 . mapHalf concatWord8 $ v
341bitcastVec (ATInt (ITVec IT64 n)) [B8V v]
342 | V.length v == n*8 = Just . B64V . mapHalf concatWord32 . mapHalf concatWord16 . mapHalf concatWord8 $ v
344bitcastVec (ATInt (ITVec IT8 n)) [B16V v]
345 | V.length v * 2 == n = Just . B8V . mapDouble truncWord16 $ v
346bitcastVec (ATInt (ITVec IT16 n)) [x@(B16V v)]
347 | V.length v == n = Just x
348bitcastVec (ATInt (ITVec IT32 n)) [B16V v]
349 | V.length v == n*2 = Just . B32V . mapHalf concatWord16 $ v
350bitcastVec (ATInt (ITVec IT64 n)) [B16V v]
351 | V.length v == n*4 = Just . B64V . mapHalf concatWord32 . mapHalf concatWord16 $ v
353bitcastVec (ATInt (ITVec IT8 n)) [B32V v]
354 | V.length v * 4 == n = Just . B8V . mapDouble truncWord16 . mapDouble truncWord32 $ v
355bitcastVec (ATInt (ITVec IT16 n)) [B32V v]
356 | V.length v * 2 == n = Just . B16V . mapDouble truncWord32 $ v
357bitcastVec (ATInt (ITVec IT32 n)) [x@(B32V v)]
358 | V.length v == n = Just x
359bitcastVec (ATInt (ITVec IT64 n)) [B32V v]
360 | V.length v == n*2 = Just . B64V . mapHalf concatWord32 $ v
362bitcastVec (ATInt (ITVec IT8 n)) [B64V v]
363 | V.length v * 8 == n = Just . B8V . mapDouble truncWord16 . mapDouble truncWord32 . mapDouble truncWord64 $ v
364bitcastVec (ATInt (ITVec IT16 n)) [B64V v]
365 | V.length v * 4 == n = Just . B16V . mapDouble truncWord32 . mapDouble truncWord64 $ v
366bitcastVec (ATInt (ITVec IT32 n)) [B64V v]
367 | V.length v == n*2 = Just . B32V . mapDouble truncWord64 $ v
368bitcastVec (ATInt (ITVec IT64 n)) [x@(B64V v)]
369 | V.length v == n = Just x
371bitcastVec _ _ = Nothing
373mkVecCon :: NativeTy -> Int -> [Const] -> Maybe Const
374mkVecCon ity count args
375 | length ints == count = Just (mkVec ity count ints)
376 | otherwise = Nothing
377 where
378 ints = getInt args
379 mkVec :: NativeTy -> Int -> [Integer] -> Const
380 mkVec IT8 len values = B8V $ V.generate len (fromInteger . (values !!))
381 mkVec IT16 len values = B16V $ V.generate len (fromInteger . (values !!))
382 mkVec IT32 len values = B32V $ V.generate len (fromInteger . (values !!))
383 mkVec IT64 len values = B64V $ V.generate len (fromInteger . (values !!))
385mkVecIndex count [vec, B32 i] = Just (idxVec vec)
386 where
387 idxVec :: Const -> Const
388 idxVec (B8V v) = B8 $ V.unsafeIndex v (fromIntegral i)
389 idxVec (B16V v) = B16 $ V.unsafeIndex v (fromIntegral i)
390 idxVec (B32V v) = B32 $ V.unsafeIndex v (fromIntegral i)
391 idxVec (B64V v) = B64 $ V.unsafeIndex v (fromIntegral i)
392mkVecIndex _ _ = Nothing
394mkVecUpdate ity count [vec, B32 i, newElem] = updateVec vec newElem
395 where
396 updateVec :: Const -> Const -> Maybe Const
397 updateVec (B8V v) (B8 e) = Just . B8V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
398 updateVec (B16V v) (B16 e) = Just . B16V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
399 updateVec (B32V v) (B32 e) = Just . B32V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
400 updateVec (B64V v) (B64 e) = Just . B64V $ V.unsafeUpdate v (V.singleton (fromIntegral i, e))
401 updateVec _ _ = Nothing
402mkVecUpdate _ _ _ = Nothing
404aTyName :: ArithTy -> String
405aTyName (ATInt t) = intTyName t
406aTyName ATFloat = "Float"
408iCmp :: IntTy -> String -> Bool -> ([Const] -> Maybe Const) -> (IntTy -> PrimFn) -> Totality -> Prim
409iCmp ity op self impl irop totality
410 = Prim (sUN $ "prim__" ++ op ++ intTyName ity)
411 (ty (replicate 2 . AType . ATInt $ ity) (AType (ATInt (if self then ity else ITNative))))
412 2 impl (2, irop ity) totality
414iBinOp, iUnOp :: IntTy -> String -> ([Const] -> Maybe Const) -> (IntTy -> PrimFn) -> Totality -> Prim
415iBinOp ity op impl irop totality
416 = Prim (sUN $ "prim__" ++ op ++ intTyName ity)
417 (ty (replicate 2 . AType . ATInt $ ity) (AType . ATInt $ ity))
418 2 impl (2, irop ity) totality
419iUnOp ity op impl irop totality
420 = Prim (sUN $ "prim__" ++ op ++ intTyName ity)
421 (ty [AType . ATInt $ ity] (AType . ATInt $ ity))
422 1 impl (1, irop ity) totality
424iCoerce :: IntTy -> IntTy -> String -> (IntTy -> IntTy -> [Const] -> Maybe Const) -> (IntTy -> IntTy -> PrimFn) -> Prim
425iCoerce from to op impl irop =
426 Prim (sUN $ "prim__" ++ op ++ intTyName from ++ "_" ++ intTyName to)
427 (ty [AType . ATInt $ from] (AType . ATInt $ to)) 1 (impl from to) (1, irop from to) total
429fBin :: (Double -> Double -> Double) -> [Const] -> Maybe Const
430fBin op [Fl x, Fl y] = Just $ Fl (op x y)
431fBin _ _ = Nothing
433bfBin :: (Double -> Double -> Bool) -> [Const] -> Maybe Const
434bfBin op [Fl x, Fl y] = let i = (if op x y then 1 else 0) in
435 Just $ I i
436bfBin _ _ = Nothing
438bcBin :: (Char -> Char -> Bool) -> [Const] -> Maybe Const
439bcBin op [Ch x, Ch y] = let i = (if op x y then 1 else 0) in
440 Just $ I i
441bcBin _ _ = Nothing
443bsBin :: (String -> String -> Bool) -> [Const] -> Maybe Const
444bsBin op [Str x, Str y]
445 = let i = (if op x y then 1 else 0) in
446 Just $ I i
447bsBin _ _ = Nothing
449sBin :: (String -> String -> String) -> [Const] -> Maybe Const
450sBin op [Str x, Str y] = Just $ Str (op x y)
451sBin _ _ = Nothing
453bsrem :: IntTy -> [Const] -> Maybe Const
454bsrem ITBig [BI x, BI y] = Just . BI $ x `rem` y
455bsrem (ITFixed IT8) [B8 x, B8 y]
456 = Just $ B8 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int8))
457bsrem (ITFixed IT16) [B16 x, B16 y]
458 = Just $ B16 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int16))
459bsrem (ITFixed IT32) [B32 x, B32 y]
460 = Just $ B32 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int32))
461bsrem (ITFixed IT64) [B64 x, B64 y]
462 = Just $ B64 (fromIntegral (fromIntegral x `rem` fromIntegral y :: Int64))
463bsrem ITNative [I x, I y] = Just $ I (x `rem` y)
464bsrem ITChar [Ch x, Ch y] = Just $ Ch (chr $ (ord x) `rem` (ord y))
465bsrem (ITVec IT8 _) [B8V x, B8V y]
466 = Just . B8V $
467 V.zipWith (\n d -> (fromIntegral (fromIntegral n `rem` fromIntegral d :: Int8))) x y
468bsrem (ITVec IT16 _) [B16V x, B16V y]
469 = Just . B16V $
470 V.zipWith (\n d -> (fromIntegral (fromIntegral n `rem` fromIntegral d :: Int16))) x y
471bsrem (ITVec IT32 _) [B32V x, B32V y]
472 = Just . B32V $
473 V.zipWith (\n d -> (fromIntegral (fromIntegral n `rem` fromIntegral d :: Int64))) x y
474bsrem (ITVec IT64 _) [B64V x, B64V y]
475 = Just . B64V $
476 V.zipWith (\n d -> (fromIntegral (fromIntegral n `rem` fromIntegral d :: Int64))) x y
477bsrem _ _ = Nothing
479bsdiv :: IntTy -> [Const] -> Maybe Const
480bsdiv ITBig [BI x, BI y] = Just . BI $ x `div` y
481bsdiv (ITFixed IT8) [B8 x, B8 y]
482 = Just $ B8 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int8))
483bsdiv (ITFixed IT16) [B16 x, B16 y]
484 = Just $ B16 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int16))
485bsdiv (ITFixed IT32) [B32 x, B32 y]
486 = Just $ B32 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int32))
487bsdiv (ITFixed IT64) [B64 x, B64 y]
488 = Just $ B64 (fromIntegral (fromIntegral x `div` fromIntegral y :: Int64))
489bsdiv ITNative [I x, I y] = Just $ I (x `div` y)
490bsdiv ITChar [Ch x, Ch y] = Just $ Ch (chr $ (ord x) `div` (ord y))
491bsdiv (ITVec IT8 _) [B8V x, B8V y]
492 = Just . B8V $
493 V.zipWith (\n d -> (fromIntegral (fromIntegral n `div` fromIntegral d :: Int8))) x y
494bsdiv (ITVec IT16 _) [B16V x, B16V y]
495 = Just . B16V $
496 V.zipWith (\n d -> (fromIntegral (fromIntegral n `div` fromIntegral d :: Int16))) x y
497bsdiv (ITVec IT32 _) [B32V x, B32V y]
498 = Just . B32V $
499 V.zipWith (\n d -> (fromIntegral (fromIntegral n `div` fromIntegral d :: Int64))) x y
500bsdiv (ITVec IT64 _) [B64V x, B64V y]
501 = Just . B64V $
502 V.zipWith (\n d -> (fromIntegral (fromIntegral n `div` fromIntegral d :: Int64))) x y
503bsdiv _ _ = Nothing
505bashr :: IntTy -> [Const] -> Maybe Const
506bashr ITBig [BI x, BI y] = Just $ BI (x `shiftR` fromIntegral y)
507bashr (ITFixed IT8) [B8 x, B8 y]
508 = Just $ B8 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int8))
509bashr (ITFixed IT16) [B16 x, B16 y]
510 = Just $ B16 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int16))
511bashr (ITFixed IT32) [B32 x, B32 y]
512 = Just $ B32 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int32))
513bashr (ITFixed IT64) [B64 x, B64 y]
514 = Just $ B64 (fromIntegral (fromIntegral x `shiftR` fromIntegral y :: Int64))
515bashr ITNative [I x, I y] = Just $ I (x `shiftR` y)
516bashr ITChar [Ch x, Ch y] = Just $ Ch (chr $ (ord x) `shiftR` (ord y))
517bashr (ITVec IT8 _) [B8V x, B8V y]
518 = Just . B8V $
519 V.zipWith (\n d -> (fromIntegral (fromIntegral n `shiftR` fromIntegral d :: Int8))) x y
520bashr (ITVec IT16 _) [B16V x, B16V y]
521 = Just . B16V $
522 V.zipWith (\n d -> (fromIntegral (fromIntegral n `shiftR` fromIntegral d :: Int16))) x y
523bashr (ITVec IT32 _) [B32V x, B32V y]
524 = Just . B32V $
525 V.zipWith (\n d -> (fromIntegral (fromIntegral n `shiftR` fromIntegral d :: Int64))) x y
526bashr (ITVec IT64 _) [B64V x, B64V y]
527 = Just . B64V $
528 V.zipWith (\n d -> (fromIntegral (fromIntegral n `shiftR` fromIntegral d :: Int64))) x y
529bashr _ _ = Nothing
531bUn :: IntTy -> (forall a. Bits a => a -> a) -> [Const] -> Maybe Const
532bUn (ITFixed IT8) op [B8 x] = Just $ B8 (op x)
533bUn (ITFixed IT16) op [B16 x] = Just $ B16 (op x)
534bUn (ITFixed IT32) op [B32 x] = Just $ B32 (op x)
535bUn (ITFixed IT64) op [B64 x] = Just $ B64 (op x)
536bUn ITBig op [BI x] = Just $ BI (op x)
537bUn ITNative op [I x] = Just $ I (op x)
538bUn ITChar op [Ch x] = Just $ Ch (chr $ op (ord x))
539bUn (ITVec IT8 _) op [B8V x] = Just . B8V $ V.map op x
540bUn (ITVec IT16 _) op [B16V x] = Just . B16V $ V.map op x
541bUn (ITVec IT32 _) op [B32V x] = Just . B32V $ V.map op x
542bUn (ITVec IT64 _) op [B64V x] = Just . B64V $ V.map op x
543bUn _ _ _ = Nothing
545bitBin :: IntTy -> (forall a. (Bits a, Integral a) => a -> a -> a) -> [Const] -> Maybe Const
546bitBin (ITFixed IT8) op [B8 x, B8 y] = Just $ B8 (op x y)
547bitBin (ITFixed IT16) op [B16 x, B16 y] = Just $ B16 (op x y)
548bitBin (ITFixed IT32) op [B32 x, B32 y] = Just $ B32 (op x y)
549bitBin (ITFixed IT64) op [B64 x, B64 y] = Just $ B64 (op x y)
550bitBin ITBig op [BI x, BI y] = Just $ BI (op x y)
551bitBin ITNative op [I x, I y] = Just $ I (op x y)
552bitBin ITChar op [Ch x, Ch y] = Just $ Ch (chr $ op (ord x) (ord y))
553bitBin (ITVec IT8 _) op [B8V x, B8V y] = Just . B8V $ V.zipWith op x y
554bitBin (ITVec IT16 _) op [B16V x, B16V y] = Just . B16V $ V.zipWith op x y
555bitBin (ITVec IT32 _) op [B32V x, B32V y] = Just . B32V $ V.zipWith op x y
556bitBin (ITVec IT64 _) op [B64V x, B64V y] = Just . B64V $ V.zipWith op x y
557bitBin _ _ _ = Nothing
559bCmp :: IntTy -> (forall a. (Integral a, Ord a) => a -> a -> Bool) -> [Const] -> Maybe Const
560bCmp (ITFixed IT8) op [B8 x, B8 y] = Just $ I (if (op x y) then 1 else 0)
561bCmp (ITFixed IT16) op [B16 x, B16 y] = Just $ I (if (op x y) then 1 else 0)
562bCmp (ITFixed IT32) op [B32 x, B32 y] = Just $ I (if (op x y) then 1 else 0)
563bCmp (ITFixed IT64) op [B64 x, B64 y] = Just $ I (if (op x y) then 1 else 0)
564bCmp ITBig op [BI x, BI y] = Just $ I (if (op x y) then 1 else 0)
565bCmp ITNative op [I x, I y] = Just $ I (if (op x y) then 1 else 0)
566bCmp ITChar op [Ch x, Ch y] = Just $ I (if (op (ord x) (ord y)) then 1 else 0)
567bCmp (ITVec IT8 _) op [B8V x, B8V y]
568 = Just . B8V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y
569bCmp (ITVec IT16 _) op [B16V x, B16V y]
570 = Just . B16V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y
571bCmp (ITVec IT32 _) op [B32V x, B32V y]
572 = Just . B32V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y
573bCmp (ITVec IT64 _) op [B64V x, B64V y]
574 = Just . B64V . V.map (\b -> if b then -1 else 0) $ V.zipWith op x y
575bCmp _ _ _ = Nothing
578cmpOp :: (Ord a, Integral a) => IntTy -> (forall b. Ord b => b -> b -> Bool) -> a -> a -> Bool
579cmpOp (ITFixed _) f = f
580cmpOp (ITNative) f = f `on` (fromIntegral :: Integral a => a -> Word)
581cmpOp (ITChar) f = f `on` ((fromIntegral :: Integral a => a -> Word))
582cmpOp _ f = let xor = (/=) in (\ x y -> (f x y) `xor` (x < 0) `xor` (y < 0))
584sCmpOp :: (Ord a, Integral a) => IntTy -> (forall b. Ord b => b -> b -> Bool) -> a -> a -> Bool
585sCmpOp (ITFixed IT8) f = f `on` (fromIntegral :: Integral a => a -> Int8)
586sCmpOp (ITFixed IT16) f = f `on` (fromIntegral :: Integral a => a -> Int16)
587sCmpOp (ITFixed IT32) f = f `on` (fromIntegral :: Integral a => a -> Int32)
588sCmpOp (ITFixed IT64) f = f `on` (fromIntegral :: Integral a => a -> Int64)
589sCmpOp _ f = f
591toInt :: Integral a => IntTy -> a -> Const
592toInt (ITFixed IT8) x = B8 (fromIntegral x)
593toInt (ITFixed IT16) x = B16 (fromIntegral x)
594toInt (ITFixed IT32) x = B32 (fromIntegral x)
595toInt (ITFixed IT64) x = B64 (fromIntegral x)
596toInt ITBig x = BI (fromIntegral x)
597toInt ITNative x = I (fromIntegral x)
598toInt ITChar x = Ch (chr $ fromIntegral x)
600intToInt :: IntTy -> IntTy -> [Const] -> Maybe Const
601intToInt (ITFixed IT8) out [B8 x] = Just $ toInt out x
602intToInt (ITFixed IT16) out [B16 x] = Just $ toInt out x
603intToInt (ITFixed IT32) out [B32 x] = Just $ toInt out x
604intToInt (ITFixed IT64) out [B64 x] = Just $ toInt out x
605intToInt ITBig out [BI x] = Just $ toInt out x
606intToInt ITNative out [I x] = Just $ toInt out x
607intToInt ITChar out [Ch x] = Just $ toInt out (ord x)
608intToInt _ _ _ = Nothing
610zext :: IntTy -> IntTy -> [Const] -> Maybe Const
611zext from ITBig val = intToInt from ITBig val
612zext ITBig _ _ = Nothing
613zext f@(ITFixed from) t@(ITFixed to) val
614 | nativeTyWidth from < nativeTyWidth to = intToInt f t val
615zext ITNative to [I x] = Just $ toInt to (fromIntegral x :: Word)
616zext from ITNative val = intToInt from ITNative val
617zext _ _ _ = Nothing
619sext :: IntTy -> IntTy -> [Const] -> Maybe Const
620sext (ITFixed IT8) out [B8 x] = Just $ toInt out (fromIntegral x :: Int8)
621sext (ITFixed IT16) out [B16 x] = Just $ toInt out (fromIntegral x :: Int16)
622sext (ITFixed IT32) out [B32 x] = Just $ toInt out (fromIntegral x :: Int32)
623sext (ITFixed IT64) out [B64 x] = Just $ toInt out (fromIntegral x :: Int64)
624sext ITBig _ _ = Nothing
625sext from to val = intToInt from to val
627trunc :: IntTy -> IntTy -> [Const] -> Maybe Const
628trunc ITBig to val = intToInt ITBig to val
629trunc _ ITBig _ = Nothing
630trunc f@(ITFixed from) t@(ITFixed to) val | nativeTyWidth from > nativeTyWidth to = intToInt f t val
631trunc ITNative to [I x] = Just $ toInt to x
632trunc from ITNative val = intToInt from ITNative val
633trunc _ _ _ = Nothing
635intToStr :: [Const] -> Maybe Const
636intToStr val | [i] <- getInt val = Just $ Str (show i)
637intToStr _ = Nothing
639getInt :: [Const] -> [Integer]
640getInt (B8 x : xs) = toInteger x : getInt xs
641getInt (B16 x : xs) = toInteger x : getInt xs
642getInt (B32 x : xs) = toInteger x : getInt xs
643getInt (B64 x : xs) = toInteger x : getInt xs
644getInt (I x : xs) = toInteger x : getInt xs
645getInt (BI x : xs) = x : getInt xs
646getInt _ = []
648strToInt :: IntTy -> [Const] -> Maybe Const
649strToInt ity [Str x] = case reads x of
650 [(n,"")] -> Just $ toInt ity (n :: Integer)
651 _ -> Just $ I 0
652strToInt _ _ = Nothing
654intToFloat :: [Const] -> Maybe Const
655intToFloat val | [i] <- getInt val = Just $ Fl (fromIntegral i)
656intToFloat _ = Nothing
658floatToInt :: IntTy -> [Const] -> Maybe Const
659floatToInt ity [Fl x] = Just $ toInt ity (truncate x :: Integer)
660floatToInt _ _ = Nothing
662c_intToChar, c_charToInt :: [Const] -> Maybe Const
663c_intToChar [(I x)] = Just . Ch . toEnum $ x
664c_intToChar _ = Nothing
665c_charToInt [(Ch x)] = Just . I . fromEnum $ x
666c_charToInt _ = Nothing
668c_negFloat :: [Const] -> Maybe Const
669c_negFloat [Fl x] = Just $ Fl (negate x)
670c_negFloat _ = Nothing
672c_floatToStr :: [Const] -> Maybe Const
673c_floatToStr [Fl x] = Just $ Str (show x)
674c_floatToStr _ = Nothing
675c_strToFloat [Str x] = case reads x of
676 [(n,"")] -> Just $ Fl n
677 _ -> Just $ Fl 0
678c_strToFloat _ = Nothing
680p_fPrim :: (Double -> Double) -> [Const] -> Maybe Const
681p_fPrim f [Fl x] = Just $ Fl (f x)
682p_fPrim f _ = Nothing
684p_floatExp, p_floatLog, p_floatSin, p_floatCos, p_floatTan, p_floatASin, p_floatACos, p_floatATan, p_floatSqrt, p_floatFloor, p_floatCeil :: [Const] -> Maybe Const
685p_floatExp = p_fPrim exp
686p_floatLog = p_fPrim log
687p_floatSin = p_fPrim sin
688p_floatCos = p_fPrim cos
689p_floatTan = p_fPrim tan
690p_floatASin = p_fPrim asin
691p_floatACos = p_fPrim acos
692p_floatATan = p_fPrim atan
693p_floatSqrt = p_fPrim sqrt
694p_floatFloor = p_fPrim (fromInteger . floor)
695p_floatCeil = p_fPrim (fromInteger . ceiling)
697p_strLen, p_strHead, p_strTail, p_strIndex, p_strCons, p_strRev :: [Const] -> Maybe Const
698p_strLen [Str xs] = Just $ I (length xs)
699p_strLen _ = Nothing
700p_strHead [Str (x:xs)] = Just $ Ch x
701p_strHead _ = Nothing
702p_strTail [Str (x:xs)] = Just $ Str xs
703p_strTail _ = Nothing
704p_strIndex [Str xs, I i]
705 | i < length xs = Just $ Ch (xs!!i)
706p_strIndex _ = Nothing
707p_strCons [Ch x, Str xs] = Just $ Str (x:xs)
708p_strCons _ = Nothing
709p_strRev [Str xs] = Just $ Str (reverse xs)
710p_strRev _ = Nothing
712p_allocate, p_appendBuffer :: [Const] -> Maybe Const
713p_allocate [B64 _] = Just $ B8V V.empty
714p_allocate n = Nothing
715p_appendBuffer [B8V vect1, B64 size1, B64 count, B64 size2, B64 off, B8V vect2] =
716 Just $ B8V (foldl (V.++)
717 (V.slice 0 (fromIntegral size1) vect1)
718 (replicate (fromIntegral count) (V.slice (fromIntegral off) (fromIntegral size2) vect2)))
719p_appendBuffer n = Nothing
720p_append :: Endianness -> [Const] -> Maybe Const
721p_append en [B8V vect, B64 size, B64 count, val] =
722 let bytes = case val of
723 B8 x -> [x]
724 B16 x -> [fromIntegral x, fromIntegral (shiftR x 8)]
725 B32 x -> map (fromIntegral . shiftR x) [0,8..24]
726 B64 x -> map (fromIntegral . shiftR x) [0,8..56]
727 in Just $ B8V (foldl V.snoc
728 (V.slice 0 (fromIntegral size) vect)
729 (concat (replicate (fromIntegral count)
730 (case en of
731 BE -> reverse bytes
732 _ -> bytes))))
733p_append _ _ = Nothing
735p_peek :: IntTy -> Endianness -> [Const] -> Maybe Const
736p_peek (ITFixed IT8) _ [B8V vect, B64 offset] = Just $ B8 (vect V.! fromIntegral offset)
737p_peek (ITFixed IT16) en [B8V vect, B64 offset] =
738 let bytes = [0..1]
739 in Just $ B16 (foldl (\full byte -> shiftL full 8 .|. fromIntegral (vect V.! (fromIntegral offset+byte)))
740 0
741 (case en of
742 BE -> bytes
743 _ -> reverse bytes))
744p_peek (ITFixed IT32) en [B8V vect, B64 offset] =
745 let bytes = [0..1]
746 in Just $ B32 (foldl (\full byte -> shiftL full 8 .|. fromIntegral (vect V.! (fromIntegral offset+byte)))
747 0
748 (case en of
749 BE -> bytes
750 _ -> reverse bytes))
751p_peek (ITFixed IT64) en [B8V vect, B64 offset] =
752 let bytes = [0..1]
753 in Just $ B64 (foldl (\full byte -> shiftL full 8 .|. fromIntegral (vect V.! (fromIntegral offset+byte)))
754 0
755 (case en of
756 BE -> bytes
757 _ -> reverse bytes))
758p_peek _ _ _ = Nothing
760p_cantreduce :: a -> Maybe b
761p_cantreduce _ = Nothing