Commit c2470add authored by simonpj's avatar simonpj
Browse files

[project @ 2002-04-22 11:52:57 by simonpj]

Add a rank-3 test
parent d0de52b3
......@@ -141,6 +141,7 @@ test "tc134" { myvtc("") }
test "tc135" { myvtc("") }
test "tc136" { myvtc("") }
test "tc137" { myvtc("") }
test "tc138" { myvtc("") }
test "tc140" { myvtc("") }
test "tc141" { myvtc("") }
test "tc142" { myvtc("") }
......@@ -152,3 +153,4 @@ test "tc147" { myvtc("") }
test "tc148" { myvtc("") }
test "tc149" { myvtc("") }
test "tc150" { myvtc("") }
test "tc151" { myvtc("") }
......@@ -6,6 +6,9 @@ module ShouldCompile where
import Control.Monad.ST
import Data.STRef
-- The pattern type sig for f makes it monomorphic,
-- but the 's' scopes over the separate type signature
-- so that is monomorphic too.
f:: ST s Int
f:: ST s Int = do
v <- newSTRef 5
......
{-# OPTIONS -fglasgow-exts #-}
-- A test for rank-3 types
module ShouldCompile where
data Fork a = ForkC a a
mapFork :: forall a1 a2 . (a1 -> a2) -> (Fork a1 -> Fork a2)
mapFork mapA (ForkC a1 a2) = ForkC (mapA a1) (mapA a2)
data SequF s a = EmptyF | ZeroF (s (Fork a)) | OneF a (s (Fork a))
newtype HFix h a = HIn (h (HFix h) a)
type Sequ = HFix SequF
mapSequF :: forall s1 s2 . (forall b1 b2 . (b1 -> b2) -> (s1 b1 -> s2 b2))
-> (forall a1 a2 . (a1 -> a2) -> (SequF s1 a1 -> SequF s2 a2))
mapSequF mapS mapA EmptyF = EmptyF
mapSequF mapS mapA (ZeroF as) = ZeroF (mapS (mapFork mapA) as)
mapSequF mapS mapA (OneF a as)= OneF (mapA a) (mapS (mapFork mapA) as)
mapHFix :: forall h1 h2 . (forall f1 f2 . (forall c1 c2 . (c1 -> c2) -> (f1 c1 -> f2 c2))
-> (forall b1 b2 . (b1 -> b2) -> (h1 f1 b1 -> h2 f2 b2)))
-> (forall a1 a2 . (a1 -> a2) -> (HFix h1 a1 -> HFix h2 a2))
mapHFix mapH mapA (HIn v) = HIn (mapH (mapHFix mapH) mapA v)
mapSequ :: forall a1 a2 . (a1 -> a2) -> (Sequ a1 -> Sequ a2)
mapSequ = mapHFix mapSequF
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