derive

src/Rlp/AltSyntax.hs

@@ -22,6 +22,8 @@ import Data.Functor.Sum
 import Control.Comonad.Cofree
 import Data.Fix
 import Data.Function            (fix)
+import GHC.Generics             (Generic(..))
+import Data.Hashable
 import Control.Lens
 
 import Text.Show.Deriving
@@ -53,7 +55,9 @@ data Type b = VarT b
             | ConT b
             | AppT (Type b) (Type b)
             | FunT
-            deriving Show
+            deriving (Show, Eq, Generic)
+
+instance (Hashable b) => Hashable (Type b)
 
 instance Core.HasArrowSyntax (Type b) (Type b) (Type b) where
     _arrowSyntax = prism make unmake where

src/Rlp/HindleyMilner.hs

@@ -6,13 +6,20 @@ module Rlp.HindleyMilner
     )
     where
 --------------------------------------------------------------------------------
-import Control.Lens             hiding (Context', Context)
+import Control.Lens             hiding (Context', Context, (:<))
 import Control.Monad.Errorful
 import Data.Text                qualified as T
 import Data.Pretty
 import Text.Printf
+import Data.Hashable
+import Data.HashMap.Strict      (HashMap)
+import Data.HashMap.Strict      qualified as H
+import Data.HashSet             (HashSet)
+import Data.HashSet             qualified as S
+import GHC.Generics             (Generic(..), Generically(..))
 
 import Data.Functor
+import Data.Fix
 import Control.Comonad.Cofree
 
 import Compiler.RlpcError
@@ -54,3 +61,28 @@ type HMError = Errorful TypeError
 infer = undefined
 check = undefined
 
+type Context' = HashMap PsName (Type PsName)
+
+data Constraint = Equality (Type PsName) (Type PsName)
+    deriving (Eq, Generic, Show)
+
+instance Hashable Constraint
+
+type Constraints = HashSet Constraint
+
+data PartialJudgement =
+    PartialJudgement Constraints Context'
+
+    deriving (Generic, Show)
+    deriving (Semigroup, Monoid)
+        via Generically PartialJudgement
+
+fixCofree :: (Functor f, Functor g)
+          => Iso (Fix f) (Fix g) (Cofree f ()) (Cofree g b)
+fixCofree = iso sa bt where
+    sa = foldFix (() :<)
+    bt (_ :< as) = Fix $ bt <$> as
+
+gather :: Context' -> RlpExpr PsName -> HMError (Type PsName, Constraints)
+gather = undefined
+