Skip to content

GitLab

GHC
GHC
Commit 46ff80f2 authored by thomie's avatar thomie
Browse files
Options

Testsuite: tabs -> spaces [skip ci]

parent 7e7094f1
Hide whitespace changes
Inline Side-by-side
Showing with 917 additions and 917 deletions
testsuite/tests/arrows/should_compile/arrowcase1.hs
View file @ 46ff80f2
......@@ -6,13 +6,13 @@ import Control.Arrow
h :: ArrowChoice a => Int -> a (Int,Int) Int
h x = proc (y,z) -> case compare x y of
LT -> returnA -< x
EQ -> returnA -< y+z
GT -> returnA -< z+x
LT -> returnA -< x
EQ -> returnA -< y+z
GT -> returnA -< z+x
g :: ArrowChoice a => Int -> a (Int,Int) Int
g x = proc (y,z) -> (case compare x y of
LT -> \ a -> returnA -< x+a
EQ -> \ b -> returnA -< y+z+b
GT -> \ c -> returnA -< z+x
LT -> \ a -> returnA -< x+a
EQ -> \ b -> returnA -< y+z+b
GT -> \ c -> returnA -< z+x
) 1
testsuite/tests/arrows/should_compile/arrowdo1.hs
View file @ 46ff80f2
......@@ -12,6 +12,6 @@ g x = proc y -> returnA -< x*y
h :: Arrow a => Int -> a (Int,Int) Int
h x = proc (y,z) -> do
a <- f -< (x,y,3)
b <- g (2+x) -< y+a
returnA -< a*b+z
a <- f -< (x,y,3)
b <- g (2+x) -< y+a
returnA -< a*b+z
testsuite/tests/arrows/should_compile/arrowdo2.hs
View file @ 46ff80f2
......@@ -6,5 +6,5 @@ import Control.Arrow
f :: Arrow a => a (Int,Int) Int
f = proc (x,y) -> do
let z = x*y
returnA -< y+z
let z = x*y
returnA -< y+z
testsuite/tests/arrows/should_compile/arrowdo3.hs
View file @ 46ff80f2
......@@ -79,144 +79,144 @@ data T70 = C70
f :: Arrow a => a Int Int
f = proc x0 -> do
x1 <- returnA -< C1
x2 <- returnA -< C2
x3 <- returnA -< C3
x4 <- returnA -< C4
x5 <- returnA -< C5
x6 <- returnA -< C6
x7 <- returnA -< C7
x8 <- returnA -< C8
x9 <- returnA -< C9
x10 <- returnA -< C10
x11 <- returnA -< C11
x12 <- returnA -< C12
x13 <- returnA -< C13
x14 <- returnA -< C14
x15 <- returnA -< C15
x16 <- returnA -< C16
x17 <- returnA -< C17
x18 <- returnA -< C18
x19 <- returnA -< C19
x20 <- returnA -< C20
x21 <- returnA -< C21
x22 <- returnA -< C22
x23 <- returnA -< C23
x24 <- returnA -< C24
x25 <- returnA -< C25
x26 <- returnA -< C26
x27 <- returnA -< C27
x28 <- returnA -< C28
x29 <- returnA -< C29
x30 <- returnA -< C30
x31 <- returnA -< C31
x32 <- returnA -< C32
x33 <- returnA -< C33
x34 <- returnA -< C34
x35 <- returnA -< C35
x36 <- returnA -< C36
x37 <- returnA -< C37
x38 <- returnA -< C38
x39 <- returnA -< C39
x40 <- returnA -< C40
x41 <- returnA -< C41
x42 <- returnA -< C42
x43 <- returnA -< C43
x44 <- returnA -< C44
x45 <- returnA -< C45
x46 <- returnA -< C46
x47 <- returnA -< C47
x48 <- returnA -< C48
x49 <- returnA -< C49
x50 <- returnA -< C50
x51 <- returnA -< C51
x52 <- returnA -< C52
x53 <- returnA -< C53
x54 <- returnA -< C54
x55 <- returnA -< C55
x56 <- returnA -< C56
x57 <- returnA -< C57
x58 <- returnA -< C58
x59 <- returnA -< C59
x60 <- returnA -< C60
x61 <- returnA -< C61
x62 <- returnA -< C62
x63 <- returnA -< C63
x64 <- returnA -< C64
x65 <- returnA -< C65
x66 <- returnA -< C66
x67 <- returnA -< C67
x68 <- returnA -< C68
x69 <- returnA -< C69
x70 <- returnA -< C70
returnA -< x70
returnA -< x69
returnA -< x68
returnA -< x67
returnA -< x66
returnA -< x65
returnA -< x64
returnA -< x63
returnA -< x62
returnA -< x61
returnA -< x60
returnA -< x59
returnA -< x58
returnA -< x57
returnA -< x56
returnA -< x55
returnA -< x54
returnA -< x53
returnA -< x52
returnA -< x51
returnA -< x50
returnA -< x49
returnA -< x48
returnA -< x47
returnA -< x46
returnA -< x45
returnA -< x44
returnA -< x43
returnA -< x42
returnA -< x41
returnA -< x40
returnA -< x39
returnA -< x38
returnA -< x37
returnA -< x36
returnA -< x35
returnA -< x34
returnA -< x33
returnA -< x32
returnA -< x31
returnA -< x30
returnA -< x29
returnA -< x28
returnA -< x27
returnA -< x26
returnA -< x25
returnA -< x24
returnA -< x23
returnA -< x22
returnA -< x21
returnA -< x20
returnA -< x19
returnA -< x18
returnA -< x17
returnA -< x16
returnA -< x15
returnA -< x14
returnA -< x13
returnA -< x12
returnA -< x11
returnA -< x10
returnA -< x9
returnA -< x8
returnA -< x7
returnA -< x6
returnA -< x5
returnA -< x4
returnA -< x3
returnA -< x2
returnA -< x1
returnA -< x0
x1 <- returnA -< C1
x2 <- returnA -< C2
x3 <- returnA -< C3
x4 <- returnA -< C4
x5 <- returnA -< C5
x6 <- returnA -< C6
x7 <- returnA -< C7
x8 <- returnA -< C8
x9 <- returnA -< C9
x10 <- returnA -< C10
x11 <- returnA -< C11
x12 <- returnA -< C12
x13 <- returnA -< C13
x14 <- returnA -< C14
x15 <- returnA -< C15
x16 <- returnA -< C16
x17 <- returnA -< C17
x18 <- returnA -< C18
x19 <- returnA -< C19
x20 <- returnA -< C20
x21 <- returnA -< C21
x22 <- returnA -< C22
x23 <- returnA -< C23
x24 <- returnA -< C24
x25 <- returnA -< C25
x26 <- returnA -< C26
x27 <- returnA -< C27
x28 <- returnA -< C28
x29 <- returnA -< C29
x30 <- returnA -< C30
x31 <- returnA -< C31
x32 <- returnA -< C32
x33 <- returnA -< C33
x34 <- returnA -< C34
x35 <- returnA -< C35
x36 <- returnA -< C36
x37 <- returnA -< C37
x38 <- returnA -< C38
x39 <- returnA -< C39
x40 <- returnA -< C40
x41 <- returnA -< C41
x42 <- returnA -< C42
x43 <- returnA -< C43
x44 <- returnA -< C44
x45 <- returnA -< C45
x46 <- returnA -< C46
x47 <- returnA -< C47
x48 <- returnA -< C48
x49 <- returnA -< C49
x50 <- returnA -< C50
x51 <- returnA -< C51
x52 <- returnA -< C52
x53 <- returnA -< C53
x54 <- returnA -< C54
x55 <- returnA -< C55
x56 <- returnA -< C56
x57 <- returnA -< C57
x58 <- returnA -< C58
x59 <- returnA -< C59
x60 <- returnA -< C60
x61 <- returnA -< C61
x62 <- returnA -< C62
x63 <- returnA -< C63
x64 <- returnA -< C64
x65 <- returnA -< C65
x66 <- returnA -< C66
x67 <- returnA -< C67
x68 <- returnA -< C68
x69 <- returnA -< C69
x70 <- returnA -< C70
returnA -< x70
returnA -< x69
returnA -< x68
returnA -< x67
returnA -< x66
returnA -< x65
returnA -< x64
returnA -< x63
returnA -< x62
returnA -< x61
returnA -< x60
returnA -< x59
returnA -< x58
returnA -< x57
returnA -< x56
returnA -< x55
returnA -< x54
returnA -< x53
returnA -< x52
returnA -< x51
returnA -< x50
returnA -< x49
returnA -< x48
returnA -< x47
returnA -< x46
returnA -< x45
returnA -< x44
returnA -< x43
returnA -< x42
returnA -< x41
returnA -< x40
returnA -< x39
returnA -< x38
returnA -< x37
returnA -< x36
returnA -< x35
returnA -< x34
returnA -< x33
returnA -< x32
returnA -< x31
returnA -< x30
returnA -< x29
returnA -< x28
returnA -< x27
returnA -< x26
returnA -< x25
returnA -< x24
returnA -< x23
returnA -< x22
returnA -< x21
returnA -< x20
returnA -< x19
returnA -< x18
returnA -< x17
returnA -< x16
returnA -< x15
returnA -< x14
returnA -< x13
returnA -< x12
returnA -< x11
returnA -< x10
returnA -< x9
returnA -< x8
returnA -< x7
returnA -< x6
returnA -< x5
returnA -< x4
returnA -< x3
returnA -< x2
returnA -< x1
returnA -< x0
testsuite/tests/arrows/should_compile/arrowrec1.hs
View file @ 46ff80f2
......@@ -7,7 +7,7 @@ import Data.Char
f :: ArrowLoop a => a Char Int
f = proc x -> do
a <- returnA -< ord x
rec b <- returnA -< ord c - ord x
c <- returnA -< chr a
returnA -< b + ord c
a <- returnA -< ord x
rec b <- returnA -< ord c - ord x
c <- returnA -< chr a
returnA -< b + ord c
testsuite/tests/arrows/should_run/arrowrun001.hs
View file @ 46ff80f2
......@@ -13,21 +13,21 @@ data Exp = Var Id | Add Exp Exp | If Exp Exp Exp | Lam Id Exp | App Exp Exp
eval :: (ArrowChoice a, ArrowApply a) => Exp -> a [(Id, Val a)] (Val a)
eval (Var s) = proc env ->
returnA -< fromJust (lookup s env)
returnA -< fromJust (lookup s env)
eval (Add e1 e2) = proc env -> do
~(Num u) <- eval e1 -< env
~(Num v) <- eval e2 -< env
returnA -< Num (u + v)
~(Num u) <- eval e1 -< env
~(Num v) <- eval e2 -< env
returnA -< Num (u + v)
eval (If e1 e2 e3) = proc env -> do
~(Bl b) <- eval e1 -< env
if b then eval e2 -< env
else eval e3 -< env
~(Bl b) <- eval e1 -< env
if b then eval e2 -< env
else eval e3 -< env
eval (Lam x e) = proc env ->
returnA -< Fun (proc v -> eval e -< (x,v):env)
returnA -< Fun (proc v -> eval e -< (x,v):env)
eval (App e1 e2) = proc env -> do
~(Fun f) <- eval e1 -< env
v <- eval e2 -< env
f -<< v
~(Fun f) <- eval e1 -< env
v <- eval e2 -< env
f -<< v
-- some tests
......@@ -38,11 +38,11 @@ double = Lam "x" (Add (Var "x") (Var "x"))
-- if b then k (double x) x else x + x + x
text_exp = If (Var "b")
(App (App k (App double (Var "x"))) (Var "x"))
(Add (Var "x") (Add (Var "x") (Var "x")))
(App (App k (App double (Var "x"))) (Var "x"))
(Add (Var "x") (Add (Var "x") (Var "x")))
unNum (Num n) = n
main = do
print (unNum (eval text_exp [("b", Bl True), ("x", Num 5)]))
print (unNum (eval text_exp [("b", Bl False), ("x", Num 5)]))
print (unNum (eval text_exp [("b", Bl True), ("x", Num 5)]))
print (unNum (eval text_exp [("b", Bl False), ("x", Num 5)]))
testsuite/tests/arrows/should_run/arrowrun002.hs
View file @ 46ff80f2
......@@ -15,7 +15,7 @@ infixr 4 :&:
-- or `powertrees' (cf Jayadev Misra's powerlists):
data Pow a = Zero a | Succ (Pow (Pair a))
deriving Show
deriving Show
type Pair a = (a, a)
......@@ -33,7 +33,7 @@ tree3 = Succ (Succ (Succ (Zero (((1, 2), (3, 4)), ((5, 6), (7, 8))))))
-- in circuit design, eg Ruby, and descriptions of parallel algorithms.)
-- And the type system will ensure that all legal programs preserve
-- this structural invariant.
--
--
-- The only problem is that the type constraint is too restrictive, rejecting
-- many of the standard operations on these trees. Typically you want to
-- split a tree into two subtrees, do some processing on the subtrees and
......@@ -56,13 +56,13 @@ apply (f :&: fs) (Succ t) = Succ (apply fs t)
-- programming with Hom's. Firstly, Hom is an arrow:
instance Category Hom where
id = id :&: id
(f :&: fs) . (g :&: gs) = (f . g) :&: (fs . gs)
id = id :&: id
(f :&: fs) . (g :&: gs) = (f . g) :&: (fs . gs)
instance Arrow Hom where
arr f = f :&: arr (f *** f)
first (f :&: fs) =
first f :&: (arr transpose >>> first fs >>> arr transpose)
arr f = f :&: arr (f *** f)
first (f :&: fs) =
first f :&: (arr transpose >>> first fs >>> arr transpose)
transpose :: ((a,b), (c,d)) -> ((a,c), (b,d))
transpose ((a,b), (c,d)) = ((a,c), (b,d))
......@@ -70,7 +70,7 @@ transpose ((a,b), (c,d)) = ((a,c), (b,d))
-- arr maps f over the leaves of a powertree.
-- The composition >>> composes sequences of functions pairwise.
--
--
-- The *** operator unriffles a powertree of pairs into a pair of powertrees,
-- applies the appropriate function to each and riffles the results.
-- It defines a categorical product for this arrow category.
......@@ -85,9 +85,9 @@ transpose ((a,b), (c,d)) = ((a,c), (b,d))
butterfly :: (Pair a -> Pair a) -> Hom a a
butterfly f = id :&: proc (x, y) -> do
x' <- butterfly f -< x
y' <- butterfly f -< y
returnA -< f (x', y')
x' <- butterfly f -< x
y' <- butterfly f -< y
returnA -< f (x', y')
-- The recursive calls operate on halves of the original tree, so the
-- recursion is well-defined.
......@@ -96,7 +96,7 @@ butterfly f = id :&: proc (x, y) -> do
rev :: Hom a a
rev = butterfly swap
where swap (x, y) = (y, x)
where swap (x, y) = (y, x)
unriffle :: Hom (Pair a) (Pair a)
unriffle = butterfly transpose
......@@ -105,26 +105,26 @@ unriffle = butterfly transpose
bisort :: Ord a => Hom a a
bisort = butterfly cmp
where cmp (x, y) = (min x y, max x y)
where cmp (x, y) = (min x y, max x y)
-- This can be used (with rev) as the merge phase of a merge sort.
--
--
sort :: Ord a => Hom a a
sort = id :&: proc (x, y) -> do
x' <- sort -< x
y' <- sort -< y
yr <- rev -< y'
p <- unriffle -< (x', yr)
bisort2 -< p
where _ :&: bisort2 = bisort
x' <- sort -< x
y' <- sort -< y
yr <- rev -< y'
p <- unriffle -< (x', yr)
bisort2 -< p
where _ :&: bisort2 = bisort
-- Here is the scan operation, using the algorithm of Ladner and Fischer:
scan :: (a -> a -> a) -> a -> Hom a a
scan op b = id :&: proc (x, y) -> do
y' <- scan op b -< op x y
l <- rsh b -< y'
returnA -< (op l x, y')
y' <- scan op b -< op x y
l <- rsh b -< y'
returnA -< (op l x, y')
-- The auxiliary function rsh b shifts each element in the tree one place to
-- the right, placing b in the now-vacant leftmost position, and discarding
......@@ -132,8 +132,8 @@ scan op b = id :&: proc (x, y) -> do
rsh :: a -> Hom a a
rsh b = const b :&: proc (x, y) -> do
w <- rsh b -< y
returnA -< (w, x)
w <- rsh b -< y
returnA -< (w, x)
-- Finally, here is the Fast Fourier Transform:
......@@ -141,11 +141,11 @@ type C = Complex Double
fft :: Hom C C
fft = id :&: proc (x, y) -> do
x' <- fft -< x
y' <- fft -< y
r <- roots (-1) -< ()
let z = r*y'
unriffle -< (x' + z, x' - z)
x' <- fft -< x
y' <- fft -< y
r <- roots (-1) -< ()
let z = r*y'
unriffle -< (x' + z, x' - z)
-- The auxiliary function roots r (where r is typically a root of unity)
-- populates a tree of size n (necessarily a power of 2) with the values
......@@ -153,73 +153,73 @@ fft = id :&: proc (x, y) -> do
roots :: C -> Hom () C
roots r = const 1 :&: proc _ -> do
x <- roots r' -< ()
unriffle -< (x, x*r')
where r' = if imagPart s >= 0 then -s else s
s = sqrt r
x <- roots r' -< ()
unriffle -< (x, x*r')
where r' = if imagPart s >= 0 then -s else s
s = sqrt r
-- Miscellaneous functions:
rrot :: Hom a a
rrot = id :&: proc (x, y) -> do
w <- rrot -< y
returnA -< (w, x)
w <- rrot -< y
returnA -< (w, x)
ilv :: Hom a a -> Hom (Pair a) (Pair a)
ilv f = proc (x, y) -> do
x' <- f -< x
y' <- f -< y
returnA -< (x', y')
x' <- f -< x
y' <- f -< y
returnA -< (x', y')
scan' :: (a -> a -> a) -> a -> Hom a a
scan' op b = proc x -> do
l <- rsh b -< x
(id :&: ilv (scan' op b)) -< op l x
l <- rsh b -< x
(id :&: ilv (scan' op b)) -< op l x
riffle :: Hom (Pair a) (Pair a)
riffle = id :&: proc ((x1, y1), (x2, y2)) -> do
x <- riffle -< (x1, x2)
y <- riffle -< (y1, y2)
returnA -< (x, y)
x <- riffle -< (x1, x2)
y <- riffle -< (y1, y2)
returnA -< (x, y)
invert :: Hom a a
invert = id :&: proc (x, y) -> do
x' <- invert -< x
y' <- invert -< y
unriffle -< (x', y')
x' <- invert -< x
y' <- invert -< y
unriffle -< (x', y')
carryLookaheadAdder :: Hom (Bool, Bool) Bool
carryLookaheadAdder = proc (x, y) -> do
carryOut <- rsh (Just False) -<
if x == y then Just x else Nothing
Just carryIn <- scan plusMaybe Nothing -< carryOut
returnA -< x `xor