clean all warnings

gibbon-compiler/src/Gibbon/Compiler.hs

@@ -66,7 +66,7 @@ import           Gibbon.Passes.Simplifier     (simplifyL1, lateInlineTriv, simpl
 -- import           Gibbon.Passes.Sequentialize  (sequentialize)
 
 import           Gibbon.Passes.DirectL3       (directL3)
-import           Gibbon.Passes.InferLocations (inferLocs, copyOutOfOrderPacked, fixRANs, removeAliasesForCopyCalls)
+import           Gibbon.Passes.InferLocations (inferLocs, fixRANs, removeAliasesForCopyCalls)
 -- This is the custom pass reference to issue #133 that moves regionsInwards
 import           Gibbon.Passes.RegionsInwards (regionsInwards)
 -- import           Gibbon.Passes.RepairProgram  (repairProgram)
@@ -91,7 +91,6 @@ import           Gibbon.Passes.Lower          (lower)
 import           Gibbon.Passes.RearrangeFree  (rearrangeFree)
 import           Gibbon.Passes.Codegen        (codegenProg)
 import           Gibbon.Passes.Fusion2        (fusion2)
-import Gibbon.Passes.CalculateBounds          (inferRegSize)
 import           Gibbon.Pretty
 import           Gibbon.L1.GenSML
 -- Configuring and launching the compiler.

gibbon-compiler/src/Gibbon/L0/Typecheck.hs

@@ -583,6 +583,7 @@ tcExp ddefs sbst venv fenv bound_tyvars is_main ex = (\(a,b,c) -> (a,b,c)) <$>
 
         Write3dPpmFile{} -> err $ text "Write3dPpmFile"
         RequestSizeOf-> err $ text "Unexpected RequestSizeOf in L0: " <+> exp_doc
+        RequestEndOf -> err $ text "Unexpected RequestEndOf in L0: " <+> exp_doc
 
 
     LetE (v, [], gvn_rhs_ty, rhs) bod -> do

gibbon-compiler/src/Gibbon/L1/Syntax.hs

@@ -24,7 +24,6 @@ import Text.PrettyPrint.GenericPretty
 import Gibbon.Language
 import Gibbon.Common
 
-import           Data.Graph                     as G
 import qualified Data.Map                       as M
 import           Prelude                        as P
 

gibbon-compiler/src/Gibbon/L1/Typecheck.hs

@@ -574,6 +574,7 @@ tcExp ddfs env exp =
 
         Write3dPpmFile{} -> throwError $ GenericTC "Write3dPpmFile not handled yet" exp
 
+        RequestEndOf{} -> throwError $ GenericTC  "tcExp of PrimAppE: RequestEndOf not handled yet" exp
 
     LetE (v,[],SymDictTy _ pty, rhs) e -> do
       tyRhs <- go rhs

gibbon-compiler/src/Gibbon/L2/Syntax.hs

@@ -5,6 +5,7 @@
 
 {-# LANGUAGE DeriveAnyClass #-}
 
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -fdefer-typed-holes #-}

gibbon-compiler/src/Gibbon/L2/Typecheck.hs

@@ -20,13 +20,12 @@ module Gibbon.L2.Typecheck
 import           Control.DeepSeq
 import           Control.Monad
 import           Control.Monad.Except
-import           Data.Foldable ( foldlM, foldrM )
+import           Data.Foldable ( foldlM )
 import qualified Data.Set as S
 import qualified Data.List as L
 import qualified Data.Map as M
 import           Data.Maybe
 import           Text.PrettyPrint.GenericPretty
-import           Debug.Trace
 
 import           Gibbon.Common
 import           Gibbon.L2.Syntax as L2
@@ -672,6 +671,8 @@ tcExp ddfs env funs constrs regs tstatein exp =
 
                  Write3dPpmFile{} -> throwError $ GenericTC "Write3dPpmFile not handled yet" exp
 
+                 RequestEndOf{} -> throwError $ GenericTC  "tcExp of PrimAppE: RequestEndOf not handled yet" exp
+
 
       LetE (v,_ls,ty,e1) e2 -> do
 

gibbon-compiler/src/Gibbon/L3/Syntax.hs

@@ -25,13 +25,6 @@ import qualified Data.Set as S
 import qualified Data.List as L
 import Text.PrettyPrint.GenericPretty
 
--- * Functions
-import           Control.DeepSeq
-import qualified Data.List                      as L
-import qualified Data.Map                       as M
-import qualified Data.Set                       as S
-import           Text.PrettyPrint.GenericPretty
-
 import           Gibbon.Common
 -- import qualified Gibbon.L2.Syntax               as L2
 import           Gibbon.Language                hiding (mapMExprs)

gibbon-compiler/src/Gibbon/L3/Typecheck.hs

@@ -748,6 +748,7 @@ tcExp isPacked ddfs env exp =
 
         Write3dPpmFile{} -> throwError $ GenericTC "Write3dPpmFile not handled yet" exp
 
+        RequestEndOf{} -> throwError $ GenericTC "RequestEndOf not handled yet" exp
 
 
     LetE (v,[],SymDictTy _ _pty, rhs) e -> do

gibbon-compiler/src/Gibbon/L4/Interp.hs

@@ -81,6 +81,7 @@ eval _   (TagTriv t) = TagVal t
 eval _   (SymTriv _) = error "eval: SymTriv not handled"
 eval _   (ProdTriv{}) = error "eval: ProdTriv not handled"
 eval _   (ProjTriv{}) = error "eval: ProjTriv not handled"
+eval _   (BoolTriv{}) = error "eval: BoolTriv not handled"
 
 
 exec :: Env -> Tail -> IO [Val]

gibbon-compiler/src/Gibbon/Language.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE UndecidableInstances  #-}
@@ -109,7 +110,7 @@ instance FreeVars (e l d) => FreeVars (PreExp e l d) where
 
 
 -- | A Typeable instance for L1 and L3 (L2 defines it's own)
-instance (Show (), Out (), Expression (e () (UrTy ())),
+instance (Show (), Out (),
           TyOf (e () (UrTy ())) ~ TyOf (PreExp e () (UrTy ())),
           FunctionTy (UrTy ()), Typeable (e () (UrTy ())))
        => Typeable (PreExp e () (UrTy ())) where

gibbon-compiler/src/Gibbon/Language/Syntax.hs

@@ -309,7 +309,7 @@ lookupVEnv v env2 = (vEnv env2) # v
 mblookupVEnv :: Var -> Env2 a -> Maybe a
 mblookupVEnv cur env2 = M.lookup cur (vEnv env2)
 
-lookupVEnv' :: Out a => Var -> Env2 a -> Maybe a
+lookupVEnv' :: Var -> Env2 a -> Maybe a
 lookupVEnv' v (Env2 ve _) = M.lookup v ve
 
 -- | Extend function type environment.

gibbon-compiler/src/Gibbon/NewL2/Syntax.hs

@@ -148,7 +148,7 @@ instance Typeable (Old.E2Ext LocArg Ty2) where
       Old.GetCilkWorkerNum    -> MkTy2 $ IntTy
       Old.LetAvail _ bod      -> gRecoverType ddfs env2 bod
       Old.AllocateTagHere{}   -> MkTy2 $ ProdTy []
-      Old.AllocateScalarsHere{} -> MkTy2 $ProdTy []
+      Old.AllocateScalarsHere{} -> MkTy2 $ ProdTy []
       Old.SSPush{}              -> MkTy2 $ ProdTy []
       Old.SSPop{}               -> MkTy2 $ ProdTy []
 

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

@@ -4,7 +4,7 @@ module Gibbon.Passes.CalculateBounds ( inferRegSize ) where
 import           Gibbon.Common
 import qualified Data.Map                      as M
 import           Gibbon.L2.Syntax
-import           Data.List as L
+import qualified Data.List as L
 import           Debug.Trace
 import           Control.Monad
 

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -9,7 +10,6 @@ module Gibbon.Passes.Flatten
     ( flattenL0, flattenL1, flattenL2, flattenL3 ) where
 
 import Control.Monad
-import Control.Monad.State
 import Text.PrettyPrint.GenericPretty
 import Prelude hiding (exp)
 import qualified Data.Map as M

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

@@ -1421,6 +1421,7 @@ fixProj renam pvar proj e =
       WithArenaE v e -> WithArenaE v $ fixProj renam pvar proj e
       Ext (L1.AddFixed{}) -> e
       Ext (L1.StartOfPkdCursor{}) -> e
+      Ext (BenchE{}) -> err$ "BenchE not supported"
       MapE{} -> err$ "MapE not supported"
       FoldE{} -> err$ "FoldE not supported"
 
@@ -1765,6 +1766,7 @@ prim p = case p of
            IntHashInsert{} -> return IntHashInsert
            IntHashLookup{} -> return IntHashLookup
            Write3dPpmFile{} -> err $ "Write3dPpmFile not handled yet."
+           RequestEndOf{} -> err $ "RequestEndOf not handled yet."
 
 emptyEnv :: FullEnv
 emptyEnv = FullEnv { dataDefs = emptyDD
@@ -1813,7 +1815,6 @@ fixRANs prg@(Prog defs funs main) = do
                Just (dcon, ls) -> do
                  let tys = lookupDataCon ddfs dcon
                      n = length [ ty | ty <- tys, ty == CursorTy ]
-                     tys' = L.drop n tys
                      rans = L.take n ls
                      needRANsExp = L.reverse $ L.take n (reverse ls)
                      ran_pairs = M.fromList $ fragileZip rans needRANsExp
@@ -1951,6 +1952,7 @@ copyOutOfOrderPacked prg@(Prog ddfs fndefs mnExp) = do
               (args1, cpy_env1) <- F.foldrM
                        (\groups (acc1, acc2) ->
                            case groups of
+                             [] -> error "copyOutOfOrderPacked: empty groups"
                              [(_,one)] -> pure (one:acc1, acc2)
                              ((_,x):xs) -> do
                                let vars = map snd xs
@@ -2113,20 +2115,20 @@ removeAliasesForCopyCalls prg@(Prog ddfs fndefs mnExp) = do
           funBody' <- removeAliases funBody (M.empty)  
           pure $ fn { funBody = funBody' }
 
-      unifyEnvs :: [AliasEnv] -> AliasEnv
-      unifyEnvs envList = M.unionsWith unifyVals envList
+      _unifyEnvs :: [AliasEnv] -> AliasEnv
+      _unifyEnvs envList = M.unionsWith _unifyVals envList
 
-      unifyVals :: (Var, S.Set Var) -> (Var, S.Set Var) -> (Var, S.Set Var) 
-      unifyVals (v, vs) (v', vs') = if v == v' then (v, vs `S.union` vs')
-                                    else error "unifyVals: Variable should be same if key is same!"
+      _unifyVals :: (Var, S.Set Var) -> (Var, S.Set Var) -> (Var, S.Set Var)
+      _unifyVals (v, vs) (v', vs') = if v == v' then (v, vs `S.union` vs')
+                                     else error "unifyVals: Variable should be same if key is same!"
 
-      myLookup :: Exp1 -> [((Exp1, Var), b)] -> Maybe b
-      myLookup _ [] = Nothing
-      myLookup key ((thiskey,thisval):rest) =
-        let (rhs, v) = thiskey
+      _myLookup :: Exp1 -> [((Exp1, Var), b)] -> Maybe b
+      _myLookup _ [] = Nothing
+      _myLookup key ((thiskey,thisval):rest) =
+        let (rhs, _v) = thiskey
          in if rhs == key
             then Just thisval
-            else myLookup key rest
+            else _myLookup key rest
 
       removeAliases :: Exp1 -> AliasEnv -> PassM Exp1
       removeAliases exp env = case exp of 

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 -------------------------------------------------------------------------------
@@ -982,9 +983,8 @@ lower Prog{fundefs,ddefs,mainExp} = do
         T.LetCallT False vsts f' (L.map (triv sym_tbl "one of app rands") ls) <$> (tail free_reg sym_tbl bod')
 
     LetE (v, _,ty, L3.SpawnE fn locs args) bod -> do
-      tl <- tail free_reg sym_tbl (LetE (v,_,ty, AppE fn locs args) bod)
-      -- This is going to be a LetCallT.
-      pure $ tl { T.async = True }
+      T.LetCallT{..} <- tail free_reg sym_tbl (LetE (v,_,ty, AppE fn locs args) bod)
+      pure $ T.LetCallT  { T.async = True, .. }
 
     LetE (_,_,_,  SyncE) bod -> do
       bod' <- tail free_reg sym_tbl bod
@@ -1188,6 +1188,7 @@ prim p =
     MkTrue       -> error "lower/prim: internal error. MkTrue should not get here."
     MkFalse      -> error "lower/prim: internal error. MkFalse should not get here."
     RequestSizeOf -> error "lower/prim: internal error. RequestSizeOf shouldn't be here."
+    RequestEndOf -> error "lower/prim: internal error. RequestEndOf shouldn't be here."
 
 isTrivial' :: Exp3 -> Bool
 isTrivial' e =

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

@@ -315,7 +315,7 @@ threadRegionsExp ddefs fundefs fnLocArgs renv env2 lfenv rlocs_env wlocs_env pkd
             free_wlocs = free `S.intersection` (M.keysSet wlocs_env')
             free_rlocs = free `S.intersection` (M.keysSet rlocs_env')
             free_rlocs' = let tmp = map (\(x,(MkTy2 (PackedTy _ loc))) -> (Just x,loc)) $
-                                    filter (\(_x,y@(MkTy2 (PackedTy tycon loc))) -> loc `S.member` free_rlocs && tycon /= hole_tycon)
+                                    filter (\(_x,_y@(MkTy2 (PackedTy tycon loc))) -> loc `S.member` free_rlocs && tycon /= hole_tycon)
                                            (M.toList $ M.filter (isPackedTy . unTy2) (vEnv env2))
                               tmp2 = map (\x -> (Nothing, x)) $ (S.toList free_rlocs) L.\\ (map snd tmp)
                           in S.fromList $ tmp ++ tmp2
@@ -403,7 +403,7 @@ threadRegionsExp ddefs fundefs fnLocArgs renv env2 lfenv rlocs_env wlocs_env pkd
             free_wlocs = free `S.intersection` (M.keysSet wlocs_env')
             free_rlocs = free `S.intersection` (M.keysSet rlocs_env')
             free_rlocs' = let tmp = map (\(x,(MkTy2 (PackedTy _ loc))) -> (Just x,loc)) $
-                                    filter (\(_x,y@(MkTy2 (PackedTy tycon loc))) -> loc `S.member` free_rlocs && tycon /= hole_tycon)
+                                    filter (\(_x,_y@(MkTy2 (PackedTy tycon loc))) -> loc `S.member` free_rlocs && tycon /= hole_tycon)
                                            (M.toList $ M.filter (isPackedTy . unTy2) (vEnv env2))
                               tmp2 = map (\x -> (Nothing, x)) $ (S.toList free_rlocs) L.\\ (map snd tmp)
                           in S.fromList $ tmp ++ tmp2
@@ -479,7 +479,7 @@ threadRegionsExp ddefs fundefs fnLocArgs renv env2 lfenv rlocs_env wlocs_env pkd
               free_wlocs = free `S.intersection` (M.keysSet wlocs_env)
               free_rlocs = free `S.intersection` (M.keysSet rlocs_env)
               free_rlocs' = let tmp = map (\(x,(MkTy2 (PackedTy _ loc))) -> (Just x,loc)) $
-                                      filter (\(_x,y@(MkTy2 (PackedTy tycon loc))) -> loc `S.member` free_rlocs && tycon /= hole_tycon)
+                                      filter (\(_x,_y@(MkTy2 (PackedTy tycon loc))) -> loc `S.member` free_rlocs && tycon /= hole_tycon)
                                              (M.toList $ M.filter (isPackedTy . unTy2) (vEnv env2))
                                 tmp2 = map (\x -> (Nothing, x)) $ (S.toList free_rlocs) L.\\ (map snd tmp)
                             in S.fromList $ tmp ++ tmp2

gibbon-compiler/src/Gibbon/Pretty.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}