Commit ee0c2e8c authored by simonpj's avatar simonpj
Browse files

[project @ 2005-03-02 17:02:26 by simonpj]

Add another fundep test
parent 1636e98e
{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-undecidable-instances #-}
{-# OPTIONS -fallow-overlapping-instances #-}
--
-- Test case adopted from the HList library
-- http://www.cwi.nl/~ralf/HList/
--
module FakePrelude where
--
-- Type-level Booleans; nothing weird
--
data HTrue; hTrue :: HTrue; hTrue = undefined
data HFalse; hFalse :: HFalse; hFalse = undefined
class HBool x; instance HBool HTrue; instance HBool HFalse
instance Show HTrue where show _ = "HTrue"
instance Show HFalse where show _ = "HFalse"
--
-- Type-level type equality
--
class HBool b => TypeEq x y b | x y -> b
--
-- Value-level incarnation; nothing too weird.
-- Rely on lazy show for type-level Booleans
--
typeEq :: TypeEq t t' b => t -> t' -> b
typeEq = undefined
--
-- Type-level cast
--
class TypeCast x y | x -> y, y -> x
where
typeCast :: x -> y
{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-overlapping-instances #-}
{-# OPTIONS -fallow-undecidable-instances #-}
--
-- Test case adopted from the HList library
-- http://www.cwi.nl/~ralf/HList/
--
-- Tests functional dependencies and overlapping instances
module Main where
import FakePrelude
import TypeEq
import TypeCast
--
-- Let's test.
-- The following should print "(HTrue,HFalse)".
--
main = print $ ( typeEq "42" "88"
, typeEq "42" (42::Int)
)
TOP=../../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-undecidable-instances #-}
--
-- Test case adopted from the HList library
-- http://www.cwi.nl/~ralf/HList/
--
module TypeCast where
import FakePrelude
--
-- We are ready to reveal the definition of type cast.
--
instance TypeCast x x where typeCast = id
{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-overlapping-instances #-}
{-# OPTIONS -fallow-undecidable-instances #-}
--
-- Test case adopted from the HList library
-- http://www.cwi.nl/~ralf/HList/
--
module TypeEq where
import FakePrelude
--
-- Type-level type equality;
-- defined in terms of type-level cast
--
instance TypeEq x x HTrue
instance (HBool b, TypeCast HFalse b) => TypeEq x y b
--
-- NOTE! instance TypeEq x y HFalse -- would violate functional dependency
--
test('typecheck.testeq1', normal, multimod_compile_and_run, \
['Main', '-v0 -fglasgow-exts'])
clean(['Main.hi', 'Main.o', 'TypeCast.hi', 'TypeCast.o', 'FakePrelude.hi', 'FakePrelude.o', 'TypeEq.hi', 'TypeEq.o'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment