Skip to content

Commit 35d3609

Browse files
vidsinghalvidsinghal
committed
misc. fixes
1 parent a66a6da commit 35d3609

File tree

10 files changed

+111
-144
lines changed

10 files changed

+111
-144
lines changed

‎.github/workflows/haskell-ci.yml‎

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -15,9 +15,6 @@
1515
name: Haskell-CI
1616
on:
1717
- push
18-
branches:
19-
- main
20-
- vidush/soa
2118
- pull_request
2219
jobs:
2320
linux:
@@ -191,7 +188,7 @@ jobs:
191188
touch cabal.project.local
192189
echo "packages: ${PKGDIR_gibbon}" >> cabal.project
193190
echo "package gibbon" >> cabal.project
194-
#echo " ghc-options: -Werror=missing-methods" >> cabal.project
191+
echo " ghc-options: -Werror=missing-methods" >> cabal.project
195192
cat >> cabal.project <<EOF
196193
EOF
197194
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(gibbon)$/; }' >> cabal.project.local

‎cabal.project‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
packages: gibbon-compiler
22

3-
--if (impl(ghc >= 9.8))
4-
-- program-options
5-
-- ghc-options: -Werror=x-no-partial
6-
--else
7-
-- program-options
8-
-- ghc-options: -Werror
3+
if (impl(ghc >= 9.8))
4+
program-options
5+
ghc-options: -Werror=x-no-partial
6+
else
7+
program-options
8+
ghc-options: -Werror

‎gibbon-compiler/examples/layout_benchmarks/Adts.hs‎

Lines changed: 68 additions & 71 deletions
Original file line numberDiff line numberDiff line change
@@ -5,11 +5,8 @@ import Contents
55
import Tags
66

77

8-
data Adt = Nil | CA (Content) (Adt)
9-
deriving (Show)
10-
11-
-- | AC (Adt) (Content) | TCA (Tags) (Content) (Adt) | ACT (Adt) (Content) (Tags) | TAC (Tags) (Adt) (Content) | ATC (Adt) (Tags) (Content) | CTA (Content) (Tags) (Adt) | CAT (Content) (Adt) (Tags) deriving (Show)
12-
8+
data Adt = Nil | CA (Content) (Adt) | AC (Adt) (Content) | TCA (Tags) (Content) (Adt) | ACT (Adt) (Content) (Tags) | TAC (Tags) (Adt) (Content) | ATC (Adt) (Tags) (Content) | CTA (Content) (Tags) (Adt) | CAT (Content) (Adt) (Tags)
9+
deriving (Show)
1310

1411
-- make list for adt CA Tail recursive
1512
mkCAListTR :: Int -> Int -> Adt -> Adt
@@ -30,7 +27,7 @@ mkCAList len strLen = if len <= 0
3027
in CA content rst
3128

3229

33-
{-- make list for adt AC
30+
-- make list for adt AC
3431
mkACList :: Int -> Int -> Adt
3532
mkACList len strLen = if len <= 0
3633
then Nil
@@ -88,7 +85,7 @@ mkCATList len tagLen strLen = if (len <= 0)
8885
else let content = mkContentText strLen
8986
rst = mkCATList (len-1) tagLen strLen
9087
tags = mkRandomTags tagLen
91-
in CAT content rst tags ---}
88+
in CAT content rst tags
9289

