Tests for generalised list comprehensions

testsuite/.darcs-boring

 # Boring file regexps:
 \.hi$
+\.hi-boot$
+_hi$
 \.o$
+\.o-boot$
+_o$
 \.p_hi$
 \.p_o$
 \.a$
@@ -29,6 +33,7 @@
 (^|/)BitKeeper($|/)
 (^|/)ChangeSet($|/)
 (^|/)\.svn($|/)
+(^|/)\.hpc($|/)
 \.py[co]$
 \#
 \.cvsignore$
@@ -42,5 +47,11 @@
 \.out[12]$
 \.inout$
 \.hc$
+\.exe\.manifest$
+\.exe$
+\.tix$
+\.genscript$
+\.comp.std[a-z]+$
+\.normalised$
 [0-9][0-9][0-9]$
 _stub.[hc]$

testsuite/tests/ghc-regress/deSugar/should_run/all.T

@@ -18,3 +18,11 @@ test('dsrun012', skip_if_fast, compile_and_run, [''])
 test('dsrun013', normal, compile_and_run, [''])
 test('dsrun014', expect_broken_for(1257, ['ghci']), compile_and_run, [''])
 test('dsrun015', expect_broken(1491), compile_and_run, [''])
+test('dsrun016', normal, compile_and_run, [''])
+test('dsrun017', normal, compile_and_run, [''])
+test('dsrun018', normal, compile_and_run, [''])
+test('dsrun019', normal, compile_and_run, [''])
+test('dsrun020', normal, compile_and_run, [''])
+test('dsrun021', normal, compile_and_run, [''])
+test('dsrun022', normal, compile_and_run, [''])
+test('dsrun023', normal, compile_and_run, [''])

testsuite/tests/ghc-regress/deSugar/should_run/dsrun016.hs

