57490fd · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Get Optimize.Port working again

57490fdEvan Czaplicki9 years ago

src/Optimize/Port.hs+131−131

compare with master

unifiedsplit

@@ -9,134 +9,139 @@ module Optimize.Port

11import Prelude hiding (maybe, null)

12−import Control.Monad (foldM, zipWithM)

12+import Control.Monad (foldM)

13+import qualified Data.Map as Map

13import qualified Data.Text as Text

14import qualified Data.Text as Text

14−import Data.Text (Text)

16−import qualified AST.Expression.Optimized as Opt

16+import qualified AST.Canonical as Can

17−import qualified AST.Helpers as Help

17+import qualified AST.Optimized as Opt

18−import qualified AST.Literal as Literal

19import qualified AST.Module.Name as ModuleName

18import qualified AST.Module.Name as ModuleName

20−import qualified AST.Type as T

19+import qualified AST.Utils.Type as Type

20+import qualified Data.Index as Index

21−import qualified AST.Variable as Var

21+import qualified Elm.Name as N

22import qualified Optimize.DecisionTree as DT

23−import qualified Optimize.Environment as Env

23+import qualified Optimize.Names as Names

27-- ENCODE

30−toEncoder :: T.Canonical -> Env.Optimizer Opt.Expr

30+toEncoder :: Can.Type -> Names.Tracker Opt.Expr

31toEncoder tipe =

32 case tipe of

33− T.Aliased _ args t ->

33+ Can.TAlias _ _ args alias ->

34− toEncoder (T.dealias args t)

34+ toEncoder (Type.dealias args alias)

36− T.Lambda _ _ ->

36+ Can.TLambda _ _ ->

37 error "toEncoder: function"

39− T.Var _ ->

39+ Can.TVar _ ->

40 error "toEncoder: type variable"

42− T.Type name []

42+ Can.TUnit ->

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"

43+ encode "null"

49− | otherwise -> error "toEncoder: bad type"

51− T.Type name [arg]

45+ Can.TTuple a b c ->

52− | Var.isMaybe name -> encodeMaybe arg

46+ encodeTuple a b c

53− | Var.isList name -> encodeList arg

54− | Var.isArray name -> encodeArray arg

55− | otherwise -> error "toEncoder: bad union type"

57− T.Type name args

48+ Can.TType _ name args ->

58− | Var.isTuple name -> encodeTuple 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"

60− T.Type _ _ ->

57+ [arg]

61− error "toEncoder: bad union type"

58+ | name == N.maybe -> encodeMaybe arg

59+ | name == N.list -> encodeList arg

60+ | name == N.array -> encodeArray arg

62+ _ ->

63+ error "toEncoder: bad union type"

64+

63− T.Record _ (Just _) ->

65+ Can.TRecord _ (Just _) ->

64 error "toEncoder: bad record"

66 error "toEncoder: bad record"

66− T.Record fields Nothing ->

68+ Can.TRecord fields Nothing ->

67 let

69 let

68− convert (field, typ) =

70+ encodeField field fieldType =

69− do encoder <- toEncoder typ

71+ do encoder <- toEncoder fieldType

70− return

71− ( field

72− , Opt.Call encoder [ Opt.Access (Opt.VarLocal "r") field ]

72+ return $ Opt.Call encoder [Opt.Access (Opt.VarLocal "r") field]

73− )

74 in

73 in

75− do record <- traverse convert fields

74+ do record <- Map.traverseWithKey encodeField fields

76− return $ Opt.Function ["r"] (Opt.Record record)

75+ return $ Opt.Function ["r"] (Opt.Record record)

80-- ENCODE HELPERS

79-- ENCODE HELPERS

83−encodeMaybe :: T.Canonical -> Env.Optimizer Opt.Expr

82+encodeMaybe :: Can.Type -> Names.Tracker Opt.Expr

84encodeMaybe tipe =

83encodeMaybe tipe =

85 do null <- encode "null"

84 do null <- encode "null"

86 encoder <- toEncoder tipe

85 encoder <- toEncoder tipe

88− let nothing = Var.inCore "Maybe" "Nothing"

89− let test = (DT.Empty, DT.Constructor nothing)

87+ let test = (DT.Empty, DT.IsCtor 2 "Nothing")

90− let just = Opt.Call encoder [ Opt.CtorAccess (Opt.VarLocal "m") 0 ]

88+ let just = Opt.Call encoder [ Opt.CtorAccess (Opt.VarLocal "m") Index.first ]

