Commit 754a2f2b authored by thomie's avatar thomie

Testsuite: delete Windows line endings [skip ci] (#11631)

parent 8626ac91
module Test.Test2 where
import Data.Typeable
data Show1 = S1 Char Char Char
deriving Typeable
data Strict = S2 Char !Char
data Opaque = forall a. O a
data List1 a = Nil | a :^ (List1 a)
deriving Show
newtype MyInt = My Int
deriving (Eq,Show,Num, Enum)
newtype MkT a = MkT a
deriving (Show)
newtype MkT2 a = MkT2 (MkT a)
deriving Show
data Param2 s r = P2 (FakeSTRef r (s(Param2 s r)))
| P2Nil
data FakeSTRef r s = Ref s
testParam2 = O (P2 (Ref P2Nil))
infixr 5 :^
--test T{t=t1} = undefined
instance Show Show1 where
show (S1 a b c) = show (a)
type Just1 = Maybe
data Unary = Unary deriving Show
poly :: a -> ()
poly x = seq x ()
\ No newline at end of file
module Test.Test2 where
import Data.Typeable
data Show1 = S1 Char Char Char
deriving Typeable
data Strict = S2 Char !Char
data Opaque = forall a. O a
data List1 a = Nil | a :^ (List1 a)
deriving Show
newtype MyInt = My Int
deriving (Eq,Show,Num, Enum)
newtype MkT a = MkT a
deriving (Show)
newtype MkT2 a = MkT2 (MkT a)
deriving Show
data Param2 s r = P2 (FakeSTRef r (s(Param2 s r)))
| P2Nil
data FakeSTRef r s = Ref s
testParam2 = O (P2 (Ref P2Nil))
infixr 5 :^
--test T{t=t1} = undefined
instance Show Show1 where
show (S1 a b c) = show (a)
type Just1 = Maybe
data Unary = Unary deriving Show
poly :: a -> ()
poly x = seq x ()
-- Trac #1581
-- Even though Eq is not in scope unqualified, we want to
-- see the Eq instance of Foo when we say :i Foo
module Foo where
import qualified Prelude
data Foo = Foo
instance Prelude.Eq Foo
-- Trac #1581
-- Even though Eq is not in scope unqualified, we want to
-- see the Eq instance of Foo when we say :i Foo
module Foo where
import qualified Prelude
data Foo = Foo
instance Prelude.Eq Foo
{-# OPTIONS_GHC -O2 #-}
-- Reading the interface file caused a black hole
-- in earlier versions of GHC
-- Also, foo should compile to very tight code with -O2
-- (The O2 was nothing to do with the black hole though.)
module ShouldCompile where
import ATLoop_help
foo :: FooT Int -> Int -> Int
foo t n = t `seq` bar n
where
bar 0 = 0
bar n | even n = bar (n `div` 2)
bar n = bar (n - int t)
{-# OPTIONS_GHC -O2 #-}
-- Reading the interface file caused a black hole
-- in earlier versions of GHC
-- Also, foo should compile to very tight code with -O2
-- (The O2 was nothing to do with the black hole though.)
module ShouldCompile where
import ATLoop_help
foo :: FooT Int -> Int -> Int
foo t n = t `seq` bar n
where
bar 0 = 0
bar n | even n = bar (n `div` 2)
bar n = bar (n - int t)
{-# LANGUAGE TypeFamilies #-}
module ATLoop_help where
class Foo a where
data FooT a :: *
int :: FooT a -> Int
instance Foo Int where
data FooT Int = FooInt !Int
int (FooInt n) = n
{-# LANGUAGE TypeFamilies #-}
module ATLoop_help where
class Foo a where
data FooT a :: *
int :: FooT a -> Int
instance Foo Int where
data FooT Int = FooInt !Int
int (FooInt n) = n
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
-- This test uses the PushC rule of the System FC operational semantics
-- Writen by Tom Schrijvers
module CoTest3 where
data T a = K (a ~ Int => a -> Int)
{-# INLINE[2] f #-}
f :: T s1 ~ T s2 => T s1 -> T s2
f x = x
{-# INLINE[3] test #-}
test :: T s1 ~ T s2 => (s1 ~ Int => s1 -> Int) -> (s2 ~ Int => s2 -> Int)
test g = case f (K g) of
K r -> r
e :: s ~ Int => s -> s -> Int
e _ s = s
final :: s1 ~ s2 => s1 -> (s2 ~ Int => s2 -> Int)
final x = test (e x)
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
-- This test uses the PushC rule of the System FC operational semantics
-- Writen by Tom Schrijvers
module CoTest3 where
data T a = K (a ~ Int => a -> Int)
{-# INLINE[2] f #-}
f :: T s1 ~ T s2 => T s1 -> T s2
f x = x
{-# INLINE[3] test #-}
test :: T s1 ~ T s2 => (s1 ~ Int => s1 -> Int) -> (s2 ~ Int => s2 -> Int)
test g = case f (K g) of
K r -> r
e :: s ~ Int => s -> s -> Int
e _ s = s
final :: s1 ~ s2 => s1 -> (s2 ~ Int => s2 -> Int)
final x = test (e x)
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeFamilies #-}
module PushedInAsGivens where
type family F a
bar y = let foo :: (F Int ~ [a]) => a -> Int
foo x = length [x,y]
in (y,foo y)
-- This example demonstrates why we need to push in
-- an unsolved wanted as a given and not a given/solved.
-- [Wanted] F Int ~ [beta]
--- forall a. F Int ~ [a] => a ~ beta
-- We we push in the [Wanted] as given, it will interact and solve the implication
-- constraint, and finally we quantify over F Int ~ [beta]. If we push it in as
-- Given/Solved, it will be discarded when we meet the given (F Int ~ [a]) and
-- we will not be able to solve the implication constraint.
-- Oct 14: actually this example is _really_ strange, and doesn't illustrate
-- the real issue in Trac #4935, for which there is a separate test
--
-- The example here requires us to infer a type
-- bar :: F Int ~ [a] => ...
-- which is a strange type to quantify over; better to complain about
-- having no instance for F Int.
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeFamilies #-}
module PushedInAsGivens where
type family F a
bar y = let foo :: (F Int ~ [a]) => a -> Int
foo x = length [x,y]
in (y,foo y)
-- This example demonstrates why we need to push in
-- an unsolved wanted as a given and not a given/solved.
-- [Wanted] F Int ~ [beta]
--- forall a. F Int ~ [a] => a ~ beta
-- We we push in the [Wanted] as given, it will interact and solve the implication
-- constraint, and finally we quantify over F Int ~ [beta]. If we push it in as
-- Given/Solved, it will be discarded when we meet the given (F Int ~ [a]) and
-- we will not be able to solve the implication constraint.
-- Oct 14: actually this example is _really_ strange, and doesn't illustrate
-- the real issue in Trac #4935, for which there is a separate test
--
-- The example here requires us to infer a type
-- bar :: F Int ~ [a] => ...
-- which is a strange type to quantify over; better to complain about
-- having no instance for F Int.
{-# LANGUAGE TypeFamilies, StandaloneDeriving, DeriveDataTypeable, FlexibleInstances #-}
module T1769 where
import Data.Typeable
data family T a
deriving instance Typeable T
-- deriving instance Functor T
data instance T [b] = T1 | T2 b
deriving instance Eq b => Eq (T [b])
{-# LANGUAGE TypeFamilies, StandaloneDeriving, DeriveDataTypeable, FlexibleInstances #-}
module T1769 where
import Data.Typeable
data family T a
deriving instance Typeable T
-- deriving instance Functor T
data instance T [b] = T1 | T2 b
deriving instance Eq b => Eq (T [b])
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, FlexibleContexts, FlexibleInstances #-}
module T2850 where
class K a where
bar :: a -> a
class K (B a) => M a where
data B a :: *
foo :: B a -> B a
instance M Bool where
data B Bool = B1Bool Bool | B2Bool Bool
foo = id
instance K (B Bool) where
bar = id
-- The 'deriving K' gives the (K (B Int)) instance
-- needed for the superclasses of M
instance M Int where
newtype B Int = BInt (B Bool) deriving K
foo = id
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, FlexibleContexts, FlexibleInstances #-}
module T2850 where
class K a where
bar :: a -> a
class K (B a) => M a where
data B a :: *
foo :: B a -> B a
instance M Bool where
data B Bool = B1Bool Bool | B2Bool Bool
foo = id
instance K (B Bool) where
bar = id
-- The 'deriving K' gives the (K (B Int)) instance
-- needed for the superclasses of M
instance M Int where
newtype B Int = BInt (B Bool) deriving K
foo = id
{-# LANGUAGE TypeFamilies, UndecidableInstances, StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
module T3423 where
newtype Trie m k a = Trie (Maybe a, m (SubKey k) (Trie m k a))
type family SubKey k
type instance SubKey [k] = k
deriving instance (Eq (m k (Trie m [k] a)), Eq a)
=> Eq (Trie m [k] a)
{-# LANGUAGE TypeFamilies, UndecidableInstances, StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
module T3423 where
newtype Trie m k a = Trie (Maybe a, m (SubKey k) (Trie m k a))
type family SubKey k
type instance SubKey [k] = k
deriving instance (Eq (m k (Trie m [k] a)), Eq a)
=> Eq (Trie m [k] a)
{-# LANGUAGE TypeFamilies #-}
module T3826 where
class C a where
type E a
c :: E a -> a -> a
data T a = MkT a
-- MkT :: a -> T a
instance C (T b) where
type E (T b) = b
c x (MkT _) = MkT x
f t@(MkT x) = c x t
{- c :: E alpha -> alpha -> alpha
t :: T beta
x :: beta
f :: T beta -> gamma
[W] C alpha
[W] E alpha ~ beta
[W] alpha ~ T beta
[W] gamma ~ alpha
---> beta = t_aqf alpha = t_aqg
alpha := T beta
gamma := alpha
[W] E (T beta) ~ beta
-->
[W] ufsk ~ beta
[W] E (T beta) ~ ufsk
--> (swap and subst)
beta := ufsk
[W] x : E (T ufsk) ~ ufsk (do not rewrite RHS)
take a step ax: E (T beta) ~ beta
-->
[W] ufsk
--------------------------
But what about this?
--------------------------
axiom F [a] = F [a]
x : F [a] ~ fsk
step
ax : F [a] ~ F [a]
flatten
ax ; x : F [a] ~ fsk
x = ax ; x Oh dear!
-}
{-# LANGUAGE TypeFamilies #-}
module T3826 where
class C a where
type E a
c :: E a -> a -> a
data T a = MkT a
-- MkT :: a -> T a
instance C (T b) where
type E (T b) = b
c x (MkT _) = MkT x
f t@(MkT x) = c x t
{- c :: E alpha -> alpha -> alpha
t :: T beta
x :: beta
f :: T beta -> gamma
[W] C alpha
[W] E alpha ~ beta
[W] alpha ~ T beta
[W] gamma ~ alpha
---> beta = t_aqf alpha = t_aqg
alpha := T beta
gamma := alpha
[W] E (T beta) ~ beta
-->
[W] ufsk ~ beta
[W] E (T beta) ~ ufsk
--> (swap and subst)
beta := ufsk
[W] x : E (T ufsk) ~ ufsk (do not rewrite RHS)
take a step ax: E (T beta) ~ beta
-->
[W] ufsk
--------------------------
But what about this?
--------------------------
axiom F [a] = F [a]
x : F [a] ~ fsk
step
ax : F [a] ~ F [a]
flatten
ax ; x : F [a] ~ fsk
x = ax ; x Oh dear!
-}
{-# LANGUAGE GADTs, TypeFamilies #-}
module T3851 where
type family TF a :: * -> *
type instance TF () = App (Equ ())
data Equ ix ix' where Refl :: Equ ix ix
data App f x = App (f x)
-- does not typecheck in 6.12.1 (but works in 6.10.4)
bar :: TF () () -> ()
bar (App Refl) = ()
-- does typecheck in 6.12.1 and 6.10.4
ar :: App (Equ ()) () -> ()
ar (App Refl) = ()
------------------
data family DF a :: * -> *
data instance DF () a = D (App (Equ ()) a)
bar_df :: DF () () -> ()
bar_df (D (App Refl)) = ()
{-# LANGUAGE GADTs, TypeFamilies #-}
module T3851 where
type family TF a :: * -> *
type instance TF () = App (Equ ())
data Equ ix ix' where Refl :: Equ ix ix
data App f x = App (f x)
-- does not typecheck in 6.12.1 (but works in 6.10.4)
bar :: TF () () -> ()
bar (App Refl) = ()
-- does typecheck in 6.12.1 and 6.10.4
ar :: App (Equ ()) () -> ()
ar (App Refl) = ()
------------------
data family DF a :: * -> *
data instance DF () a = D (App (Equ ()) a)
bar_df :: DF () () -> ()
bar_df (D (App Refl)) = ()
{-# LANGUAGE DeriveFunctor, StandaloneDeriving, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-}
module T4185 where
data family Foo k :: * -> *
------------- Generalised newtype deriving of user class -----------
class Bar f where
bar :: f a -> Int
woo :: f a -> f a
instance Bar Maybe where
bar Nothing = 0
bar Just{} = 1
woo x = x
-- Deriving clause
newtype instance Foo Int a = FooInt (Maybe a) deriving (Bar)
-- Standalone deriving
newtype instance Foo Char a = FooChar (Maybe a)
deriving instance Bar (Foo Char)
{-
dBarMaybe :: Bar Maybe
newtype FooInt a = FooInt (Maybe a)
axiom ax7 a : Foo Int a ~ FooInt a -- Family axiom
axiom ax7 : FooInt ~ Maybe -- Newtype axiom
dBarFooInt :: Bar (Foo Int)
dBarFooInt = dBarMaybe |> Bar ax7
-}
------------- Deriving on data types for Functor -----------
-- Deriving clause
data instance Foo Bool a = FB1 a | FB2 a deriving( Functor )
-- Standalone deriving
data instance Foo Float a = FB3 a
deriving instance Functor (Foo Float)
--instance Functor (Foo Bool) where
-- fmap f (FB1 x) = FB1 (f x)
-- fmap f (FB2 y) = FB2 (f y)
\ No newline at end of file
{-# LANGUAGE DeriveFunctor, StandaloneDeriving, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-}