Commit b504085d authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Two new tricky deriving tests

parent b2d6de1c
......@@ -22,3 +22,5 @@ test('drvrun016', skip_if_fast, compile_and_run, ['-funbox-strict-fields'])
test('drvrun017', compose(skip_if_fast, only_compiler_types(['ghc'])), compile_and_run, [''])
test('drvrun018', skip_if_fast, compile_and_run, [''])
test('drvrun019', normal, compile_and_run, [''])
test('drvrun020', normal, compile_and_run, [''])
test('drvrun021', normal, compile_and_run, [''])
-- A nasty deriving test
-- Note the "T2 T1 { f1=3 }" part!
module Main where
infix 4 :%%
data T = Int :%% T
| T1 { f1 :: Int }
| T2 T
deriving( Show, Read )
main = print (read "3 :%% T2 T1 { f1=3 }" :: T)
{- Here's the parser that is produced
import GHC.Read
import Text.ParserCombinators.ReadPrec
import Text.Read
instance Read T where
readPrec =
parens
( prec 4 (
do x <- step readPrec
Symbol ":%%" <- lexP
y <- step readPrec
return (x :%% y))
+++
prec (appPrec+1) (
do Ident "T1" <- lexP
Punc "{" <- lexP
Ident "f1" <- lexP
Punc "=" <- lexP
x <- reset readPrec
Punc "}" <- lexP
return (T1 { f1 = x }))
+++
prec appPrec (
do Ident "T2" <- lexP
x <- step readPrec
return (T2 x))
)
appPrec = 10::Int
-}
module Main where
class Show a => Foo a where
op :: a -> a
newtype Moose = MkMoose () deriving (Show, Eq, Ord)
newtype Noose = MkNoose () deriving (Ord)
instance Eq Noose where
a == b = False -- Non-standard!
f :: Ord a => a -> Bool
f x = x==x
main = do print (MkNoose () == MkNoose ()) -- Eq Noose
print (f (MkNoose ())) -- via Ord Noose
print (MkMoose () == MkMoose ()) -- Eq Moose
print (f (MkMoose ())) -- via Ord Moose
putStrLn (show (MkMoose ())) -- Should not use the show () method
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