91 let leaf expr = Opt.Leaf (Opt.Inline expr)

89 let leaf expr = Opt.Leaf (Opt.Inline expr)

93 return $ Opt.Function ["m"] $

91 return $ Opt.Function ["m"] $

94 Opt.Case "m" (Opt.Chain [test] (leaf null) (leaf just)) []

92 Opt.Case "m" (Opt.Chain [test] (leaf null) (leaf just)) []

97−encodeList :: T.Canonical -> Env.Optimizer Opt.Expr

95+encodeList :: Can.Type -> Names.Tracker Opt.Expr

98encodeList tipe =

96encodeList tipe =

99 do list <- encode "list"

97 do list <- encode "list"

100− map_ <- core "List" "map"

98+ map_ <- Names.registerGlobal ModuleName.list "map"

101 encoder <- toEncoder tipe

99 encoder <- toEncoder tipe

102 return $

100 return $

103 Opt.Function ["xs"] $

101 Opt.Function ["xs"] $

104 Opt.Call list [ Opt.Call map_ [ encoder, Opt.VarLocal "xs" ] ]

102 Opt.Call list [ Opt.Call map_ [ encoder, Opt.VarLocal "xs" ] ]

105

103

106

104

107−encodeArray :: T.Canonical -> Env.Optimizer Opt.Expr

105+encodeArray :: Can.Type -> Names.Tracker Opt.Expr

108encodeArray tipe =

106encodeArray tipe =

109 do array <- encode "array"

107 do array <- encode "array"

110− map_ <- core "Array" "map"

108+ map_ <- Names.registerGlobal ModuleName.array "map"

111 encoder <- toEncoder tipe

109 encoder <- toEncoder tipe

112 return $

110 return $

113 Opt.Function ["xs"] $

111 Opt.Function ["xs"] $

114 Opt.Call array [ Opt.Call map_ [ encoder, Opt.VarLocal "xs" ] ]

112 Opt.Call array [ Opt.Call map_ [ encoder, Opt.VarLocal "xs" ] ]

115

113

116

114

117−encodeTuple :: [T.Canonical] -> Env.Optimizer Opt.Expr

115+encodeTuple :: Can.Type -> Can.Type -> Maybe Can.Type -> Names.Tracker Opt.Expr

118−encodeTuple tipes =

116+encodeTuple a b maybeC =

119 let

117 let

120− convert tipe index =

118+ convert index tipe =

121 do encoder <- toEncoder tipe

119 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 ]

124 in

121 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+ )

128

133

129

134

130

135

131-- FLAGS DECODER

136-- FLAGS DECODER

132

137

133

138

134−toFlagsDecoder :: T.Canonical -> Env.Optimizer Opt.Expr

139+toFlagsDecoder :: Can.Type -> Names.Tracker Opt.Expr

135toFlagsDecoder tipe =

140toFlagsDecoder tipe =

136 case tipe of

141 case tipe of

137− T.Type name [] | Var.isTuple name ->

142+ Can.TUnit ->

138 do succeed <- decode "succeed"

143 do succeed <- decode "succeed"

139− return $ Opt.Call succeed [ Opt.Ctor Help.zeroTuple [] ]

144+ return $ Opt.Call succeed [ Opt.Unit ]

140

145

141 _ ->

146 _ ->

142 toDecoder tipe

147 toDecoder tipe

@@ -146,43 +151,45 @@ toFlagsDecoder tipe =

146-- DECODE

151-- DECODE

147

152

148

153

149−toDecoder :: T.Canonical -> Env.Optimizer Opt.Expr

154+toDecoder :: Can.Type -> Names.Tracker Opt.Expr

150toDecoder tipe =

155toDecoder tipe =

151 case tipe of

156 case tipe of

152− T.Lambda _ _ ->

157+ Can.TLambda _ _ ->

153 error "functions should not be allowed through input ports"

158 error "functions should not be allowed through input ports"

154

159

155− T.Var _ ->

160+ Can.TVar _ ->

156 error "type variables should not be allowed through input ports"

161 error "type variables should not be allowed through input ports"

157

162

158− T.Aliased _ args t ->

163+ Can.TAlias _ _ args alias ->

159− toDecoder (T.dealias args t)

164+ toDecoder (Type.dealias args alias)

165+

166+ Can.TUnit ->

167+ decodeTuple0

160

168

161− T.Type name []

169+ Can.TTuple a b c ->

162− | Var.isPrim "Float" name -> decode "float"

170+ decodeTuple a b c

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

171

