compiler: fix #396 related issues

au-ts · Mar 19, 2021 · 8d7e015 · 8d7e015
1 parent 1f2e543
commit 8d7e015
Show file tree

Hide file tree

Showing 4 changed files with 6 additions and 7 deletions.
diff --git a/cogent/src/Cogent/Parser.hs b/cogent/src/Cogent/Parser.hs
@@ -510,8 +510,8 @@ polytype = polytype' <|> PT [] [] <$> monotype
     flt2 (x, y) | Right v <- y = pure (x, v)
                 | otherwise    = mempty
 
-klSignature = (,) <$> variableName <*> (Left <$> (reservedOp ":<" *> kind <?> "kind")
-                  <|> Right <$> (reservedOp ":~" *> atomtype <?> "typeid")
+klSignature = (,) <$> variableName <*> (Left <$> (reservedOp ":<" *> kind <?> "uniqueness constraint")
+                  <|> Right <$> (reservedOp ":~" *> monotype <?> "layout-type matching constraint")
                   <|> Left <$> (pure $ K False False False))
   where kind = do x <- identifier
                   determineKind x (K False False False)

diff --git a/cogent/src/Cogent/TypeCheck/Solver/Simplify.hs b/cogent/src/Cogent/TypeCheck/Solver/Simplify.hs
@@ -234,10 +234,6 @@ simplify ks lts = Rewrite.pickOne' $ onGoal $ \case
   TLArray e1 _     :~< TLArray e2 _ -> hoistMaybe $ Just [e1 :~< e2]
 #endif
 
-  l1               :~< l2 | TLU _ <- l1 -> hoistMaybe Nothing
-                          | TLU _ <- l2 -> hoistMaybe Nothing
-                          | otherwise   -> unsat $ LayoutsNotCompatible l1 l2  -- FIXME!
-
   t1 :~~ t2 | isBoxedType t1, isBoxedType t2 -> hoistMaybe $ Just []  -- If both are pointers, then their layouts will be compatible
 
   T (TVar n1 _ _) :~~ T (TVar n2 _ _) | n1 == n2 -> hoistMaybe $ Just []
@@ -259,7 +255,7 @@ simplify ks lts = Rewrite.pickOne' $ onGoal $ \case
             | isPrimType t1 && isPrimType t2
             , primTypeSize t1 <= primTypeSize t2
             -> hoistMaybe $ Just []
-            | otherwise -> unsat $ TypesNotFit t1 t2
+            | otherwise -> hoistMaybe Nothing
 
   T (TFun t1 t2) :=: T (TFun r1 r2) -> hoistMaybe $ Just [r1 :=: t1, t2 :=: r2]
   T (TFun t1 t2) :<  T (TFun r1 r2) -> hoistMaybe $ Just [r1 :<  t1, t2 :<  r2]

diff --git a/cogent/tests/tests/dargent/config.yaml b/cogent/tests/tests/dargent/config.yaml
@@ -6,6 +6,7 @@
     - pass_inner-synonym.cogent
     - pass_layout-poly.cogent
     - pass_dargent-unspec.cogent
+    - pass_l-matches-record.cogent
   expected_result: pass
   flags:
     - -g

diff --git a/cogent/tests/tests/dargent/pass_l-matches-record.cogent b/cogent/tests/tests/dargent/pass_l-matches-record.cogent
@@ -0,0 +1,2 @@
+main : all (l :~ #{a : U8} ). {a : U8} layout l -> {a : U8} layout l
+main x = x
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1,2 @@
		main : all (l :~ #{a : U8} ). {a : U8} layout l -> {a : U8} layout l
		main x = x