9390
printAdt :: Adt -> ()
9491
printAdt adt =
@@ -99,75 +96,75 @@ printAdt adt =
9996
in ()
10097
CA a rst ->
10198
let _ = printsym (quote "(CA ")
102-
--_ = printContent a
99+
_ = printContent a
103100
_ = printsym (quote "SPACE")
104101
_ = printAdt rst
105102
_ = printsym (quote ")")
106103
_ = printsym (quote "SPACE")
107104
in ()
108-
-- AC rst a ->
109-
-- let _ = printsym (quote "(AC ")
110-
-- _ = printAdt rst
111-
-- _ = printContent a
112-
-- _ = printsym (quote "SPACE")
113-
-- _ = printsym (quote ")")
114-
-- _ = printsym (quote "SPACE")
115-
-- in ()
116-
-- TCA tags content rst ->
117-
-- let _ = printsym (quote "(TCA ")
118-
-- _ = printTags tags
119-
-- _ = printContent content
120-
-- _ = printAdt rst
121-
-- _ = printsym (quote "SPACE")
122-
-- _ = printsym (quote ")")
123-
-- _ = printsym (quote "SPACE")
124-
-- in ()
125-
-- ACT rst content tags ->
126-
-- let _ = printsym (quote "(ACT ")
127-
-- _ = printAdt rst
128-
-- _ = printContent content
129-
-- _ = printTags tags
130-
-- _ = printsym (quote "SPACE")
131-
-- _ = printsym (quote ")")
132-
-- _ = printsym (quote "SPACE")
133-
-- in ()
134-
-- TAC tags rst content ->
135-
-- let _ = printsym (quote "(TAC ")
136-
-- _ = printTags tags
137-
-- _ = printAdt rst
138-
-- _ = printContent content
139-
-- _ = printsym (quote "SPACE")
140-
-- _ = printsym (quote ")")
141-
-- _ = printsym (quote "SPACE")
142-
-- in ()
143-
-- ATC rst tags content ->
144-
-- let _ = printsym (quote "(ATC ")
145-
-- _ = printAdt rst
146-
-- _ = printTags tags
147-
-- _ = printContent content
148-
-- _ = printsym (quote "SPACE")
149-
-- _ = printsym (quote ")")
150-
-- _ = printsym (quote "SPACE")
151-
-- in ()
152-
-- CTA content tags rst ->
153-
-- let _ = printsym (quote "(CTA ")
154-
-- _ = printContent content
155-
-- _ = printTags tags
156-
-- _ = printAdt rst
157-
-- _ = printsym (quote "SPACE")
158-
-- _ = printsym (quote ")")
159-
-- _ = printsym (quote "SPACE")
160-
-- in ()
161-
-- CAT content rst tags ->
162-
-- let _ = printsym (quote "(CAT ")
163-
-- _ = printContent content
164-
-- _ = printAdt rst
165-
-- _ = printTags tags
166-
-- _ = printsym (quote "SPACE")
167-
-- _ = printsym (quote ")")
168-
-- _ = printsym (quote "SPACE")
169-
-- in ()
170-
--
105+
AC rst a ->
106+
let _ = printsym (quote "(AC ")
107+
_ = printAdt rst
108+
_ = printContent a
109+
_ = printsym (quote "SPACE")
110+
_ = printsym (quote ")")
111+
_ = printsym (quote "SPACE")
112+
in ()
113+
TCA tags content rst ->
114+
let _ = printsym (quote "(TCA ")
115+
_ = printTags tags
116+
_ = printContent content
117+
_ = printAdt rst
118+
_ = printsym (quote "SPACE")
119+
_ = printsym (quote ")")
120+
_ = printsym (quote "SPACE")
121+
in ()
122+
ACT rst content tags ->
123+
let _ = printsym (quote "(ACT ")
124+
_ = printAdt rst
125+
_ = printContent content
126+
_ = printTags tags
127+
_ = printsym (quote "SPACE")
128+
_ = printsym (quote ")")
129+
_ = printsym (quote "SPACE")
130+
in ()
131+
TAC tags rst content ->
132+
let _ = printsym (quote "(TAC ")
133+
_ = printTags tags
134+
_ = printAdt rst
135+
_ = printContent content
136+
_ = printsym (quote "SPACE")
137+
_ = printsym (quote ")")
138+
_ = printsym (quote "SPACE")
139+
in ()
140+
ATC rst tags content ->
141+
let _ = printsym (quote "(ATC ")
142+
_ = printAdt rst
143+
_ = printTags tags
144+
_ = printContent content
145+
_ = printsym (quote "SPACE")
146+
_ = printsym (quote ")")
147+
_ = printsym (quote "SPACE")
148+
in ()
149+
CTA content tags rst ->
150+
let _ = printsym (quote "(CTA ")
151+
_ = printContent content
152+
_ = printTags tags
153+
_ = printAdt rst
154+
_ = printsym (quote "SPACE")
155+
_ = printsym (quote ")")
156+
_ = printsym (quote "SPACE")
157+
in ()
158+
CAT content rst tags ->
159+
let _ = printsym (quote "(CAT ")
160+
_ = printContent content
161+
_ = printAdt rst
162+
_ = printTags tags
163+
_ = printsym (quote "SPACE")
164+
_ = printsym (quote ")")
165+
_ = printsym (quote "SPACE")
166+
in ()
167+
171168

