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