minigent: remove join/meet in minigent

au-ts · Mar 9, 2020 · 21b81a5 · 21b81a5
1 parent 416270b
commit 21b81a5
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 142 deletions.
diff --git a/minigent/src/Minigent/TC/JoinMeet.hs b/minigent/src/Minigent/TC/JoinMeet.hs
diff --git a/minigent/src/Minigent/TC/SinkFloat.hs b/minigent/src/Minigent/TC/SinkFloat.hs
@@ -108,6 +108,11 @@ sinkFloat = Rewrite.rewrite' $ \cs -> do
       , Just r2var <- rowVar r2
         = makeRowRowVarSubsts r2new r2var
 
+    -- tfun
+    genStructSubst (Function _ _ :< UnifVar i)  = makeFunUnifSubsts i
+    genStructSubst (UnifVar i :< Function _ _)  = makeFunUnifSubsts i
+    genStructSubst (Function _ _ :=: UnifVar i) = makeFunUnifSubsts i
+    genStructSubst (UnifVar i :=: Function _ _) = makeFunUnifSubsts i
 
     -- primitive types
     genStructSubst (t@(PrimType _) :< UnifVar i) = pure [TyAssign i t]
@@ -133,3 +138,8 @@ sinkFloat = Rewrite.rewrite' $ \cs -> do
     absTypeSubs n s ts i = do 
       ts' <- mapM (const (UnifVar <$> fresh)) ts
       return [TyAssign i (AbsType n s ts')]
+
+    makeFunUnifSubsts i = do
+      t' <- UnifVar <$> fresh
+      u' <- UnifVar <$> fresh
+      return [TyAssign i $ Function t' u']
diff --git a/minigent/src/Minigent/TC/Solver.hs b/minigent/src/Minigent/TC/Solver.hs
@@ -21,7 +21,6 @@ import Minigent.TC.Normalise
 import Minigent.TC.Simplify
 import Minigent.TC.Unify
 import Minigent.TC.Equate
-import Minigent.TC.JoinMeet
 import Minigent.TC.SinkFloat
 import Minigent.TC.Assign
 import Minigent.Fresh
@@ -71,9 +70,7 @@ solve axs cs = do
           -- Rewrite.debugNewline "[equate]" debugPrettyConstraints <>
           Rewrite.lift equate <>
           -- Rewrite.debugNewline "[sink/float]" debugPrettyConstraints <>
-          sinkFloat <>
-          -- Rewrite.debugNewline "[join/meet]" debugPrettyConstraints <>
-          joinMeet)
+          sinkFloat)
 
 -- | Run a solver computation.
 runSolver :: Solver a -> FreshT VarName IO (a,[Assign])