ghc/tests/typecheck/should_run/tcrun004.hs

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