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
|
module FlatCurry.FlexRigid(FlexRigidResult(..),getFlexRigid) where
import FlatCurry.Types
data FlexRigidResult = UnknownFR | ConflictFR | KnownFlex | KnownRigid
getFlexRigid :: Expr -> FlexRigidResult
getFlexRigid (Var _) = UnknownFR
getFlexRigid (Lit _) = UnknownFR
getFlexRigid (Comb _ _ args) =
foldr joinCaseTypes UnknownFR (map getFlexRigid args)
getFlexRigid (Let _ e) = getFlexRigid e
getFlexRigid (Free _ e) = getFlexRigid e
getFlexRigid (Or e1 e2) =
joinCaseTypes (getFlexRigid e1) (getFlexRigid e2)
getFlexRigid (Case ctype e bs) =
foldr joinCaseTypes (if ctype==Flex then KnownFlex else KnownRigid)
(map getFlexRigid (e : map (\(Branch _ be)->be) bs))
getFlexRigid (Typed e _) = getFlexRigid e
joinCaseTypes ConflictFR ConflictFR = ConflictFR
joinCaseTypes ConflictFR UnknownFR = ConflictFR
joinCaseTypes ConflictFR KnownFlex = ConflictFR
joinCaseTypes ConflictFR KnownRigid = ConflictFR
joinCaseTypes UnknownFR ConflictFR = ConflictFR
joinCaseTypes KnownFlex ConflictFR = ConflictFR
joinCaseTypes KnownRigid ConflictFR = ConflictFR
joinCaseTypes UnknownFR UnknownFR = UnknownFR
joinCaseTypes UnknownFR KnownFlex = KnownFlex
joinCaseTypes UnknownFR KnownRigid = KnownRigid
joinCaseTypes KnownFlex UnknownFR = KnownFlex
joinCaseTypes KnownFlex KnownFlex = KnownFlex
joinCaseTypes KnownFlex KnownRigid = ConflictFR
joinCaseTypes KnownRigid UnknownFR = KnownRigid
joinCaseTypes KnownRigid KnownFlex = ConflictFR
joinCaseTypes KnownRigid KnownRigid = KnownRigid
|