[project @ 1999-01-27 15:01:03 by simonpj]

Haskell 98 updates

32 files changed, 104 insertions, 32 deletions

diff --git a/ghc/tests/array/should_run/arr001.hs b/ghc/tests/array/should_run/arr001.hs
index 1e42f19796..d45d7b8d31 100644
--- a/ghc/tests/array/should_run/arr001.hs
+++ b/ghc/tests/array/should_run/arr001.hs
@@ -1,4 +1,4 @@
---!!! Simple array creation
+-- !!! Simple array creation
 
 import Array
 
diff --git a/ghc/tests/array/should_run/arr002.hs b/ghc/tests/array/should_run/arr002.hs
index 67c5d82b86..56505d6437 100644
--- a/ghc/tests/array/should_run/arr002.hs
+++ b/ghc/tests/array/should_run/arr002.hs
@@ -1,4 +1,4 @@
---!!! Array creation, (index,value) list with duplicates.
+-- !!! Array creation, (index,value) list with duplicates.
 -- 
 -- Haskell library report 1.3 (and earlier) specifies
 -- that `array' values created with lists containing dups,
diff --git a/ghc/tests/array/should_run/arr003.hs b/ghc/tests/array/should_run/arr003.hs
index 06faa313d0..14a99214eb 100644
--- a/ghc/tests/array/should_run/arr003.hs
+++ b/ghc/tests/array/should_run/arr003.hs
@@ -1,4 +1,4 @@
---!!! Array creation, (index,value) list with out of bound index.
+-- !!! Array creation, (index,value) list with out of bound index.
 -- 
 -- Haskell library report 1.3 (and earlier) specifies
 -- that `array' values created with lists containing out-of-bounds indices,
diff --git a/ghc/tests/array/should_run/arr004.hs b/ghc/tests/array/should_run/arr004.hs
index f7537d6928..cc54395c27 100644
--- a/ghc/tests/array/should_run/arr004.hs
+++ b/ghc/tests/array/should_run/arr004.hs
@@ -1,4 +1,4 @@
---!!! Array - accessing undefined element
+-- !!! Array - accessing undefined element
 -- 
 -- Sample Haskell implementation in the 1.3 Lib report defines
 -- this as being undefined/error.
diff --git a/ghc/tests/array/should_run/arr005.hs b/ghc/tests/array/should_run/arr005.hs
index 84e4a76157..62ed12c72e 100644
--- a/ghc/tests/array/should_run/arr005.hs
+++ b/ghc/tests/array/should_run/arr005.hs
@@ -1,4 +1,4 @@
---!!! Array - recurrences
+-- !!! Array - recurrences
 -- 
 -- array does not evaluate the elements.
 --
diff --git a/ghc/tests/array/should_run/arr006.hs b/ghc/tests/array/should_run/arr006.hs
index ff2c561be0..8aa1ddd368 100644
--- a/ghc/tests/array/should_run/arr006.hs
+++ b/ghc/tests/array/should_run/arr006.hs
@@ -1,4 +1,4 @@
---!!! Array - empty arrays
+-- !!! Array - empty arrays
 -- 
 -- print a couple of them to try to expose empty arrays 
 -- to a GC or two.
diff --git a/ghc/tests/array/should_run/arr007.hs b/ghc/tests/array/should_run/arr007.hs
index 2a4d9aece8..ec0c98376c 100644
--- a/ghc/tests/array/should_run/arr007.hs
+++ b/ghc/tests/array/should_run/arr007.hs
@@ -1,4 +1,4 @@
---!!! Array - accessing empty arrays
+-- !!! Array - accessing empty arrays
 -- 
 -- empty arrays are legal, but indexing them is undefined!
 --
diff --git a/ghc/tests/array/should_run/arr008.hs b/ghc/tests/array/should_run/arr008.hs
index 6b07292759..30d79a6044 100644
--- a/ghc/tests/array/should_run/arr008.hs
+++ b/ghc/tests/array/should_run/arr008.hs
@@ -1,4 +1,4 @@
---!!! Array - out-of-range (index,value) pairs
+-- !!! Array - out-of-range (index,value) pairs
 -- 
 -- supplying a list containing one or more pairs 
 -- with out-of-range index is undefined.
diff --git a/ghc/tests/array/should_run/arr009.hs b/ghc/tests/array/should_run/arr009.hs
index ad9f0a6c27..b45e9e39a3 100644
--- a/ghc/tests/array/should_run/arr009.hs
+++ b/ghc/tests/array/should_run/arr009.hs
@@ -1,4 +1,4 @@
---!!! Array - derived ops
+-- !!! Array - derived ops
 -- 
 -- testing the well-behavedness of 
 -- derived ops for empty and non-empty arrays
diff --git a/ghc/tests/array/should_run/arr010.hs b/ghc/tests/array/should_run/arr010.hs
index ead7d65d25..94bf8f3fca 100644
--- a/ghc/tests/array/should_run/arr010.hs
+++ b/ghc/tests/array/should_run/arr010.hs
@@ -1,4 +1,4 @@
---!!! Array - accumulated arrays
+-- !!! Array - accumulated arrays
 -- 
 --
 module Main(main) where
diff --git a/ghc/tests/array/should_run/arr011.hs b/ghc/tests/array/should_run/arr011.hs
index fca26f9d50..f4a95d1910 100644
--- a/ghc/tests/array/should_run/arr011.hs
+++ b/ghc/tests/array/should_run/arr011.hs
@@ -1,4 +1,4 @@
---!!! Array - array difference operator
+-- !!! Array - array difference operator
 -- 
 --
 module Main(main) where
diff --git a/ghc/tests/array/should_run/arr012.hs b/ghc/tests/array/should_run/arr012.hs
index 98da45efd0..e0ed3a9d49 100644
--- a/ghc/tests/array/should_run/arr012.hs
+++ b/ghc/tests/array/should_run/arr012.hs
@@ -1,4 +1,4 @@
---!!! Array map operations
+-- !!! Array map operations
 -- 
 --
 module Main(main) where
diff --git a/ghc/tests/array/should_run/arr014.hs b/ghc/tests/array/should_run/arr014.hs
index 86996a10d1..7efb1b5aa3 100644
--- a/ghc/tests/array/should_run/arr014.hs
+++ b/ghc/tests/array/should_run/arr014.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -fglasgow-exts #-}
 
---!!! multi-dimensional arrays
+-- !!! multi-dimensional arrays
 
 module Main ( main ) where
 import GlaExts
diff --git a/ghc/tests/ccall/should_compile/cc001.hs b/ghc/tests/ccall/should_compile/cc001.hs
index 465a4332d5..2c93e8a50a 100644
--- a/ghc/tests/ccall/should_compile/cc001.hs
+++ b/ghc/tests/ccall/should_compile/cc001.hs
@@ -1,4 +1,4 @@
---!!! cc001 -- ccall with standard boxed arguments and results
+-- !!! cc001 -- ccall with standard boxed arguments and results
 
 module ShouldCompile where
 
diff --git a/ghc/tests/ccall/should_compile/cc002.hs b/ghc/tests/ccall/should_compile/cc002.hs
index d3ed1f15db..48880c6f87 100644
--- a/ghc/tests/ccall/should_compile/cc002.hs
+++ b/ghc/tests/ccall/should_compile/cc002.hs
@@ -1,4 +1,4 @@
---!!! cc002 -- ccall with ambiguous result (should be defaulted to ())
+-- !!! cc002 -- ccall with ambiguous result (should be defaulted to ())
 module ShouldCompile where
 
 a :: IO ()
diff --git a/ghc/tests/ccall/should_compile/cc003.hs b/ghc/tests/ccall/should_compile/cc003.hs
index a3dbf78b58..4ac4c824a2 100644
--- a/ghc/tests/ccall/should_compile/cc003.hs
+++ b/ghc/tests/ccall/should_compile/cc003.hs
@@ -1,5 +1,5 @@
---!!! cc003 -- ccall with unresolved polymorphism (should fail)
---!!! not anymore (as of 0.29, result type will default to ())
+-- !!! cc003 -- ccall with unresolved polymorphism (should fail)
+-- !!! not anymore (as of 0.29, result type will default to ())
 module ShouldCompile where
 
 fubar :: IO Int
diff --git a/ghc/tests/ccall/should_compile/cc006.hs b/ghc/tests/ccall/should_compile/cc006.hs
index 488491f916..374010792b 100644
--- a/ghc/tests/ccall/should_compile/cc006.hs
+++ b/ghc/tests/ccall/should_compile/cc006.hs
@@ -1,4 +1,4 @@
---!!! cc006 -- ccall with non-standard boxed arguments and results
+-- !!! cc006 -- ccall with non-standard boxed arguments and results
 
 module Test where
 
diff --git a/ghc/tests/ccall/should_fail/cc001.hs b/ghc/tests/ccall/should_fail/cc001.hs
index f0dd58c8ff..4019f61782 100644
--- a/ghc/tests/ccall/should_fail/cc001.hs
+++ b/ghc/tests/ccall/should_fail/cc001.hs
@@ -1,4 +1,4 @@
---!!! cc002 -- ccall with ambiguous argument
+-- !!! cc002 -- ccall with ambiguous argument
 module Test where
 
 f :: IO ()
