blob: b498ed422074bda2c987240ad51538169ba98ef8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
FlexibleInstances #-}
-- !!! Functional dependencies
-- This one made the 5.00.1 typechecker go into an infinite loop.
-- The context simplifier keep thinking it was doing an 'improve'
-- step, and hence kept going round and round.
module Main where
main = print (get ((AttributeLeaf (MyLabel "x") 4)::Env1) (MyLabel "x"))
class Eq l => Domain d l | d -> l where
(<<) :: d -> d -> d
empty :: d
class Domain e l => Environment e l t | e -> l t where
get :: e -> l -> Maybe t
attribute :: l -> t -> e
class Eq' a where
(=?=) :: a -> a -> Bool
newtype MyLabel = MyLabel String deriving Eq
instance Eq' MyLabel where
l =?= l' = l == l'
data BinTreeEnv l t =
EmptyEnv |
AttributeLeaf l t |
Union (BinTreeEnv l t) (BinTreeEnv l t)
instance (Eq l, Eq' l) => Domain (BinTreeEnv l t) l where
EmptyEnv << d = d
d << EmptyEnv = d
d << d' = Union d d'
empty = EmptyEnv
instance (Eq l, Eq' l) => Environment (BinTreeEnv l t) l t where
get EmptyEnv l = Nothing
get (AttributeLeaf l t) l' = if l =?= l' then Just t
else Nothing
get (Union d d') l = error "!??"
attribute l t = AttributeLeaf l t
type Env1 = BinTreeEnv MyLabel Integer
|
