diff options
| -rw-r--r-- | compiler/hsSyn/HsTypes.lhs | 3 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 1 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.lhs | 1 | ||||
| -rw-r--r-- | compiler/rename/RnHsSyn.lhs | 1 | ||||
| -rw-r--r-- | compiler/rename/RnTypes.lhs | 7 | ||||
| -rw-r--r-- | compiler/typecheck/TcHsType.lhs | 8 |
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 |