Turn on -Werror

package.yaml

@@ -33,7 +33,14 @@ library:
   - monad-loops
   - sparse-linear-algebra
   ghc-options:
-  - -Wall
+  - -Wunused-imports
+  - -Wname-shadowing
+  - -Wincomplete-patterns
+  - -Wtype-defaults
+  - -Wunused-local-binds
+  - -Wunused-matches
+  - -Wunused-top-binds
+  - -Werror
 
 executables:
   zar-exe:

src/Cotree.hs

@@ -3,15 +3,9 @@
 
 module Cotree where
 
-import Data.List (sortBy)
-import Data.Maybe (fromMaybe)
-
 import Datatypes
-import ListTree
-import Nat
 import Sexp
 import Tree
-import Util
 
 -- | Greatest fixed point / final TreeF-coalgebra
 type Cotree a = Fix (TreeF a)

src/Dep.hs

@@ -8,7 +8,6 @@ import Data.List (intersect, nub, union)
 import Data.Maybe (fromJust, fromMaybe)
 import Lang
 import Symtab (Id(..))
-import Util (debug)
 
 -- Compute dependencies of variables in a command (possibly a sequence
 -- of commands).
@@ -35,7 +34,7 @@ init_deps (Assign (x, _) e) = [(Id x, id_of_name <$> fvs e)]
 init_deps (Sample (x, _) e) = [(Id x, id_of_name <$> fvs e)]
 init_deps (Seq c1 c2) = union_deps (init_deps c1) (init_deps c2)
 init_deps (Ite _ c1 c2) = union_deps (init_deps c1) (init_deps c2)
-init_deps (While e c) = init_deps c
+init_deps (While _ c) = init_deps c
 init_deps _ = []
 
 -- Compute transitive closure (iterate until fixed point).
@@ -45,12 +44,12 @@ iter_deps deps =
   where
     deps' = f deps (fst <$> deps)
     f :: [(Id, [Id])] -> [Id] -> [(Id, [Id])]
-    f deps (x:xs) =
-      let ys = fromJust $ lookup x deps
-          ys_deps = nub $ concat $ fromMaybe [] . flip lookup deps <$> ys
+    f deps0 (x:xs) =
+      let ys = fromJust $ lookup x deps0
+          ys_deps = nub $ concat $ fromMaybe [] . flip lookup deps0 <$> ys
       in
-        f (upd_deps x (union ys_deps) deps) xs
-    f deps [] = deps
+        f (upd_deps x (union ys_deps) deps0) xs
+    f deps0 [] = deps0
 
 
 -- Collect variables that are directly assigned random values.

src/Distributions.hs

@@ -1,7 +1,6 @@
 module Distributions where
 
 import Data.Ratio
-import Data.Typeable
 
 -- import Lang
 import Tree

src/IOInterp.hs

@@ -12,7 +12,6 @@ import           Data.Maybe (fromMaybe)
 import           Data.Typeable
 import           System.Random
 
-import           Classes
 import           Lang hiding (Com, Env, Exp, St, Val, interp)
 import qualified Lang (Com, Env, Exp, St, Val)
 
@@ -42,8 +41,11 @@ eval env (EVar x) st =
 eval env (EUnop u e) st =
   case (u, eval env e st) of
     (UNot, VBool b)   -> VBool $ not b
+    (UNot, _)         -> error "IOInterp:eval: ill-typed UNot"
     (UFst, VPair x _) -> x
+    (UFst, _)         -> error "IOInterp:eval: ill-typed UFst"
     (USnd, VPair _ y) -> y
+    (USnd, _)         -> error "IOInterp:eval: ill-typed USnd"
 
 eval env (EBinop b e1 e2) st =
   case (b, eval env e1 st, eval env e2 st) of
@@ -62,6 +64,7 @@ eval env (EBinop b e1 e2) st =
     (BLt,    VRational r1, VRational r2) -> VBool     $ r1 < r2
     (BLt,    VInteger i1,  VInteger i2)  -> VBool     $ i1 < i2
     (BLt,    VFloat f1,    VFloat f2)    -> VBool     $ f1 < f2
