#5022: Arrow desugarer generates Core Lint error
-------------------------------+--------------------------------------------
Reporter: serpentologist | Owner: ross
Type: bug | Status: new
Priority: high | Milestone: 7.2.1
Component: Compiler | Version: 7.0.2
Keywords: infinite loop | Testcase:
Blockedby: | Difficulty:
Os: Linux | Blocking:
Architecture: x86_64 (amd64) | Failure: None/Unknown
-------------------------------+--------------------------------------------
Changes (by simonpj):
* owner: igloo => ross
Comment:
OK I managed to reproduce this, thank you. It turns out to be an error in
the desugarer for arrows, which generates a Core Lint error. (Alwyas try
switching on `-dcore-lint`!) I did not investigate the exact cause of the
loop (which shows up in the `FloatOut` pass, but it might result from
constructing an infinite type, or something like that. Anyway the first
thing is to generate a type correct program.
Ross: here is a nice smallihs standalone test case. Could you
investigate? Compile with `-dcore-lint` and it fails. No need for
supporting packages or such. Thanks
{{{
{-# LANGUAGE Arrows, FlexibleInstances, MultiParamTypeClasses,
ScopedTypeVariables #-}
module T5022 (
pSwitch
) where
import Prelude hiding ( id, init, (.) )
import Control.Arrow( Arrow, ArrowLoop, ArrowChoice )
import Control.Category( Category, (.) )
init :: b -> ArrowP SF p b b
init = error "urk"
returnA :: ArrowP SF p b b
returnA = error "urk"
------------
newtype SF a b = SF { runSF :: (a -> (b, SF a b)) }
instance ArrowLoop SF where
instance Category SF where
instance Arrow SF where
------------
newtype ArrowP a p b c = ArrowP (a b c)
instance ArrowLoop a => ArrowLoop (ArrowP a p) where
instance ArrowChoice a => ArrowChoice (ArrowP a p) where
instance Arrow a => Arrow (ArrowP a p) where
instance Category a => Category (ArrowP a p) where
strip :: ArrowP SF p b c -> SF b c
strip = error "urk"
------------
type Signal clk a b = ArrowP SF clk a b
pSwitch :: forall p col a. (Functor col) =>
col (Signal p () a)
-> Signal p () [()]
-> (col (Signal p () a) -> [()] -> col (Signal p () a))
-> Signal p () (col a)
pSwitch col esig mod =
proc _ -> do
rec
evts <- esig -< ()
sfcol <- init col -< mod sfcol' evts
let rs = fmap (\s -> runSF (strip s) ()) sfcol :: col (a, SF () a)
(as, sfcol') = (fmap fst rs, fmap (ArrowP . snd) rs)
returnA -< as
}}}
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/5022#comment:12>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
