ghc/tests/typecheck/should_run/tcrun004.hs

   1 -- Originally from Kevin Glynn
   2 -- Tests existential data types
   3
   4 module Main where
   5
   6 data Coordinate3D = Coord3D {cx, cy, cz::Double}
   7                     deriving (Eq, Show)
   8
   9 -- We Represent a line by two coordinates which it passes through.
  10 data Line = MkLine Coordinate3D Coordinate3D
  11
  12
  13 class PictureObject pot where
  14
  15       -- Returns ordered (rel to 0 0 0) of points where the object
  16       -- intersects the given line.
  17       intersectLineObject :: pot -> Line -> [Coordinate3D]
  18
  19       getPictureName :: pot -> String
  20
  21 data Sphere =
  22    Sphere Coordinate3D                  -- Centre
  23           Double                        -- Radius
  24           Double                        -- ambient coeff
  25           Double                        -- diffuse coeff
  26           Double                        -- specular coeff
  27           Double                        -- phong specular exponent
  28
  29 intersectLineSphere :: Sphere -> Line -> [Coordinate3D]
  30 intersectLineSphere sp line = []
  31
  32 instance PictureObject Sphere where
  33          intersectLineObject = intersectLineSphere
  34          getPictureName _ = "Sphere"
  35
  36 data Cube =
  37    Cube Coordinate3D            -- Origin corner
  38         Coordinate3D            -- Opposite corner
  39         Double                  -- ambient coeff
  40         Double                  -- diffuse coeff
  41         Double                  -- specular coeff
  42         Double                  -- phong specular exponent
  43    deriving (Eq, Show)
  44
  45 intersectLineCube :: Cube -> Line -> [Coordinate3D]
  46 intersectLineCube cube line = []
  47
  48 instance PictureObject Cube where
  49          intersectLineObject = intersectLineCube
  50          getPictureName _ = "Cube"
  51
  52
  53 data GenPic = forall pot. (PictureObject pot) => MkGenPic pot
  54
  55 sphere :: Sphere
  56 sphere = Sphere (Coord3D 1 1 1) 1 1 1 1 1
  57
  58 cube :: Cube
  59 cube = Cube (Coord3D 1 1 1) (Coord3D 2 2 2) 1 1 1 1
  60
  61 obj_list:: [GenPic]
  62 obj_list = [MkGenPic sphere, MkGenPic cube]
  63
  64 putName :: PictureObject pot => pot -> IO ()
  65 putName x = putStr $ getPictureName x
  66
  67
  68 main :: IO ()
  69 main = do { sequence $ map put_it obj_list }
  70      where
  71        put_it (MkGenPic s) = putStr (getPictureName s)
  72