Improved error messages
This commit is contained in:
parent
4038f34cc5
commit
f8a70b4cf4
2 changed files with 74 additions and 68 deletions
|
|
@ -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
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue