git.iko.soy/elk
on b5df201 help sign in
elk/src/Type/Error.hs
157 lines 3.0 kB history raw
1module Type.Error
2 ( Type(..)
3 , Extension(..)
4 , iteratedDealias
5 , Localizer
6 )
7 where
10import qualified Data.Map as Map
12import qualified AST.Module.Name as ModuleName
13import qualified Elm.Name as N
17-- ERROR TYPES
20data Type
21 = Lambda Type Type [Type]
22 | Infinite
23 | Error
24 | FlexVar N.Name
25 | FlexSuper N.Name
26 | RigidVar N.Name
27 | RigidSuper N.Name
28 | Type ModuleName.Canonical N.Name [Type]
29 | Record (Map.Map N.Name Type) Extension
30 | Unit
31 | Tuple Type Type (Maybe Type)
32 | Alias ModuleName.Canonical N.Name [(N.Name, Type)] Type
35data Extension
36 = Closed
37 | FlexOpen N.Name
38 | RigidOpen N.Name
41iteratedDealias :: Type -> Type
42iteratedDealias tipe =
43 case tipe of
44 Alias _ _ _ realType ->
45 iteratedDealias realType
47 _ ->
48 tipe
52-- LOCALIZE
55type Localizer = Map.Map N.Name ()
60{-- DIFF
63data Diff
64 = TooFewArgs
65 |
70-- DETECT MISSING ARGS
73detectMissingArgs :: Type -> Type -> Maybe (Type, [Type])
74detectMissingArgs actual expected =
75 detectMissingArgsHelp (reverseArgs actual) (reverseArgs expected)
78detectMissingArgsHelp :: [Type] -> [Type] -> Maybe (Type, [Type])
79detectMissingArgsHelp actuals expecteds =
80 case (actuals, expecteds) of
81 (x:xs, y:ys) -> if isMatchy x y then detectMissingArgsHelp xs ys else Nothing
82 (x:xs, []) -> Just (x, xs)
83 ([], []) -> Nothing
84 ([], _:_) -> Nothing
87reverseArgs :: Type -> [Type]
88reverseArgs tipe =
89 case tipe of
90 Lambda a b cs -> reverse (a:b:cs)
91 Infinite -> [tipe]
92 Error -> [tipe]
93 FlexVar _ -> [tipe]
94 FlexSuper _ -> [tipe]
95 RigidVar _ -> [tipe]
96 RigidSuper _ -> [tipe]
97 Type _ _ _ -> [tipe]
98 Record _ _ -> [tipe]
99 Unit -> [tipe]
100 Tuple _ _ _ -> [tipe]
101 Alias _ _ _ t -> reverseArgs t
104isMatchy :: Type -> Type -> Bool
105isMatchy t1 t2 =
106 case (t1, t2) of
107 (Lambda a b cs, Lambda x y zs) ->
108 isMatchy a x && isMatchy b y && length cs == length zs && and (zipWith isMatchy cs zs)
110 (Infinite, Infinite) ->
111 True
113 (Error, Error) ->
114 True
116 (FlexVar _, _) ->
117 True
119 (_, FlexVar _) ->
120 True
122 (FlexSuper x, FlexSuper y) ->
123 x == y
125 (RigidVar x, RigidVar y) ->
126 x == y
128 (RigidSuper x, RigidSuper y) ->
129 x == y
131 (Type home1 name1 args1, Type home2 name2 args2) ->
132 home1 == home2 && name1 == name2 && and (zipWith isMatchy args1 args2)
134 (Record fields1 ext1, Record fields2 ext2) ->
135 isMatchRecord
136 (Map.size (Map.difference fields1 fields2))
137 (Map.intersectionWith isMatchy fields1 fields2)
138 (Map.size (Map.difference fields2 fields1))
140 (Unit, Unit) ->
141 True
143 (Tuple a b Nothing, Tuple x y Nothing) ->
144 isMatchy a x && isMatchy b y
146 (Tuple a b (Just c), Tuple x y (Just z)) ->
147 isMatchy a x && isMatchy b y && isMatchy c z
149 (Alias _ _ _ alias1, tipe2) ->
150 isMatchy alias1 tipe2
152 (tipe1, Alias _ _ _ alias2) ->
153 isMatchy tipe1 alias2
155 (_, _) ->
156 False
157-}