Commit 8626ac91 authored by thomie's avatar thomie

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

parent 31c312eb
module Main where
import qualified Data.Set as Set
import Control.Monad
import Data.List
---
---
---
data Direction = DirUp | DirLeft | DirRight | DirDown
deriving (Eq,Ord,Show,Read)
directions = [DirUp,DirLeft,DirRight,DirDown]
coordOffset DirUp = (-1,0)
coordOffset DirLeft = (0,-1)
coordOffset DirRight = (0,1)
coordOffset DirDown = (1,0)
move (r,c) d = (r+dr,c+dc) where (dr,dc) = coordOffset d
sortPair (x,y) =
case compare x y of
EQ -> (x,y)
LT -> (x,y)
GT -> (y,x)
mapPair12 f (x,y) = (f x,f y)
cachedUsingList f = f'
where
list = map f [0..]
f' i = list !! i
nubSorted [] = []
nubSorted (x:xs) = nubSorted' x xs
where
nubSorted' x [] = [x]
nubSorted' x (y:ys)
| x == y = nubSorted' x ys
| otherwise = x : nubSorted' y ys
---
---
---
size = 21
largestExplicitlyEnumeratedArea = 7
type Cell = (Int,Int)
type Edge = (Cell,Cell)
mkEdge cell1 cell2 = sortPair (cell1,cell2)
cellsAround area = nubSorted $ sort $
do
cell <- area
dir <- directions
let cell2 = move cell dir
guard $ cell2 `notElem` area
return $ cell2
increaseAreas areas = nubSorted $ sort $
do
area <- areas
cell2 <- cellsAround area
return $ sort $ cell2 : area
getAreas :: Int -> [[Cell]]
getAreasRaw 1 = [[(0,0)]]
getAreasRaw n = areas
where
areas = increaseAreas $ getAreas $ n - 1
getAreas = cachedUsingList getAreasRaw
getEdges area = mapPair12 (map snd) $ partition fst $ nubSorted $ sort $
do
cell <- area
dir <- directions
let cell2 = move cell dir
let isInternal = cell2 `elem` area
return (isInternal,mkEdge cell cell2)
type SizedArea = (Int,((Set.Set Cell,Set.Set Cell),(Set.Set Edge,Set.Set Edge)))
getExtendedAreas n =
do
area <- getAreas n
let areaAround = cellsAround area
let edgeInfo = getEdges area
return ((Set.fromList area,Set.fromList areaAround),mapPair12 Set.fromList edgeInfo)
getSizedAreasThrough :: Int -> [SizedArea]
getSizedAreasThrough n =
do
n' <- [1 .. n]
extendedArea <- getExtendedAreas n'
return $ (n',extendedArea)
sizeForSizedArea (asize,_) = asize
allSizedAreas = getSizedAreasThrough largestExplicitlyEnumeratedArea
main = print $ allSizedAreas
module Main where
import qualified Data.Set as Set
import Control.Monad
import Data.List
---
---
---
data Direction = DirUp | DirLeft | DirRight | DirDown
deriving (Eq,Ord,Show,Read)
directions = [DirUp,DirLeft,DirRight,DirDown]
coordOffset DirUp = (-1,0)
coordOffset DirLeft = (0,-1)
coordOffset DirRight = (0,1)
coordOffset DirDown = (1,0)
move (r,c) d = (r+dr,c+dc) where (dr,dc) = coordOffset d
sortPair (x,y) =
case compare x y of
EQ -> (x,y)
LT -> (x,y)
GT -> (y,x)
mapPair12 f (x,y) = (f x,f y)
cachedUsingList f = f'
where
list = map f [0..]
f' i = list !! i
nubSorted [] = []
nubSorted (x:xs) = nubSorted' x xs
where
nubSorted' x [] = [x]
nubSorted' x (y:ys)
| x == y = nubSorted' x ys
| otherwise = x : nubSorted' y ys
---
---
---
size = 21
largestExplicitlyEnumeratedArea = 7
type Cell = (Int,Int)
type Edge = (Cell,Cell)
mkEdge cell1 cell2 = sortPair (cell1,cell2)
cellsAround area = nubSorted $ sort $
do
cell <- area
dir <- directions
let cell2 = move cell dir
guard $ cell2 `notElem` area
return $ cell2
increaseAreas areas = nubSorted $ sort $
do
area <- areas
cell2 <- cellsAround area
return $ sort $ cell2 : area
getAreas :: Int -> [[Cell]]
getAreasRaw 1 = [[(0,0)]]
getAreasRaw n = areas
where
areas = increaseAreas $ getAreas $ n - 1
getAreas = cachedUsingList getAreasRaw
getEdges area = mapPair12 (map snd) $ partition fst $ nubSorted $ sort $
do
cell <- area
dir <- directions
let cell2 = move cell dir
let isInternal = cell2 `elem` area
return (isInternal,mkEdge cell cell2)
type SizedArea = (Int,((Set.Set Cell,Set.Set Cell),(Set.Set Edge,Set.Set Edge)))
getExtendedAreas n =
do
area <- getAreas n
let areaAround = cellsAround area
let edgeInfo = getEdges area
return ((Set.fromList area,Set.fromList areaAround),mapPair12 Set.fromList edgeInfo)
getSizedAreasThrough :: Int -> [SizedArea]
getSizedAreasThrough n =
do
n' <- [1 .. n]
extendedArea <- getExtendedAreas n'
return $ (n',extendedArea)
sizeForSizedArea (asize,_) = asize
allSizedAreas = getSizedAreasThrough largestExplicitlyEnumeratedArea
main = print $ allSizedAreas
module Eta where
data T = MkT
newtype Foo = Foo T
lift :: Foo -> T
lift (Foo x) = bof x
-- The point is that we expect
-- lift = bof |> co
-- not
-- lift = \fx -> bof (fx |> co)
bof :: T -> T
{-# NOINLINE bof #-}
bof MkT = MkT
module Eta where
data T = MkT
newtype Foo = Foo T
lift :: Foo -> T
lift (Foo x) = bof x
-- The point is that we expect
-- lift = bof |> co
-- not
-- lift = \fx -> bof (fx |> co)
bof :: T -> T
{-# NOINLINE bof #-}
bof MkT = MkT
module T5366 where
newtype Id a = Id Int
data Foo = Foo {-# UNPACK #-} !(Id Foo) String
data Bar = Bar {-# UNPACK #-} !Foo
f :: Bar -> Int
f (Bar (Foo (Id x) _)) = x
module T5366 where
newtype Id a = Id Int
data Foo = Foo {-# UNPACK #-} !(Id Foo) String
data Bar = Bar {-# UNPACK #-} !Foo
f :: Bar -> Int
f (Bar (Foo (Id x) _)) = x
{-# LANGUAGE MagicHash #-}
module T7287 where
import GHC.Prim
{-# RULES
"int2Word#/word2Int#" forall x. int2Word# (word2Int# x) = x
#-}
{- We get a legitmiate
T7287.hs:7:3: warning:
Rule int2Word#/word2Int# may never fire because
rule "word2Int#" for ‘word2Int#’ might fire first
Probable fix: add phase [n] or [~n] to the competing rule
because rule "word2Int#" is the constant folding rule that converts
a sufficiently-narrow Word# literal to an Int#. There is a similar
one for int2Word#, so the whole lot is confluent. -}
\ No newline at end of file
{-# LANGUAGE MagicHash #-}
module T7287 where
import GHC.Prim
{-# RULES
"int2Word#/word2Int#" forall x. int2Word# (word2Int# x) = x
#-}
{- We get a legitmiate
T7287.hs:7:3: warning:
Rule int2Word#/word2Int# may never fire because
rule "word2Int#" for ‘word2Int#’ might fire first
Probable fix: add phase [n] or [~n] to the competing rule
because rule "word2Int#" is the constant folding rule that converts
a sufficiently-narrow Word# literal to an Int#. There is a similar
one for int2Word#, so the whole lot is confluent. -}
-- This one triggers the bug reported in Trac #1092
-- The problem is that the rule
-- forall w. f (\v->w) = w
-- erroneously matches the call
-- f id
--
-- Lint catches the error
module Foo where
f :: (Int -> Int) -> Int
{-# NOINLINE f #-}
f g = g 4
{-# RULES
"f" forall w. f (\v->w) = w
#-}
h = f id
-- This one triggers the bug reported in Trac #1092
-- The problem is that the rule
-- forall w. f (\v->w) = w
-- erroneously matches the call
-- f id
--
-- Lint catches the error
module Foo where
f :: (Int -> Int) -> Int
{-# NOINLINE f #-}
f g = g 4
{-# RULES
"f" forall w. f (\v->w) = w
#-}
h = f id
module Main where
import T5441a
main = putStrLn (showNat Z)
module Main where
import T5441a
main = putStrLn (showNat Z)
module T5441a where
import Unsafe.Coerce (unsafeCoerce)
import GHC.Prim (Any)
listmap :: (a -> b) -> [a] -> [b]
listmap f [] = []
listmap f (x : xs) = f x : listmap f xs
data Nat = Z | S Nat
{-# NOINLINE inject #-}
inject :: Nat -> Nat -> Nat
inject m i = i
{-# NOINLINE look #-}
look :: Nat -> String -> Char
look Z _ = '0'
showDigit :: Nat -> () -> Nat -> Char
showDigit base prf d = look (inject base d) ""
toDigits :: Nat -> Nat -> [Nat]
toDigits Z Z = [Z]
coe1 :: (Nat -> String) -> Any
coe1 = unsafeCoerce
coe2 :: Any -> (Nat -> String)
coe2 = unsafeCoerce
showInBase :: Nat -> Any
showInBase base
= coe1 (\n -> listmap
(showDigit base ())
(toDigits base n))
showNat :: Nat -> String
showNat = coe2 (showInBase Z)
module T5441a where
import Unsafe.Coerce (unsafeCoerce)
import GHC.Prim (Any)
listmap :: (a -> b) -> [a] -> [b]
listmap f [] = []
listmap f (x : xs) = f x : listmap f xs
data Nat = Z | S Nat
{-# NOINLINE inject #-}
inject :: Nat -> Nat -> Nat
inject m i = i
{-# NOINLINE look #-}
look :: Nat -> String -> Char
look Z _ = '0'
showDigit :: Nat -> () -> Nat -> Char
showDigit base prf d = look (inject base d) ""
toDigits :: Nat -> Nat -> [Nat]
toDigits Z Z = [Z]
coe1 :: (Nat -> String) -> Any
coe1 = unsafeCoerce
coe2 :: Any -> (Nat -> String)
coe2 = unsafeCoerce
showInBase :: Nat -> Any
showInBase base
= coe1 (\n -> listmap
(showDigit base ())
(toDigits base n))
showNat :: Nat -> String
showNat = coe2 (showInBase Z)
module T8037 where
import Unsafe.Coerce
import Foreign.C.Types
import System.IO.Unsafe
data D4 = D4 CInt CInt CInt
data Color3 = Color3 CInt CInt
crash :: D4 -> IO ()
crash x = color (unsafeCoerce x)
color :: Color3 -> IO ()
color (Color3 r g) = f (unsafePerformIO undefined) r g
foreign import ccall f :: CInt -> CInt -> CInt -> IO ()
module T8037 where
import Unsafe.Coerce
import Foreign.C.Types
import System.IO.Unsafe
data D4 = D4 CInt CInt CInt
data Color3 = Color3 CInt CInt
crash :: D4 -> IO ()
crash x = color (unsafeCoerce x)
color :: Color3 -> IO ()
color (Color3 r g) = f (unsafePerformIO undefined) r g
foreign import ccall f :: CInt -> CInt -> CInt -> IO ()
{-# LANGUAGE TemplateHaskell #-}
-- Test Trac #2597 (first bug)
module ShouldCompile where
import T2597a_Lib
bug = $mkBug
{-# LANGUAGE TemplateHaskell #-}
-- Test Trac #2597 (first bug)
module ShouldCompile where
import T2597a_Lib
bug = $mkBug
{-# LANGUAGE TemplateHaskell #-}
-- Library module for T2597a
module T2597a_Lib where
import Language.Haskell.TH
mkBug :: ExpQ
mkBug = return $ CompE [BindS (VarP $ mkName "p") (ListE []), NoBindS
(VarE $ mkName "p")]
{-# LANGUAGE TemplateHaskell #-}
-- Library module for T2597a
module T2597a_Lib where
import Language.Haskell.TH
mkBug :: ExpQ
mkBug = return $ CompE [BindS (VarP $ mkName "p") (ListE []), NoBindS
(VarE $ mkName "p")]
{-# LANGUAGE TemplateHaskell #-}
-- Test Trac #2597 (second bug)
module ShouldCompile where
import T2597b_Lib
bug2 = $mkBug2
{-# LANGUAGE TemplateHaskell #-}
-- Test Trac #2597 (second bug)
module ShouldCompile where
import T2597b_Lib
bug2 = $mkBug2
{-# LANGUAGE TemplateHaskell #-}
-- Library module for T2597b
module T2597b_Lib where
import Language.Haskell.TH
mkBug2 :: ExpQ
mkBug2 = return $ DoE []
{-# LANGUAGE TemplateHaskell #-}
-- Library module for T2597b
module T2597b_Lib where
import Language.Haskell.TH
mkBug2 :: ExpQ
mkBug2 = return $ DoE []
{-# LANGUAGE TemplateHaskell #-}
module T2700 where
import Language.Haskell.TH
import System.IO
$( do { d <- sigD (mkName "foo") [t| (Int -> Bool) -> Bool |]
; runIO (hPutStrLn stderr (pprint d))
; return [] }
)
{-# LANGUAGE TemplateHaskell #-}
module T2700 where
import Language.Haskell.TH
import System.IO
$( do { d <- sigD (mkName "foo") [t| (Int -> Bool) -> Bool |]
; runIO (hPutStrLn stderr (pprint d))
; return [] }
)
{-# LANGUAGE TemplateHaskell #-}
module Fixity where
class MyClass a where
(.*.) :: a -> a -> a
f x = x
$( [d| x = undefined |] )
infixr 3 .*.
f :: Int -> Int
{-# LANGUAGE TemplateHaskell #-}
module Fixity where
class MyClass a where
(.*.) :: a -> a -> a
f x = x
$( [d| x = undefined |] )
infixr 3 .*.
f :: Int -> Int
{-# LANGUAGE TemplateHaskell #-}
module T3395 where
import Language.Haskell.TH
foo = $(return $
CompE
[NoBindS (VarE $ mkName "undefined")
,BindS (VarP $ mkName "r1") (VarE $ mkName "undefined") ])
{-# LANGUAGE TemplateHaskell #-}
module T3395 where
import Language.Haskell.TH
foo = $(return $
CompE
[NoBindS (VarE $ mkName "undefined")
,BindS (VarP $ mkName "r1") (VarE $ mkName "undefined") ])
{-# LANGUAGE TemplateHaskell #-}
-- Test Trac #3467
module T3467 where
import Language.Haskell.TH
import Foreign
sizeq :: Name -> Q Exp
sizeq n = [| sizeOf (undefined :: $(conT n)) |]
{-# LANGUAGE TemplateHaskell #-}
-- Test Trac #3467
module T3467 where
import Language.Haskell.TH
import Foreign
sizeq :: Name -> Q Exp
sizeq n = [| sizeOf (undefined :: $(conT n)) |]
{-# LANGUAGE TemplateHaskell #-}
module T5404 where
foobar :: Int
foobar = $([|
let
bar :: Int
bar = 5
in bar
|])
{-# LANGUAGE TemplateHaskell #-}
module T5404 where
foobar :: Int
foobar = $([|
let
bar :: Int
bar = 5
in bar
|])
{-# LANGUAGE TemplateHaskell #-}
module Main where
$([d| instance Show (a -> b) where
showsPrec _ _ = showString "<function>"
|])
main = print id
\ No newline at end of file
{-# LANGUAGE TemplateHaskell #-}
module Main where
$([d| instance Show (a -> b) where
showsPrec _ _ = showString "<function>"
|])
main = print id
{-# LANGUAGE TemplateHaskell #-}
module T5665 where
import T5665a
data Record = Record { recordField :: Int }
$(doSomeTH "SomeType" ''Int)
{-# LANGUAGE TemplateHaskell #-}
module T5665 where