Skip to content

Commit eb4aa04

Browse files
ulysses4everulysses4ever
committed
erradicate -Wwarn and prefer more fine-grained warning settings
1 parent 1dfb073 commit eb4aa04

File tree

10 files changed

+47
-46
lines changed

10 files changed

+47
-46
lines changed

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

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,7 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
1+
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
2+
{-# OPTIONS_GHC -Wno-unused-local-binds #-}
3+
{-# OPTIONS_GHC -Wno-name-shadowing #-}
4+
{-# OPTIONS_GHC -Wno-unused-matches #-}
25
module Gibbon.Passes.Cursorize
36
(cursorize) where
47

@@ -858,7 +861,6 @@ cursorizeExp freeVarToVarEnv lenv ddfs fundefs denv tenv senv ex =
858861
-- SingleR v -> cursorizePackedExp freeVarToVarEnv ddfs fundefs denv tenv senv bod
859862
-- SoARv dv _ -> cursorizePackedExp freeVarToVarEnv ddfs fundefs denv tenv senv bod
860863

861-
_ -> error $ "Unpexected Expression: " ++ show ext
862864

863865
MapE{} -> error $ "TODO: cursorizeExp MapE"
864866
FoldE{} -> error $ "TODO: cursorizeExp FoldE"

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

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
2-
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
1+
{-# OPTIONS_GHC -Wno-name-shadowing #-}
32
{-# OPTIONS_GHC -Wno-unused-matches #-}
43
{-# LANGUAGE BlockArguments #-}
54

@@ -435,7 +434,7 @@ freshTyLocs ty ddefs = do
435434
--return $ PackedTy tc newSoALoc
436435
dbuf' <- fresh
437436
let dcons = getConOrdering ddefs tc
438-
locsForFields <- lift $ lift $convertTyHelperSoAParent tc ddefs dcons
437+
locsForFields <- lift $ lift $ convertTyHelperSoAParent tc ddefs dcons
439438
let soaLocation = SoA (unwrapLocVar dbuf') locsForFields
440439
return $ PackedTy tc soaLocation
441440
Single _ -> do
@@ -1891,6 +1890,8 @@ finishExp e =
18911890
Ext (AllocateScalarsHere{}) -> err $ "todo: " ++ sdoc e
18921891
Ext (SSPush{}) -> err $ "todo: " ++ sdoc e
18931892
Ext (SSPop{}) -> err $ "todo: " ++ sdoc e
1893+
Ext (LetRegE{}) -> err $ "todo: " ++ sdoc e
1894+
Ext (BoundsCheckVector{}) -> err $ "todo: " ++ sdoc e
18941895
MapE{} -> err$ "MapE not supported"
18951896
FoldE{} -> err$ "FoldE not supported"
18961897

@@ -2015,21 +2016,18 @@ cleanExp e =
20152016
in if S.member s s'
20162017
then let ls = case lex of
20172018
GenSoALoc dcloc flocs -> [dcloc] ++ P.map (\(_, ll) -> ll) flocs
2018-
oth -> []
20192019
in (Ext (LetLocE s lex e'), S.delete s (S.union s' $ S.fromList ls))
20202020
else (e',s')
20212021
Ext (LetLocE s@(SoA dloc flcs) lex@(AssignLE _) e) -> let (e',s') = cleanExp e
20222022
in if S.member s s'
20232023
then let ls = case lex of
20242024
AssignLE loc -> [loc]
2025-
oth -> []
20262025
in (Ext (LetLocE s lex e'), S.delete s (S.union s' $ S.fromList ls))
20272026
else (e' ,s')
20282027
Ext (LetLocE s@(SoA dloc flcs) lex@(GetFieldLocSoA _ loc) e) -> let (e',s') = cleanExp e
20292028
in if S.member s s'
20302029
then let ls = case lex of
20312030
GetFieldLocSoA _ loc -> [loc]
2032-
oth -> []
20332031
in (Ext (LetLocE s lex e'), S.delete s (S.union s' $ S.fromList ls))
20342032
else (e' ,s')
20352033
Ext (LetLocE s@(SoA dloc flcs) lex e) -> let (e',s') = cleanExp e
@@ -2054,6 +2052,8 @@ cleanExp e =
20542052
Ext (AllocateScalarsHere{}) -> err $ "todo: " ++ sdoc e
20552053
Ext (SSPush{}) -> err $ "todo: " ++ sdoc e
20562054
Ext (SSPop{}) -> err $ "todo: " ++ sdoc e
2055+
Ext (LetRegE{}) -> err $ "todo: " ++ sdoc e
2056+
Ext (BoundsCheckVector{}) -> err $ "todo: " ++ sdoc e
20572057
MapE{} -> err$ "MapE not supported"
20582058
FoldE{} -> err$ "FoldE not supported"
20592059

@@ -2128,6 +2128,7 @@ fixProj renam pvar proj e =
21282128
moveProjsAfterSync :: LocVar -> Exp2 -> Exp2
21292129
moveProjsAfterSync sv ex = case sv of
21302130
l@(Single loc) -> go [] (S.singleton $ fromLocVarToFreeVarsTy l) ex
2131+
SoA {} -> error "moveProjsAfterSync: unexpected SoA location"
21312132
where
21322133
go :: [Binds (Exp2)] -> S.Set FreeVarsTy -> Exp2 -> Exp2
21332134
go acc1 pending ex =
@@ -2685,6 +2686,9 @@ fixRANs prg@(Prog defs funs main) = do
26852686
AllocateScalarsHere{} -> return ([],e0)
26862687
SSPush{} -> return ([],e0)
26872688
SSPop{} -> return ([],e0)
2689+
LetRegE{} -> return ([],e0)
2690+
BoundsCheckVector{} -> return ([],e0)
2691+
26882692

26892693
LitE{} -> return ([],e0)
26902694
CharE{} -> return ([],e0)

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
1+
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
22
{-| Do all things necessary to compile parallel allocations to a single region.
33
44
In the sequential semantics, (letloc-after x) can only run after x is written to
@@ -136,10 +136,10 @@ parAllocExp ddefs fundefs env2 reg_env after_env mb_parent_id pending_binds spaw
136136
Nothing (M.elems (vEnv env2))
137137
indr_dcon = Sf.headErr $ filter isIndirectionTag $ getConOrdering ddefs tycon
138138
reg_from = case (reg_env # from) of
139-
SingleR v -> v
139+
SingleR v' -> v'
140140
SoARv _ _ -> error "parAlloc: did not expect an SoA region!"
141141
reg_to = case (reg_env # to) of
142-
SingleR v -> v
142+
SingleR v' -> v'
143143
SoARv _ _ -> error "parAlloc: did not expect an SoA region!"
144144
rhs = Ext $ IndirectionE tycon indr_dcon (from, singleLocVar reg_from) (to, singleLocVar reg_to) (AppE "nocopy" [] [])
145145
pure $ LetE (indr, [], PackedTy tycon from, rhs) acc)

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

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
1+
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
2+
{-# OPTIONS_GHC -Wno-unused-matches #-}
23
module Gibbon.Passes.RegionsInwards (regionsInwards) where
34

45
import Data.Foldable as F
@@ -7,7 +8,6 @@ import qualified Data.Map as M
78
import Data.Maybe ()
89
import qualified Data.Maybe as S
910
import qualified Data.Set as S
10-
import Data.Text.Array (new)
1111
import Gibbon.Common
1212
import Gibbon.L2.Syntax
1313
import Text.PrettyPrint.GenericPretty
@@ -673,10 +673,10 @@ removeAliasedLocations env definedLocs ex =
673673
rhs' <- removeAliasedLocations env definedLocs' rhs
674674
let nloc = case loc of
675675
Single _ -> getAliasLoc env loc
676-
SoA dcl fieldLocs ->
676+
SoA dcl fieldLocs' ->
677677
let dcl' = getAliasLoc env (Single dcl)
678-
fieldLocs' = map (\(k, l) -> (k, getAliasLoc env l)) fieldLocs
679-
in SoA (unwrapLocVar dcl') fieldLocs'
678+
fieldLocs'' = map (\(k, l) -> (k, getAliasLoc env l)) fieldLocs'
679+
in SoA (unwrapLocVar dcl') fieldLocs''
680680
ndconl = getAliasLoc env dconl
681681
nfieldLocs = map (\(k, l) -> (k, getAliasLoc env l)) fieldLocs
682682
case existsLetForLoc of

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

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
1+
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
22
-- | Replace calls to copy functions with tagged indirection nodes
33
module Gibbon.Passes.RemoveCopies where
44

@@ -38,7 +38,6 @@ removeCopiesFn :: DDefs Ty2 -> FunDefs2 -> FunDef2 -> PassM FunDef2
3838
removeCopiesFn ddefs fundefs f@FunDef{funArgs,funTy,funBody} = do
3939
let initLocEnv = M.fromList $ map (\(LRM lc r _) -> case r of
4040
_ -> (lc, regionToVar r)
41-
SoAR _ _ -> error "TODO: removeCopiesFn structure of arrays not implemented yet."
4241
) (locVars funTy)
4342
initTyEnv = M.fromList $ zip funArgs (arrIns funTy)
4443
env2 = Env2 initTyEnv (initFunEnv fundefs)
@@ -78,10 +77,10 @@ removeCopiesExp ddefs fundefs lenv env2 ex =
7877
[] -> error $ "removeCopies: No indirection constructor found for: " ++ sdoc tycon
7978
[dcon] -> do
8079
let reg_lout = case (lenv # lout) of
81-
SingleR v -> v
80+
SingleR v' -> v'
8281
SoARv _ _ -> error "removeCopies: structure of arrays not implemented yet."
8382
let reg_lin = case (lenv # lin) of
84-
SingleR v -> v
83+
SingleR v' -> v'
8584
SoARv _ _ -> error "removeCopies: structure of arrays not implemented yet."
8685
LetE (v,locs,ty, Ext $ IndirectionE tycon dcon (lout , singleLocVar $ reg_lout) (lin, singleLocVar $ reg_lin) arg) <$>
8786
removeCopiesExp ddefs fundefs lenv (extendVEnv v ty env2) bod

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

Lines changed: 4 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
1+
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
2+
{-# OPTIONS_GHC -Wno-overlapping-patterns #-}
3+
{-# OPTIONS_GHC -Wno-unused-matches #-}
24
module Gibbon.Passes.ReorderLetExprs (reorderLetExprs) where
35

4-
import qualified Data.List as L
56
import qualified Data.Set as S
6-
77
import qualified Data.Map as M
88

99
import Data.Foldable as F
@@ -12,7 +12,6 @@ import Text.PrettyPrint.GenericPretty
1212
import Gibbon.Common
1313
import Gibbon.L2.Syntax
1414
import Data.Maybe ()
15-
import qualified Data.Maybe as S
1615

1716
data DelayedExpr = LetExpr (Var, [LocVar], Ty2, Exp2)
1817
| LetLocExpr LocVar LocExp
@@ -201,10 +200,6 @@ reorderLetExprsFunBody definedVars delayedExprMap ex = do
201200

202201
FoldE _ _ _ -> error "reorderLetExprsFunBody: FoldE not supported!"
203202

204-
WithArenaE v e -> do
205-
(e', delayedExprMap') <- reorderLetExprsFunBody definedVars delayedExprMap e
206-
pure $ (WithArenaE v e', delayedExprMap')
207-
208203
Ext (LetLocE loc rhs bod) -> do
209204
let freeVarsRhs = freeVarsInLocExp rhs
210205
--freeVarsRhs' = S.map (fromVarToFreeVarsTy) freeVarsRhs
@@ -293,7 +288,6 @@ reorderLetExprsFunBody definedVars delayedExprMap ex = do
293288
pure $ (Ext $ LetRegionE r sz ty bod', delayedExprMap')
294289

295290
_ -> error $ "reorderLetExprs : unexpected expression not handled!!" ++ sdoc ex
296-
_ -> pure (ex, delayedExprMap)
297291

298292

299293
{- We also need to release let expressions which are defined -}
@@ -445,7 +439,6 @@ releaseExprsFunBody definedVars delayedExprMap ex = do
445439
pure $ Ext $ LetRegionE r sz ty bod'
446440

447441
_ -> error $ "reorderLetExprs : unexpected expression not handled!!" ++ sdoc ex
448-
_ -> pure ex
449442
where
450443
releaseAllLetLocE :: DefinedVars -> DelayedExprMap -> [Exp2] -> PassM (DefinedVars, DelayedExprMap, [Exp2])
451444
releaseAllLetLocE envDefinedVars envDelayedExprMap letsToBeReleased = do
@@ -610,8 +603,7 @@ ensureLocationsAreDefinedForWrite definedVars ex = do
610603
pure $ Ext $ LetRegionE r sz ty bod'
611604

612605
_ -> error $ "reorderLetExprs : unexpected expression not handled!!" ++ sdoc ex
613-
_ -> pure ex
614-
where
606+
where
615607
go = ensureLocationsAreDefinedForWrite definedVars
616608

617609

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

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
1+
{-# OPTIONS_GHC -Wno-name-shadowing #-}
2+
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
23
{-# LANGUAGE RecordWildCards #-}
34

45
module Gibbon.Passes.ReorderScalarWrites
@@ -61,7 +62,7 @@ writeOrderMarkers (Prog ddefs fundefs mainExp) = do
6162
let aenvl = M.insert reg (RegionLocs [loc] S.empty) aenv
6263
in case loc of
6364
Single _ -> aenvl
64-
SoA dcloc fieldLocs ->
65+
SoA _dcloc fieldLocs ->
6566
let aenvl' = foldr (\(k, floc) acc -> do
6667
let freg = case lookup k fieldRegs of
6768
Just freg -> freg

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

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
2-
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
1+
{-# OPTIONS_GHC -Wno-unused-matches #-}
2+
{-# OPTIONS_GHC -Wno-name-shadowing #-}
3+
{-# OPTIONS_GHC -Wno-unused-binds #-}
34
{-# LANGUAGE FlexibleContexts #-}
45
{-# LANGUAGE CPP #-}
56
{-# LANGUAGE RecordWildCards #-}
@@ -36,13 +37,11 @@ import Data.Map as M
3637
import Data.Set as S
3738
import Control.Monad
3839

39-
import Data.Foldable ( foldrM, foldlM )
40+
import Data.Foldable ( foldlM )
4041

4142
import Gibbon.Common
4243
import Gibbon.L2.Syntax as L2
4344
import Gibbon.L1.Syntax as L1
44-
import Control.Arrow (Arrow(first))
45-
import Gibbon.L0.Typecheck (instDataConTy)
4645
import GHC.Generics
4746
import Text.PrettyPrint.GenericPretty
4847

@@ -176,6 +175,8 @@ bindReturns ex =
176175
AllocateScalarsHere{} -> pure ex
177176
SSPush{} -> pure ex
178177
SSPop{} -> pure ex
178+
LetRegE {} -> error "bindReturns: LetRegE not handled"
179+
BoundsCheckVector {} -> error "bindReturns: BoundsCheckVector not handled"
179180
MapE{} -> error $ "bindReturns: TODO MapE"
180181
FoldE{} -> error $ "bindReturns: TODO FoldE"
181182

@@ -415,7 +416,7 @@ routeEnds prg@Prog{ddefs,fundefs,mainExp} = do
415416
in case self_recursive_locs_in_order of
416417
[] -> L.foldr f afterenv $ zip (L.map (fromLocVarToFreeVarsTy . snd) vls) (Sf.tailErr $ L.map snd vls)
417418
_ -> let
418-
first_self_rec = L.head self_recursive_locs_in_order
419+
first_self_rec:_ = self_recursive_locs_in_order
419420
(afterenv_self_rec', _) = L.foldl (\(acc, seen) tup@(v, l) -> if (l /= first_self_rec)
420421
then
421422
if seen == True
@@ -811,6 +812,7 @@ routeEnds prg@Prog{ddefs,fundefs,mainExp} = do
811812
let_to_release = case (M.lookup l1 inst_waiting_on_loc) of
812813
Just lets -> let lets' = L.map (\exp -> case exp of
813814
LetLocExpr a b -> LetLocE a b
815+
LetExpr {} -> error "RouteEnds: unexpected LetExpr in inst_waiting_on_loc"
814816
) lets
815817

816818
in lets' ++ alias_same

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
1+
{-# OPTIONS_GHC -Wno-name-shadowing #-}
2+
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
23
module Gibbon.Passes.ThreadRegions where
34

45
import qualified Data.List as L

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

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,11 @@
1-
{-# OPTIONS_GHC -Wwarn #-}
1+
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
2+
{-# OPTIONS_GHC -Wno-unused-local-binds #-}
3+
{-# OPTIONS_GHC -Wno-name-shadowing #-}
24
{-# LANGUAGE BangPatterns #-}
35
{-# LANGUAGE BlockArguments #-}
46

57
module Gibbon.Passes.ThreadRegions2 where
68

7-
import Control.Monad.IO.Class (liftIO)
89
import Data.Foldable (foldrM)
910
import qualified Data.List as L
1011
import qualified Data.Map as M
@@ -17,7 +18,6 @@ import Gibbon.DynFlags
1718
import Gibbon.L2.Syntax as Old
1819
import Gibbon.NewL2.Syntax as NewL2
1920
import qualified Safe as Sf
20-
import System.IO (hPutStrLn, stderr)
2121

2222
--------------------------------------------------------------------------------
2323

@@ -168,7 +168,7 @@ threadRegionsFn ddefs fundefs f@FunDef {funName, funArgs, funTy, funMeta, funBod
168168
packed_outs
169169
regInsts =
170170
concatMap
171-
( \(LRM loc reg mode) ->
171+
( \(LRM _loc reg mode) ->
172172
case reg of
173173
SoAR dcReg fieldRegs ->
174174
let dcreg = regionToVar dcReg
@@ -895,7 +895,7 @@ threadRegionsExp ddefs fundefs fnLocArgs renv env2 lfenv rlocs_env wlocs_env pkd
895895
-- in acc'
896896
mp' <-
897897
mapM
898-
( \tup@(dcon, b, c) -> do
898+
( \tup@(dcon, b, _c) -> do
899899
let locs_case = dbgTrace (minChatLvl) "Print ty of Scrut: " dbgTrace (minChatLvl) (sdoc (reg)) dbgTrace (minChatLvl) "End scrut ty.\n" map (toLocVar . snd) b
900900
let region_locs' = case reg of
901901
SingleR _ -> region_locs

0 commit comments

Comments
 (0)