SaplStruct.icl 3.1 KB
Newer Older
1
2
3
implementation module Sapl.SaplStruct

import StdEnv
4
import Data.Error, Data.Maybe
5
import Sapl.SaplTokenizer
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
ltVarByName :: !SaplVar !SaplVar -> Bool
ltVarByName a b = unpackVar a < unpackVar b

eqVarByName :: !SaplVar !SaplVar -> Bool
eqVarByName a b = unpackVar a == unpackVar b

eqVarByNameLevel :: !SaplVar !SaplVar -> Bool
eqVarByNameLevel a b = unpackVar a == unpackVar b && unpackLevel a == unpackLevel b

ltVarByNameLevel :: !SaplVar !SaplVar -> Bool
ltVarByNameLevel a b = unpackVar a < unpackVar b || (unpackVar a == unpackVar b && unpackLevel a < unpackLevel b)

unpackLevel (NormalVar _ level) = level 
unpackLevel (StrictVar _ level) = level
21

22
instance toString SaplVar
23
where
24
25
26
27
	toString (NormalVar name 0) = name
	toString (NormalVar name level) = name +++ "_" +++ toString level
	toString (StrictVar name 0) = "!" +++ name
	toString (StrictVar name level) = "!" +++ name +++ "_" +++ toString level
28

29
30
removeTypeInfo :: !SaplTypedVar -> SaplVar
removeTypeInfo (TypedVar var _) = var
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
instance eqStrictVar SaplVar
where
	eqStrictVar :: !String !SaplVar -> Bool
	eqStrictVar name1 (StrictVar name2 _) = name1 == name2 
	eqStrictVar _ _ = False

instance eqStrictVar SaplTypedVar
where
	eqStrictVar :: !String !SaplTypedVar -> Bool
	eqStrictVar name (TypedVar var _) = eqStrictVar name var

instance isStrictVar SaplVar
where
	isStrictVar :: !SaplVar -> Bool
	isStrictVar (StrictVar _ _) = True
	isStrictVar _ = False

instance isStrictVar SaplTypedVar
where
	isStrictVar :: !SaplTypedVar -> Bool
	isStrictVar (TypedVar var _) = isStrictVar var

instance toNormalVar SaplVar
where
	toNormalVar :: !SaplVar -> SaplVar
	toNormalVar (StrictVar name level) = (NormalVar name level)
	toNormalVar v = v

instance toNormalVar SaplTypedVar
where
	toNormalVar :: !SaplTypedVar -> SaplTypedVar
	toNormalVar (TypedVar var type) = TypedVar (toNormalVar var) type

instance toStrictVar SaplVar
where
	toStrictVar :: !SaplVar -> SaplVar
	toStrictVar (NormalVar name level) = (StrictVar name level)
	toStrictVar v = v
70

71
72
73
74
instance toStrictVar SaplTypedVar
where
	toStrictVar :: !SaplTypedVar -> SaplTypedVar
	toStrictVar (TypedVar var type) = TypedVar (toStrictVar var) type
75

76
77
78
79
80
instance unpackVar SaplVar
where
	unpackVar :: !SaplVar -> String
	unpackVar (NormalVar name _) = name
	unpackVar (StrictVar name _) = name
81

82
83
84
85
instance unpackVar SaplTypedVar
where
	unpackVar :: !SaplTypedVar -> String
	unpackVar (TypedVar var _) = unpackVar var
86

87
88
unpackBindVar :: !SaplLetDef -> SaplTypedVar
unpackBindVar (SaplLetDef typedVar _) = typedVar
89

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
90
91
92
unpackBindExpr :: !SaplLetDef -> SaplTerm
unpackBindExpr (SaplLetDef _ expr) = expr

93
94
95
96
unpackConsName :: !SaplPattern -> Maybe String
unpackConsName (PCons cons _) = Just cons
unpackConsName _ = Nothing

97
toStrictBind :: !SaplLetDef -> SaplLetDef
98
toStrictBind (SaplLetDef (TypedVar var type) body) = SaplLetDef (TypedVar (toStrictVar var) type) body
99

100
101
102
103
isConsPattern :: !SaplPattern -> Bool
isConsPattern (PCons _ _) = True
isConsPattern _ = False

104
105
106
isDefaultPattern :: !SaplPattern -> Bool
isDefaultPattern PDefault = True
isDefaultPattern _ = False