GeneralTerms.hs 2.68 KB
Newer Older
marton bognar's avatar
marton bognar committed
1
2
{-# OPTIONS_GHC -Wall #-}

marton bognar's avatar
marton bognar committed
3
module GeneralTerms where
Belpaire's avatar
Belpaire committed
4

marton bognar's avatar
marton bognar committed
5
6
7
type FoldName         = String
type ConstructorName  = String
type SortName         = String
8
type NamespaceName    = String
marton bognar's avatar
marton bognar committed
9
type IdenName         = String
marton bognar's avatar
marton bognar committed
10
11
type HaskellTypeName  = String
type InstanceName     = String
Belpaire's avatar
Belpaire committed
12

marton bognar's avatar
marton bognar committed
13
-- | Definition of an inherited or a synthesized context
marton bognar's avatar
marton bognar committed
14
data Context
marton bognar's avatar
marton bognar committed
15
16
  = INH { xinst :: InstanceName, xnamespace :: NamespaceName }
  | SYN { xinst :: InstanceName, xnamespace :: NamespaceName }
Belpaire's avatar
Belpaire committed
17
18
  deriving (Show, Eq)

marton bognar's avatar
marton bognar committed
19
-- | The left side of an attribute definition
Belpaire's avatar
Belpaire committed
20
data LeftExpr
21
  = LeftLHS { linst :: InstanceName }
marton bognar's avatar
marton bognar committed
22
  | LeftSub { _liden :: IdenName, linst :: InstanceName }
Belpaire's avatar
Belpaire committed
23
24
  deriving (Show, Eq)

marton bognar's avatar
marton bognar committed
25
26
-- | Returns the identifier on the left side of the attribute definition
-- or an empty string if it is a LHS definition
marton bognar's avatar
marton bognar committed
27
liden :: LeftExpr -> IdenName
28
liden left@LeftSub{} = _liden left
marton bognar's avatar
marton bognar committed
29
30
liden _                = ""

marton bognar's avatar
marton bognar committed
31
-- | The right side of an attribute definition
Belpaire's avatar
Belpaire committed
32
data RightExpr
33
34
35
  = RightLHS { rinst :: InstanceName }
  | RightSub { riden :: IdenName, rinst :: InstanceName }
  | RightAdd { rexp :: RightExpr, riden :: IdenName }
Belpaire's avatar
Belpaire committed
36
37
  deriving (Show, Eq)

marton bognar's avatar
marton bognar committed
38
-- | Attribute definition (e.g. t1.ctx = lhs.ctx, T)
39
type AttributeDef = (LeftExpr, RightExpr)
Belpaire's avatar
Belpaire committed
40

marton bognar's avatar
marton bognar committed
41
-- | Namespace declaration
42
data NamespaceDef
marton bognar's avatar
marton bognar committed
43
44
  = MkNameSpace {
    nname :: NamespaceName,
45
    nsort :: SortName
marton bognar's avatar
marton bognar committed
46
  }
Belpaire's avatar
Belpaire committed
47
48
  deriving (Show, Eq)

marton bognar's avatar
marton bognar committed
49
-- | Sort declaration
marton bognar's avatar
marton bognar committed
50
data SortDef
marton bognar's avatar
marton bognar committed
51
52
53
54
55
56
  = MkDefSort {
    sname :: SortName,
    sctxs :: [Context],
    sctors :: [ConstructorDef],
    srewrite :: Bool
  }
Belpaire's avatar
Belpaire committed
57
58
  deriving (Show, Eq)

marton bognar's avatar
marton bognar committed
59
-- | Constructor declaration
Belpaire's avatar
Belpaire committed
60
data ConstructorDef
marton bognar's avatar
marton bognar committed
61
62
63
64
65
66
67
68
69
70
71
72
73
  = MkDefConstructor {
    cname :: ConstructorName,
    clists :: [(IdenName, SortName)],
    csorts :: [(IdenName, SortName)],
    cfolds :: [(IdenName, SortName, FoldName)],
    cattrs :: [AttributeDef],
    cnatives :: [HaskellTypeName]
  }
  | MkBindConstructor {
    cname :: ConstructorName,
    clists :: [(IdenName, SortName)],
    csorts :: [(IdenName, SortName)],
    cfolds :: [(IdenName, SortName, FoldName)],
marton bognar's avatar
marton bognar committed
74
    _cbinder :: (IdenName, NamespaceName),
marton bognar's avatar
marton bognar committed
75
76
77
78
79
80
81
    cattrs :: [AttributeDef],
    cnatives :: [HaskellTypeName]
  }
  | MkVarConstructor {
    cname :: ConstructorName,
    cinst :: InstanceName
  }
Belpaire's avatar
Belpaire committed
82
83
  deriving (Show, Eq)

marton bognar's avatar
marton bognar committed
84
85
-- | Returns the binder of a constructor or Nothing if it is not a bind
-- constructor
marton bognar's avatar
marton bognar committed
86
87
88
cbinder :: ConstructorDef -> Maybe (IdenName, NamespaceName)
cbinder ctor@MkBindConstructor{} = Just (_cbinder ctor)
cbinder _                        = Nothing
89

marton bognar's avatar
marton bognar committed
90
91
92
93
94
-- | Returns whether the given constructor has a binder
isBind :: ConstructorDef -> Bool
isBind MkBindConstructor{} = True
isBind _                   = False

marton bognar's avatar
marton bognar committed
95
-- | Complete definition of a language
marton bognar's avatar
marton bognar committed
96
type Language = ([NamespaceDef], [SortDef], [(String, [String])], [String])