git.iko.soy/elk
on master help sign in
cosmetic: add vertical whitespace
fe7bbbdEvan Czaplicki
src/Optimize/DecisionTree.hs+24
compare with master
unifiedsplit
@@ -29,8 +29,10 @@ import qualified Reporting.Annotation as A
29type CPattern = P.Canonical
29type CPattern = P.Canonical
30
30
31
31
32+
32-- COMPILE CASES
33-- COMPILE CASES
33
34
35+
34{-| Users of this module will mainly interact with this function. It takes
36{-| Users of this module will mainly interact with this function. It takes
35some normal branches and gives out a decision tree that has "labels" at all
37some normal branches and gives out a decision tree that has "labels" at all
36the leafs and a dictionary that maps these "labels" to the code that should
38the leafs and a dictionary that maps these "labels" to the code that should
@@ -66,8 +68,10 @@ type VariantDict =
66 Map.Map Var.Home (Map.Map Text Int)
68 Map.Map Var.Home (Map.Map Text Int)
67
69
68
70
71+
69-- DECISION TREES
72-- DECISION TREES
70
73
74+
71data DecisionTree
75data DecisionTree
72 = Match Int
76 = Match Int
73 | Decision
77 | Decision
@@ -92,8 +96,10 @@ data Path
92 deriving (Eq)
96 deriving (Eq)
93
97
94
98
99+
95-- PATH HELPERS
100-- PATH HELPERS
96
101
102+
97add :: Path -> Path -> Path
103add :: Path -> Path -> Path
98add path finalLink =
104add path finalLink =
99 case path of
105 case path of
@@ -118,8 +124,10 @@ subPositions path patterns =
118 patterns
124 patterns
119
125
120
126
127+
121-- ACTUALLY BUILD DECISION TREES
128-- ACTUALLY BUILD DECISION TREES
122
129
130+
123data Branch =
131data Branch =
124 Branch
132 Branch
125 { _goal :: Int
133 { _goal :: Int
@@ -191,8 +199,10 @@ getArity variantDict (Var.Canonical home name) =
191 \inference, it is impossible that a pattern cannot be found."
199 \inference, it is impossible that a pattern cannot be found."
192
200
193
201
202+
194-- FLATTEN PATTERNS
203-- FLATTEN PATTERNS
195
204
205+
196{-| Flatten type aliases and use the VariantDict to figure out when a tag is
206{-| Flatten type aliases and use the VariantDict to figure out when a tag is
197the only variant so we can skip doing any tests on it.
207the only variant so we can skip doing any tests on it.
198-}
208-}
@@ -229,8 +239,10 @@ flatten variantDict pathPattern@(path, A.A ann pattern) =
229 [pathPattern]
239 [pathPattern]
230
240
231
241
242+
232-- SUCCESSFULLY MATCH
243-- SUCCESSFULLY MATCH
233
244
245+
234{-| If the first branch has no more "decision points" we can finally take that
246{-| If the first branch has no more "decision points" we can finally take that
235path. If that is the case we give the resulting label and a mapping from free
247path. If that is the case we give the resulting label and a mapping from free
236variables to "how to get their value". So a pattern like (Just (x,_)) will give
248variables to "how to get their value". So a pattern like (Just (x,_)) will give
@@ -246,8 +258,10 @@ checkForMatch branches =
246 Nothing
258 Nothing
247
259
248
260
261+
249-- GATHER OUTGOING EDGES
262-- GATHER OUTGOING EDGES
250
263
264+
251gatherEdges :: VariantDict -> [Branch] -> Path -> ([(Test, [Branch])], [Branch])
265gatherEdges :: VariantDict -> [Branch] -> Path -> ([(Test, [Branch])], [Branch])
252gatherEdges variantDict branches path =
266gatherEdges variantDict branches path =
253 let
267 let
@@ -266,8 +280,10 @@ gatherEdges variantDict branches path =
266 ( allEdges, fallbacks )
280 ( allEdges, fallbacks )
267
281
268
282
283+
269-- FIND RELEVANT TESTS
284-- FIND RELEVANT TESTS
270
285
286+
271testsAtPath :: Path -> [Branch] -> [Test]
287testsAtPath :: Path -> [Branch] -> [Test]
272testsAtPath selectedPath branches =
288testsAtPath selectedPath branches =
273 let
289 let
@@ -312,8 +328,10 @@ testAtPath selectedPath (Branch _ pathPatterns) =
312 Nothing
328 Nothing
313
329
314
330
331+
315-- BUILD EDGES
332-- BUILD EDGES
316
333
334+
317edgesFor :: Path -> [Branch] -> Test -> (Test, [Branch])
335edgesFor :: Path -> [Branch] -> Test -> (Test, [Branch])
318edgesFor path branches test =
336edgesFor path branches test =
319 ( test
337 ( test
@@ -369,8 +387,10 @@ extract selectedPath pathPatterns =
369 Just (first : start, foundPattern, end)
387 Just (first : start, foundPattern, end)
370
388
371
389
390+
372-- FIND IRRELEVANT BRANCHES
391-- FIND IRRELEVANT BRANCHES
373
392
393+
374isIrrelevantTo :: Path -> Branch -> Bool
394isIrrelevantTo :: Path -> Branch -> Bool
375isIrrelevantTo selectedPath (Branch _ pathPatterns) =
395isIrrelevantTo selectedPath (Branch _ pathPatterns) =
376 case List.lookup selectedPath pathPatterns of
396 case List.lookup selectedPath pathPatterns of
@@ -403,8 +423,10 @@ needsTests (A.A _ pattern) =
403 True
423 True
404
424
405
425
426+
406-- PICK A PATH
427-- PICK A PATH
407
428
429+
408pickPath :: VariantDict -> [Branch] -> Path
430pickPath :: VariantDict -> [Branch] -> Path
409pickPath variantDict branches =
431pickPath variantDict branches =
410 let
432 let
@@ -453,8 +475,10 @@ bests allPaths =
453 snd (List.foldl' gatherMinimum (headWeight, [headPath]) weightedPaths)
475 snd (List.foldl' gatherMinimum (headWeight, [headPath]) weightedPaths)
454
476
455
477
478+
456-- PATH PICKING HEURISTICS
479-- PATH PICKING HEURISTICS
457
480
481+
458smallDefaults :: [Branch] -> Path -> Int
482smallDefaults :: [Branch] -> Path -> Int
459smallDefaults branches path =
483smallDefaults branches path =
460 length (filter (isIrrelevantTo path) branches)
484 length (filter (isIrrelevantTo path) branches)