Improved error messages

src/AnnForall.hs

@@ -8,7 +8,7 @@ import           Control.Applicative  (Applicative (liftA2))
 import Control.Monad.Except (throwError)
 import Data.Function (on)
 import Data.Set (Set)
-import qualified Data.Set             as Set
+import Data.Set qualified as Set
 import Grammar.Abs
 import Grammar.ErrM (Err)
 
@@ -21,19 +21,17 @@ annotateForall (Program defs) = do
     ss' = map (DSig . annSig) ss
     (ds, ss, bs) = partitionDefs defs
 
-
 annData :: Data -> Err Data
 annData (Data typ injs) = do
     (typ', tvars) <- annTyp typ
     pure (Data typ' $ map (annInj tvars) injs)
-
   where
     annTyp typ = do
         (bounded, ts) <- boundedTVars mempty typ
         unbounded <- Set.fromList <$> mapM assertTVar ts
         let diff = unbounded Set.\\ bounded
             typ' = foldr TAll typ diff
-        (typ', ) . fst <$> boundedTVars mempty typ'
+        (typ',) . fst <$> boundedTVars mempty typ'
       where
         boundedTVars tvars typ = case typ of
             TAll tvar t -> boundedTVars (Set.insert tvar tvars) t
@@ -42,7 +40,10 @@ annData (Data typ injs) = do
 
         assertTVar typ = case typ of
             TVar tvar -> pure tvar
-            _         -> throwError $ unwords [ "Misformed data declaration:"
+            _ ->
+                throwError $
+                    unwords
+                        [ "Misformed data declaration:"
                         , "Non type variable argument"
                         ]
     annInj tvars (Inj n t) =
@@ -55,7 +56,9 @@ annBind :: Bind -> Err Bind
 annBind (Bind name vars exp) = Bind name vars <$> annExp exp
   where
     annExp = \case
-        EAnn e t    -> flip EAnn (annType t) <$> annExp e
+        -- Annotated types should not be
+        -- foralled without the consent of the user
+        EAnn e t -> flip EAnn t <$> annExp e
         EApp e1 e2 -> liftA2 EApp (annExp e1) (annExp e2)
         EAdd e1 e2 -> liftA2 EAdd (annExp e1) (annExp e2)
         ELet bind e -> liftA2 ELet (annBind bind) (annExp e)
@@ -79,22 +82,25 @@ unboundedTVars' bs typ = tvars.unbounded Set.\\ tvars.bounded
   where
     tvars = gatherTVars typ
     gatherTVars = \case
-      TAll tvar t  -> TVars { bounded   = Set.singleton tvar
+        TAll tvar t ->
+            TVars
+                { bounded = Set.singleton tvar
                 , unbounded = unboundedTVars' (Set.insert tvar bs) t
                 }
         TVar tvar -> uTVars $ Set.singleton tvar
         TFun t1 t2 -> uTVars $ on Set.union (unboundedTVars' bs) t1 t2
         TData _ typs -> uTVars $ foldr (Set.union . unboundedTVars' bs) mempty typs
-      _            -> TVars { bounded = mempty, unbounded = mempty }
+        _ -> TVars{bounded = mempty, unbounded = mempty}
 
 data TVars = TVars
     { bounded :: Set TVar
     , unbounded :: Set TVar
-  } deriving (Eq, Show, Ord)
+    }
+    deriving (Eq, Show, Ord)
 
 uTVars :: Set TVar -> TVars
-uTVars us = TVars
+uTVars us =
+    TVars
         { bounded = mempty
         , unbounded = us
         }
-

src/Codegen/Emits.hs

@@ -9,14 +9,14 @@ import           Codegen.LlvmIr                as LIR
 import Control.Applicative ((<|>))
 import Control.Monad (when)
 import Control.Monad.State (gets, modify)
-import qualified Data.Bifunctor                as BI
+import Data.Bifunctor qualified as BI
 import Data.Char (ord)
 import Data.Coerce (coerce)
-import qualified Data.Map                      as Map
+import Data.Map qualified as Map
 import Data.Maybe (fromJust, fromMaybe)
 import Data.Tuple.Extra (dupe, first, second)
 import Monomorphizer.MonomorphizerIr as MIR
-import qualified TypeChecker.TypeCheckerIr     as TIR
+import TypeChecker.TypeCheckerIr qualified as TIR
 
 compileScs :: [MIR.Def] -> CompilerState ()
 compileScs [] = do
@@ -226,10 +226,10 @@ emitECased t e cases = do
                                 emit $ SetVariable deref (ExtractValue botT' (VIdent casted Ptr) i)
                                 emit $ SetVariable x (Load topT' Ptr deref)
                             else emit $ SetVariable x (ExtractValue botT' (VIdent casted Ptr) i)
-                    PLit (_l, _t) -> undefined
+                    PLit (_l, _t) -> error "Nested pattern matching to be implemented"
-                    PInj _id _ps -> undefined
+                    PInj _id _ps -> error "Nested pattern matching to be implemented"
                     PCatch -> pure ()
-                    PEnum _id -> undefined
+                    PEnum _id -> error "Nested pattern matching to be implemented"
             )
             cs
         val <- exprToValue exp