diff options
| author | Moritz Angermann <moritz.angermann@gmail.com> | 2020-11-02 13:55:57 +0800 |
|---|---|---|
| committer | Moritz Angermann <moritz.angermann@gmail.com> | 2020-11-02 13:55:57 +0800 |
| commit | e98e3d124a92cdf48108d918e501a132eaaee53a (patch) | |
| tree | cfe71abf04f1ed1b3c60b583cc07e9253215f929 | |
| parent | 13a7028bd83f33b0647cd924830f3ad228e9ee24 (diff) | |
| download | haskell-wip/angerman/x.tar.gz | |
[SizedCmm Word] Trying to fix TH Quoteswip/angerman/x
| -rw-r--r-- | compiler/GHC/Builtin/Types.hs | 17 | ||||
| -rw-r--r-- | compiler/GHC/Core.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 15 |
3 files changed, 30 insertions, 9 deletions
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index 9ce753fd3f..26d140a52f 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -54,6 +54,9 @@ module GHC.Builtin.Types ( -- * Word wordTyCon, wordDataCon, wordTyConName, wordTy, + -- * Word8 + word8TyCon, word8DataCon, word8Ty, + -- * List listTyCon, listTyCon_RDR, listTyConName, listTyConKey, nilDataCon, nilDataConName, nilDataConKey, @@ -348,9 +351,10 @@ nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing") justDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just") justDataConKey justDataCon -wordTyConName, wordDataConName :: Name +wordTyConName, wordDataConName, word8DataConName :: Name wordTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Word") wordTyConKey wordTyCon wordDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#") wordDataConKey wordDataCon +word8DataConName = mkWiredInDataConName UserSyntax gHC_WORD (fsLit "W8#") word8DataConKey word8DataCon floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name floatTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Float") floatTyConKey floatTyCon @@ -1537,6 +1541,17 @@ wordTyCon = pcTyCon wordTyConName wordDataCon :: DataCon wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon +word8Ty :: Type +word8Ty = mkTyConTy word8TyCon + +word8TyCon :: TyCon +word8TyCon = pcTyCon word8TyConName + (Just (CType NoSourceText Nothing + (NoSourceText, fsLit "HsWord8"))) [] + [word8DataCon] +word8DataCon :: DataCon +word8DataCon = pcDataCon word8DataConName [] [word8PrimTy] word8TyCon + floatTy :: Type floatTy = mkTyConTy floatTyCon diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs index c99182f978..112f8d8671 100644 --- a/compiler/GHC/Core.hs +++ b/compiler/GHC/Core.hs @@ -29,6 +29,7 @@ module GHC.Core ( mkIntLit, mkIntLitInt, mkWordLit, mkWordLitWord, + mkWord8Lit, mkWord8LitWord, mkWord64LitWord64, mkInt64LitInt64, mkCharLit, mkStringLit, mkFloatLit, mkFloatLitFloat, @@ -1995,6 +1996,12 @@ mkWordLitWord :: Platform -> Word -> Expr b mkWordLit platform w = Lit (mkLitWord platform w) mkWordLitWord platform w = Lit (mkLitWord platform (toInteger w)) +mkWord8Lit :: Platform -> Integer -> Expr b +mkWord8Lit _platform w = Lit (mkLitWord8 w) + +mkWord8LitWord :: Platform -> Integer -> Expr b +mkWord8LitWord _platform w = Lit (mkLitWord8 (toInteger w)) + mkWord64LitWord64 :: Word64 -> Expr b mkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w)) diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index 0d6e224c57..5d2d1a8bb2 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -2750,14 +2750,13 @@ repTyVarSig (MkC bndr) = rep2 tyVarSigName [bndr] -- Literals repLiteral :: HsLit GhcRn -> MetaM (Core TH.Lit) --- XXX this needs fixing. --- repLiteral (HsStringPrim _ bs) --- = do platform <- getPlatform --- word8_ty <- lookupType word8TyConName --- let w8s = unpack bs --- w8s_expr = map (\w8 -> mkCoreConApps word8DataCon --- [mkWordLit platform (toInteger w8)]) w8s --- rep2_nw stringPrimLName [mkListExpr word8_ty w8s_expr] +repLiteral (HsStringPrim _ bs) + = do platform <- getPlatform + word8_ty <- lookupType word8TyConName + let w8s = unpack bs + w8s_expr = map (\w8 -> mkCoreConApps word8DataCon + [mkWord8Lit platform (toInteger w8)]) w8s + rep2_nw stringPrimLName [mkListExpr word8_ty w8s_expr] repLiteral lit = do lit' <- case lit of HsIntPrim _ i -> mk_integer i |