172169
gibbon_main =
173170
let lst = mkCAList 10 2

‎gibbon-compiler/examples/layout_benchmarks/Contents.hs‎

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -44,10 +44,6 @@ printContent content =
4444
_ = printString n
4545
in ()
4646

47-
48-
49-
50-
5147
gibbon_main =
5248
let content = mkContentText 10
5349
imageContent = mkContentImage 10

‎gibbon-compiler/examples/listRandomize.hs‎

Lines changed: 15 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -2,19 +2,18 @@ module Main where
22

33
{- Defining List type. -}
44

5-
data List = Nil | Cons Int (List) -- | Snoc (List) Int deriving (Show)
5+
data List = Nil | Cons Int (List) | Snoc (List) Int deriving (Show)
66

77

88
randomizeList :: List -> List
99
randomizeList list = case list of
1010
Nil-> Nil
11-
Cons a rst -> Cons a (randomizeList rst)
12-
--if (mod rand 2 == 0)
13-
--then Cons a (randomizeList rst)
14-
--else Snoc (randomizeList rst) a
15-
--Snoc rst a -> if (mod rand 2 == 0)
16-
-- then Cons a (randomizeList rst)
17-
-- else Snoc (randomizeList rst) a
11+
Cons a rst -> if (mod rand 2 == 0)
12+
then Cons a (randomizeList rst)
13+
else Snoc (randomizeList rst) a
14+
Snoc rst a -> if (mod rand 2 == 0)
15+
then Cons a (randomizeList rst)
16+
else Snoc (randomizeList rst) a
1817

1918
mkList :: Int -> List
2019
mkList len =
@@ -45,14 +44,14 @@ printSyms lst =
4544
_ = printsym (quote ")")
4645
_ = printsym (quote "SPACE")
4746
in ()
48-
--Snoc rst a ->
49-
-- let _ = printsym (quote "(Snoc ")
50-
-- _ = printSyms rst
51-
-- _ = printint a
52-
-- _ = printsym (quote "SPACE")
53-
-- _ = printsym (quote ")")
54-
-- _ = printsym (quote "SPACE")
55-
-- in ()
47+
Snoc rst a ->
48+
let _ = printsym (quote "(Snoc ")
49+
_ = printSyms rst
50+
_ = printint a
51+
_ = printsym (quote "SPACE")
52+
_ = printsym (quote ")")
53+
_ = printsym (quote "SPACE")
54+
in ()
5655

5756
gibbon_main =
5857
let step1 = printsym (quote "--- Start of Program ---\n")

‎gibbon-compiler/examples/poly/T127b.hs‎

Lines changed: 0 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -8,14 +8,6 @@ data Baz a = MkBaz (Foo Int a)
88

99
gibbon_main =
1010
let foo = MkFoo 10 20
11-
--_ = printPacked foo
12-
--_ = printsym (quote "\n")
13-
--bar = MkBar foo
14-
--_ = printPacked bar
15-
--_ = printsym (quote "\n")
16-
--baz = MkBaz (MkFoo 12 20)
1711
baz = MkBaz foo
1812
baz2 = MkBaz (MkFoo 10 False)
19-
--_ = printPacked baz2
20-
--_ = printsym (quote "\n")
2113
in 10

