Skip to content

Commit c937d0c

Browse files
committed
Main pass to optimize layout when user annotates function
1 parent 583a207 commit c937d0c

File tree

5 files changed

+478
-63
lines changed

5 files changed

+478
-63
lines changed
Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
import Basics
2+
import GenerateLayout1
3+
4+
type Text = Vector Char
5+
6+
emphKeywordInContent :: Text -> Blog -> Blog
7+
{-# ANN emphKeywordInContent Layout1 #-}
8+
emphKeywordInContent keyword blogs =
9+
case blogs of
10+
End -> End
11+
Layout1 header id author date content tags rst -> let newContent = case content of
12+
Content block -> Content (emphasizeKeywordInBlock keyword block)
13+
newRst = emphKeywordInContent keyword rst
14+
in Layout1 header id author date newContent tags newRst
15+
16+
-- main function
17+
gibbon_main =
18+
let blogs = mkBlogs_layout1 2
19+
keyword :: Vector Char
20+
keyword = "a"
21+
newblgs = emphKeywordInContent keyword blogs
22+
in printPacked newblgs

gibbon-compiler/src/Gibbon/Compiler.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,7 @@ import Gibbon.Passes.Codegen (codegenProg)
9292
import Gibbon.Passes.Fusion2 (fusion2)
9393
import Gibbon.Passes.CalculateBounds (inferRegSize)
9494
import Gibbon.Pretty
95+
import Gibbon.Passes.OptimizeADTLayout (shuffleDataCon)
9596

9697

9798

@@ -639,6 +640,7 @@ passes config@Config{dynflags} l0 = do
639640
-- branches before InferLocations.
640641

641642
-- Note: L1 -> L2
643+
l1 <- goE1 "optimizeADTLayout" shuffleDataCon l1
642644
l1 <- goE1 "copyOutOfOrderPacked" copyOutOfOrderPacked l1
643645
l1 <- goE1 "simplify_2" simplifyL1 l1
644646
l1 <- go "L1.typecheck" L1.tcProg l1

gibbon-compiler/src/Gibbon/Passes/DefinitionUseChains.hs

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -104,11 +104,7 @@ generateDefUseChainsFunction ::
104104
generateDefUseChainsFunction env f@FunDef {funName, funBody, funTy, funArgs} =
105105
let edgeList = generateDefUseChainsFunBody env funBody
106106
(graph, nodeFromVertex, vertexFromKey) = G.graphFromEdges edgeList
107-
in dbgTraceIt
108-
(sdoc edgeList)
109-
dbgTraceIt
110-
("\n")
111-
M.insert
107+
in M.insert
112108
funName
113109
(graph, nodeFromVertex, vertexFromKey)
114110
M.empty
@@ -119,7 +115,7 @@ getDefinitionsReachingLetExp :: (FreeVars (e l d), Ord l, Ord d, Ord (e l d), Ou
119115
getDefinitionsReachingLetExp f@FunDef {funName, funBody, funTy, funArgs} =
120116
let edgeList = generateUseDefChainsFunBody M.empty funBody
121117
(graph, nodeFromVertex, vertexFromKey) = G.graphFromEdges edgeList
122-
in dbgTraceIt (sdoc edgeList) dbgTraceIt ("\n") M.insert funName (graph, nodeFromVertex, vertexFromKey) M.empty
118+
in M.insert funName (graph, nodeFromVertex, vertexFromKey) M.empty
123119

124120

125121

@@ -132,11 +128,7 @@ generateDefUseChainsExp ::
132128
generateDefUseChainsExp env key expr =
133129
let edgeList = generateDefUseChainsFunBody env expr
134130
(graph, nodeFromVertex, vertexFromKey) = G.graphFromEdges edgeList
135-
in dbgTraceIt
136-
(sdoc edgeList)
137-
dbgTraceIt
138-
("\n")
139-
M.insert
131+
in M.insert
140132
key
141133
(graph, nodeFromVertex, vertexFromKey)
142134
M.empty
@@ -350,3 +342,11 @@ getDefUseChainsVar var exp isReDefined =
350342
MapE {} -> error "getDefUseChainsVar: TODO MapE"
351343
FoldE {} -> error "getDefUseChainsVar: TODO FoldE"
352344
Ext _ -> error "getDefUseChainsVar: TODO Ext"
345+
346+
347+
348+
-- TODO:
349+
-- For UseDefChains, add variables introduced in case expressions.
350+
-- successors are expressions that use those expressions, make this recursive.
351+
-- remove all let binds
352+
-- then release let binds using gFreeVars

0 commit comments

Comments
 (0)