diff --git a/ghc/tests/ccall/should_fail/cc002.hs b/ghc/tests/ccall/should_fail/cc002.hs
index 7dbbf7297e..36d6a77691 100644
--- a/ghc/tests/ccall/should_fail/cc002.hs
+++ b/ghc/tests/ccall/should_fail/cc002.hs
@@ -1,4 +1,4 @@
---!!! cc002 -- ccall with non-standard boxed arguments and results
+-- !!! cc002 -- ccall with non-standard boxed arguments and results
 
 module Test where
 
diff --git a/ghc/tests/ccall/should_fail/cc004.hs b/ghc/tests/ccall/should_fail/cc004.hs
index eded2ff65c..6f7207f979 100644
--- a/ghc/tests/ccall/should_fail/cc004.hs
+++ b/ghc/tests/ccall/should_fail/cc004.hs
@@ -1,4 +1,4 @@
---!!! cc004 -- ccall with synonyms, polymorphic type variables and user type variables.
+-- !!! cc004 -- ccall with synonyms, polymorphic type variables and user type variables.
 module Test where
 
 -- Since I messed up the handling of polymorphism originally, I'll
diff --git a/ghc/tests/deriving/should_compile/drv001.hs b/ghc/tests/deriving/should_compile/drv001.hs
index ffe8196c8f..694af6a50f 100644
--- a/ghc/tests/deriving/should_compile/drv001.hs
+++ b/ghc/tests/deriving/should_compile/drv001.hs
@@ -1,4 +1,4 @@
---!!! canonical weird example for "deriving"
+-- !!! canonical weird example for "deriving"
 module ShouldSucceed where
 
 data X a b
diff --git a/ghc/tests/deriving/should_compile/drv003.hs b/ghc/tests/deriving/should_compile/drv003.hs
index f6d678006a..0b8149ce8a 100644
--- a/ghc/tests/deriving/should_compile/drv003.hs
+++ b/ghc/tests/deriving/should_compile/drv003.hs
@@ -1,4 +1,4 @@
---!!! This is the example given in TcDeriv
+-- !!! This is the example given in TcDeriv
 --
 module ShouldSucceed where
 
diff --git a/ghc/tests/deriving/should_compile/drv004.hs b/ghc/tests/deriving/should_compile/drv004.hs
index 5c095ddeef..324a7f81d4 100644
--- a/ghc/tests/deriving/should_compile/drv004.hs
+++ b/ghc/tests/deriving/should_compile/drv004.hs
@@ -1,4 +1,4 @@
---!!! simple example of deriving Ord and Eq simultaneously
+-- !!! simple example of deriving Ord and Eq simultaneously
 --
 module ShouldSucceed where
 
diff --git a/ghc/tests/deriving/should_compile/drv005.hs b/ghc/tests/deriving/should_compile/drv005.hs
index 93d8b45e0e..527dde98b9 100644
--- a/ghc/tests/deriving/should_compile/drv005.hs
+++ b/ghc/tests/deriving/should_compile/drv005.hs
@@ -1,4 +1,4 @@
---!!! simple example of deriving Enum
+-- !!! simple example of deriving Enum
 --
 module ShouldSucceed where
 
diff --git a/ghc/tests/deriving/should_compile/drv006.hs b/ghc/tests/deriving/should_compile/drv006.hs
index b21d9f22fb..d2a88fd106 100644
--- a/ghc/tests/deriving/should_compile/drv006.hs
+++ b/ghc/tests/deriving/should_compile/drv006.hs
@@ -1,4 +1,4 @@
---!!! simple examples of deriving Ix
+-- !!! simple examples of deriving Ix
 --
 module ShouldSucceed where
 import Ix
diff --git a/ghc/tests/deriving/should_compile/drv007.hs b/ghc/tests/deriving/should_compile/drv007.hs
index feb7297156..22da5b4aa3 100644
--- a/ghc/tests/deriving/should_compile/drv007.hs
+++ b/ghc/tests/deriving/should_compile/drv007.hs
@@ -1,4 +1,4 @@
---!!! deriving Ord on d. type with a single nullary constructor.
+-- !!! deriving Ord on d. type with a single nullary constructor.
 -- (from ghc-2.10 panic - as reported by Sergey Mechveliani <mechvel@botik.ru>)
 --  
 module ShouldSucceed where
diff --git a/ghc/tests/deriving/should_compile/drv008.hs b/ghc/tests/deriving/should_compile/drv008.hs
index c06332e26e..c374193777 100644
--- a/ghc/tests/deriving/should_compile/drv008.hs
+++ b/ghc/tests/deriving/should_compile/drv008.hs
@@ -1,4 +1,4 @@
---!!! deriving Ix on d. type with nullary constructors
+-- !!! deriving Ix on d. type with nullary constructors
 module ShouldSucceed where
 
 import Ix
