SHARE
TWEET

Untitled

a guest Feb 22nd, 2019 51 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. {-# Language RankNTypes, FlexibleInstances, MultiParamTypeClasses #-}
  2. module Church where
  3.  
  4. import Data.Functor.Identity
  5.  
  6. import Traversable -- for fusion rules
  7. import Unfoldable_r
  8. import Unfoldable
  9. import Empty
  10. import FIFO_r
  11. import FIFO
  12. import State
  13.  
  14. ----
  15. -- Church0 for Stream
  16.  
  17. data Church0 a = Church0 {runChurch0 :: forall b. (((a,b) -> b) -> b)}
  18.  
  19. instance Set0_r Identity Church0 where
  20.  set0_r (Identity x,(Church0 xs)) = Church0 (\set0' -> set0' (x,(xs set0')))
  21.  
  22. instance Set0 Church0
  23.  
  24. instance Unfoldable0_r Identity Church0 where
  25.  unfoldr0_r = unfoldr0_rDefault
  26.  
  27. instance Unfoldable0 Church0 where
  28.  unfoldr0 = unfoldr0Default
  29.  
  30. build0 :: Set0 f => Church0 a -> f a
  31. {-# INLINE [1] build0 #-}
  32. build0 (Church0 f) = f set0
  33.  
  34. {-# RULES
  35. "foldr0'/build0"    forall k (g::forall b. ((a,b) -> b) -> b) .
  36.                     foldr0' k (build0 (Church0 g)) = g (uncurry k)
  37. #-}
  38.  
  39. loop0 :: Set0 f => s -> State0 s a -> f a
  40. loop0 s = build0 . unfoldr0 s
  41.  
  42.  
  43. ----
  44. -- Church1 for Linear
  45.  
  46. data Church1 a = Church1 {runChurch1 :: forall b. (((a,Maybe b) -> b) -> b)}
  47.  
  48. instance Set0_r Identity Church1 where
  49.  set0_r = set0_rDefault
  50.  
  51. -- instance Set0 Church1
  52.  
  53. instance Unfoldable0_r Identity Church1 where
  54.  
  55. instance Unfoldable0 Church1
  56.  
  57. instance Set1_r Identity Church1 where
  58.  set1_r (Identity x,Nothing) = Church1 (\f -> f (x,Nothing))
  59.  set1_r (Identity x,Just (Church1 xs)) = Church1 (\set1' -> set1' (x,Just (xs set1')))
  60.  
  61. instance Set1 Church1
  62.  
  63. instance Unfoldable1_r Identity Church1 where
  64.  unfoldr1_r = unfoldr1_rDefault
  65.  
  66. instance Unfoldable1 Church1 where
  67.  unfoldr1 = unfoldr1Default
  68.  
  69. build1 :: Set1 f => Church1 a -> f a
  70. {-# INLINE [1] build1 #-}
  71. build1 (Church1 f) = f set1
  72.  
  73. {-# RULES
  74. "foldr1'/build1"    forall k (g::forall b. ((a,Maybe b) -> b) -> b) .
  75.                     foldr1' k (build1 (Church1 g)) = g (uncurry k)
  76. #-}
  77.  
  78. loop1 :: Set1 f => s -> State1 s a -> f a
  79. loop1 s = build1 . unfoldr1 s
  80.  
  81. ----
  82. -- Church for Stack
  83.  
  84. data Church a = Church {runChurch :: forall b. ((Maybe (a,b) -> b) -> b)}
  85.  
  86. instance Set0_r Identity Church where
  87.  set0_r = set0_rDefault
  88.  
  89. instance Set0 Church
  90.  
  91. instance Set1_r Identity Church where
  92.  set1_r = set1_rDefault
  93.  
  94. instance Set1 Church
  95.  
  96. instance Empty Church where
  97.  empty = emptyDefault
  98.  isEmpty = error "isEmpty Church"
  99.  
  100. instance Set_r Identity Church where
  101.  set_r Nothing = Church (\f -> f Nothing)
  102.  set_r (Just (Identity x,(Church xs))) = Church (\set' -> set' (Just (x,(xs set'))))
  103.  
  104. instance Set Church
  105.  
  106. instance Unfoldable0_r Identity Church
  107.  
  108. instance Unfoldable0 Church
  109.  
  110. instance Unfoldable1_r Identity Church
  111.  
  112. instance Unfoldable1 Church
  113.  
  114. instance Unfoldable_r Identity Church where
  115.  unfoldr_r = unfoldr_rDefault
  116.  
  117. instance Unfoldable Church where
  118.  unfoldr = unfoldrDefault
  119.  
  120. build :: Set f => Church a -> f a
  121. {-# INLINE [1] build #-}
  122. build (Church f) = f set
  123.  
  124. {-# RULES
  125. "foldr'/build"    forall b k (g::forall b. (Maybe (a,b) -> b) -> b) .
  126.                   foldr' k b (build (Church g)) = g ((\f b' -> maybe b' (uncurry f)) k b)
  127. #-}
  128.  
  129.  
  130. loop :: Set f => s -> State s a -> f a
  131. loop s = build . unfoldr s
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top