Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/826b75a9a4fc6e978a4cfa09d896a927c56cfb75 >--------------------------------------------------------------- commit 826b75a9a4fc6e978a4cfa09d896a927c56cfb75 Author: Iavor S. Diatchki <[email protected]> Date: Sun Dec 18 14:26:47 2011 -0800 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. >--------------------------------------------------------------- compiler/hsSyn/HsTypes.lhs | 3 +++ compiler/parser/Parser.y.pp | 1 + compiler/parser/RdrHsSyn.lhs | 1 + compiler/rename/RnHsSyn.lhs | 1 + compiler/rename/RnTypes.lhs | 7 +++++++ 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 b76ff4b..f4b3bc0 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 855a428..33ddd28 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 10e731b..30f5a47 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 e2369bb..43494bb 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 df6008b..936f38f 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 3a35046..6741e7b 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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