‎gibbon-compiler/src/Gibbon/Common.hs‎

Lines changed: 13 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -154,40 +154,25 @@ type Location = Var
154154
type FieldIndex = Int
155155
-- | A data constructor is a String type in the compiler
156156
type DataCon = String
157-
158-
-- | Single: For storing a single location, useful for adding a cursor in a region.
159-
-- | SoA: A location signature for a structure of arrays representation.
160-
-- The first location points to a location in the data constructor buffer.
161-
-- The list includes locations for each field and a tuple storing
162-
-- information about which data constructor and corresponding index the field
163-
-- comes from.
164-
-- TODO: I think the type for an SoA location is not right here
165-
-- A Location should work for a data constructor buffer
166-
-- However, imagine if we have a data type definition of
167-
-- data Foo = A Int List Tree Tree | Leaf
168-
-- here the List would be in its own buffer potentially
169-
-- so we have nesting of SoA locations
170-
-- Possibly need to change Location in SoA to LocVar, a recursive data type
171-
-- But for simple data types like data List = Cons Int List | Nil
172-
-- this should work just fine.
173-
-- One reason I don't want to make an SoA location recursive is that you might
174-
-- want to make the level of factoring limited to only depth = 1
175-
-- more factoring than a depth of level one might slow down too much
176-
-- data List2 = Cons2 Int List List2 | Nil2
177-
-- In the SoA representation, it is guaranteed that the data constructors should
178-
-- Remain in the same buffer. Hence, its fine to have its type as Location instead
179-
-- of LocVar.
180-
181-
data LocVar = Single Location | SoA Location [((DataCon, FieldIndex), LocVar)]
182-
deriving (Show, Ord, Eq, Read, Generic, NFData, Out)
157+
158+
data LocVar =
159+
-- | Single: For storing a single location, useful for adding a cursor in a region.
160+
Single Location
161+
|
162+
-- | SoA: A location signature for a structure of arrays representation.
163+
-- The first location points to a location in the data constructor buffer.
164+
-- The list includes locations for each field and a tuple storing
165+
-- information about which data constructor and corresponding index the field
166+
-- comes from.
167+
SoA Location [((DataCon, FieldIndex), LocVar)]
168+
deriving (Show, Ord, Eq, Read, Generic, NFData, Out)
183169

184170
-- | Abstract region variables.
185-
-- type RegVar = Var
186171
data RegVar = SingleR Var | SoARv RegVar [((DataCon, FieldIndex), RegVar)]
187172
deriving (Show, Ord, Eq, Read, Generic, NFData, Out)
188173

189174

190-
-- gFreeVars ++ locations ++ region variables
175+
-- | gFreeVars ++ locations ++ region variables
191176
data FreeVarsTy = V Var | FL LocVar | R RegVar
192177
deriving (Read, Show, Eq, Ord, Generic, NFData, Out)
193178

