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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
module Library.TypeVar (
Number,
Name(..),
TypeOp(..),
Type(..),
Const(..),
Var(..),
mkEqualsType,
typeFunc,
typeBool,
typeVarsInType,
isTypeVar,
typeVarSub
) where
import Data.List
import Data.Maybe
import qualified Data.Set as Set
import Data.Map( Map, (!) )
import qualified Data.Map as Map
type Number = Int
data Name = Name { nameSpace :: [String]
, nameId :: String } deriving (Eq, Ord)
data TypeOp = TypeOp { tyOp :: Name } deriving (Eq, Ord)
data Type = TypeVar { typeVar :: Name }
| AType { aType :: [Type]
, aTypeOp :: TypeOp } deriving (Eq, Ord)
data Const = Const { constName :: Name } deriving (Eq, Ord)
data Var = Var { varName :: Name
, varTy :: Type } deriving (Eq, Ord)
instance Show Name where
show a = intercalate "." (nameSpace a ++ [nameId a])
instance Show TypeOp where
show a = "typeOp " ++ (show $ tyOp a)
instance Show Type where
show (TypeVar tyVar) = "V " ++ (show tyVar)
show (AType [] (TypeOp (Name [] "bool"))) = "bool"
show (AType [d,r] (TypeOp (Name [] "->"))) = "(" ++ show d ++ " -> " ++ show r ++ ")"
show (AType list typeOp) = "type " ++ (show $ tyOp typeOp) ++ " " ++ (show list)
instance Show Const where
show (Const a) = show a
instance Show Var where
show (Var a _) = show a
mkEqualsType :: Type -> Type
mkEqualsType ty = typeFunc ty (typeFunc ty typeBool)
typeFunc :: Type -> Type -> Type
typeFunc ty1 ty2 = AType [ty1,ty2] (TypeOp (Name [] "->"))
typeBool :: Type
typeBool = AType [] (TypeOp (Name [] "bool"))
typeVarsInType :: Type -> Set.Set Type
typeVarsInType (TypeVar t) = Set.singleton (TypeVar t)
typeVarsInType (AType list _) = Set.unions . (map typeVarsInType) $ list
isTypeVar :: Type -> Bool
isTypeVar (TypeVar _) = True
isTypeVar _ = False
typeVarSub :: Map Name Type -> Type -> Type
typeVarSub m (TypeVar a) =
if (Map.member a m)
then fromJust (Map.lookup a m)
else TypeVar a
typeVarSub m (AType list op) =
AType (map (typeVarSub m) list) op
|