+-- Tests grouping WITH a using clause but WITHOUT a by clause
+
+{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Main where
+
+import List(inits)
+
+main = putStrLn (show output)
+  where
+    output = [ x
+             | y <- [1..3]
+             , x <- "hello"
+             , then group using inits ]

testsuite/tests/ghc-regress/deSugar/should_run/dsrun016.stdout

+["","h","he","hel","hell","hello","helloh","hellohe","hellohel","hellohell","hellohello","hellohelloh","hellohellohe","hellohellohel","hellohellohell","hellohellohello"]

testsuite/tests/ghc-regress/deSugar/should_run/dsrun017.hs

+-- Tests grouping WITH a by clause but WITHOUT a using clause
+
+{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Main where
+
+import GHC.Exts(the)
+
+main = putStrLn (show output)
+  where
+    output = [ (the dept, sum salary, name) 
+             | (dept, salary, name) <- [("A", 1, "Bob"), ("B", 2, "Fred"), ("A", 5, "Jim"), ("A", 9, "Jim")]
+             , then group by dept ]
\ No newline at end of file

testsuite/tests/ghc-regress/deSugar/should_run/dsrun017.stdout

+[("A",15,["Bob","Jim","Jim"]),("B",2,["Fred"])]

testsuite/tests/ghc-regress/deSugar/should_run/dsrun018.hs

+-- Test grouping with both a using and a by clause
+
+{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Main where
+
+import List(groupBy)
+import GHC.Exts(the)
+
+groupRuns :: Eq b => (a -> b) -> [a] -> [[a]]
+groupRuns f = groupBy (\x y -> f x == f y)
+
+main = putStrLn (show output)
+  where
+    output = [ (the x, product y)
+             | x <- ([1, 1, 1, 2, 2, 1, 3])
+             , y <- [4..6]
+             , then group by x using groupRuns ]
\ No newline at end of file

testsuite/tests/ghc-regress/deSugar/should_run/dsrun018.stdout

+[(1,1728000),(2,14400),(1,120),(3,120)]

testsuite/tests/ghc-regress/deSugar/should_run/dsrun019.hs

+-- Test transform WITHOUT a by clause
+
+{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Main where
+
+main = putStrLn (show output)
+  where
+    output = [ x 
+             | x <- [1..10]
+             , then take 5 ]
\ No newline at end of file

testsuite/tests/ghc-regress/deSugar/should_run/dsrun019.stdout

+[1,2,3,4,5]

testsuite/tests/ghc-regress/deSugar/should_run/dsrun020.hs

+-- Tests transform WITH a by clause
+
+{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Main where
+
+import List(takeWhile)
+
+main = putStrLn (show output)
+  where
+    output = [ (x * 10) + y
+             | x <- [1..4]
+             , y <- [1..4]
+             , then takeWhile by (x + y) < 4]
\ No newline at end of file

testsuite/tests/ghc-regress/deSugar/should_run/dsrun020.stdout

+[11,12]

testsuite/tests/ghc-regress/deSugar/should_run/dsrun021.hs

+-- Transformation stress test
+
+{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Main where
+
+import List(takeWhile)
+import GHC.Exts(sortWith)
+
+employees = [ ("Simon", "MS", 80)
+            , ("Erik", "MS", 100)
+            , ("Phil", "Ed", 40)
+            , ("Gordon", "Ed", 45)
+            , ("Paul", "Yale", 60)]
+
+main = putStrLn (show output)
+  where
+    output = [ (dept, salary) 
+             | then sortWith by 1
+		     , (name, dept, salary) <- employees
+             , then sortWith by salary
+             , then filter by salary > 50
+             , then take 1 ]
\ No newline at end of file

testsuite/tests/ghc-regress/deSugar/should_run/dsrun021.stdout

+[("Yale",60)]

testsuite/tests/ghc-regress/deSugar/should_run/dsrun022.hs

+-- Transformation and grouping stress test
+
+{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Main where
+
+import GHC.Exts(sortWith, the)
+
+employees = [ ("Simon", "MS", 80)
+            , ("Erik", "MS", 100)
+            , ("Phil", "Ed", 40)
+            , ("Gordon", "Ed", 45)
+            , ("Paul", "Yale", 60) ]
+
+main = putStrLn (show output)
+  where
+    output = [ (the dept, map sum salary, (show x) ++ " and " ++ (show y)) 
+             | (name, dept, salary) <- employees
+             , then group by dept
+             , x <- [1, 2, 3]
+             , y <- [4, 5, 6]
+             , then sortWith by sum salary
+             , then take 4
+             , then group using replicate 2 ]
\ No newline at end of file

testsuite/tests/ghc-regress/deSugar/should_run/dsrun022.stdout

+[(["Yale"],[60,60,60,60],"[1,1,1,2] and [4,5,6,4]"),(["Yale"],[60,60,60,60],"[1,1,1,2] and [4,5,6,4]")]

testsuite/tests/ghc-regress/deSugar/should_run/dsrun023.hs

+-- "Big tuple" stress test for parallel and transform comprehensions
+
+{-# OPTIONS_GHC -XTransformListComp -XParallelListComp #-}
+
+module Main where
+
+main = putStrLn (show output)
+  where
+    output = [ x0 + x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 +
+               x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 +
+               x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 +
+               x30 + x31 + x32 + x33 + x34 + x35 + x36 + x37 + x38 + x39 +
+               x40 + x41 + x42 + x43 + x44 + x45 + x46 + x47 + x48 + x49 +
+               x50 + x51 + x52 + x53 + x54 + x55 + x56 + x57 + x58 + x59 +
+               x60 + x61 + x62 + x63 + x64 + x65 + x66 + x67 + x68 + x69 +
+               x70 + x71 + x72 + x73 + x74 + x75 + x76 + x77 + x78 + x79 +
+               x80 + x81 + x82 + x83 + x84 + x85 + x86 + x87 + x88 + x89 +
+               x90 + x91 + x92 + x93 + x94 + x95 + x96 + x97 + x98 + x99 +
+               y
+             | x0 <- [0], x1 <- [1], x2 <- [2], x3 <- [3], x4 <- [4]
+             , x5 <- [5], x6 <- [6], x7 <- [7], x8 <- [8], x9 <- [9]
+             , x10 <- [0], x11 <- [1], x12 <- [2], x13 <- [3], x14 <- [4]
+             , x15 <- [5], x16 <- [6], x17 <- [7], x18 <- [8], x19 <- [9]
+             , x20 <- [0], x21 <- [1], x22 <- [2], x23 <- [3], x24 <- [4]
+             , x25 <- [5], x26 <- [6], x27 <- [7], x28 <- [8], x29 <- [9]
+             , x30 <- [0], x31 <- [1], x32 <- [2], x33 <- [3], x34 <- [4]
+             , x35 <- [5], x36 <- [6], x37 <- [7], x38 <- [8], x39 <- [9]
+             , x40 <- [0], x41 <- [1], x42 <- [2], x43 <- [3], x44 <- [4]
+             , x45 <- [5], x46 <- [6], x47 <- [7], x48 <- [8], x49 <- [9]
+             , x50 <- [0], x51 <- [1], x52 <- [2], x53 <- [3], x54 <- [4]
+             , x55 <- [5], x56 <- [6], x57 <- [7], x58 <- [8], x59 <- [9]
+             , x60 <- [0], x61 <- [1], x62 <- [2], x63 <- [3], x64 <- [4]
+             , x65 <- [5], x66 <- [6], x67 <- [7], x68 <- [8], x69 <- [9]
+             , x70 <- [0], x71 <- [1], x72 <- [2], x73 <- [3], x74 <- [4]
+             , x75 <- [5], x76 <- [6], x77 <- [7], x78 <- [8], x79 <- [9]
+             , x80 <- [0], x81 <- [1], x82 <- [2], x83 <- [3], x84 <- [4]
+             , x85 <- [5], x86 <- [6], x87 <- [7], x88 <- [8], x89 <- [9]
+             , x90 <- [0], x91 <- [1], x92 <- [2], x93 <- [3], x94 <- [4]
+             , x95 <- [5], x96 <- [6], x97 <- [7], x98 <- [8], x99 <- [9]
+             , then take 4
+             | y <- [10] ]
\ No newline at end of file

testsuite/tests/ghc-regress/deSugar/should_run/dsrun023.stdout

+[460]

testsuite/tests/ghc-regress/parser/should_compile/all.T

@@ -73,3 +73,4 @@ test('read058', normal, compile, [''])
 test('read059', normal, compile, [''])
 test('read060', normal, compile, [''])
 test('read061', normal, compile, [''])
+test('read062', normal, compile, [''])

testsuite/tests/ghc-regress/parser/should_compile/read062.hs

+{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Foo where
+
+import List
+import GHC.Exts
+
+foo = [ ()
+      | x <- [1..10]
+      , then take 5
+      , then sortWith by x
+      , then group by x
+      , then group using inits
+      , then group by x using groupWith
+      ]
+