git.iko.soy/elk
on master help sign in
Hook up decision tree in optimize phase
9b18f28Evan Czaplicki
src/Optimize.hs+30−10
compare with master
unifiedsplit
@@ -13,13 +13,9 @@ import qualified AST.Optimized as Opt
13import qualified AST.Module.Name as ModuleName
13import qualified AST.Module.Name as ModuleName
14import qualified Data.Index as Index
14import qualified Data.Index as Index
15import qualified Elm.Name as N
15import qualified Elm.Name as N
16−--import qualified Optimize.Case as Case
16+import qualified Optimize.Case as Case
17−import qualified Optimize.DecisionTree as DT
18import qualified Optimize.Names as Names
17import qualified Optimize.Names as Names
19−--import qualified Optimize.Inline as Inline
20−--import qualified Optimize.Port as Port
21import qualified Reporting.Annotation as A
18import qualified Reporting.Annotation as A
22−import qualified Reporting.Region as R
23
19
24
20
25
21
@@ -80,8 +76,7 @@ optimizeExpr (A.At region expression) =
80 Can.Lambda args body ->
76 Can.Lambda args body ->
81 do (argNames, defss) <- destructArgs args
77 do (argNames, defss) <- destructArgs args
82 obody <- optimizeExpr body
78 obody <- optimizeExpr body
83− pure $
84− Opt.Function argNames (foldr Opt.Let obody (concat defss))
79+ pure $ Opt.Function argNames (foldr Opt.Let obody (concat defss))
85
80
86 Can.Call func args ->
81 Can.Call func args ->
87 Opt.Call
82 Opt.Call
@@ -121,7 +116,20 @@ optimizeExpr (A.At region expression) =
121 Opt.Let (Opt.Def name oexpr) (foldr Opt.Let obody defs)
116 Opt.Let (Opt.Def name oexpr) (foldr Opt.Let obody defs)
122
117
123 Can.Case expr branches ->
118 Can.Case expr branches ->
124− error "TODO"
119+ let
120+ optimizeBranch root (Can.CaseBranch pattern branch) =
121+ do defs <- destructHelp (Opt.VarLocal root) pattern []
122+ obranch <- optimizeExpr branch
123+ pure (pattern, foldr Opt.Let obranch defs)
124+ in
125+ do oexpr <- optimizeExpr expr
126+ case oexpr of
127+ Opt.VarLocal root ->
128+ Case.optimize root <$> traverse (optimizeBranch root) branches
129+
130+ _ ->
131+ do root <- Names.generate
132+ Case.optimize root <$> traverse (optimizeBranch root) branches
125
133
126 Can.Accessor field ->
134 Can.Accessor field ->
127 pure (Opt.Accessor field)
135 pure (Opt.Accessor field)
@@ -340,7 +348,20 @@ optimizeTailExpr name argNames locExpr@(A.At _ expression) =
340 Opt.Let (Opt.Def dname oexpr) (foldr Opt.Let obody defs)
348 Opt.Let (Opt.Def dname oexpr) (foldr Opt.Let obody defs)
341
349
342 Can.Case expr branches ->
350 Can.Case expr branches ->
343− error "TODO"
351+ let
352+ optimizeBranch root (Can.CaseBranch pattern branch) =
353+ do defs <- destructHelp (Opt.VarLocal root) pattern []
354+ obranch <- optimizeTailExpr name argNames branch
355+ pure (pattern, foldr Opt.Let obranch defs)
356+ in
357+ do oexpr <- optimizeExpr expr
358+ case oexpr of
359+ Opt.VarLocal root ->
360+ Case.optimize root <$> traverse (optimizeBranch root) branches
361+
362+ _ ->
363+ do root <- Names.generate
364+ Case.optimize root <$> traverse (optimizeBranch root) branches
344
365
345 _ ->
366 _ ->
346 optimizeExpr locExpr
367 optimizeExpr locExpr
@@ -375,4 +396,3 @@ hasTailCall expression =
375
396
376 _ ->
397 _ ->
377 False
398 False
378−
src/Optimize/Case.hs+12−11
@@ -1,14 +1,18 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−module Optimize.Case (optimize) where
2+module Optimize.Case
3+ ( optimize
4+ )
5+ where
6+
3
7
4import Control.Arrow (second)
8import Control.Arrow (second)
5import qualified Data.Map as Map
9import qualified Data.Map as Map
6import Data.Map ((!))
10import Data.Map ((!))
7import qualified Data.Maybe as Maybe
11import qualified Data.Maybe as Maybe
8−import Data.Text (Text)
9
12
10−import qualified AST.Expression.Optimized as Opt
13+import qualified AST.Canonical as Can
14+import qualified AST.Optimized as Opt
11−import qualified AST.Pattern as P
15+import qualified Elm.Name as N
12import qualified Optimize.DecisionTree as DT
16import qualified Optimize.DecisionTree as DT
13
17
14
18
@@ -16,16 +20,13 @@ import qualified Optimize.DecisionTree as DT
16-- OPTIMIZE A CASE EXPRESSION
20-- OPTIMIZE A CASE EXPRESSION
17
21
18
22
19−optimize :: DT.VariantDict -> Text -> [(P.Canonical, Opt.Expr)] -> Opt.Expr
23+optimize :: N.Name -> [(Can.Pattern, Opt.Expr)] -> Opt.Expr
20−optimize variantDict exprName optBranches =
24+optimize exprName optBranches =
21 let
25 let
22 (patterns, indexedBranches) =
26 (patterns, indexedBranches) =
23 unzip (zipWith indexify [0..] optBranches)
27 unzip (zipWith indexify [0..] optBranches)
24−
25− decisionTree =
26− DT.compile variantDict patterns
27 in
28 in
28− treeToExpr exprName decisionTree indexedBranches
29+ treeToExpr exprName (DT.compile patterns) indexedBranches
29
30
30
31
31indexify :: Int -> (a,b) -> ((a,Int), (Int,b))
32indexify :: Int -> (a,b) -> ((a,Int), (Int,b))
@@ -39,7 +40,7 @@ indexify index (pattern, branch) =
39-- CONVERT A TREE TO AN EXPRESSION
40-- CONVERT A TREE TO AN EXPRESSION
40
41
41
42
42−treeToExpr :: Text -> DT.DecisionTree -> [(Int, Opt.Expr)] -> Opt.Expr
43+treeToExpr :: N.Name -> DT.DecisionTree -> [(Int, Opt.Expr)] -> Opt.Expr
43treeToExpr name decisionTree allJumps =
44treeToExpr name decisionTree allJumps =
44 let
45 let
45 decider =
46 decider =
src/Optimize/DecisionTree.hs+2−1
@@ -1,7 +1,8 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Optimize.DecisionTree
3module Optimize.DecisionTree
4+ ( DecisionTree(..)
4− ( compile
5+ , compile
5 , Path(..)
6 , Path(..)
6 , Test(..)
7 , Test(..)
7 )
8 )