170− T.Type name [arg]

172+ Can.TType _ name args ->

171− | Var.isMaybe name -> decodeMaybe arg

173+ case args of

172− | Var.isList name -> decodeList arg

174+ []

173− | Var.isArray name -> decodeArray arg

175+ | name == N.float -> decode "float"

174− | otherwise -> error "toDecoder: bad union type"

176+ | name == N.int -> decode "int"

177+ | name == N.bool -> decode "bool"

178+ | name == N.string -> decode "string"

179+ | name == N.value -> decode "value"

175

180

176− T.Type name args

181+ [arg]

177− | Var.isTuple name -> decodeTuple args

182+ | name == N.maybe -> decodeMaybe arg

183+ | name == N.list -> decodeList arg

184+ | name == N.array -> decodeArray arg

178

185

179− T.Type _ _ ->

186+ _ ->

180− error "toDecoder: bad union type"

187+ error "toDecoder: bad type"

181

188

182− T.Record _ (Just _) ->

189+ Can.TRecord _ (Just _) ->

183 error "toDecoder: bad record"

190 error "toDecoder: bad record"

184

191

185− T.Record fields Nothing ->

192+ Can.TRecord fields Nothing ->

186 decodeRecord fields

193 decodeRecord fields

187

194

188

195

@@ -190,13 +197,10 @@ toDecoder tipe =

190-- DECODE MAYBE

197-- DECODE MAYBE

191

198

192

199

193−decodeMaybe :: T.Canonical -> Env.Optimizer Opt.Expr

200+decodeMaybe :: Can.Type -> Names.Tracker Opt.Expr

194decodeMaybe tipe =

201decodeMaybe tipe =

195− do let nothing = Var.Global (ModuleName.inCore "Maybe") "Nothing"

202+ do nothing <- Names.registerGlobal ModuleName.maybe "Nothing"

196− let just = Var.Global (ModuleName.inCore "Maybe") "Just"

203+ just <- Names.registerGlobal ModuleName.maybe "Just"

197−

198− Env.register nothing

199− Env.register just

200

204

201 oneOf <- decode "oneOf"

205 oneOf <- decode "oneOf"

202 null <- decode "null"

206 null <- decode "null"

@@ -207,8 +211,8 @@ decodeMaybe tipe =

207 return $

211 return $

208 Opt.Call oneOf

212 Opt.Call oneOf

209 [ Opt.List

213 [ Opt.List

210− [ Opt.Call null [ Opt.VarGlobal nothing ]

214+ [ Opt.Call null [ nothing ]

211− , Opt.Call map_ [ Opt.VarGlobal just, subDecoder ]

215+ , Opt.Call map_ [ just, subDecoder ]

212 ]

216 ]

213 ]

217 ]

214

218

@@ -216,7 +220,7 @@ decodeMaybe tipe =

216-- DECODE LIST

220-- DECODE LIST

217

221

218

222

219−decodeList :: T.Canonical -> Env.Optimizer Opt.Expr

223+decodeList :: Can.Type -> Names.Tracker Opt.Expr

220decodeList tipe =

224decodeList tipe =

221 do list <- decode "list"

225 do list <- decode "list"

222 decoder <- toDecoder tipe

226 decoder <- toDecoder tipe

@@ -227,7 +231,7 @@ decodeList tipe =

227-- DECODE ARRAY

231-- DECODE ARRAY

228

232

229

233

230−decodeArray :: T.Canonical -> Env.Optimizer Opt.Expr

234+decodeArray :: Can.Type -> Names.Tracker Opt.Expr

231decodeArray tipe =

235decodeArray tipe =

232 do array <- decode "array"

236 do array <- decode "array"

233 decoder <- toDecoder tipe

237 decoder <- toDecoder tipe

@@ -238,44 +242,47 @@ decodeArray tipe =

238-- DECODE TUPLES

242-- DECODE TUPLES

239

243

240

244

241−decodeTuple0 :: Env.Optimizer Opt.Expr

245+decodeTuple0 :: Names.Tracker Opt.Expr

242decodeTuple0 =

246decodeTuple0 =

243 do null <- decode "null"

247 do null <- decode "null"

244− return (Opt.Call null [ Opt.Ctor Help.zeroTuple [] ])

248+ return (Opt.Call null [ Opt.Unit ])

245

249

246

250

247−decodeTuple :: [T.Canonical] -> Env.Optimizer Opt.Expr

251+decodeTuple :: Can.Type -> Can.Type -> Maybe Can.Type -> Names.Tracker Opt.Expr

