Improved error messages

This commit is contained in:
sebastianselander 2023-05-03 17:58:50 +02:00
parent 4038f34cc5
commit f8a70b4cf4
2 changed files with 74 additions and 68 deletions

View file

@ -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,12 +21,10 @@ 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
@ -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,7 +82,9 @@ 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
@ -90,11 +95,12 @@ unboundedTVars' bs typ = tvars.unbounded Set.\\ tvars.bounded
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
}

View file

@ -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
PInj _id _ps -> undefined
PLit (_l, _t) -> error "Nested pattern matching to be implemented"
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