compiler: fix #47

au-ts · Mar 6, 2018 · 25e068a · 25e068a
1 parent e9d6d9d
commit 25e068a
Show file tree

Hide file tree

Showing 3 changed files with 6 additions and 4 deletions.
diff --git a/cogent/src/Cogent/PrettyPrint.hs b/cogent/src/Cogent/PrettyPrint.hs
@@ -279,7 +279,7 @@ instance (Pretty t, TypeType t) => Pretty (Type t) where
                          typename n <+> hsep (map prettyT' as)
     where prettyT' e | not $ isAtomic e = parens (pretty e)
                      | otherwise        = pretty e
-  pretty (TVar n b)  = typevar n
+  pretty (TVar n b)  = typevar n <> (if b then typesymbol "!" else empty)
   pretty (TTuple ts) = tupled (map pretty ts)
   pretty (TUnit)     = typesymbol "()" & (if __cogent_fdisambiguate_pp then (<+> comment "{- unit -}") else id)
   pretty (TRecord ts s)

diff --git a/cogent/src/Cogent/TypeCheck/Solver.hs b/cogent/src/Cogent/TypeCheck/Solver.hs
@@ -190,8 +190,10 @@ rule Unsat   {} = return Nothing
 rule SemiSat {} = return Nothing
 rule Sat     {} = return Nothing
 
-rule (Share  (T TVar {}) _) = return Nothing
-rule (Drop   (T TVar {}) _) = return Nothing
+rule (Share  (T (TVar _ s)) _) | s         = return $ Just Sat
+                               | otherwise = return $ Nothing
+rule (Drop   (T (TVar _ s)) _) | s         = return $ Just Sat
+                               | otherwise = return $ Nothing
 rule (Escape (T TVar {}) _) = return Nothing
 
 rule (Share  (T (TTuple xs)) m) = return . Just . mconcat $ map (flip Share m) xs

diff --git a/cogent/tests/pass_unknown-underscore-type.cogent b/cogent/tests/pass_unknown-underscore-type.cogent
@@ -12,7 +12,7 @@ check_dirent_empty #{obj = new_dirent, acc = maybe_prev_dirent} =
         | Some prev_dirent ->
             let ex = destroy_Ext2DirEnt prev_dirent
             in check_dirent_empty2 (new_dirent, offset)
-        | None _ ->
+        | None ->
             check_dirent_empty2 (new_dirent, offset)