Add numeric types to the parsing part of the front end.

For the moment, the kind of the numerical literals is the type "Word"
lifted to the kind level.  This should probably be changed in the future.

6 files changed, 21 insertions, 0 deletions

diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index b76ff4b0f5..f4b3bc0c6e 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -181,6 +181,8 @@ data HsType name
         [PostTcKind]     -- See Note [Promoted lists and tuples]
         [LHsType name]   
 
+  | HsNumberTy Integer    -- A promoted numeric literal.
+
   | HsWrapTy HsTyWrapper (HsType name)  -- only in typechecker output
   deriving (Data, Typeable)
 
@@ -553,6 +555,7 @@ ppr_mono_ty _    (HsSpliceTy s _ _)  = pprSplice s
 ppr_mono_ty _    (HsCoreTy ty)       = ppr ty
 ppr_mono_ty _    (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
 ppr_mono_ty _    (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys)
+ppr_mono_ty _    (HsNumberTy n)      = integer n
 
 ppr_mono_ty ctxt_prec (HsWrapTy (WpKiApps _kis) ty)
   = ppr_mono_ty ctxt_prec ty
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 855a428798..33ddd28c8c 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -1067,6 +1067,7 @@ atype :: { LHsType RdrName }
         | SIMPLEQUOTE  '(' ctype ',' comma_types1 ')' { LL $ HsExplicitTupleTy [] ($3 : $5) }
         | SIMPLEQUOTE  '[' comma_types0 ']'           { LL $ HsExplicitListTy placeHolderKind $3 }
         | '[' ctype ',' comma_types1 ']'              { LL $ HsExplicitListTy placeHolderKind ($2 : $4) }
+        | INTEGER                       { LL $ HsNumberTy $ getINTEGER $1 }
 
 -- An inst_type is what occurs in the head of an instance decl
 --      e.g.  (Foo a, Gaz b) => Wibble a b
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 10e731b3e0..30f5a47c74 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -136,6 +136,7 @@ extract_lty (L loc ty) acc
       HsDocTy ty _              -> extract_lty ty acc
       HsExplicitListTy _ tys    -> extract_ltys tys acc
       HsExplicitTupleTy _ tys   -> extract_ltys tys acc
+      HsNumberTy _              -> acc
       HsWrapTy _ _              -> panic "extract_lty"
 
 extract_tv :: SrcSpan -> RdrName -> [Located RdrName] -> [Located RdrName]
diff --git a/compiler/rename/RnHsSyn.lhs b/compiler/rename/RnHsSyn.lhs
index e2369bb776..43494bbded 100644
--- a/compiler/rename/RnHsSyn.lhs
+++ b/compiler/rename/RnHsSyn.lhs
@@ -88,6 +88,7 @@ extractHsTyNames ty
     		  	       	 		-- but I don't think it matters
     get (HsExplicitListTy _ tys) = extractHsTyNames_s tys
     get (HsExplicitTupleTy _ tys) = extractHsTyNames_s tys
+    get (HsNumberTy _)         = emptyNameSet
     get (HsWrapTy {})          = panic "extractHsTyNames"
 
 extractHsTyNames_s  :: [LHsType Name] -> NameSet
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index df6008b574..936f38f55b 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -221,6 +221,13 @@ rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys) = do
     tys' <- mapM (rnLHsTyKi isType doc) tys
     return (HsTupleTy tup_con tys')
 
+-- 1. Perhaps we should use a separate extension here?
+-- 2. Check that the integer is positive?
+rnHsTyKi isType _ numberTy@(HsNumberTy n) = do
+    poly_kinds <- xoptM Opt_PolyKinds
+    unless (poly_kinds || isType) (addErr (polyKindsErr numberTy))
+    return (HsNumberTy n)
+
 rnHsTyKi isType doc (HsAppTy ty1 ty2) = do
     ty1' <- rnLHsTyKi isType doc ty1
     ty2' <- rnLHsTyKi isType doc ty2
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 3a35046959..6741e7b360 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -524,6 +524,11 @@ kc_hs_type ty@(HsExplicitTupleTy _ tys) exp_kind = do
   checkExpectedKind ty tupleKi exp_kind
   return (HsExplicitTupleTy (map snd ty_k_s) (map fst ty_k_s))
 
+kc_hs_type ty@(HsNumberTy n) exp_kind = do
+  -- XXX: Temporarily we use the Word type lifted to the kind level.
+  checkExpectedKind ty wordTy exp_kind
+  return (HsNumberTy n)
+
 kc_hs_type (HsWrapTy {}) _exp_kind =
     panic "kc_hs_type HsWrapTy"  -- We kind checked something twice
 
@@ -759,6 +764,9 @@ ds_type (HsExplicitTupleTy kis tys) = do
   tys' <- mapM dsHsType tys
   return $ mkTyConApp (buildPromotedDataTyCon (tupleCon BoxedTuple (length kis'))) (kis' ++ tys')
 
+ds_type (HsNumberTy n) =
+  failWithTc (ptext (sLit "ds_type: NumberTy not yet implemenetd"))
+
 ds_type (HsWrapTy (WpKiApps kappas) ty) = do
   tau <- ds_type ty
   kappas' <- mapM zonkTcKindToKind kappas