Merge remote-tracking branch 'origin/master' into type-nats
[ghc.git] / compiler / coreSyn / CoreLint.lhs
index d40ef52..f62d519 100644 (file)
@@ -743,6 +743,8 @@ lintType (ForAllTy tv ty)
   = do { lintTyBndrKind tv
        ; addInScopeVar tv (lintType ty) }
 
+lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty)
+
 ----------------
 lint_ty_app :: Type -> Kind -> [OutType] -> LintM Kind
 lint_ty_app ty k tys 
@@ -755,6 +757,14 @@ lint_co_app ty k tys
        ; return () }
 
 ----------------
+lintTyLit :: TyLit -> LintM ()
+lintTyLit (NumTyLit n)
+  | n >= 0    = return ()
+  | otherwise = failWithL msg
+    where msg = ptext (sLit "Negative type literal:") <+> integer n
+lintTyLit (StrTyLit _) = return ()
+
+----------------
 lint_kind_app :: SDoc -> Kind -> [OutType] -> LintM Kind
 -- (lint_kind_app d fun_kind arg_tys)
 --    We have an application (f arg_ty1 .. arg_tyn),