+    (_,      _,            _           ) -> error "IOInterp:eval: ill-typed EBinop"
 
 eval env (EPair e1 e2) st = VPair (eval env e1 st) (eval env e2 st)
 

src/IORepr.hs

@@ -6,17 +6,14 @@
 module IORepr (primitives) where
 
 import Control.Monad.Identity
-import Data.Proxy
 import System.Random
 
 import           Classes
 import           IOInterp
 import           Lang hiding (Env, Exp, SomeVal, SomeTypeVal, Val)
-import qualified Lang as L (Env, Exp, SomeVal, SomeTypeVal(..), Val)
+import qualified Lang as L (Exp, SomeTypeVal(..), Val)
 
-type Env         = L.Env         Identity IO
 type Exp         = L.Exp         Identity IO
-type SomeVal     = L.SomeVal     Identity IO
 type SomeTypeVal = L.SomeTypeVal Identity IO
 type Val         = L.Val         Identity IO
 
@@ -45,7 +42,7 @@ bernoulli_prim = VPrim f
 
 -- IO actions are never equal.
 instance Eq a => Eq (IO a) where
-  f == g = False
+  _ == _ = False
 -- Trivial show instance.
 instance Show a => Show (IO a) where
   show _ = "IO"

src/Inference.hs

@@ -5,15 +5,12 @@ module Inference
 where
 
 import Control.Monad
-import Data.Bifunctor (bimap, second)
+import Data.Bifunctor (second)
 import Data.List (sum)
 import Data.Maybe (fromMaybe)
-import Data.Typeable
 
 import Classes
-import Lang
-import Tree
-import Util (counts, debug)
+import Util (counts)
 
 -- | Any g with a Sample instance admits sampling based inference.
 

src/Lang.hs

@@ -22,19 +22,11 @@
 
 module Lang where
 
-import Control.Monad.Identity
-import Control.Monad.Reader
-import Control.Monad.State hiding (get)
-import qualified Control.Monad.State as S (get)
-
-import Data.Bifunctor (first)
 import Data.Proxy
 import Data.Typeable
 
 import Classes
-import Distributions
 import Symtab (Id(..))
-import Util (debug, mapJoin)
 
 -- Dummy instances for arrow type indices.
 instance Eq (a -> b) where
@@ -273,7 +265,7 @@ instance Eq (Exp m g a) where
   ENil == ENil = True
   EUniform e1 == EUniform e2 = e1 == e2
   -- TODO finish
-  _ == _ = False
+  _ == _ = error "internal error in Lang:Eq (Exp ...)"
 
 -- instance Show a => Show (Exp m g a) where
 --   show (EVal v) = "(EVal " ++ show v ++ ")"
@@ -299,6 +291,7 @@ instance Show a => Show (Exp m g a) where
   show (EUnop u e) = "EUnop " ++ show u ++ " " ++ show e
   show (EBinop b e1 e2) =
     "EBinop " ++ show b ++ " " ++ show e1 ++ " " ++ show e2
+  show (EPair e1 e2) = "EPair " ++ show e1 ++ " " ++ show e2
   show ENil = "ENil"
   show (ECons e1 e2) = "ECons " ++ show e1 ++ " " ++ show e2
   show (EDestruct l z f) = -- "(EDestruct " ++ show l ++ " " ++ show z ++ ")"
@@ -308,7 +301,7 @@ instance Show a => Show (Exp m g a) where
   show (ECom _ c) = "ECom " ++ show c
   show (ECond b e1 e2) =
     "ECond " ++ show b ++ " " ++ show e1 ++ " " ++ show e2
-  show (EPrim f) = "EPrim"
+  show (EPrim _) = "EPrim"
   show (EUniform l) = "EUniform " ++ show l
 
 
