Fixed more precise type annotation for monomorphizer

This commit is contained in:
sebastianselander 2023-04-29 17:55:18 +02:00
parent a87862a99f
commit d7a09a720b

View file

@ -7,7 +7,7 @@
module TypeChecker.TypeCheckerHm where module TypeChecker.TypeCheckerHm where
import Auxiliary (int, litType, maybeToRightM, unzip4) import Auxiliary (int, litType, maybeToRightM, unzip4)
import qualified Auxiliary as Aux import Auxiliary qualified as Aux
import Control.Monad.Except import Control.Monad.Except
import Control.Monad.Identity (Identity, runIdentity) import Control.Monad.Identity (Identity, runIdentity)
import Control.Monad.Reader import Control.Monad.Reader
@ -18,14 +18,14 @@ import Data.Function (on)
import Data.List (foldl', nub, sortOn) import Data.List (foldl', nub, sortOn)
import Data.List.Extra (unsnoc) import Data.List.Extra (unsnoc)
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as M import Data.Map qualified as M
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as S import Data.Set qualified as S
import Debug.Trace (trace) import Debug.Trace (trace)
import Grammar.Abs import Grammar.Abs
import Grammar.Print (printTree) import Grammar.Print (printTree)
import qualified TypeChecker.TypeCheckerIr as T import TypeChecker.TypeCheckerIr qualified as T
{- {-
TODO TODO
@ -168,6 +168,8 @@ checkBind (Bind name args e) = do
let m1 = M.fromList $ zip fvs1 letters let m1 = M.fromList $ zip fvs1 letters
let t0 = replace m0 t' let t0 = replace m0 t'
let t1 = replace m1 lambda_t let t1 = replace m1 lambda_t
-- Not sure if this is actually correct
sub <- unify t' lambda_t
unless unless
(t1 <<= t0) (t1 <<= t0)
( throwError $ ( throwError $
@ -180,7 +182,9 @@ checkBind (Bind name args e) = do
) )
False False
) )
return $ T.Bind (coerce name, t') [] (e, lambda_t) -- Applying sub to t' will worsen error messages.
-- Unfortunately I do not know a better solution at the moment.
return $ T.Bind (coerce name, apply sub t') [] (apply sub e, lambda_t)
_ -> do _ -> do
insertSig (coerce name) (Just lambda_t) insertSig (coerce name) (Just lambda_t)
return (T.Bind (coerce name, lambda_t) [] (e, lambda_t)) return (T.Bind (coerce name, lambda_t) [] (e, lambda_t))