diff --git a/ghc/tests/deriving/should_compile/drv009.hs b/ghc/tests/deriving/should_compile/drv009.hs
index 4d192788ba..10e889e929 100644
--- a/ghc/tests/deriving/should_compile/drv009.hs
+++ b/ghc/tests/deriving/should_compile/drv009.hs
@@ -1,4 +1,4 @@
---!!! deriving Ix on d. type with one constructor
+-- !!! deriving Ix on d. type with one constructor
 module ShouldSucceed where
 
 import Ix
diff --git a/ghc/tests/deriving/should_compile/drv010.hs b/ghc/tests/deriving/should_compile/drv010.hs
index e681450799..1a3f9dc33a 100644
--- a/ghc/tests/deriving/should_compile/drv010.hs
+++ b/ghc/tests/deriving/should_compile/drv010.hs
@@ -1,4 +1,4 @@
---!!! deriving Enum on d. type with nullary constructors
+-- !!! deriving Enum on d. type with nullary constructors
 module ShouldSucceed where
 
 data AD = A | B | C | D deriving (Enum)
diff --git a/ghc/tests/deriving/should_fail/drvfail004.hs b/ghc/tests/deriving/should_fail/drvfail004.hs
index cbdd96f29c..6e090d8fe1 100644
--- a/ghc/tests/deriving/should_fail/drvfail004.hs
+++ b/ghc/tests/deriving/should_fail/drvfail004.hs
@@ -1,4 +1,4 @@
---!!! deriving Ord without deriving Eq
+-- !!! deriving Ord without deriving Eq
 --
 module ShouldFail where
 
diff --git a/ghc/tests/deriving/should_fail/drvfail007.hs b/ghc/tests/deriving/should_fail/drvfail007.hs
index 87efc246c9..74f9f033d3 100644
--- a/ghc/tests/deriving/should_fail/drvfail007.hs
+++ b/ghc/tests/deriving/should_fail/drvfail007.hs
@@ -1,4 +1,4 @@
---!!! buggy deriving with function type, reported by Sigbjorn Finne
+-- !!! buggy deriving with function type, reported by Sigbjorn Finne
 module ShouldFail where
 
 data Foo = Foo (Int -> Int) deriving Eq
diff --git a/ghc/tests/typecheck/should_run/tcrun004.hs b/ghc/tests/typecheck/should_run/tcrun004.hs
new file mode 100644
index 0000000000..d204758867
--- /dev/null
+++ b/ghc/tests/typecheck/should_run/tcrun004.hs
@@ -0,0 +1,72 @@
+-- Originally from Kevin Glynn
+-- Tests existential data types
+
+module Main where
+
+data Coordinate3D = Coord3D {cx, cy, cz::Double} 
+                    deriving (Eq, Show)
+
+-- We Represent a line by two coordinates which it passes through.
+data Line = MkLine Coordinate3D Coordinate3D 
+
+
+class PictureObject pot where
+
+      -- Returns ordered (rel to 0 0 0) of points where the object
+      -- intersects the given line. 
+      intersectLineObject :: pot -> Line -> [Coordinate3D]
+
+      getPictureName :: pot -> String
+
+data Sphere = 
+   Sphere Coordinate3D			-- Centre
+          Double			-- Radius
+	  Double			-- ambient coeff
+	  Double			-- diffuse coeff
+	  Double			-- specular coeff
+	  Double			-- phong specular exponent
+
+intersectLineSphere :: Sphere -> Line -> [Coordinate3D]
+intersectLineSphere sp line = []
+
+instance PictureObject Sphere where
+ 	 intersectLineObject = intersectLineSphere
+	 getPictureName _ = "Sphere"
+
+data Cube = 
+   Cube Coordinate3D		-- Origin corner 
+        Coordinate3D		-- Opposite corner
+	Double			-- ambient coeff
+	Double			-- diffuse coeff
+	Double			-- specular coeff
+	Double			-- phong specular exponent
+   deriving (Eq, Show)
+
+intersectLineCube :: Cube -> Line -> [Coordinate3D]
+intersectLineCube cube line = []
+
+instance PictureObject Cube where
+	 intersectLineObject = intersectLineCube
+	 getPictureName _ = "Cube"
+
+
+data GenPic = forall pot. (PictureObject pot) => MkGenPic pot
+
+sphere :: Sphere
+sphere = Sphere (Coord3D 1 1 1) 1 1 1 1 1
+
+cube :: Cube
+cube = Cube (Coord3D 1 1 1) (Coord3D 2 2 2) 1 1 1 1
+
+obj_list:: [GenPic] 
+obj_list = [MkGenPic sphere, MkGenPic cube]
+
+putName :: PictureObject pot => pot -> IO ()
+putName x = putStr $ getPictureName x
+
+
+main :: IO ()
+main = do { sequence $ map put_it obj_list }
+     where
+       put_it (MkGenPic s) = putStr (getPictureName s)
+