Fixed more precise type annotation for monomorphizer
This commit is contained in:
parent
a87862a99f
commit
d7a09a720b
1 changed files with 64 additions and 60 deletions
|
|
@ -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))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue