@@ -9,134 +9,139 @@ module Optimize.Port
99
1010
1111import Prelude hiding (maybe, null)
12−import Control.Monad (foldM, zipWithM)
12+import Control.Monad (foldM)
13+import qualified Data.Map as Map
1314import qualified Data.Text as Text
14−import Data.Text (Text)
1515
16−import qualified AST.Expression.Optimized as Opt
17−import qualified AST.Helpers as Help
18−import qualified AST.Literal as Literal
16+import qualified AST.Canonical as Can
17+import qualified AST.Optimized as Opt
1918import qualified AST.Module.Name as ModuleName
20−import qualified AST.Type as T
21−import qualified AST.Variable as Var
19+import qualified AST.Utils.Type as Type
20+import qualified Data.Index as Index
21+import qualified Elm.Name as N
2222import qualified Optimize.DecisionTree as DT
23−import qualified Optimize.Environment as Env
23+import qualified Optimize.Names as Names
2424
2525
2626
2727-- ENCODE
2828
2929
30−toEncoder :: T.Canonical -> Env.Optimizer Opt.Expr
30+toEncoder :: Can.Type -> Names.Tracker Opt.Expr
3131toEncoder tipe =
3232 case tipe of
33− T.Aliased _ args t ->
34− toEncoder (T.dealias args t)
33+ Can.TAlias _ _ args alias ->
34+ toEncoder (Type.dealias args alias)
3535
36− T.Lambda _ _ ->
36+ Can.TLambda _ _ ->
3737 error "toEncoder: function"
3838
39− T.Var _ ->
39+ Can.TVar _ ->
4040 error "toEncoder: type variable"
4141
42− T.Type name []
43− | Var.isPrim "Float" name -> encode "float"
44− | Var.isPrim "Int" name -> encode "int"
45− | Var.isPrim "Bool" name -> encode "bool"
46− | Var.isPrim "String" name -> encode "string"
47− | Var.isJson name -> encode "value"
48− | Var.isTuple name -> encode "null"
49− | otherwise -> error "toEncoder: bad type"
42+ Can.TUnit ->
43+ encode "null"
5044
51− T.Type name [arg]
52− | Var.isMaybe name -> encodeMaybe arg
53− | Var.isList name -> encodeList arg
54− | Var.isArray name -> encodeArray arg
55− | otherwise -> error "toEncoder: bad union type"
45+ Can.TTuple a b c ->
46+ encodeTuple a b c
5647
57− T.Type name args
58− | Var.isTuple name -> encodeTuple args
48+ Can.TType _ name args ->
49+ case args of
50+ []
51+ | name == N.float -> encode "float"
52+ | name == N.int -> encode "int"
53+ | name == N.bool -> encode "bool"
54+ | name == N.string -> encode "string"
55+ | name == N.value -> encode "value"
5956
60− T.Type _ _ ->
61− error "toEncoder: bad union type"
57+ [arg]
58+ | name == N.maybe -> encodeMaybe arg
59+ | name == N.list -> encodeList arg
60+ | name == N.array -> encodeArray arg
6261
63− T.Record _ (Just _) ->
62+ _ ->
63+ error "toEncoder: bad union type"
64+
65+ Can.TRecord _ (Just _) ->
6466 error "toEncoder: bad record"
6567
66− T.Record fields Nothing ->
68+ Can.TRecord fields Nothing ->
6769 let
68− convert (field, typ) =
69− do encoder <- toEncoder typ
70− return
71− ( field
72− , Opt.Call encoder [ Opt.Access (Opt.VarLocal "r") field ]
73− )
70+ encodeField field fieldType =
71+ do encoder <- toEncoder fieldType
72+ return $ Opt.Call encoder [Opt.Access (Opt.VarLocal "r") field]
7473 in
75− do record <- traverse convert fields
76− return $ Opt.Function ["r"] (Opt.Record record)
74+ do record <- Map.traverseWithKey encodeField fields
75+ return $ Opt.Function ["r"] (Opt.Record record)
7776
7877
7978
8079-- ENCODE HELPERS
8180
8281
83−encodeMaybe :: T.Canonical -> Env.Optimizer Opt.Expr
82+encodeMaybe :: Can.Type -> Names.Tracker Opt.Expr
8483encodeMaybe tipe =
8584 do null <- encode "null"
8685 encoder <- toEncoder tipe
8786
88− let nothing = Var.inCore "Maybe" "Nothing"
89− let test = (DT.Empty, DT.Constructor nothing)
90− let just = Opt.Call encoder [ Opt.CtorAccess (Opt.VarLocal "m") 0 ]
87+ let test = (DT.Empty, DT.IsCtor 2 "Nothing")
88+ let just = Opt.Call encoder [ Opt.CtorAccess (Opt.VarLocal "m") Index.first ]
9189 let leaf expr = Opt.Leaf (Opt.Inline expr)
9290
9391 return $ Opt.Function ["m"] $
9492 Opt.Case "m" (Opt.Chain [test] (leaf null) (leaf just)) []
9593
9694
97−encodeList :: T.Canonical -> Env.Optimizer Opt.Expr
95+encodeList :: Can.Type -> Names.Tracker Opt.Expr
9896encodeList tipe =
9997 do list <- encode "list"
100− map_ <- core "List" "map"
98+ map_ <- Names.registerGlobal ModuleName.list "map"
10199 encoder <- toEncoder tipe
102100 return $
103101 Opt.Function ["xs"] $
104102 Opt.Call list [ Opt.Call map_ [ encoder, Opt.VarLocal "xs" ] ]
105103
106104
107−encodeArray :: T.Canonical -> Env.Optimizer Opt.Expr
105+encodeArray :: Can.Type -> Names.Tracker Opt.Expr
108106encodeArray tipe =
109107 do array <- encode "array"
110− map_ <- core "Array" "map"
108+ map_ <- Names.registerGlobal ModuleName.array "map"
111109 encoder <- toEncoder tipe
112110 return $
113111 Opt.Function ["xs"] $
114112 Opt.Call array [ Opt.Call map_ [ encoder, Opt.VarLocal "xs" ] ]
115113
116114
117−encodeTuple :: [T.Canonical] -> Env.Optimizer Opt.Expr
118−encodeTuple tipes =
115+encodeTuple :: Can.Type -> Can.Type -> Maybe Can.Type -> Names.Tracker Opt.Expr
116+encodeTuple a b maybeC =
119117 let
120− convert tipe index =
118+ convert index tipe =
121119 do encoder <- toEncoder tipe
122− return $
123− Opt.Call encoder [ Opt.CtorAccess (Opt.VarLocal "t") index ]
120+ return $ Opt.Call encoder [ Opt.CtorAccess (Opt.VarLocal "t") index ]
124121 in
125− do list <- encode "list"
126− entries <- zipWithM convert tipes [ 0 .. length tipes ]
127− return $ Opt.Function ["t"] $ Opt.Call list entries
122+ Opt.Function ["t"] <$> (
123+ Opt.Call
124+ <$> encode "list"
125+ <*>
126+ case maybeC of
127+ Nothing ->
128+ Index.indexedTraverse convert [a,b]
129+
130+ Just c ->
131+ Index.indexedTraverse convert [a,b,c]
132+ )
128133
129134
130135
131136-- FLAGS DECODER
132137
133138
134−toFlagsDecoder :: T.Canonical -> Env.Optimizer Opt.Expr
139+toFlagsDecoder :: Can.Type -> Names.Tracker Opt.Expr
135140toFlagsDecoder tipe =
136141 case tipe of
137− T.Type name [] | Var.isTuple name ->
142+ Can.TUnit ->
138143 do succeed <- decode "succeed"
139− return $ Opt.Call succeed [ Opt.Ctor Help.zeroTuple [] ]
144+ return $ Opt.Call succeed [ Opt.Unit ]
140145
141146 _ ->
142147 toDecoder tipe
@@ -146,43 +151,45 @@ toFlagsDecoder tipe =
146151-- DECODE
147152
148153
149−toDecoder :: T.Canonical -> Env.Optimizer Opt.Expr
154+toDecoder :: Can.Type -> Names.Tracker Opt.Expr
150155toDecoder tipe =
151156 case tipe of
152− T.Lambda _ _ ->
157+ Can.TLambda _ _ ->
153158 error "functions should not be allowed through input ports"
154159
155− T.Var _ ->
160+ Can.TVar _ ->
156161 error "type variables should not be allowed through input ports"
157162
158− T.Aliased _ args t ->
159− toDecoder (T.dealias args t)
163+ Can.TAlias _ _ args alias ->
164+ toDecoder (Type.dealias args alias)
165+
166+ Can.TUnit ->
167+ decodeTuple0
160168
161− T.Type name []
162− | Var.isPrim "Float" name -> decode "float"
163− | Var.isPrim "Int" name -> decode "int"
164− | Var.isPrim "Bool" name -> decode "bool"
165− | Var.isPrim "String" name -> decode "string"
166− | Var.isJson name -> decode "value"
167− | Var.isTuple name -> decodeTuple0
168− | otherwise -> error "toDecoder: bad type"
169+ Can.TTuple a b c ->
170+ decodeTuple a b c
169171
170− T.Type name [arg]
171− | Var.isMaybe name -> decodeMaybe arg
172− | Var.isList name -> decodeList arg
173− | Var.isArray name -> decodeArray arg
174− | otherwise -> error "toDecoder: bad union type"
172+ Can.TType _ name args ->
173+ case args of
174+ []
175+ | name == N.float -> decode "float"
176+ | name == N.int -> decode "int"
177+ | name == N.bool -> decode "bool"
178+ | name == N.string -> decode "string"
179+ | name == N.value -> decode "value"
175180
176− T.Type name args
177− | Var.isTuple name -> decodeTuple args
181+ [arg]
182+ | name == N.maybe -> decodeMaybe arg
183+ | name == N.list -> decodeList arg
184+ | name == N.array -> decodeArray arg
178185
179− T.Type _ _ ->
180− error "toDecoder: bad union type"
186+ _ ->
187+ error "toDecoder: bad type"
181188
182− T.Record _ (Just _) ->
189+ Can.TRecord _ (Just _) ->
183190 error "toDecoder: bad record"
184191
185− T.Record fields Nothing ->
192+ Can.TRecord fields Nothing ->
186193 decodeRecord fields
187194
188195
@@ -190,13 +197,10 @@ toDecoder tipe =
190197-- DECODE MAYBE
191198
192199
193−decodeMaybe :: T.Canonical -> Env.Optimizer Opt.Expr
200+decodeMaybe :: Can.Type -> Names.Tracker Opt.Expr
194201decodeMaybe tipe =
195− do let nothing = Var.Global (ModuleName.inCore "Maybe") "Nothing"
196− let just = Var.Global (ModuleName.inCore "Maybe") "Just"
197−
198− Env.register nothing
199− Env.register just
202+ do nothing <- Names.registerGlobal ModuleName.maybe "Nothing"
203+ just <- Names.registerGlobal ModuleName.maybe "Just"
200204
201205 oneOf <- decode "oneOf"
202206 null <- decode "null"
@@ -207,8 +211,8 @@ decodeMaybe tipe =
207211 return $
208212 Opt.Call oneOf
209213 [ Opt.List
210− [ Opt.Call null [ Opt.VarGlobal nothing ]
211− , Opt.Call map_ [ Opt.VarGlobal just, subDecoder ]
214+ [ Opt.Call null [ nothing ]
215+ , Opt.Call map_ [ just, subDecoder ]
212216 ]
213217 ]
214218
@@ -216,7 +220,7 @@ decodeMaybe tipe =
216220-- DECODE LIST
217221
218222
219−decodeList :: T.Canonical -> Env.Optimizer Opt.Expr
223+decodeList :: Can.Type -> Names.Tracker Opt.Expr
220224decodeList tipe =
221225 do list <- decode "list"
222226 decoder <- toDecoder tipe
@@ -227,7 +231,7 @@ decodeList tipe =
227231-- DECODE ARRAY
228232
229233
230−decodeArray :: T.Canonical -> Env.Optimizer Opt.Expr
234+decodeArray :: Can.Type -> Names.Tracker Opt.Expr
231235decodeArray tipe =
232236 do array <- decode "array"
233237 decoder <- toDecoder tipe
@@ -238,44 +242,47 @@ decodeArray tipe =
238242-- DECODE TUPLES
239243
240244
241−decodeTuple0 :: Env.Optimizer Opt.Expr
245+decodeTuple0 :: Names.Tracker Opt.Expr
242246decodeTuple0 =
243247 do null <- decode "null"
244− return (Opt.Call null [ Opt.Ctor Help.zeroTuple [] ])
248+ return (Opt.Call null [ Opt.Unit ])
245249
246250
247−decodeTuple :: [T.Canonical] -> Env.Optimizer Opt.Expr
248−decodeTuple types =
249− let
250− size =
251− length types
251+decodeTuple :: Can.Type -> Can.Type -> Maybe Can.Type -> Names.Tracker Opt.Expr
252+decodeTuple a b maybeC =
253+ do succeed <- decode "succeed"
254+ case maybeC of
255+ Nothing ->
256+ let tuple = Opt.Tuple (toLocal 0) (toLocal 1) Nothing in
257+ indexAndThen 0 a =<<
258+ indexAndThen 1 b (Opt.Call succeed [tuple])
252259
253− entries =
254− zip [ 0 .. size - 1] types
260+ Just c ->
261+ let tuple = Opt.Tuple (toLocal 0) (toLocal 1) (Just (toLocal 2)) in
262+ indexAndThen 0 a =<<
263+ indexAndThen 1 b =<<
264+ indexAndThen 2 c (Opt.Call succeed [tuple])
255265
256− tuple =
257− Opt.Ctor
258− (Help.makeTuple size)
259− (map (Opt.VarLocal . indexToName . fst) entries)
260− in
261− do succeed <- decode "succeed"
262− foldM indexAndThen (Opt.Call succeed [tuple]) entries
266+
267+toLocal :: Int -> Opt.Expr
268+toLocal index =
269+ Opt.VarLocal (indexToName index)
263270
264271
265−indexToName :: Int -> Text
272+indexToName :: Int -> N.Name
266273indexToName index =
267274 Text.pack ('x' : show index)
268275
269276
270−indexAndThen :: Opt.Expr -> (Int, T.Canonical) -> Env.Optimizer Opt.Expr
271−indexAndThen decoder (i, tipe) =
277+indexAndThen :: Int -> Can.Type -> Opt.Expr -> Names.Tracker Opt.Expr
278+indexAndThen i tipe decoder =
272279 do andThen <- decode "andThen"
273280 index <- decode "index"
274281 typeDecoder <- toDecoder tipe
275282 return $
276283 Opt.Call andThen
277284 [ Opt.Function [indexToName i] decoder
278− , Opt.Call index [ Opt.Literal (Literal.IntNum i), typeDecoder ]
285+ , Opt.Call index [ Opt.Int i, typeDecoder ]
279286 ]
280287
281288
@@ -283,20 +290,20 @@ indexAndThen decoder (i, tipe) =
283290-- DECODE RECORDS
284291
285292
286−decodeRecord :: [(Text, T.Canonical)] -> Env.Optimizer Opt.Expr
293+decodeRecord :: Map.Map N.Name Can.Type -> Names.Tracker Opt.Expr
287294decodeRecord fields =
288295 let
289− toFieldExpr (key, _) =
290− (key, Opt.VarLocal key)
296+ toFieldExpr name _ =
297+ Opt.VarLocal name
291298
292299 record =
293− Opt.Record (map toFieldExpr fields)
300+ Opt.Record (Map.mapWithKey toFieldExpr fields)
294301 in
295302 do succeed <- decode "succeed"
296− foldM fieldAndThen (Opt.Call succeed [record]) fields
303+ foldM fieldAndThen (Opt.Call succeed [record]) (Map.toList fields)
297304
298305
299−fieldAndThen :: Opt.Expr -> (Text, T.Canonical) -> Env.Optimizer Opt.Expr
306+fieldAndThen :: Opt.Expr -> (N.Name, Can.Type) -> Names.Tracker Opt.Expr
300307fieldAndThen decoder (key, tipe) =
301308 do andThen <- decode "andThen"
302309 field <- decode "field"
@@ -304,7 +311,7 @@ fieldAndThen decoder (key, tipe) =
304311 return $
305312 Opt.Call andThen
306313 [ Opt.Function [key] decoder
307− , Opt.Call field [ Opt.Literal (Literal.Str key), typeDecoder ]
314+ , Opt.Call field [ Opt.Str key, typeDecoder ]
308315 ]
309316
310317
@@ -312,18 +319,11 @@ fieldAndThen decoder (key, tipe) =
312319-- GLOBALS HELPERS
313320
314321
315−core :: Text -> Text -> Env.Optimizer Opt.Expr
316−core home name =
317− do let var = Var.Global (ModuleName.inCore home) name
318− Env.register var
319− return (Opt.VarGlobal var)
320−
321−
322−encode :: Text -> Env.Optimizer Opt.Expr
322+encode :: N.Name -> Names.Tracker Opt.Expr
323323encode name =
324− core "Json.Encode" name
324+ Names.registerGlobal ModuleName.jsonEncode name
325325
326326
327−decode :: Text -> Env.Optimizer Opt.Expr
327+decode :: N.Name -> Names.Tracker Opt.Expr
328328decode name =
329− core "Json.Decode" name
329+ Names.registerGlobal ModuleName.jsonDecode name