@@ -378,7 +371,8 @@ fvs = go []
     go bound (EDestruct l z f) = go bound l ++ go bound z ++ go bound f
     go bound (EApp e1 e2) = go bound e1 ++ go bound e2
     go bound (ELam x body) = go (SomeName x : bound) body
-    go bound (ECom args com) =
+    --note(jgs): fvs(ECom _ com) ignores com?
+    go bound (ECom args _) =
       concatMap (\(SomeNameExp _ e) -> go bound e) args
     go bound (ECond b e1 e2) = go bound b ++ go bound e1 ++ go bound e2
     go _ _ = []
@@ -462,14 +456,17 @@ vlist_nth n (VCons hd tl)
   | n < 0 = error "vlist_nth: negative index"
   | n == 0 = hd
   | otherwise = vlist_nth (n-1) tl
+vlist_nth _ _ = error "internal error in Lang:vlist_nth; please report"
 
 vlist_length :: Val m g [a] -> Int
 vlist_length VNil = 0
 vlist_length (VCons _ tl) = 1 + vlist_length tl
+vlist_length _ = error "internal error in Lang:vlist_length; please report"
 
 vlist_list :: Val m g [a] -> [Val m g a]
 vlist_list VNil = []
 vlist_list (VCons x xs) = x : vlist_list xs
+vlist_list _ = error "internal error in Lang:vlist_list; please report"
 
 
 ------------------------------------------------------------------------
@@ -482,5 +479,5 @@ class (Typeable m, AllF g) => Repr m g | g -> m where
 
 -- Initial environment containing primitives.
 initEnv :: Repr m g => Env m g
