Commit 5c117b6a authored by Ian Lynagh's avatar Ian Lynagh

Add a test for #5267

It currently gives a core lint failure (#5605).
parent 9caf8050
{-# LANGUAGE Arrows, TypeOperators, GeneralizedNewtypeDeriving #-}
module T5267 where
import Prelude
import Control.Arrow
import Control.Category
newtype A (~>) b c = A { unA :: b ~> c }
deriving (Arrow, Category)
ite :: ArrowChoice (~>)
=> (env ~> Bool) -> A (~>) env d -> A (~>) env d -> A (~>) env d
ite iA tA eA = A $ proc env ->
do i <- iA -< env
if i then unA tA -< env else unA eA -< env
ite_perm tA eA i = ite i tA eA
-- In 6.12, this worked:
ite' cA tA eA = proc x ->
do c <- cA -< x
(| (ite_perm tA eA) (returnA -< c) |)
-- but this didn't:
ite'' cA tA eA = proc x ->
do c <- cA -< x
(| ite_perm' (returnA -< c) |)
where ite_perm' i = ite i tA eA
......@@ -16,3 +16,4 @@ test('arrowrec1', normal, compile, [''])
test('arrowpat', normal, compile, [''])
test('T3964', normal, compile, [''])
test('T5283', normal, compile, [''])
test('T5267', expect_broken(5605), compile, [''])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment