git.iko.soy/elk
on master help sign in
Get types lined up in canonicalization, ignoring effects for now
fe1e5d2Evan Czaplicki
src/AST/Module.hs+1−1
compare with master
unifiedsplit
@@ -125,7 +125,7 @@ data ImportMethod =
125
125
126data Info expr =
126data Info expr =
127 Info
127 Info
128− { docs :: Docs.Centralized
128+ { docs :: A.Located (Maybe Docs.Centralized)
129 , exports :: [Var.Value]
129 , exports :: [Var.Value]
130 , imports :: [Name.Raw]
130 , imports :: [Name.Raw]
131 , program :: expr
131 , program :: expr
src/Canonicalize.hs+82−97
@@ -8,7 +8,6 @@ import qualified Data.Traversable as T
8import qualified Data.Foldable as T
8import qualified Data.Foldable as T
9
9
10import AST.Expression.General (Expr'(..), dummyLet)
10import AST.Expression.General (Expr'(..), dummyLet)
11−import AST.Module (Body(..))
12import Elm.Utils ((|>))
11import Elm.Utils ((|>))
13
12
14import qualified AST.Declaration as D
13import qualified AST.Declaration as D
@@ -19,7 +18,6 @@ import qualified AST.Module.Name as ModuleName
19import qualified AST.Pattern as P
18import qualified AST.Pattern as P
20import qualified AST.Type as Type
19import qualified AST.Type as Type
21import qualified AST.Variable as Var
20import qualified AST.Variable as Var
22−import qualified Docs.AST as Docs
23import qualified Docs.Centralize as Docs
21import qualified Docs.Centralize as Docs
24import qualified Reporting.Annotation as A
22import qualified Reporting.Annotation as A
25import qualified Reporting.Error as Error
23import qualified Reporting.Error as Error
@@ -37,115 +35,105 @@ import qualified Canonicalize.Type as Canonicalize
37import qualified Canonicalize.Variable as Canonicalize
35import qualified Canonicalize.Variable as Canonicalize
38
36
39
37
38+
40-- MODULES
39-- MODULES
41
40
41+
42module'
42module'
43 :: [ModuleName.Canonical]
43 :: [ModuleName.Canonical]
44 -> Module.Interfaces
44 -> Module.Interfaces
45− -> Module.ValidModule
45+ -> Module.Valid
46− -> R.Result Warning.Warning Error.Error Module.CanonicalModule
46+ -> R.Result Warning.Warning Error.Error Module.Canonical
47module' canonicalImports interfaces modul =
47module' canonicalImports interfaces modul =
48 let
48 let
49+ (Module.Valid docs exports imports decls effects) =
50+ Module.info modul
51+
49 importDict =
52 importDict =
50 canonicalImports
53 canonicalImports
51 |> map (\cName -> (ModuleName._module cName, cName))
54 |> map (\cName -> (ModuleName._module cName, cName))
52 |> Map.fromList
55 |> Map.fromList
53
56
57+ canonicalDeclsResult =
58+ Setup.environment importDict interfaces modul
59+ `Result.andThen` \env -> (,) env <$> T.traverse (declaration env) decls
60+
54 (Result.Result uses rawResults) =
61 (Result.Result uses rawResults) =
55− moduleHelp importDict interfaces modul
62+ (,)
63+ <$> canonicalDeclsResult
64+ <*> resolveExports (concatMap declToValue decls) exports
56 in
65 in
57− case rawResults of
66+ case rawResults of
58− Result.Ok (env, almostCanonicalModule) ->
67+ Result.Err msgs ->
59− R.addDealiaser (Env.toDealiaser env) $
68+ R.throwMany (map (A.map Error.Canonicalize) msgs)
60− filterImports uses almostCanonicalModule
61
69
62− Result.Err msgs ->
70+ Result.Ok ((env, canonicalDecls), canonicalExports) ->
63− R.throwMany (map (A.map Error.Canonicalize) msgs)
71+ let
72+ nakedDecls =
73+ map A.drop canonicalDecls
64
74
75+ centralizedDocs =
76+ A.map (fmap (Docs.centralize canonicalDecls)) docs
65
77
66−type AlmostCanonicalModule =
78+ program =
67− Module.Module
79+ Sort.definitions (dummyLet (Decls.toExpr (Module.name modul) canonicalDecls))
68− Docs.Centralized
69− ([Module.DefaultImport], [Module.UserImport])
70− [Var.Value]
71− (Module.Body Canonical.Expr)
72
80
81+ fixities =
82+ [ (assoc,level,op) | D.Fixity assoc level op <- nakedDecls ]
73
83
74−moduleHelp
84+ aliases =
75− :: Map.Map ModuleName.Raw ModuleName.Canonical
85+ Map.fromList [ (name,(tvs,alias)) | D.Alias name tvs alias <- nakedDecls ]
76− -> Module.Interfaces
77− -> Module.ValidModule
78− -> Result.ResultErr (Env.Environment, AlmostCanonicalModule)
79−moduleHelp importDict interfaces modul@(Module.Module _ _ _ comment exports _ decls) =
80− canonicalModule
81− <$> canonicalDeclsResult
82− <*> resolveExports locals exports
83− where
84− canonicalModule (env, canonicalDecls) canonicalExports =
85− (,) env $
86− modul
87− { Module.docs = A.map (fmap (Docs.centralize canonicalDecls)) comment
88− , Module.exports = canonicalExports
89− , Module.body = body canonicalDecls
90− }
91−
92− locals :: [Var.Value]
93− locals =
94− concatMap declToValue decls
95
86
96− canonicalDeclsResult =
87+ unions =
97− Setup.environment importDict interfaces modul
88+ Map.fromList [ (name,(vars,ctors)) | D.Union name vars ctors <- nakedDecls ]
98− `Result.andThen` \env -> (,) env <$> T.traverse (declaration env) decls
99−
100− body :: [D.CanonicalDecl] -> Module.Body Canonical.Expr
101− body decls =
102− let nakedDecls = map A.drop decls
103 in
89 in
104− Module.Body
90+ R.addDealiaser (Env.toDealiaser env) $
105− { program =
91+ do canonicalImports <- filterImports uses imports
106− let expr = Decls.toExpr (Module.name modul) decls
92+ return $ modul {
107− in
93+ Module.info =
108− Sort.definitions (dummyLet expr)
94+ Module.Info
109−
95+ { Module.docs = centralizedDocs
110− , types =
96+ , Module.exports = canonicalExports
97+ , Module.imports = canonicalImports
98+ , Module.program = program
111− Map.empty
99+ , Module.types = Map.empty
112−
100+ , Module.fixities = fixities
113− , unions =
101+ , Module.aliases = aliases
114− Map.fromList [ (name,(vars,ctors)) | D.Datatype name vars ctors <- nakedDecls ]
102+ , Module.unions = unions
103+ , Module.effects = error "TODO"
104+ }
105+ }
115
106
116− , fixities =
117− [ (assoc,level,op) | D.Fixity assoc level op <- nakedDecls ]
118−
119− , aliases =
120− Map.fromList [ (name,(tvs,alias)) | D.TypeAlias name tvs alias <- nakedDecls ]
121− }
122
107
123
108
124-- IMPORTS
109-- IMPORTS
125
110
111+
126filterImports
112filterImports
127 :: Set.Set ModuleName.Raw
113 :: Set.Set ModuleName.Raw
128− -> AlmostCanonicalModule
114+ -> ([Module.DefaultImport], [Module.UserImport])
129− -> R.Result Warning.Warning e Module.CanonicalModule
115+ -> R.Result Warning.Warning e [ModuleName.Raw]
130−filterImports uses modul@(Module.Module _ _ _ _ _ (defaults, imports) _) =
116+filterImports uses (defaults, imports) =
131− do reducedImports <-
117+ let
132− Maybe.catMaybes <$> T.traverse checkImport imports
133−
134− return $ modul
135− { Module.imports =
136− Set.toList (Set.fromList (map fst defaults ++ reducedImports))
137− }
138− where
139 checkImport (A.A region (name, _method)) =
118 checkImport (A.A region (name, _method)) =
140 if Set.member name uses then
119 if Set.member name uses then
141− return (Just name)
120+ return (Just name)
121+
142 else
122 else
143− do R.warn region (Warning.UnusedImport name)
123+ do R.warn region (Warning.UnusedImport name)
144− return Nothing
124+ return Nothing
125+ in
126+ do reducedImports <-
127+ Maybe.catMaybes <$> T.traverse checkImport imports
128+
129+ return $
130+ Set.toList (Set.fromList (map fst defaults ++ reducedImports))
131+
145
132
146
133
147-- EXPORTS
134-- EXPORTS
148
135
136+
149resolveExports
137resolveExports
150 :: [Var.Value]
138 :: [Var.Value]
151 -> Var.Listing (A.Located Var.Value)
139 -> Var.Listing (A.Located Var.Value)
@@ -153,6 +141,7 @@ resolveExports
153resolveExports fullList (Var.Listing partialList open) =
141resolveExports fullList (Var.Listing partialList open) =
154 if open then
142 if open then
155 Result.ok fullList
143 Result.ok fullList
144+
156 else
145 else
157 let
146 let
158 (allValues, allAliases, allAdts) =
147 (allValues, allAliases, allAdts) =
@@ -259,8 +248,10 @@ allUnique statedExports =
259 T.traverse_ id (Map.mapWithKey isUnique locations)
248 T.traverse_ id (Map.mapWithKey isUnique locations)
260
249
261
250
251+
262-- GROUPING VALUES
252-- GROUPING VALUES
263
253
254+
264maybeUnzip3 :: [(Maybe a, Maybe b, Maybe c)] -> ([a],[b],[c])
255maybeUnzip3 :: [(Maybe a, Maybe b, Maybe c)] -> ([a],[b],[c])
265maybeUnzip3 tuples =
256maybeUnzip3 tuples =
266 let (as, bs, cs) = unzip3 tuples
257 let (as, bs, cs) = unzip3 tuples
@@ -304,16 +295,16 @@ splitLocatedValue (A.A region value) =
304
295
305-- DECLARATIONS
296-- DECLARATIONS
306
297
307−declToValue :: D.ValidDecl -> [Var.Value]
298+declToValue :: D.Valid -> [Var.Value]
308declToValue (A.A _ decl) =
299declToValue (A.A _ decl) =
309 case decl of
300 case decl of
310− D.Definition (Valid.Definition pattern _ _) ->
301+ D.Def (Valid.Definition pattern _ _) ->
311 map Var.Value (P.boundVarList pattern)
302 map Var.Value (P.boundVarList pattern)
312
303
313− D.Datatype name _tvs ctors ->
304+ D.Union name _tvs ctors ->
314 [ Var.Union name (Var.Listing (map fst ctors) False) ]
305 [ Var.Union name (Var.Listing (map fst ctors) False) ]
315
306
316− D.TypeAlias name _ tipe ->
307+ D.Alias name _ tipe ->
317 case tipe of
308 case tipe of
318 A.A _ (Type.RRecord _ Nothing) ->
309 A.A _ (Type.RRecord _ Nothing) ->
319 [ Var.Alias name, Var.Value name ]
310 [ Var.Alias name, Var.Value name ]
@@ -324,29 +315,26 @@ declToValue (A.A _ decl) =
324 _ -> []
315 _ -> []
325
316
326
317
327−declaration
328− :: Env.Environment
318+declaration :: Env.Environment -> D.Valid -> Result.ResultErr D.Canonical
329− -> D.ValidDecl
330− -> Result.ResultErr D.CanonicalDecl
331−declaration env (A.A ann@(region,_) decl) =
319+declaration env (A.A ann decl) =
332− A.A ann <$>
320+ A.A ann <$>
333 case decl of
321 case decl of
334− D.Definition (Valid.Definition pat expr typ) ->
322+ D.Def (Valid.Definition pat expr typ) ->
335− D.Definition <$> (
323+ D.Def <$> (
336 Canonical.Definition Canonical.dummyFacts
324 Canonical.Definition Canonical.dummyFacts
337 <$> pattern env pat
325 <$> pattern env pat
338 <*> expression env expr
326 <*> expression env expr
339 <*> T.traverse (regionType env) typ
327 <*> T.traverse (regionType env) typ
340 )
328 )
341
329
342− D.Datatype name tvars ctors ->
330+ D.Union name tvars ctors ->
343− D.Datatype name tvars <$> T.traverse canonicalize' ctors
331+ D.Union name tvars <$> T.traverse canonicalizeArgs ctors
344 where
332 where
345− canonicalize' (ctor,args) =
333+ canonicalizeArgs (ctor, args) =
346 (,) ctor <$> T.traverse (Canonicalize.tipe env) args
334 (,) ctor <$> T.traverse (Canonicalize.tipe env) args
347
335
348− D.TypeAlias name tvars expanded ->
336+ D.Alias name tvars expanded ->
349− D.TypeAlias name tvars
337+ D.Alias name tvars
350 <$> Canonicalize.tipe env expanded
338 <$> Canonicalize.tipe env expanded
351
339
352 D.Fixity assoc prec op ->
340 D.Fixity assoc prec op ->
@@ -442,10 +430,7 @@ expression env (A.A region validExpr) =
442 Result.ok (GLShader uid src tipe)
430 Result.ok (GLShader uid src tipe)
443
431
444
432
445−pattern
446− :: Env.Environment
433+pattern :: Env.Environment -> P.Raw -> Result.ResultErr P.Canonical
447− -> P.RawPattern
448− -> Result.ResultErr P.CanonicalPattern
449pattern env (A.A region ptrn) =
434pattern env (A.A region ptrn) =
450 A.A region <$>
435 A.A region <$>
451 case ptrn of
436 case ptrn of
src/Canonicalize/Setup.hs+1−1
@@ -32,7 +32,7 @@ environment
32 -> Result.ResultErr Env.Environment
32 -> Result.ResultErr Env.Environment
33environment importDict interfaces (Module.Module _ name _ info) =
33environment importDict interfaces (Module.Module _ name _ info) =
34 let
34 let
35− (Module.Valid _ _ (defaults, imports) decls _ _) =
35+ (Module.Valid _ _ (defaults, imports) decls _) =
36 info
36 info
37
37
38 allImports =
38 allImports =