... | ... | @@ -49,10 +49,13 @@ to: |
|
|
Diverges
|
|
|
```
|
|
|
|
|
|
>
|
|
|
>
|
|
|
> This information is used to tell when it is safe to perform a nested CPR
|
|
|
> worker-wrapper transformation. Unpacking a nested component in the return
|
|
|
> value is safe only when that component definitely converges.
|
|
|
>
|
|
|
>
|
|
|
|
|
|
### Changes to the demand analyzer
|
|
|
|
... | ... | @@ -91,11 +94,18 @@ bar (a :+ b) _ = b :+ a |
|
|
This is a simple recursive function with an easy-to-spot nested CPR property. Note that `a - 1` is always convering in an obvious way.
|
|
|
|
|
|
|
|
|
|
|
|
Status: ok
|
|
|
|
|
|
|
|
|
```
|
|
|
moduleFoowheref::Int->(Int,Int)f0=(1,2)f n
|
|
|
| even n = f (div n 2)| otherwise =case f (n -1)of(a, b)->(a -1, b)
|
|
|
module Foo where
|
|
|
f :: Int -> (Int, Int)
|
|
|
f 0 = (1, 2)
|
|
|
f n
|
|
|
| even n = f (div n 2)
|
|
|
| otherwise = case f (n - 1) of
|
|
|
(a, b) -> (a - 1, b)
|
|
|
```
|
|
|
|
|
|
### strictness.hs
|
... | ... | @@ -107,12 +117,19 @@ This one is trickier in that the analysis has to use the nested strictness of `f |
|
|
Indeed, it's not obvious how the last branch has the nested CPR property. Consider the condition for the first branch, which will evaluate `p` and its two `Int`s completely. So, we have the components of `p` available deconstructed. According to `Note [CPR in a product case alternative]` this is enough to give `p` the nested CPR property, in the sense that we could supply a constructed product of that depth if we wanted to (because we can immediately deconstruct it when the wrapper is inlined, for example).
|
|
|
|
|
|
|
|
|
|
|
|
Status: ok
|
|
|
|
|
|
|
|
|
```
|
|
|
{-# LANGUAGE BangPatterns #-}moduleFoowherefoo::Int->(Int,Int)->(Int,Int)foo n p
|
|
|
| even (n + uncurry (+) p), n /=0= foo (n -1) p
|
|
|
| n ==0=(1,2)| otherwise = p
|
|
|
{-# LANGUAGE BangPatterns #-}
|
|
|
module Foo where
|
|
|
|
|
|
foo :: Int -> (Int, Int) -> (Int, Int)
|
|
|
foo n p
|
|
|
| even (n + uncurry (+) p), n /= 0 = foo (n - 1) p
|
|
|
| n == 0 = (1, 2)
|
|
|
| otherwise = p
|
|
|
```
|
|
|
|
|
|
### strict_field.hs
|
... | ... | @@ -121,15 +138,24 @@ Status: ok |
|
|
This one needs a correct handling of strict constructor fields. Inspired by `nofib/imaginary/x2n1`.
|
|
|
|
|
|
|
|
|
|
|
|
Status: ok
|
|
|
|
|
|
|
|
|
```
|
|
|
{-# LANGUAGE BangPatterns #-}moduleFoowheredataC a =C!a !a
|
|
|
{-# LANGUAGE BangPatterns #-}
|
|
|
module Foo where
|
|
|
data C a = C !a !a
|
|
|
|
|
|
pow::CDouble->Int->CDoublepow!_0=C01pow!c 1= c
|
|
|
pow :: C Double -> Int -> C Double
|
|
|
pow !_ 0 = C 0 1
|
|
|
pow !c 1 = c
|
|
|
pow c n
|
|
|
| even n =let d = pow c (div n 2)in mul d d
|
|
|
| otherwise = mul c (pow c (n -1))mul::CDouble->CDouble->CDoublemul(C a b)(C d e)=C(a*d-b*e)(a*e+b*d)
|
|
|
| even n = let d = pow c (div n 2) in mul d d
|
|
|
| otherwise = mul c (pow c (n - 1))
|
|
|
|
|
|
mul :: C Double -> C Double -> C Double
|
|
|
mul (C a b) (C d e) = C (a*d-b*e) (a*e+b*d)
|
|
|
```
|
|
|
|
|
|
### strict_field1.hs
|
... | ... | @@ -141,16 +167,23 @@ This is similar to `strict_field.hs`, but needs a more aggressive worker-wrapper |
|
|
Status: ok
|
|
|
|
|
|
|
|
|
|
|
|
Changing CPR analysis alone wouldn't help here. We need to give the function a better strictness as well.
|
|
|
|
|
|
|
|
|
```
|
|
|
moduleFoo(pow)wheredataC a =C!a !a
|
|
|
module Foo (pow) where
|
|
|
|
|
|
data C a = C !a !a
|
|
|
|
|
|
pow::CDouble->Int->CDoublepow x y
|
|
|
| even y = pow (x `mul` x)(y `quot`2)| y ==1= x
|
|
|
| otherwise = pow (x `mul` x)((y -1)`quot`2)`mul` x
|
|
|
pow :: C Double -> Int -> C Double
|
|
|
pow x y
|
|
|
| even y = pow (x `mul` x) (y `quot` 2)
|
|
|
| y == 1 = x
|
|
|
| otherwise = pow (x `mul` x) ((y - 1) `quot` 2) `mul` x
|
|
|
|
|
|
mul::CDouble->CDouble->CDoublemul(C a b)(C d e)=C(a*d-b*e)(a*e+b*d)
|
|
|
mul :: C Double -> C Double -> C Double
|
|
|
mul (C a b) (C d e) = C (a*d-b*e) (a*e+b*d)
|
|
|
```
|
|
|
|
|
|
### peek.hs
|
... | ... | @@ -159,13 +192,29 @@ mul::CDouble->CDouble->CDoublemul(C a b)(C d e)=C(a*d-b*e)(a*e+b*d) |
|
|
This example involves reading a tuple of Ints from memory.
|
|
|
|
|
|
|
|
|
|
|
|
Status: needs -fcpr-depth=4 or higher.
|
|
|
|
|
|
|
|
|
```
|
|
|
{-# LANGUAGE BangPatterns #-}moduleFoo(peek4)whereimportForeign.StorableimportForeign.Ptrpeek4::PtrInt->PtrInt->(PtrInt->IO(PtrInt,PtrInt))->IO(PtrInt,PtrInt,(Int,Int,Int,Int))peek4 ptr end req
|
|
|
| end `minusPtr` ptr >=32=do
|
|
|
val <-(,,,)<$> peekByteOff ptr 0<*> peekByteOff ptr 8<*> peekByteOff ptr 16<*> peekByteOff ptr 24let!ptr' = ptr `plusPtr`32
|
|
|
return (ptr', end, val)| otherwise =do(ptr', end')<- req ptr
|
|
|
{-# LANGUAGE BangPatterns #-}
|
|
|
module Foo (peek4) where
|
|
|
|
|
|
import Foreign.Storable
|
|
|
import Foreign.Ptr
|
|
|
|
|
|
peek4 :: Ptr Int -> Ptr Int -> (Ptr Int -> IO (Ptr Int, Ptr Int)) -> IO (Ptr Int, Ptr Int, (Int, Int, Int, Int))
|
|
|
peek4 ptr end req
|
|
|
| end `minusPtr` ptr >= 32 = do
|
|
|
val <- (,,,)
|
|
|
<$> peekByteOff ptr 0
|
|
|
<*> peekByteOff ptr 8
|
|
|
<*> peekByteOff ptr 16
|
|
|
<*> peekByteOff ptr 24
|
|
|
let !ptr' = ptr `plusPtr` 32
|
|
|
return (ptr', end, val)
|
|
|
| otherwise = do
|
|
|
(ptr', end') <- req ptr
|
|
|
peek4 ptr' end' req
|
|
|
```
|
|
|
|
... | ... | @@ -176,18 +225,34 @@ This is a real-world example taken from [ https://github.com/tsurucapital/beamab |
|
|
It serializes a `Word` using a variable-length encoding.
|
|
|
|
|
|
|
|
|
|
|
|
Status: ok
|
|
|
|
|
|
|
|
|
```
|
|
|
moduleFoo(beamWordPoke)whereimportData.BitsimportData.MonoidimportData.WordimportForeign.PtrimportForeign.StorablenewtypePoke=Poke(PtrWord8->IO(PtrWord8))instanceMonoidPokewhere
|
|
|
mempty =Poke return
|
|
|
mappend (Poke a)(Poke b)=Poke$\ptr -> a ptr >>= b
|
|
|
module Foo(beamWordPoke) where
|
|
|
|
|
|
import Data.Bits
|
|
|
import Data.Monoid
|
|
|
import Data.Word
|
|
|
import Foreign.Ptr
|
|
|
import Foreign.Storable
|
|
|
|
|
|
beamWordPoke::Word->PokebeamWordPoke n
|
|
|
| next ==0= pokeWord8 firstSeptet
|
|
|
| otherwise = pokeWord8 (firstSeptet .|.0x80)<> beamWordPoke next
|
|
|
newtype Poke = Poke (Ptr Word8 -> IO (Ptr Word8))
|
|
|
|
|
|
instance Monoid Poke where
|
|
|
mempty = Poke return
|
|
|
mappend (Poke a) (Poke b) = Poke $ \ptr -> a ptr >>= b
|
|
|
|
|
|
beamWordPoke :: Word -> Poke
|
|
|
beamWordPoke n
|
|
|
| next == 0 = pokeWord8 firstSeptet
|
|
|
| otherwise = pokeWord8 (firstSeptet .|. 0x80) <> beamWordPoke next
|
|
|
where
|
|
|
firstSeptet ::Word8
|
|
|
firstSeptet = fromIntegral $ n .&.0x7F
|
|
|
next = n `shiftR`7pokeWord8::Word8->PokepokeWord8 w =Poke$\p ->do poke p w; return $! p `plusPtr`1
|
|
|
firstSeptet :: Word8
|
|
|
firstSeptet = fromIntegral $ n .&. 0x7F
|
|
|
next = n `shiftR` 7
|
|
|
|
|
|
pokeWord8 :: Word8 -> Poke
|
|
|
pokeWord8 w = Poke $ \p -> do poke p w; return $! p `plusPtr` 1
|
|
|
``` |
|
|
\ No newline at end of file |