git.iko.soy/elk
on master help sign in
Switch Optimize/ over to Data.Name
36b505fEvan Czaplicki
compiler/src/Optimize/Case.hs+2−2
compare with master
unifiedsplit
@@ -9,10 +9,10 @@ import Control.Arrow (second)
9import qualified Data.Map as Map
9import qualified Data.Map as Map
10import Data.Map ((!))
10import Data.Map ((!))
11import qualified Data.Maybe as Maybe
11import qualified Data.Maybe as Maybe
12+import qualified Data.Name as Name
12
13
13import qualified AST.Canonical as Can
14import qualified AST.Canonical as Can
14import qualified AST.Optimized as Opt
15import qualified AST.Optimized as Opt
15−import qualified Elm.Name as N
16import qualified Optimize.DecisionTree as DT
16import qualified Optimize.DecisionTree as DT
17
17
18
18
@@ -20,7 +20,7 @@ import qualified Optimize.DecisionTree as DT
20-- OPTIMIZE A CASE EXPRESSION
20-- OPTIMIZE A CASE EXPRESSION
21
21
22
22
23−optimize :: N.Name -> N.Name -> [(Can.Pattern, Opt.Expr)] -> Opt.Expr
23+optimize :: Name.Name -> Name.Name -> [(Can.Pattern, Opt.Expr)] -> Opt.Expr
24optimize temp root optBranches =
24optimize temp root optBranches =
25 let
25 let
26 (patterns, indexedBranches) =
26 (patterns, indexedBranches) =
compiler/src/Optimize/DecisionTree.hs+2−2
@@ -25,13 +25,13 @@ import Control.Monad (liftM, liftM2, liftM5)
25import Data.Binary
25import Data.Binary
26import qualified Data.List as List
26import qualified Data.List as List
27import qualified Data.Maybe as Maybe
27import qualified Data.Maybe as Maybe
28+import qualified Data.Name as Name
28import qualified Data.Set as Set
29import qualified Data.Set as Set
29import Data.Utf8 (Utf8)
30import Data.Utf8 (Utf8)
30
31
31import qualified AST.Canonical as Can
32import qualified AST.Canonical as Can
32import qualified AST.Module.Name as ModuleName
33import qualified AST.Module.Name as ModuleName
33import qualified Data.Index as Index
34import qualified Data.Index as Index
34−import qualified Elm.Name as N
35import qualified Reporting.Annotation as A
35import qualified Reporting.Annotation as A
36
36
37
37
@@ -72,7 +72,7 @@ data DecisionTree
72
72
73
73
74data Test
74data Test
75− = IsCtor ModuleName.Canonical N.Name Index.ZeroBased Int Can.CtorOpts
75+ = IsCtor ModuleName.Canonical Name.Name Index.ZeroBased Int Can.CtorOpts
76 | IsCons
76 | IsCons
77 | IsNil
77 | IsNil
78 | IsTuple
78 | IsTuple
compiler/src/Optimize/Expression.hs+14−14
@@ -11,6 +11,7 @@ module Optimize.Expression
11import Prelude hiding (cycle)
11import Prelude hiding (cycle)
12import Control.Monad (foldM)
12import Control.Monad (foldM)
13import qualified Data.Map as Map
13import qualified Data.Map as Map
14+import qualified Data.Name as Name
14import qualified Data.Set as Set
15import qualified Data.Set as Set
15
16
16import qualified AST.Canonical as Can
17import qualified AST.Canonical as Can
@@ -18,7 +19,6 @@ import qualified AST.Optimized as Opt
18import qualified AST.Module.Name as ModuleName
19import qualified AST.Module.Name as ModuleName
19import qualified AST.Utils.Shader as Shader
20import qualified AST.Utils.Shader as Shader
20import qualified Data.Index as Index
21import qualified Data.Index as Index
21−import qualified Elm.Name as N
22import qualified Optimize.Case as Case
22import qualified Optimize.Case as Case
23import qualified Optimize.Names as Names
23import qualified Optimize.Names as Names
24import qualified Reporting.Annotation as A
24import qualified Reporting.Annotation as A
@@ -29,7 +29,7 @@ import qualified Reporting.Annotation as A
29
29
30
30
31type Cycle =
31type Cycle =
32− Set.Set N.Name
32+ Set.Set Name.Name
33
33
34
34
35optimize :: Cycle -> Can.Expr -> Names.Tracker Opt.Expr
35optimize :: Cycle -> Can.Expr -> Names.Tracker Opt.Expr
@@ -60,7 +60,7 @@ optimize cycle (A.At region expression) =
60 Names.registerGlobal home name
60 Names.registerGlobal home name
61
61
62 Can.Chr chr ->
62 Can.Chr chr ->
63− Names.registerKernel N.utils (Opt.Chr chr)
63+ Names.registerKernel Name.utils (Opt.Chr chr)
64
64
65 Can.Str str ->
65 Can.Str str ->
66 pure (Opt.Str str)
66 pure (Opt.Str str)
@@ -72,11 +72,11 @@ optimize cycle (A.At region expression) =
72 pure (Opt.Float float)
72 pure (Opt.Float float)
73
73
74 Can.List entries ->
74 Can.List entries ->
75− Names.registerKernel N.list Opt.List
75+ Names.registerKernel Name.list Opt.List
76 <*> traverse (optimize cycle) entries
76 <*> traverse (optimize cycle) entries
77
77
78 Can.Negate expr ->
78 Can.Negate expr ->
79− do func <- Names.registerGlobal ModuleName.basics N.negate
79+ do func <- Names.registerGlobal ModuleName.basics Name.negate
80 arg <- optimize cycle expr
80 arg <- optimize cycle expr
81 pure $ Opt.Call func [arg]
81 pure $ Opt.Call func [arg]
82
82
@@ -162,10 +162,10 @@ optimize cycle (A.At region expression) =
162 <*> traverse (optimize cycle) fields
162 <*> traverse (optimize cycle) fields
163
163
164 Can.Unit ->
164 Can.Unit ->
165− Names.registerKernel N.utils Opt.Unit
165+ Names.registerKernel Name.utils Opt.Unit
166
166
167 Can.Tuple a b maybeC ->
167 Can.Tuple a b maybeC ->
168− Names.registerKernel N.utils Opt.Tuple
168+ Names.registerKernel Name.utils Opt.Tuple
169 <*> optimize cycle a
169 <*> optimize cycle a
170 <*> optimize cycle b
170 <*> optimize cycle b
171 <*> traverse (optimize cycle) maybeC
171 <*> traverse (optimize cycle) maybeC
@@ -197,7 +197,7 @@ optimizeDef cycle def body =
197 optimizeDefHelp cycle name (map fst typedArgs) expr body
197 optimizeDefHelp cycle name (map fst typedArgs) expr body
198
198
199
199
200−optimizeDefHelp :: Cycle -> N.Name -> [Can.Pattern] -> Can.Expr -> Opt.Expr -> Names.Tracker Opt.Expr
200+optimizeDefHelp :: Cycle -> Name.Name -> [Can.Pattern] -> Can.Expr -> Opt.Expr -> Names.Tracker Opt.Expr
201optimizeDefHelp cycle name args expr body =
201optimizeDefHelp cycle name args expr body =
202 do oexpr <- optimize cycle expr
202 do oexpr <- optimize cycle expr
203 case args of
203 case args of
@@ -214,18 +214,18 @@ optimizeDefHelp cycle name args expr body =
214-- DESTRUCTURING
214-- DESTRUCTURING
215
215
216
216
217−destructArgs :: [Can.Pattern] -> Names.Tracker ([N.Name], [Opt.Destructor])
217+destructArgs :: [Can.Pattern] -> Names.Tracker ([Name.Name], [Opt.Destructor])
218destructArgs args =
218destructArgs args =
219 do (argNames, destructorLists) <- unzip <$> traverse destruct args
219 do (argNames, destructorLists) <- unzip <$> traverse destruct args
220 return (argNames, concat destructorLists)
220 return (argNames, concat destructorLists)
221
221
222
222
223−destructCase :: N.Name -> Can.Pattern -> Names.Tracker [Opt.Destructor]
223+destructCase :: Name.Name -> Can.Pattern -> Names.Tracker [Opt.Destructor]
224destructCase rootName pattern =
224destructCase rootName pattern =
225 reverse <$> destructHelp (Opt.Root rootName) pattern []
225 reverse <$> destructHelp (Opt.Root rootName) pattern []
226
226
227
227
228−destruct :: Can.Pattern -> Names.Tracker (N.Name, [Opt.Destructor])
228+destruct :: Can.Pattern -> Names.Tracker (Name.Name, [Opt.Destructor])
229destruct pattern@(A.At _ ptrn) =
229destruct pattern@(A.At _ ptrn) =
230 case ptrn of
230 case ptrn of
231 Can.PVar name ->
231 Can.PVar name ->
@@ -353,14 +353,14 @@ optimizePotentialTailCallDef cycle def =
353 optimizePotentialTailCall cycle name (map fst typedArgs) expr
353 optimizePotentialTailCall cycle name (map fst typedArgs) expr
354
354
355
355
356−optimizePotentialTailCall :: Cycle -> N.Name -> [Can.Pattern] -> Can.Expr -> Names.Tracker Opt.Def
356+optimizePotentialTailCall :: Cycle -> Name.Name -> [Can.Pattern] -> Can.Expr -> Names.Tracker Opt.Def
357optimizePotentialTailCall cycle name args expr =
357optimizePotentialTailCall cycle name args expr =
358 do (argNames, destructors) <- destructArgs args
358 do (argNames, destructors) <- destructArgs args
359 toTailDef name argNames destructors <$>
359 toTailDef name argNames destructors <$>
360 optimizeTail cycle name argNames expr
360 optimizeTail cycle name argNames expr
361
361
362
362
363−optimizeTail :: Cycle -> N.Name -> [N.Name] -> Can.Expr -> Names.Tracker Opt.Expr
363+optimizeTail :: Cycle -> Name.Name -> [Name.Name] -> Can.Expr -> Names.Tracker Opt.Expr
364optimizeTail cycle rootName argNames locExpr@(A.At _ expression) =
364optimizeTail cycle rootName argNames locExpr@(A.At _ expression) =
365 case expression of
365 case expression of
366 Can.Call func args ->
366 Can.Call func args ->
@@ -442,7 +442,7 @@ optimizeTail cycle rootName argNames locExpr@(A.At _ expression) =
442-- DETECT TAIL CALLS
442-- DETECT TAIL CALLS
443
443
444
444
445−toTailDef :: N.Name -> [N.Name] -> [Opt.Destructor] -> Opt.Expr -> Opt.Def
445+toTailDef :: Name.Name -> [Name.Name] -> [Opt.Destructor] -> Opt.Expr -> Opt.Def
446toTailDef name argNames destructors body =
446toTailDef name argNames destructors body =
447 if hasTailCall body then
447 if hasTailCall body then
448 Opt.TailDef name argNames (foldr Opt.Destruct body destructors)
448 Opt.TailDef name argNames (foldr Opt.Destruct body destructors)
compiler/src/Optimize/Module.hs+23−23
@@ -10,6 +10,7 @@ import Prelude hiding (cycle)
10import Control.Monad (foldM)
10import Control.Monad (foldM)
11import qualified Data.List as List
11import qualified Data.List as List
12import qualified Data.Map as Map
12import qualified Data.Map as Map
13+import qualified Data.Name as Name
13import qualified Data.Set as Set
14import qualified Data.Set as Set
14import Data.Map ((!))
15import Data.Map ((!))
15
16
@@ -18,7 +19,6 @@ import qualified AST.Optimized as Opt
18import qualified AST.Module.Name as ModuleName
19import qualified AST.Module.Name as ModuleName
19import qualified AST.Utils.Type as Type
20import qualified AST.Utils.Type as Type
20import qualified Canonicalize.Effects as Effects
21import qualified Canonicalize.Effects as Effects
21−import qualified Elm.Name as N
22import qualified Optimize.Expression as Expr
22import qualified Optimize.Expression as Expr
23import qualified Optimize.Names as Names
23import qualified Optimize.Names as Names
24import qualified Optimize.Port as Port
24import qualified Optimize.Port as Port
@@ -38,7 +38,7 @@ type Result i w a =
38
38
39
39
40type Annotations =
40type Annotations =
41− Map.Map N.Name Can.Annotation
41+ Map.Map Name.Name Can.Annotation
42
42
43
43
44optimize :: Annotations -> Can.Module -> Result i [W.Warning] Opt.Graph
44optimize :: Annotations -> Can.Module -> Result i [W.Warning] Opt.Graph
@@ -58,7 +58,7 @@ type Nodes =
58 Map.Map Opt.Global Opt.Node
58 Map.Map Opt.Global Opt.Node
59
59
60
60
61−addUnions :: ModuleName.Canonical -> Map.Map N.Name Can.Union -> Opt.Graph -> Opt.Graph
61+addUnions :: ModuleName.Canonical -> Map.Map Name.Name Can.Union -> Opt.Graph -> Opt.Graph
62addUnions home unions (Opt.Graph mains nodes fields) =
62addUnions home unions (Opt.Graph mains nodes fields) =
63 Opt.Graph mains (Map.foldr (addUnion home) nodes unions) fields
63 Opt.Graph mains (Map.foldr (addUnion home) nodes unions) fields
64
64
@@ -84,12 +84,12 @@ addCtorNode home opts nodes (Can.Ctor name index numArgs _) =
84-- ALIAS
84-- ALIAS
85
85
86
86
87−addAliases :: ModuleName.Canonical -> Map.Map N.Name Can.Alias -> Opt.Graph -> Opt.Graph
87+addAliases :: ModuleName.Canonical -> Map.Map Name.Name Can.Alias -> Opt.Graph -> Opt.Graph
88addAliases home aliases graph =
88addAliases home aliases graph =
89 Map.foldrWithKey (addAlias home) graph aliases
89 Map.foldrWithKey (addAlias home) graph aliases
90
90
91
91
92−addAlias :: ModuleName.Canonical -> N.Name -> Can.Alias -> Opt.Graph -> Opt.Graph
92+addAlias :: ModuleName.Canonical -> Name.Name -> Can.Alias -> Opt.Graph -> Opt.Graph
93addAlias home name (Can.Alias _ tipe) graph@(Opt.Graph mains nodes fieldCounts) =
93addAlias home name (Can.Alias _ tipe) graph@(Opt.Graph mains nodes fieldCounts) =
94 case tipe of
94 case tipe of
95 Can.TRecord fields Nothing ->
95 Can.TRecord fields Nothing ->
@@ -110,7 +110,7 @@ addAlias home name (Can.Alias _ tipe) graph@(Opt.Graph mains nodes fieldCounts)
110 graph
110 graph
111
111
112
112
113−addRecordCtorField :: N.Name -> Can.FieldType -> Map.Map N.Name Int -> Map.Map N.Name Int
113+addRecordCtorField :: Name.Name -> Can.FieldType -> Map.Map Name.Name Int -> Map.Map Name.Name Int
114addRecordCtorField name _ fields =
114addRecordCtorField name _ fields =
115 Map.insertWith (+) name 1 fields
115 Map.insertWith (+) name 1 fields
116
116
@@ -152,7 +152,7 @@ addEffects home effects graph@(Opt.Graph mains nodes fields) =
152 Opt.Graph mains newNodes fields
152 Opt.Graph mains newNodes fields
153
153
154
154
155−addPort :: ModuleName.Canonical -> N.Name -> Can.Port -> Opt.Graph -> Opt.Graph
155+addPort :: ModuleName.Canonical -> Name.Name -> Can.Port -> Opt.Graph -> Opt.Graph
156addPort home name port_ graph =
156addPort home name port_ graph =
157 case port_ of
157 case port_ of
158 Can.Incoming _ payloadType _ ->
158 Can.Incoming _ payloadType _ ->
@@ -174,7 +174,7 @@ addPort home name port_ graph =
174-- HELPER
174-- HELPER
175
175
176
176
177−addToGraph :: Opt.Global -> Opt.Node -> Map.Map N.Name Int -> Opt.Graph -> Opt.Graph
177+addToGraph :: Opt.Global -> Opt.Node -> Map.Map Name.Name Int -> Opt.Graph -> Opt.Graph
178addToGraph name node fields (Opt.Graph mains nodes fieldCounts) =
178addToGraph name node fields (Opt.Graph mains nodes fieldCounts) =
179 Opt.Graph
179 Opt.Graph
180 mains
180 mains
@@ -213,13 +213,13 @@ findMain defs =
213 def:rest ->
213 def:rest ->
214 case def of
214 case def of
215 Can.Def (A.At region name) _ _ ->
215 Can.Def (A.At region name) _ _ ->
216− if name == N.main then Just region else findMain rest
216+ if name == Name.main then Just region else findMain rest
217
217
218 Can.TypedDef (A.At region name) _ _ _ _ ->
218 Can.TypedDef (A.At region name) _ _ _ _ ->
219− if name == N.main then Just region else findMain rest
219+ if name == Name.main then Just region else findMain rest
220
220
221
221
222−defToName :: Can.Def -> N.Name
222+defToName :: Can.Def -> Name.Name
223defToName def =
223defToName def =
224 case def of
224 case def of
225 Can.Def (A.At _ name) _ _ -> name
225 Can.Def (A.At _ name) _ _ -> name
@@ -242,9 +242,9 @@ addDef home annotations def graph =
242 addDefHelp region annotations home name (map fst typedArgs) body graph
242 addDefHelp region annotations home name (map fst typedArgs) body graph
243
243
244
244
245−addDefHelp :: R.Region -> Annotations -> ModuleName.Canonical -> N.Name -> [Can.Pattern] -> Can.Expr -> Opt.Graph -> Result i w Opt.Graph
245+addDefHelp :: R.Region -> Annotations -> ModuleName.Canonical -> Name.Name -> [Can.Pattern] -> Can.Expr -> Opt.Graph -> Result i w Opt.Graph
246addDefHelp region annotations home name args body graph@(Opt.Graph mains nodes fieldCounts) =
246addDefHelp region annotations home name args body graph@(Opt.Graph mains nodes fieldCounts) =
247− if name /= N.main then
247+ if name /= Name.main then
248 Result.ok (addDefNode home name args body Set.empty graph)
248 Result.ok (addDefNode home name args body Set.empty graph)
249 else
249 else
250 let
250 let
@@ -259,11 +259,11 @@ addDefHelp region annotations home name args body graph@(Opt.Graph mains nodes f
259 Opt.Graph newMains nodes newFields
259 Opt.Graph newMains nodes newFields
260 in
260 in
261 case Type.deepDealias tipe of
261 case Type.deepDealias tipe of
262− Can.TType hm nm [_] | hm == ModuleName.virtualDom && nm == N.node ->
262+ Can.TType hm nm [_] | hm == ModuleName.virtualDom && nm == Name.node ->
263 Result.ok $ addMain $ Names.run $
263 Result.ok $ addMain $ Names.run $
264− Names.registerKernel N.virtualDom Opt.Static
264+ Names.registerKernel Name.virtualDom Opt.Static
265
265
266− Can.TType hm nm [flags, _, message] | hm == ModuleName.platform && nm == N.program ->
266+ Can.TType hm nm [flags, _, message] | hm == ModuleName.platform && nm == Name.program ->
267 case Effects.checkPayload flags of
267 case Effects.checkPayload flags of
268 Right () ->
268 Right () ->
269 Result.ok $ addMain $ Names.run $
269 Result.ok $ addMain $ Names.run $
@@ -276,7 +276,7 @@ addDefHelp region annotations home name args body graph@(Opt.Graph mains nodes f
276 Result.throw (E.BadType region tipe)
276 Result.throw (E.BadType region tipe)
277
277
278
278
279−addDefNode :: ModuleName.Canonical -> N.Name -> [Can.Pattern] -> Can.Expr -> Set.Set Opt.Global -> Opt.Graph -> Opt.Graph
279+addDefNode :: ModuleName.Canonical -> Name.Name -> [Can.Pattern] -> Can.Expr -> Set.Set Opt.Global -> Opt.Graph -> Opt.Graph
280addDefNode home name args body mainDeps graph =
280addDefNode home name args body mainDeps graph =
281 let
281 let
282 (deps, fields, def) =
282 (deps, fields, def) =
@@ -300,7 +300,7 @@ addDefNode home name args body mainDeps graph =
300
300
301data State =
301data State =
302 State
302 State
303− { _values :: [(N.Name, Opt.Expr)]
303+ { _values :: [(Name.Name, Opt.Expr)]
304 , _functions :: [Opt.Def]
304 , _functions :: [Opt.Def]
305 }
305 }
306
306
@@ -309,7 +309,7 @@ addRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.Graph -> Opt.Graph
309addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
309addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
310 let
310 let
311 names = reverse (map toName defs)
311 names = reverse (map toName defs)
312− cycleName = Opt.Global home (N.toCompositeName names)
312+ cycleName = Opt.Global home (Name.fromManyNames names)
313 cycle = foldr addValueName Set.empty defs
313 cycle = foldr addValueName Set.empty defs
314 links = foldr (addLink home (Opt.Link cycleName)) Map.empty defs
314 links = foldr (addLink home (Opt.Link cycleName)) Map.empty defs
315
315
@@ -323,14 +323,14 @@ addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =
323 (Map.unionWith (+) fields fieldCounts)
323 (Map.unionWith (+) fields fieldCounts)
324
324
325
325
326−toName :: Can.Def -> N.Name
326+toName :: Can.Def -> Name.Name
327toName def =
327toName def =
328 case def of
328 case def of
329 Can.Def (A.At _ name) _ _ -> name
329 Can.Def (A.At _ name) _ _ -> name
330 Can.TypedDef (A.At _ name) _ _ _ _ -> name
330 Can.TypedDef (A.At _ name) _ _ _ _ -> name
331
331
332
332
333−addValueName :: Can.Def -> Set.Set N.Name -> Set.Set N.Name
333+addValueName :: Can.Def -> Set.Set Name.Name -> Set.Set Name.Name
334addValueName def names =
334addValueName def names =
335 case def of
335 case def of
336 Can.Def (A.At _ name) args _ -> if null args then Set.insert name names else names
336 Can.Def (A.At _ name) args _ -> if null args then Set.insert name names else names
@@ -351,7 +351,7 @@ addLink home link def links =
351-- ADD RECURSIVE DEFS
351-- ADD RECURSIVE DEFS
352
352
353
353
354−addRecDef :: Set.Set N.Name -> State -> Can.Def -> Names.Tracker State
354+addRecDef :: Set.Set Name.Name -> State -> Can.Def -> Names.Tracker State
355addRecDef cycle state def =
355addRecDef cycle state def =
356 case def of
356 case def of
357 Can.Def (A.At _ name) args body ->
357 Can.Def (A.At _ name) args body ->
@@ -361,7 +361,7 @@ addRecDef cycle state def =
361 addRecDefHelp cycle state name (map fst args) body
361 addRecDefHelp cycle state name (map fst args) body
362
362
363
363
364−addRecDefHelp :: Set.Set N.Name -> State -> N.Name -> [Can.Pattern] -> Can.Expr -> Names.Tracker State
364+addRecDefHelp :: Set.Set Name.Name -> State -> Name.Name -> [Can.Pattern] -> Can.Expr -> Names.Tracker State
365addRecDefHelp cycle (State values funcs) name args body =
365addRecDefHelp cycle (State values funcs) name args body =
366 case args of
366 case args of
367 [] ->
367 [] ->
compiler/src/Optimize/Names.hs+17−17
@@ -17,13 +17,13 @@ module Optimize.Names
17
17
18
18
19import qualified Data.Map as Map
19import qualified Data.Map as Map
20+import qualified Data.Name as Name
20import qualified Data.Set as Set
21import qualified Data.Set as Set
21
22
22import qualified AST.Canonical as Can
23import qualified AST.Canonical as Can
23import qualified AST.Optimized as Opt
24import qualified AST.Optimized as Opt
24import qualified AST.Module.Name as ModuleName
25import qualified AST.Module.Name as ModuleName
25import qualified Data.Index as Index
26import qualified Data.Index as Index
26−import qualified Elm.Name as N
27import qualified Elm.Package as Pkg
27import qualified Elm.Package as Pkg
28import qualified Reporting.Region as R
28import qualified Reporting.Region as R
29
29
@@ -37,50 +37,50 @@ newtype Tracker a =
37 forall r.
37 forall r.
38 Int
38 Int
39 -> Set.Set Opt.Global
39 -> Set.Set Opt.Global
40− -> Map.Map N.Name Int
40+ -> Map.Map Name.Name Int
41− -> (Int -> Set.Set Opt.Global -> Map.Map N.Name Int -> a -> r)
41+ -> (Int -> Set.Set Opt.Global -> Map.Map Name.Name Int -> a -> r)
42 -> r
42 -> r
43 )
43 )
44
44
45
45
46−run :: Tracker a -> (Set.Set Opt.Global, Map.Map N.Name Int, a)
46+run :: Tracker a -> (Set.Set Opt.Global, Map.Map Name.Name Int, a)
47run (Tracker k) =
47run (Tracker k) =
48 k 0 Set.empty Map.empty
48 k 0 Set.empty Map.empty
49 (\_uid deps fields value -> (deps, fields, value))
49 (\_uid deps fields value -> (deps, fields, value))
50
50
51
51
52−generate :: Tracker N.Name
52+generate :: Tracker Name.Name
53generate =
53generate =
54 Tracker $ \uid deps fields ok ->
54 Tracker $ \uid deps fields ok ->
55− ok (uid + 1) deps fields (N.addIndex "_n" uid)
55+ ok (uid + 1) deps fields (Name.fromVarIndex uid)
56
56
57
57
58−registerKernel :: N.Name -> a -> Tracker a
58+registerKernel :: Name.Name -> a -> Tracker a
59registerKernel home value =
59registerKernel home value =
60 Tracker $ \uid deps fields ok ->
60 Tracker $ \uid deps fields ok ->
61 ok uid (Set.insert (toKernelGlobal home) deps) fields value
61 ok uid (Set.insert (toKernelGlobal home) deps) fields value
62
62
63
63
64−toKernelGlobal :: N.Name -> Opt.Global
64+toKernelGlobal :: Name.Name -> Opt.Global
65toKernelGlobal home =
65toKernelGlobal home =
66− Opt.Global (ModuleName.Canonical Pkg.kernel home) N.dollar
66+ Opt.Global (ModuleName.Canonical Pkg.kernel home) Name.dollar
67
67
68
68
69−registerGlobal :: ModuleName.Canonical -> N.Name -> Tracker Opt.Expr
69+registerGlobal :: ModuleName.Canonical -> Name.Name -> Tracker Opt.Expr
70registerGlobal home name =
70registerGlobal home name =
71 Tracker $ \uid deps fields ok ->
71 Tracker $ \uid deps fields ok ->
72 let global = Opt.Global home name in
72 let global = Opt.Global home name in
73 ok uid (Set.insert global deps) fields (Opt.VarGlobal global)
73 ok uid (Set.insert global deps) fields (Opt.VarGlobal global)
74
74
75
75
76−registerDebug :: N.Name -> ModuleName.Canonical -> R.Region -> Tracker Opt.Expr
76+registerDebug :: Name.Name -> ModuleName.Canonical -> R.Region -> Tracker Opt.Expr
77registerDebug name home region =
77registerDebug name home region =
78 Tracker $ \uid deps fields ok ->
78 Tracker $ \uid deps fields ok ->
79 let global = Opt.Global ModuleName.debug name in
79 let global = Opt.Global ModuleName.debug name in
80 ok uid (Set.insert global deps) fields (Opt.VarDebug name home region Nothing)
80 ok uid (Set.insert global deps) fields (Opt.VarDebug name home region Nothing)
81
81
82
82
83−registerCtor :: ModuleName.Canonical -> N.Name -> Index.ZeroBased -> Can.CtorOpts -> Tracker Opt.Expr
83+registerCtor :: ModuleName.Canonical -> Name.Name -> Index.ZeroBased -> Can.CtorOpts -> Tracker Opt.Expr
84registerCtor home name index opts =
84registerCtor home name index opts =
85 Tracker $ \uid deps fields ok ->
85 Tracker $ \uid deps fields ok ->
86 let
86 let
@@ -104,16 +104,16 @@ registerCtor home name index opts =
104
104
105identity :: Opt.Global
105identity :: Opt.Global
106identity =
106identity =
107− Opt.Global ModuleName.basics N.identity
107+ Opt.Global ModuleName.basics Name.identity
108
108
109
109
110−registerField :: N.Name -> a -> Tracker a
110+registerField :: Name.Name -> a -> Tracker a
111registerField name value =
111registerField name value =
112 Tracker $ \uid d fields ok ->
112 Tracker $ \uid d fields ok ->
113 ok uid d (Map.insertWith (+) name 1 fields) value
113 ok uid d (Map.insertWith (+) name 1 fields) value
114
114
115
115
116−registerFieldDict :: Map.Map N.Name v -> a -> Tracker a
116+registerFieldDict :: Map.Map Name.Name v -> a -> Tracker a
117registerFieldDict newFields value =
117registerFieldDict newFields value =
118 Tracker $ \uid d fields ok ->
118 Tracker $ \uid d fields ok ->
119 ok uid d (Map.unionWith (+) fields (Map.map toOne newFields)) value
119 ok uid d (Map.unionWith (+) fields (Map.map toOne newFields)) value
@@ -123,13 +123,13 @@ toOne :: a -> Int
123toOne _ = 1
123toOne _ = 1
124
124
125
125
126−registerFieldList :: [N.Name] -> a -> Tracker a
126+registerFieldList :: [Name.Name] -> a -> Tracker a
127registerFieldList names value =
127registerFieldList names value =
128 Tracker $ \uid deps fields ok ->
128 Tracker $ \uid deps fields ok ->
129 ok uid deps (foldr addOne fields names) value
129 ok uid deps (foldr addOne fields names) value
130
130
131
131
132−addOne :: N.Name -> Map.Map N.Name Int -> Map.Map N.Name Int
132+addOne :: Name.Name -> Map.Map Name.Name Int -> Map.Map Name.Name Int
133addOne name fields =
133addOne name fields =
134 Map.insertWith (+) name 1 fields
134 Map.insertWith (+) name 1 fields
135
135
compiler/src/Optimize/Port.hs+34−34
@@ -11,13 +11,13 @@ module Optimize.Port
11import Prelude hiding (maybe, null)
11import Prelude hiding (maybe, null)
12import Control.Monad (foldM)
12import Control.Monad (foldM)
13import qualified Data.Map as Map
13import qualified Data.Map as Map
14+import qualified Data.Name as Name
14
15
15import qualified AST.Canonical as Can
16import qualified AST.Canonical as Can
16import qualified AST.Optimized as Opt
17import qualified AST.Optimized as Opt
17import qualified AST.Module.Name as ModuleName
18import qualified AST.Module.Name as ModuleName
18import qualified AST.Utils.Type as Type
19import qualified AST.Utils.Type as Type
19import qualified Data.Index as Index
20import qualified Data.Index as Index
20−import qualified Elm.Name as N
21import qualified Optimize.Names as Names
21import qualified Optimize.Names as Names
22
22
23
23
@@ -38,7 +38,7 @@ toEncoder tipe =
38 error "toEncoder: type variable"
38 error "toEncoder: type variable"
39
39
40 Can.TUnit ->
40 Can.TUnit ->
41− Opt.Function [N.dollar] <$> encode "null"
41+ Opt.Function [Name.dollar] <$> encode "null"
42
42
43 Can.TTuple a b c ->
43 Can.TTuple a b c ->
44 encodeTuple a b c
44 encodeTuple a b c
@@ -46,16 +46,16 @@ toEncoder tipe =
46 Can.TType _ name args ->
46 Can.TType _ name args ->
47 case args of
47 case args of
48 []
48 []
49− | name == N.float -> encode "float"
49+ | name == Name.float -> encode "float"
50− | name == N.int -> encode "int"
50+ | name == Name.int -> encode "int"
51− | name == N.bool -> encode "bool"
51+ | name == Name.bool -> encode "bool"
52− | name == N.string -> encode "string"
52+ | name == Name.string -> encode "string"
53− | name == N.value -> Names.registerGlobal ModuleName.basics N.identity
53+ | name == Name.value -> Names.registerGlobal ModuleName.basics Name.identity
54
54
55 [arg]
55 [arg]
56− | name == N.maybe -> encodeMaybe arg
56+ | name == Name.maybe -> encodeMaybe arg
57− | name == N.list -> encodeList arg
57+ | name == Name.list -> encodeList arg
58− | name == N.array -> encodeArray arg
58+ | name == Name.array -> encodeArray arg
59
59
60 _ ->
60 _ ->
61 error "toEncoder: bad union type"
61 error "toEncoder: bad union type"
@@ -67,13 +67,13 @@ toEncoder tipe =
67 let
67 let
68 encodeField (name, Can.FieldType _ fieldType) =
68 encodeField (name, Can.FieldType _ fieldType) =
69 do encoder <- toEncoder fieldType
69 do encoder <- toEncoder fieldType
70− let value = Opt.Call encoder [Opt.Access (Opt.VarLocal N.dollar) name]
70+ let value = Opt.Call encoder [Opt.Access (Opt.VarLocal Name.dollar) name]
71− return $ Opt.Tuple (Opt.Str (N.toText name)) value Nothing
71+ return $ Opt.Tuple (Opt.Str (Name.toUtf8 name)) value Nothing
72 in
72 in
73 do object <- encode "object"
73 do object <- encode "object"
74 keyValuePairs <- traverse encodeField (Map.toList fields)
74 keyValuePairs <- traverse encodeField (Map.toList fields)
75 Names.registerFieldDict fields $
75 Names.registerFieldDict fields $
76− Opt.Function [N.dollar] (Opt.Call object [Opt.List keyValuePairs])
76+ Opt.Function [Name.dollar] (Opt.Call object [Opt.List keyValuePairs])
77
77
78
78
79
79
@@ -85,8 +85,8 @@ encodeMaybe tipe =
85 do null <- encode "null"
85 do null <- encode "null"
86 encoder <- toEncoder tipe
86 encoder <- toEncoder tipe
87 destruct <- Names.registerGlobal ModuleName.maybe "destruct"
87 destruct <- Names.registerGlobal ModuleName.maybe "destruct"
88− return $ Opt.Function [N.dollar] $
88+ return $ Opt.Function [Name.dollar] $
89− Opt.Call destruct [ null, encoder, Opt.VarLocal N.dollar ]
89+ Opt.Call destruct [ null, encoder, Opt.VarLocal Name.dollar ]
90
90
91
91
92encodeList :: Can.Type -> Names.Tracker Opt.Expr
92encodeList :: Can.Type -> Names.Tracker Opt.Expr
@@ -107,27 +107,27 @@ encodeTuple :: Can.Type -> Can.Type -> Maybe Can.Type -> Names.Tracker Opt.Expr
107encodeTuple a b maybeC =
107encodeTuple a b maybeC =
108 let
108 let
109 let_ arg index body =
109 let_ arg index body =
110− Opt.Destruct (Opt.Destructor arg (Opt.Index index (Opt.Root N.dollar))) body
110+ Opt.Destruct (Opt.Destructor arg (Opt.Index index (Opt.Root Name.dollar))) body
111
111
112 encodeArg arg tipe =
112 encodeArg arg tipe =
113 do encoder <- toEncoder tipe
113 do encoder <- toEncoder tipe
114 return $ Opt.Call encoder [ Opt.VarLocal arg ]
114 return $ Opt.Call encoder [ Opt.VarLocal arg ]
115 in
115 in
116 do list <- encode "list"
116 do list <- encode "list"
117− identity <- Names.registerGlobal ModuleName.basics N.identity
117+ identity <- Names.registerGlobal ModuleName.basics Name.identity
118 arg1 <- encodeArg "a" a
118 arg1 <- encodeArg "a" a
119 arg2 <- encodeArg "b" b
119 arg2 <- encodeArg "b" b
120
120
121 case maybeC of
121 case maybeC of
122 Nothing ->
122 Nothing ->
123− return $ Opt.Function [N.dollar] $
123+ return $ Opt.Function [Name.dollar] $
124 let_ "a" Index.first $
124 let_ "a" Index.first $
125 let_ "b" Index.second $
125 let_ "b" Index.second $
126 Opt.Call list [ identity, Opt.List [ arg1, arg2 ] ]
126 Opt.Call list [ identity, Opt.List [ arg1, arg2 ] ]
127
127
128 Just c ->
128 Just c ->
129 do arg3 <- encodeArg "c" c
129 do arg3 <- encodeArg "c" c
130− return $ Opt.Function [N.dollar] $
130+ return $ Opt.Function [Name.dollar] $
131 let_ "a" Index.first $
131 let_ "a" Index.first $
132 let_ "b" Index.second $
132 let_ "b" Index.second $
133 let_ "c" Index.third $
133 let_ "c" Index.third $
@@ -174,16 +174,16 @@ toDecoder tipe =
174 Can.TType _ name args ->
174 Can.TType _ name args ->
175 case args of
175 case args of
176 []
176 []
177− | name == N.float -> decode "float"
177+ | name == Name.float -> decode "float"
178− | name == N.int -> decode "int"
178+ | name == Name.int -> decode "int"
179− | name == N.bool -> decode "bool"
179+ | name == Name.bool -> decode "bool"
180− | name == N.string -> decode "string"
180+ | name == Name.string -> decode "string"
181− | name == N.value -> decode "value"
181+ | name == Name.value -> decode "value"
182
182
183 [arg]
183 [arg]
184− | name == N.maybe -> decodeMaybe arg
184+ | name == Name.maybe -> decodeMaybe arg
185− | name == N.list -> decodeList arg
185+ | name == Name.list -> decodeList arg
186− | name == N.array -> decodeArray arg
186+ | name == Name.array -> decodeArray arg
187
187
188 _ ->
188 _ ->
189 error "toDecoder: bad type"
189 error "toDecoder: bad type"
@@ -268,7 +268,7 @@ decodeTuple a b maybeC =
268
268
269toLocal :: Int -> Opt.Expr
269toLocal :: Int -> Opt.Expr
270toLocal index =
270toLocal index =
271− Opt.VarLocal (N.addIndex "x" index)
271+ Opt.VarLocal (Name.fromVarIndex index)
272
272
273
273
274indexAndThen :: Int -> Can.Type -> Opt.Expr -> Names.Tracker Opt.Expr
274indexAndThen :: Int -> Can.Type -> Opt.Expr -> Names.Tracker Opt.Expr
@@ -278,7 +278,7 @@ indexAndThen i tipe decoder =
278 typeDecoder <- toDecoder tipe
278 typeDecoder <- toDecoder tipe
279 return $
279 return $
280 Opt.Call andThen
280 Opt.Call andThen
281− [ Opt.Function [N.addIndex "x" i] decoder
281+ [ Opt.Function [Name.fromVarIndex i] decoder
282 , Opt.Call index [ Opt.Int i, typeDecoder ]
282 , Opt.Call index [ Opt.Int i, typeDecoder ]
283 ]
283 ]
284
284
@@ -287,7 +287,7 @@ indexAndThen i tipe decoder =
287-- DECODE RECORDS
287-- DECODE RECORDS
288
288
289
289
290−decodeRecord :: Map.Map N.Name Can.FieldType -> Names.Tracker Opt.Expr
290+decodeRecord :: Map.Map Name.Name Can.FieldType -> Names.Tracker Opt.Expr
291decodeRecord fields =
291decodeRecord fields =
292 let
292 let
293 toFieldExpr name _ =
293 toFieldExpr name _ =
@@ -301,7 +301,7 @@ decodeRecord fields =
301 Names.registerFieldDict fields (Map.toList fields)
301 Names.registerFieldDict fields (Map.toList fields)
302
302
303
303
304−fieldAndThen :: Opt.Expr -> (N.Name, Can.FieldType) -> Names.Tracker Opt.Expr
304+fieldAndThen :: Opt.Expr -> (Name.Name, Can.FieldType) -> Names.Tracker Opt.Expr
305fieldAndThen decoder (key, Can.FieldType _ tipe) =
305fieldAndThen decoder (key, Can.FieldType _ tipe) =
306 do andThen <- decode "andThen"
306 do andThen <- decode "andThen"
307 field <- decode "field"
307 field <- decode "field"
@@ -309,7 +309,7 @@ fieldAndThen decoder (key, Can.FieldType _ tipe) =
309 return $
309 return $
310 Opt.Call andThen
310 Opt.Call andThen
311 [ Opt.Function [key] decoder
311 [ Opt.Function [key] decoder
312− , Opt.Call field [ Opt.Str (N.toText key), typeDecoder ]
312+ , Opt.Call field [ Opt.Str (Name.toUtf8 key), typeDecoder ]
313 ]
313 ]
314
314
315
315
@@ -317,11 +317,11 @@ fieldAndThen decoder (key, Can.FieldType _ tipe) =
317-- GLOBALS HELPERS
317-- GLOBALS HELPERS
318
318
319
319
320−encode :: N.Name -> Names.Tracker Opt.Expr
320+encode :: Name.Name -> Names.Tracker Opt.Expr
321encode name =
321encode name =
322 Names.registerGlobal ModuleName.jsonEncode name
322 Names.registerGlobal ModuleName.jsonEncode name
323
323
324
324
325−decode :: N.Name -> Names.Tracker Opt.Expr
325+decode :: Name.Name -> Names.Tracker Opt.Expr
326decode name =
326decode name =
327 Names.registerGlobal ModuleName.jsonDecode name
327 Names.registerGlobal ModuleName.jsonDecode name