64f3f0a · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Make sure pattern match destructures come out in the right order

64f3f0aEvan Czaplicki9 years ago

src/Optimize/Expression.hs+18−13

compare with master

unifiedsplit

@@ -129,7 +129,7 @@ optimize cycle (A.At region expression) =

129 Can.Case expr branches ->

130 let

131 optimizeBranch root (Can.CaseBranch pattern branch) =

132− do destructors <- destructHelp (Opt.Root root) pattern []

132+ do destructors <- destructCase root pattern

133 obranch <- optimize cycle branch

134 pure (pattern, foldr Opt.Destruct obranch destructors)

135 in

@@ -209,6 +209,11 @@ destructArgs args =

209 return (argNames, concat destructorLists)

210

211

212+destructCase :: N.Name -> Can.Pattern -> Names.Tracker [Opt.Destructor]

213+destructCase rootName pattern =

214+ reverse <$> destructHelp (Opt.Root rootName) pattern []

215+

216+

212destruct :: Can.Pattern -> Names.Tracker (N.Name, [Opt.Destructor])

217destruct :: Can.Pattern -> Names.Tracker (N.Name, [Opt.Destructor])

213destruct pattern@(A.At _ ptrn) =

218destruct pattern@(A.At _ ptrn) =

214 case ptrn of

219 case ptrn of

@@ -254,16 +259,16 @@ destructHelp path (A.At region pattern) revDs =

254 Can.PTuple a b (Just c) ->

259 Can.PTuple a b (Just c) ->

255 case path of

260 case path of

256 Opt.Root _ ->

261 Opt.Root _ ->

257− destructHelp (Opt.Index Index.first path) a =<<

262+ destructHelp (Opt.Index Index.third path) c =<<

258 destructHelp (Opt.Index Index.second path) b =<<

263 destructHelp (Opt.Index Index.second path) b =<<

259− destructHelp (Opt.Index Index.third path) c revDs

264+ destructHelp (Opt.Index Index.first path) a revDs

260

265

261 _ ->

266 _ ->

262 do name <- Names.generate

267 do name <- Names.generate

263 let newRoot = Opt.Root name

268 let newRoot = Opt.Root name

264− destructHelp (Opt.Index Index.first newRoot) a =<<

269+ destructHelp (Opt.Index Index.third newRoot) c =<<

265 destructHelp (Opt.Index Index.second newRoot) b =<<

270 destructHelp (Opt.Index Index.second newRoot) b =<<

266− destructHelp (Opt.Index Index.third newRoot) c (Opt.Destructor name path : revDs)

271+ destructHelp (Opt.Index Index.first newRoot) a (Opt.Destructor name path : revDs)

267

272

268 Can.PList [] ->

273 Can.PList [] ->

269 pure revDs

274 pure revDs

@@ -285,11 +290,11 @@ destructHelp path (A.At region pattern) revDs =

285

290

286 Can.PCtor _ _ (Can.Union _ _ _ opts) _ _ args ->

291 Can.PCtor _ _ (Can.Union _ _ _ opts) _ _ args ->

287 case args of

292 case args of

288− [Can.PatternCtorArg i _ arg] ->

293+ [Can.PatternCtorArg _ _ arg] ->

289 case opts of

294 case opts of

290− Can.Normal -> destructHelp (Opt.Index i path) arg revDs

295+ Can.Normal -> destructHelp (Opt.Index Index.first path) arg revDs

291 Can.Unbox -> destructHelp (Opt.Unbox path) arg revDs

296 Can.Unbox -> destructHelp (Opt.Unbox path) arg revDs

292− Can.Enum -> destructHelp (Opt.Index i path) arg revDs

297+ Can.Enum -> destructHelp (Opt.Index Index.first path) arg revDs

293

298

294 _ ->

299 _ ->

295 case path of

300 case path of

@@ -305,14 +310,14 @@ destructTwo :: Opt.Path -> Can.Pattern -> Can.Pattern -> [Opt.Destructor] -> Nam

305destructTwo path a b revDs =

310destructTwo path a b revDs =

306 case path of

311 case path of

307 Opt.Root _ ->

312 Opt.Root _ ->

308− destructHelp (Opt.Index Index.first path) a =<<

313+ destructHelp (Opt.Index Index.second path) b =<<

309− destructHelp (Opt.Index Index.second path) b revDs

314+ destructHelp (Opt.Index Index.first path) a revDs

310

315

311 _ ->

316 _ ->

312 do name <- Names.generate

317 do name <- Names.generate

313 let newRoot = Opt.Root name

318 let newRoot = Opt.Root name

314− destructHelp (Opt.Index Index.first newRoot) a =<<

319+ destructHelp (Opt.Index Index.second newRoot) b =<<

315− destructHelp (Opt.Index Index.second newRoot) b (Opt.Destructor name path : revDs)

320+ destructHelp (Opt.Index Index.first newRoot) a (Opt.Destructor name path : revDs)

316

321

317

322

318destructCtorArg :: Opt.Path -> [Opt.Destructor] -> Can.PatternCtorArg -> Names.Tracker [Opt.Destructor]

323destructCtorArg :: Opt.Path -> [Opt.Destructor] -> Can.PatternCtorArg -> Names.Tracker [Opt.Destructor]

@@ -391,7 +396,7 @@ optimizeTail cycle rootName argNames locExpr@(A.At _ expression) =

391 Can.Case expr branches ->

396 Can.Case expr branches ->

392 let

397 let

393 optimizeBranch root (Can.CaseBranch pattern branch) =

398 optimizeBranch root (Can.CaseBranch pattern branch) =

394− do destructors <- destructHelp (Opt.Root root) pattern []

399+ do destructors <- destructCase root pattern

395 obranch <- optimizeTail cycle rootName argNames branch

400 obranch <- optimizeTail cycle rootName argNames branch

396 pure (pattern, foldr Opt.Destruct obranch destructors)

401 pure (pattern, foldr Opt.Destruct obranch destructors)

397 in

402 in