From cb5692248f65c9e28182d84774eeff73c2d5dbad Mon Sep 17 00:00:00 2001 From: crumbtoo Date: Thu, 28 Dec 2023 14:46:10 -0700 Subject: [PATCH] back and medicated! --- src/Core/HindleyMilner.hs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/src/Core/HindleyMilner.hs b/src/Core/HindleyMilner.hs index c0d64f8..eb11ce7 100644 --- a/src/Core/HindleyMilner.hs +++ b/src/Core/HindleyMilner.hs @@ -1,6 +1,6 @@ {-| Module : Core.HindleyMilner -Description : Hindley-Milner inference +Description : Hindley-Milner type system -} {-# LANGUAGE LambdaCase #-} module Core.HindleyMilner @@ -18,6 +18,7 @@ import Data.Maybe (fromMaybe) import Data.Text qualified as T import Data.HashMap.Strict qualified as H import Data.Foldable (traverse_) +import Compiler.RLPC import Control.Monad (foldM, void) import Control.Monad.State import Control.Monad.Utils (mapAccumLM) @@ -41,11 +42,15 @@ data TypeError | TyErrRecursiveType Name Type -- | Untyped, potentially undefined variable | TyErrUntypedVariable Name + | TyErrMissingTypeSig Name deriving (Show, Eq) -- | Synonym for @Either TypeError@ type HMError = Either TypeError +-- TODO: better errors. Errorful-esque, with cummulative errors instead of +-- instantly dying. + -- | Assert that an expression unifies with a given type -- -- >>> let e = [coreProg|3|] @@ -69,8 +74,13 @@ checkProg p = scDefs g = gatherTypeSigs p k :: ScDef' -> HMError () - k sc | Just t <- lookup (sc ^. _lhs._1) g - = check g t (sc ^. _rhs) + k sc = case lookup scname g of + Just t -> check g t (sc ^. _rhs) + Nothing -> Left (TyErrMissingTypeSig $ scname) + where scname = sc ^. _lhs._1 + +checkRlpcProg :: Program' -> RLPC TypeError () +checkRlpcProg = undefined -- | Infer the type of an expression under some context. --