Add numeric types to the parsing part of the front end.
authorIavor S. Diatchki <iavor.diatchki@gmail.com>
Sun, 18 Dec 2011 22:26:47 +0000 (14:26 -0800)
committerIavor S. Diatchki <iavor.diatchki@gmail.com>
Mon, 19 Dec 2011 01:24:34 +0000 (17:24 -0800)
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.

compiler/hsSyn/HsTypes.lhs
compiler/parser/Parser.y.pp
compiler/parser/RdrHsSyn.lhs
compiler/rename/RnHsSyn.lhs
compiler/rename/RnTypes.lhs
compiler/typecheck/TcHsType.lhs

index b76ff4b..f4b3bc0 100644 (file)
@@ -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
index 855a428..33ddd28 100644 (file)
@@ -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
index 10e731b..30f5a47 100644 (file)
@@ -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]
index e2369bb..43494bb 100644 (file)
@@ -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
index df6008b..936f38f 100644 (file)
@@ -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
index 3a35046..6741e7b 100644 (file)
@@ -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