248−decodeTuple types =

252+decodeTuple a b maybeC =

249− let

253+ do succeed <- decode "succeed"

250− size =

254+ case maybeC of

251− length types

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])

252

259

253− entries =

260+ Just c ->

254− zip [ 0 .. size - 1] types

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])

255

265

256− tuple =

266+

257− Opt.Ctor

267+toLocal :: Int -> Opt.Expr

258− (Help.makeTuple size)

268+toLocal index =

259− (map (Opt.VarLocal . indexToName . fst) entries)

269+ Opt.VarLocal (indexToName index)

260− in

261− do succeed <- decode "succeed"

262− foldM indexAndThen (Opt.Call succeed [tuple]) entries

263

270

264

271

265−indexToName :: Int -> Text

272+indexToName :: Int -> N.Name

266indexToName index =

273indexToName index =

267 Text.pack ('x' : show index)

274 Text.pack ('x' : show index)

268

275

269

276

270−indexAndThen :: Opt.Expr -> (Int, T.Canonical) -> Env.Optimizer Opt.Expr

277+indexAndThen :: Int -> Can.Type -> Opt.Expr -> Names.Tracker Opt.Expr

271−indexAndThen decoder (i, tipe) =

278+indexAndThen i tipe decoder =

272 do andThen <- decode "andThen"

279 do andThen <- decode "andThen"

273 index <- decode "index"

280 index <- decode "index"

274 typeDecoder <- toDecoder tipe

281 typeDecoder <- toDecoder tipe

275 return $

282 return $

276 Opt.Call andThen

283 Opt.Call andThen

277 [ Opt.Function [indexToName i] decoder

284 [ Opt.Function [indexToName i] decoder

278− , Opt.Call index [ Opt.Literal (Literal.IntNum i), typeDecoder ]

285+ , Opt.Call index [ Opt.Int i, typeDecoder ]

279 ]

286 ]

280

287

281

288

@@ -283,20 +290,20 @@ indexAndThen decoder (i, tipe) =

283-- DECODE RECORDS

290-- DECODE RECORDS

284

291

285

292

286−decodeRecord :: [(Text, T.Canonical)] -> Env.Optimizer Opt.Expr

293+decodeRecord :: Map.Map N.Name Can.Type -> Names.Tracker Opt.Expr

287decodeRecord fields =

294decodeRecord fields =

288 let

295 let

289− toFieldExpr (key, _) =

296+ toFieldExpr name _ =

290− (key, Opt.VarLocal key)

297+ Opt.VarLocal name

291

298

292 record =

299 record =

293− Opt.Record (map toFieldExpr fields)

300+ Opt.Record (Map.mapWithKey toFieldExpr fields)

294 in

301 in

295 do succeed <- decode "succeed"

302 do succeed <- decode "succeed"

296− foldM fieldAndThen (Opt.Call succeed [record]) fields

303+ foldM fieldAndThen (Opt.Call succeed [record]) (Map.toList fields)

297

304

298

305

299−fieldAndThen :: Opt.Expr -> (Text, T.Canonical) -> Env.Optimizer Opt.Expr

306+fieldAndThen :: Opt.Expr -> (N.Name, Can.Type) -> Names.Tracker Opt.Expr

300fieldAndThen decoder (key, tipe) =

307fieldAndThen decoder (key, tipe) =

301 do andThen <- decode "andThen"

308 do andThen <- decode "andThen"

302 field <- decode "field"

309 field <- decode "field"

@@ -304,7 +311,7 @@ fieldAndThen decoder (key, tipe) =

304 return $

311 return $

305 Opt.Call andThen

312 Opt.Call andThen

306 [ Opt.Function [key] decoder

313 [ Opt.Function [key] decoder

307− , Opt.Call field [ Opt.Literal (Literal.Str key), typeDecoder ]

314+ , Opt.Call field [ Opt.Str key, typeDecoder ]

308 ]

315 ]

309

316

310

317

@@ -312,18 +319,11 @@ fieldAndThen decoder (key, tipe) =

312-- GLOBALS HELPERS

319-- GLOBALS HELPERS

313

320

314

321

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

323encode name =

324− core "Json.Encode" name

324+ Names.registerGlobal ModuleName.jsonEncode name

325

326

327−decode :: Text -> Env.Optimizer Opt.Expr

327+decode :: N.Name -> Names.Tracker Opt.Expr

328decode name =

329− core "Json.Decode" name

329+ Names.registerGlobal ModuleName.jsonDecode name