Add missing clauses. Still broken

src/TypeChecker/TypeCheckerBidir.hs

@@ -482,8 +482,8 @@ subtype (TEVar alpha) a | notElem alpha $ frees a = instantiateL alpha a
 --  Γ[ά] ⊢ A <: ά ⊣ Δ
 subtype a  (TEVar alpha) | notElem alpha $ frees a = instantiateR a alpha
 
-subtype t1 t2 = case (t1, t2) of
+
-    (TData name1 typs1, TData name2 typs2)
+subtype (TData name1 typs1) (TData name2 typs2)
 
     --  D₁ = D₂
     --  ----------------
@@ -491,7 +491,7 @@ subtype t1 t2 = case (t1, t2) of
     | name1 == name2
     , [] <- typs1
     , [] <- typs2
-      -> pure ()
+    = pure ()
 
     --                    Γ ⊢ ά₁ <: έ₁ ⊣ Θ₁
     --                           ...
@@ -501,7 +501,7 @@ subtype t1 t2 = case (t1, t2) of
     | name1 == name2
     , t1:t1s <- typs1
     , t2:t2s <- typs2
-      -> do
+    = do
     subtype t1 t2
     zipWithM_ go t1s t2s
   where
@@ -510,7 +510,9 @@ subtype t1 t2 = case (t1, t2) of
         t2'' <- apply t2'
         subtype t1'' t2''
 
-    _ -> throwError $ unwords ["Types", ppT t1, "and", ppT t2, "doesn't match!"]
+subtype (TIdent t1) (TIdent t2) | t1 == t2 = pure ()
+
+subtype t1 t2 = throwError $ unwords ["Types", show t1, "and", show t2, "doesn't match!"]
 
 ---------------------------------------------------------------------------
 -- * Instantiation rules
@@ -788,6 +790,7 @@ applyType' cxt typ | typ == typ' = typ'
         TFun t1 t2      -> on TFun (applyType' cxt) t1 t2
         -- [Γ](∀α. A) = (∀α. [Γ]A)
         TAll tvar t     -> TAll tvar $ applyType' cxt t
+        TIdent t        -> typ
 
 applyExp :: T.Exp' Type -> Tc (T.Exp' Type)
 applyExp exp = case exp of
@@ -841,6 +844,8 @@ ppT = \case
     TEVar (MkTEVar (LIdent s)) -> "tevar_" ++ s
     TData (UIdent name) typs   -> name ++ " (" ++ unwords (map ppT typs)
                                        ++ " )"
+    TIdent (UIdent name)       -> name
+
 ppEnvElem = \case
    EnvVar         (LIdent s) t           -> s ++ ":" ++ ppT t
    EnvTVar        (MkTVar  (LIdent s))   -> "tvar_" ++ s