Zero Warnings Plan

Zero GHC warnings with new opts. General cleanup and updates.

src/Eval.hs

@@ -6,18 +6,18 @@ import Research
 
 import Control.Monad (foldM)
 import Data.List (partition, (\\), elemIndex, foldl')
-import Data.Map  (Map)
+import Data.Map  ()
 import Data.Set  (Set)
 import Database.SQLite.Simple
 
-import qualified Data.Foldable as F
+import qualified Data.Foldable as F ()
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
 
 data DB
-  = BVar Int          -- bound (0 = nearest binder)
-  | BFree String      -- free/global
+  = BVar Int
+  | BFree String
   | BLam DB
   | BApp DB DB
   | BLeaf
@@ -59,12 +59,12 @@ evalSingle env term
 evalTricu :: Env -> [TricuAST] -> Env
 evalTricu env x = go env (reorderDefs env x)
   where
-    go env []     = env
-    go env [x]    =
-      let updatedEnv = evalSingle env x
+    go env' []     = env'
+    go env' [def]    =
+      let updatedEnv = evalSingle env' def
       in Map.insert "!result" (result updatedEnv) updatedEnv
-    go env (x:xs) =
-      evalTricu (evalSingle env x) xs
+    go env' (def:xs) =
+      evalTricu (evalSingle env' def) xs
 
 evalASTSync :: Env -> TricuAST -> T
 evalASTSync env term = case term of
@@ -129,7 +129,7 @@ resolveTermFromStore conn selectedVersions name mhash = case mhash of
     case matchingVersions of
       [] -> return Nothing
       [(_, term, _)] -> return $ Just term
-      _ -> return Nothing -- Ambiguous or too many matches
+      _ -> return Nothing
   Nothing -> case Map.lookup name selectedVersions of
     Just hash -> loadTree conn hash
     Nothing -> do
@@ -137,7 +137,7 @@ resolveTermFromStore conn selectedVersions name mhash = case mhash of
       case versions of
         [] -> return Nothing
         [(_, term, _)] -> return $ Just term
-        _ -> return $ Just $ (\(_, t, _) -> t) $ case versions of (_:_) -> head versions; _ -> error "resolveTermFromStore: unexpected empty versions list"
+        _ -> return $ Just (head (map (\(_, t, _) -> t) versions))
 
 elimLambda :: TricuAST -> TricuAST
 elimLambda = go
@@ -155,12 +155,10 @@ elimLambda = go
     etaReduction (SLambda [v] (SApp f (SVar x Nothing))) = v == x && not (usesBinder v f)
     etaReduction _ = False
 
-    -- triage: \a b c -> TLeaf (TLeaf a b) c  (checked in DB with a↦2, b↦1, c↦0)
     triagePattern (SLambda [a] (SLambda [b] (SLambda [c] body))) =
       toDB [c,b,a] body == triageBodyDB
     triagePattern _ = False
 
-    -- compose: \f g x -> f (g x)  (checked in DB with f↦2, g↦1, x↦0)
     composePattern (SLambda [f] (SLambda [g] (SLambda [x] body))) =
       toDB [x,g,f] body == composeBodyDB
     composePattern _ = False
@@ -174,30 +172,34 @@ elimLambda = go
     application (SApp _ _) = True
     application _ = False
 
-    -- rewrites
     etaReduceResult (SLambda [_] (SApp f _)) = f
+    etaReduceResult _ = error "etaReduceResult: expected SLambda [v] (SApp f _)"
 
     lambdaListResult (SLambda [v] (SList xs)) =
       SLambda [v] (foldr wrapTLeaf TLeaf xs)
       where
         wrapTLeaf m r = SApp (SApp TLeaf m) r
+    lambdaListResult _ = error "lambdaListResult: expected SLambda [v] (SList xs)"
 
     nestedLambdaResult (SLambda (v:vs) body)
       | null vs   =
           let body' = go body
               db    = toDB [v] body'
-          in toSKIKiselyov db 
+          in toSKIKiselyov db
       | otherwise = go (SLambda [v] (SLambda vs body))
+    nestedLambdaResult _ = error "nestedLambdaResult: expected SLambda (_:_) _"
 
     applicationResult (SApp f g) = SApp (go f) (go g)
+    applicationResult _ = error "applicationResult: expected SApp _ _"
 
     isSList (SList _) = True
     isSList _         = False
 
     slistTransform :: TricuAST -> TricuAST
     slistTransform (SList xs) = foldr (\m r -> SApp (SApp TLeaf (go m)) r) TLeaf xs
-    slistTransform ast = ast -- Should not be reached if isSList is the guard
+    slistTransform ast = ast -- Should not be reached
 
+_S, _K, _I, _R, _C, _B, _T, _TRI :: TricuAST
 _S   = parseSingle "t (t (t t t)) t"
 _K   = parseSingle "t t"
 _I   = parseSingle "t (t (t t)) t"
@@ -207,7 +209,9 @@ _B   = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)"
 _T   = SApp _C _I
 _TRI = parseSingle "t (t (t t (t (t (t t t))))) t"
 
+triageBody  :: String -> String -> String -> TricuAST
 triageBody a b c   = SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a Nothing)) (SVar b Nothing))) (SVar c Nothing)
+composeBody :: String -> String -> String -> TricuAST
 composeBody f g x  = SApp (SVar f Nothing) (SApp (SVar g Nothing) (SVar x Nothing))
 
 isFree :: String -> TricuAST -> Bool
@@ -270,7 +274,7 @@ buildDepGraph topDefs
 sortDeps :: Map.Map String (Set.Set String) -> [String]
 sortDeps graph = go [] Set.empty (Map.keys graph)
   where
-    go sorted sortedSet [] = sorted
+    go sorted _sortedSet [] = sorted
     go sorted sortedSet remaining =
       let ready = [ name | name <- remaining
                         , let deps = Map.findWithDefault Set.empty name graph
@@ -354,7 +358,7 @@ freeDBNames = \case
   BList xs  -> foldMap freeDBNames xs
   BEmpty    -> mempty
 
--- Helper: “is the binder named v used in body?”
+-- Helper: "is the binder named v used in body?"
 usesBinder :: String -> TricuAST -> Bool
 usesBinder v body = dependsOnLevel 0 (toDB [v] body)
 
@@ -395,9 +399,7 @@ toSKIDB (BList xs) =
   in if not anyUses
         then SApp _K (SList (map fromDBClosed xs))
         else SList (map toSKIDB xs)
-toSKIDB other
-  | not (dependsOnLevel 0 other) = SApp _K (fromDBClosed other)
-toSKIDB other = _K `SApp` TLeaf
+toSKIDB _other = _K `SApp` TLeaf
 
 app2 :: TricuAST -> TricuAST -> TricuAST
 app2 f x = SApp f x
@@ -415,11 +417,13 @@ kisConv = \case
   BVar n | n > 0 -> do
     (g,d) <- kisConv (BVar (n - 1))
     Right (False:g, d)
+  BVar n     -> Right ([], SVar ("BVar" ++ show n) Nothing)
+  BFree s    -> Right ([], SVar s Nothing)
   BApp e1 e2 -> do
     (g1,d1) <- kisConv e1
     (g2,d2) <- kisConv e2
-    let g = zipWithDefault False (||) g1 g2   -- <— propagate Γ outside (#)
-        d = kisHash (g1,d1) (g2,d2)           -- <— (#) yields only the term
+    let g = zipWithDefault False (||) g1 g2   -- <- propagate Γ outside (#)
+        d = kisHash (g1,d1) (g2,d2)           -- <- (#) yields only the term
     Right (g, d)
   -- Treat closed constants as free 'combinator leaves' (no binder use).
   BLeaf      -> Right ([], TLeaf)
@@ -437,12 +441,11 @@ kisConv = \case
   BFork l r
     | dependsOnLevel 0 l || dependsOnLevel 0 r -> Left "Fork with binder use: fallback"
     | otherwise                                -> Right ([], TFork (fromDBClosed l) (fromDBClosed r))
-  -- We shouldn’t see BLam under elim; treat as unsupported so we fallback.
+  -- We shouldn't see BLam under elim; treat as unsupported so we fallback.
   BLam _      -> Left "Nested lambda under body: fallback"
-  BFree s     -> Right ([], SVar s Nothing)
 
 -- Application combiner with K-optimization (lazy weakening).
--- Mirrors Lynn’s 'optK' rules: choose among S, B, C, R based on leading flags.
+-- Mirrors Lynn's 'optK' rules: choose among S, B, C, R based on leading flags.
 -- η-aware (#) with K-optimization (adapted from TS kiselyov_eta)
 kisHash :: (Uses, TricuAST) -> (Uses, TricuAST) -> TricuAST
 kisHash (g1, d1) (g2, d2) =
@@ -563,7 +566,6 @@ bulkS :: Int -> TricuAST
 bulkS n | n <= 1    = _S
         | otherwise = SApp sPrime (bulkS (n - 1))
 
--- Count how many leading pairs (a,b) repeat at the head of zip g1 g2
 headPairRun :: [Bool] -> [Bool] -> ((Bool, Bool), Int)
 headPairRun g1 g2 =
   case zip g1 g2 of