-initEnv = (\(x, SomeTypeVal t v) ->
+initEnv = (\(x, SomeTypeVal _ v) ->
              SomeNameExp (x, Proxy) (EVal v)) <$> primitives

src/LinEq.hs

@@ -5,7 +5,6 @@ import Data.Maybe (catMaybes, maybeToList)
 
 import Sexp
 import Tree
-import Util (debug)
 
 -- Boolean-valued trees with mandatory labels at all split nodes.
 data LTree =
@@ -80,7 +79,7 @@ equations_of_ltree _ = []
 lookup_term :: Maybe Var -> [Term] -> Maybe Coeff
 lookup_term (Just x) ((c, Just y) : terms) =
   if x == y then Just c else lookup_term (Just x) terms
-lookup_term Nothing ((c, Nothing) : terms) = Just c
+lookup_term Nothing ((c, Nothing) : _) = Just c
 lookup_term x (_ : terms) = lookup_term x terms
 lookup_term _ [] = Nothing
 
@@ -94,7 +93,7 @@ remove_term = go []
     go acc (Just x) (tm@(c, Just y) : terms) =
       if x == y then Just (c, acc ++ terms)
       else go (tm:acc) (Just x) terms
-    go acc Nothing (tm@(c, Nothing) : terms) = Just (c, acc ++ terms)
+    go acc Nothing ((c, Nothing) : terms) = Just (c, acc ++ terms)
     go acc x (tm : terms) = go (tm:acc) x terms
     go _ _ [] = Nothing
 
@@ -132,6 +131,8 @@ solve_equations :: [Equation] -> Equation
 solve_equations = go . sort
   where
     go :: [Equation] -> Equation
+
+    go [] = error "internal error in LinEq:solve_equations" --note(jgs): fix
     go [eq] = simplify_equation eq
     go (Equation (x, terms) : eqs) =
       go $ simplify_equation . subst_equation x terms <$> eqs

src/ListTree.hs

@@ -1,10 +1,12 @@
 module ListTree where
 
-import Data.Bifunctor (second)
-import Data.List (nub, sort)
-import Sexp
+--note(jgs): redundant imports
+--import Data.Bifunctor (second)
+--import Data.List (nub, sort)
+--import Sexp
 import Tree
-import Util
+--import Util
+
 
 -- List form of trees.
 type TreeL a = [[Tree a]]

src/Parser.hs

@@ -1,10 +1,7 @@
 module Parser where
 
-import Control.Monad (void)
-
 import Control.Monad.Combinators.Expr -- from parser-combinators
 import qualified Data.List.NonEmpty as NonEmpty
-import Data.Maybe (fromMaybe)
 import Data.Ratio
 import Data.Set (singleton)
 import Data.Void
@@ -15,7 +12,6 @@ import qualified Text.Megaparsec.Char.Lexer as L
 import Untyped
 import Symtab (Id(..))
 import Token
-import Util (debug)
 
 
 parens :: Parser a -> Parser a
@@ -41,7 +37,7 @@ bool = choice
 rational :: Parser Rational
 rational = do
   num <- integer
-  symbol "/"
+  _ <- symbol "/"
   denom <- integer
   return $ num % denom
 
@@ -369,12 +365,12 @@ dist = L.indentBlock scn $ do
   keyword "dist"
   dist_nm <- ident
   args <- parens $ commaSep func_arg
-  dist_ty <- symbol "->" >> ty
+  dty <- symbol "->" >> ty
   symbol ":"
   return $ L.IndentSome Nothing
     (\coms ->
        return $ Dist { dist_name = dist_nm
-                     , dist_type = dist_ty
+                     , dist_type = dty
                      , dist_args = args
                      , dist_body = mkSeq coms })
     com
@@ -390,9 +386,9 @@ prog = L.nonIndented scn (L.indentBlock scn p)
   where      
     p = do
       funcs_dists <- many $ choice [Left <$> func, Right <$> dist]
-      com <- main
+      c <- main
       eof
-      return $ L.IndentNone (funcs_dists, com)
+      return $ L.IndentNone (funcs_dists, c)
 
 
 -- Main parsing function called from the outside.

src/Sample.hs

@@ -85,7 +85,7 @@ mcmc_sample cz@(ct, ws) n = cata alg ct
                                 s <- mcmc_sample (zipUp cz) (n - 1)
                                 return (x:s)
                         Nothing -> error "mcmc_sample: out of bits"
-        alg (SplitF s1 s2) = do
+        alg (SplitF _ _) = do
             case ws of
                 [] -> do
                     bit <- gets headMaybe

src/SparseLinAlg.hs

@@ -1,12 +1,11 @@
 module SparseLinAlg (solve_tree) where
 
-import Data.Bifunctor (bimap, second)
+import Data.Bifunctor (bimap)
 import Data.List (sort)
 import Data.Maybe (fromJust)
 import Data.Sparse.SpMatrix
 import Data.Sparse.SpVector
 import Numeric.LinearAlgebra.Sparse
-import System.IO.Unsafe (unsafePerformIO)
 
 import LinEq (Coeff, Var, Equation(..), remove_term, combine_terms, ltree_of_tree, equations_of_ltree)
 import Sexp 
@@ -34,7 +33,7 @@ mateq_of_equation (Equation (x, tms)) =
 constraint_matrix :: [MatEq] -> SpMatrix Rational
 constraint_matrix eqs =
   let l = concat $ f <$> zip [0..] eqs in
-    debug ("l: " ++ show ((\(x, y, z) -> (x, y, fromRational z)) <$> l)) $
+    debug ("l: " ++ show ((\(x, y, z) -> (x, y, fromRational z :: Double)) <$> l)) $
     fromListSM (n, n) l
   where
     n = length eqs
@@ -77,8 +76,8 @@ solve_system_gmres mat rhs =
   -- let _ = unsafePerformIO $ prd mat in
   -- mat <\> (fromListDenseSV n )
   mat <\> rhs
-  where
-    n = nrows mat -- should also be the length of the rhs vector
+  -- where
+  --   n = nrows mat -- should also be the length of the rhs vector
 
 solve_tree :: Tree Bool -> IO (SpVector Double)
 -- solve_tree = solve_system_gmres . tree_constraint_matrix