‎gibbon-compiler/src/Gibbon/Compiler.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -820,7 +820,8 @@ Also see Note [Adding dummy traversals] and Note [Adding random access nodes].
820820
l2 <- go "inferFunAllocs" inferFunAllocs l2
821821
l2 <- go "L2.typecheck" L2.tcProg l2
822822
-- L2 program no longer typechecks while these next passes run
823-
l2 <- goE2 "simplifyLocBinds" (simplifyLocBinds True) l2 {- VS: This used to be false, why doesn't true work ? -}
823+
{- VS: The Argument to simplify loc binds used to be False, why doesn't true work ? -}
824+
l2 <- goE2 "simplifyLocBinds" (simplifyLocBinds True) l2
824825
l2 <- go "addRedirectionCon" addRedirectionCon l2
825826
-- l2 <- if gibbon1
826827
-- then pure l2

‎gibbon-compiler/src/Gibbon/L0/Syntax.hs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -110,7 +110,7 @@ instance FreeVars (E0Ext l d) where
110110
PrintPacked _ e1 -> gFreeVars e1
111111
CopyPacked _ e1 -> gFreeVars e1
112112
TravPacked _ e1 -> gFreeVars e1
113-
Gibbon.L0.Syntax.L _ e1 -> gFreeVars e1
113+
L _ e1 -> gFreeVars e1
114114
LinearExt ext -> gFreeVars ext
115115

116116
instance (Out l, Out d, Show l, Show d) => Expression (E0Ext l d) where
@@ -133,7 +133,7 @@ instance HasSubstitutableExt E0Ext l d => SubstitutableExt (PreExp E0Ext l d) (E
133133
PrintPacked ty e1 -> PrintPacked ty (gSubst old new e1)
134134
CopyPacked ty e1 -> CopyPacked ty (gSubst old new e1)
135135
TravPacked ty e1 -> TravPacked ty (gSubst old new e1)
136-
Gibbon.L0.Syntax.L p e1 -> Gibbon.L0.Syntax.L p (gSubst old new e1)
136+
L p e1 -> L p (gSubst old new e1)
137137
LinearExt e -> LinearExt (gSubstExt old new e)
138138

139139
gSubstEExt old new ext =
@@ -146,7 +146,7 @@ instance HasSubstitutableExt E0Ext l d => SubstitutableExt (PreExp E0Ext l d) (E
146146
PrintPacked ty e -> PrintPacked ty $ (gSubstE old new e)
147147
CopyPacked ty e -> CopyPacked ty $ (gSubstE old new e)
148148
TravPacked ty e -> TravPacked ty $ (gSubstE old new e)
149-
Gibbon.L0.Syntax.L p e -> Gibbon.L0.Syntax.L p $ (gSubstE old new e)
149+
L p e -> L p $ (gSubstE old new e)
150150
LinearExt e -> LinearExt (gSubstEExt old new e)
151151

152152
instance HasRenamable E0Ext l d => Renamable (E0Ext l d) where
@@ -160,7 +160,7 @@ instance HasRenamable E0Ext l d => Renamable (E0Ext l d) where
160160
PrintPacked ty e -> PrintPacked ty (gRename env e)
161161
CopyPacked ty e -> CopyPacked ty (gRename env e)
162162
TravPacked ty e -> TravPacked ty (gRename env e)
163-
Gibbon.L0.Syntax.L p e -> Gibbon.L0.Syntax.L p (gRename env e)
163+
L p e -> L p (gRename env e)
164164
LinearExt e -> LinearExt (gRename env e)
165165
where
166166
go :: forall a. Renamable a => a -> a
@@ -558,7 +558,7 @@ recoverType ddfs env2 ex =
558558
in ProdTy [ty,ty]
559559
ToLinearE a -> recoverType ddfs env2 a
560560

561-
Gibbon.L0.Syntax.L _ e -> recoverType ddfs env2 e
561+
L _ e -> recoverType ddfs env2 e
562562
where
563563
-- Return type for a primitive operation.
564564
primRetTy1 :: Prim Ty0 -> Ty0

‎gibbon-compiler/src/Gibbon/Passes/Simplifier.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -173,7 +173,7 @@ simplifyLocBinds only_cse (Prog ddefs fundefs mainExp) = do
173173
in
174174
if ((fromLocVarToFreeVarsTy loc) `elem` free_vars)
175175
then Ext (LetLocE loc rhs bod')
176-
else dbgTraceIt "Print freeVars: " dbgTraceIt (sdoc (rhs, free_vars)) dbgTraceIt "End\n" bod'
176+
else dbgTrace (minChatLvl) "Print freeVars: " dbgTrace (minChatLvl) (sdoc (rhs, free_vars)) dbgTrace (minChatLvl) "End\n" bod'
177177
LetAvail vars bod -> Ext (LetAvail vars (go2 bod))
178178
_ -> Ext ext
179179
_ -> ex

0 commit comments

Comments
 (0)