diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/deSugar/DsMeta.hs | 13 | ||||
-rw-r--r-- | compiler/hsSyn/Convert.hs | 1 | ||||
-rw-r--r-- | compiler/prelude/PrelNames.hs | 9 | ||||
-rw-r--r-- | compiler/prelude/THNames.hs | 15 | ||||
-rw-r--r-- | compiler/prelude/TysWiredIn.hs | 20 |
5 files changed, 49 insertions, 9 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 70bc6908f7..b9805ac58b 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -58,6 +58,7 @@ import ForeignCall import Util import MonadUtils +import Data.ByteString ( unpack ) import Data.Maybe import Control.Monad import Data.List @@ -1984,6 +1985,13 @@ repKConstraint = rep2 constraintKName [] -- Literals repLiteral :: HsLit -> DsM (Core TH.Lit) +repLiteral (HsStringPrim _ bs) + = do dflags <- getDynFlags + word8_ty <- lookupType word8TyConName + let w8s = unpack bs + w8s_expr = map (\w8 -> mkCoreConApps word8DataCon + [mkWordLit dflags (toInteger w8)]) w8s + rep2 stringPrimLName [mkListExpr word8_ty w8s_expr] repLiteral lit = do lit' <- case lit of HsIntPrim _ i -> mk_integer i @@ -1991,6 +1999,7 @@ repLiteral lit HsInt _ i -> mk_integer i HsFloatPrim r -> mk_rational r HsDoublePrim r -> mk_rational r + HsCharPrim _ c -> mk_char c _ -> return lit lit_expr <- dsLit lit' case mb_lit_name of @@ -2005,6 +2014,7 @@ repLiteral lit HsFloatPrim _ -> Just floatPrimLName HsDoublePrim _ -> Just doublePrimLName HsChar _ _ -> Just charLName + HsCharPrim _ _ -> Just charPrimLName HsString _ _ -> Just stringLName HsRat _ _ -> Just rationalLName _ -> Nothing @@ -2018,6 +2028,9 @@ mk_rational r = do rat_ty <- lookupType rationalTyConName mk_string :: FastString -> DsM HsLit mk_string s = return $ HsString "" s +mk_char :: Char -> DsM HsLit +mk_char c = return $ HsChar "" c + repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit) repOverloadedLiteral (OverLit { ol_val = val}) = do { lit <- mk_lit val; repLiteral lit } diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index da7fcdeae1..4749871eea 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -880,6 +880,7 @@ cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim (show w) w } cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim (cvtFractionalLit f) } cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim (cvtFractionalLit f) } cvtLit (CharL c) = do { force c; return $ HsChar (show c) c } +cvtLit (CharPrimL c) = do { force c; return $ HsCharPrim (show c) c } cvtLit (StringL s) = do { let { s' = mkFastString s } ; force s' ; return $ HsString s s' } diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 570ec071b0..32c133d924 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -282,7 +282,7 @@ basicKnownKeyNames -- FFI primitive types that are not wired-in. stablePtrTyConName, ptrTyConName, funPtrTyConName, int8TyConName, int16TyConName, int32TyConName, int64TyConName, - word8TyConName, word16TyConName, word32TyConName, word64TyConName, + word16TyConName, word32TyConName, word64TyConName, -- Others otherwiseIdName, inlineIdName, @@ -1117,8 +1117,7 @@ int32TyConName = tcQual gHC_INT (fsLit "Int32") int32TyConKey int64TyConName = tcQual gHC_INT (fsLit "Int64") int64TyConKey -- Word module -word8TyConName, word16TyConName, word32TyConName, word64TyConName :: Name -word8TyConName = tcQual gHC_WORD (fsLit "Word8") word8TyConKey +word16TyConName, word32TyConName, word64TyConName :: Name word16TyConName = tcQual gHC_WORD (fsLit "Word16") word16TyConKey word32TyConName = tcQual gHC_WORD (fsLit "Word32") word32TyConKey word64TyConName = tcQual gHC_WORD (fsLit "Word64") word64TyConKey @@ -1567,7 +1566,8 @@ typeRepTyConKey = mkPreludeTyConUnique 183 charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey, floatDataConKey, intDataConKey, integerSDataConKey, nilDataConKey, ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey, - ioDataConKey, integerDataConKey, eqBoxDataConKey, coercibleDataConKey :: Unique + word8DataConKey, ioDataConKey, integerDataConKey, eqBoxDataConKey, + coercibleDataConKey :: Unique charDataConKey = mkPreludeDataConUnique 1 consDataConKey = mkPreludeDataConUnique 2 doubleDataConKey = mkPreludeDataConUnique 3 @@ -1577,6 +1577,7 @@ intDataConKey = mkPreludeDataConUnique 6 integerSDataConKey = mkPreludeDataConUnique 7 nilDataConKey = mkPreludeDataConUnique 11 ratioDataConKey = mkPreludeDataConUnique 12 +word8DataConKey = mkPreludeDataConUnique 13 stableNameDataConKey = mkPreludeDataConUnique 14 trueDataConKey = mkPreludeDataConUnique 15 wordDataConKey = mkPreludeDataConUnique 16 diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs index 5ccfaeb3e8..254431e360 100644 --- a/compiler/prelude/THNames.hs +++ b/compiler/prelude/THNames.hs @@ -33,7 +33,8 @@ templateHaskellNames = [ -- Lit charLName, stringLName, integerLName, intPrimLName, wordPrimLName, - floatPrimLName, doublePrimLName, rationalLName, + floatPrimLName, doublePrimLName, rationalLName, stringPrimLName, + charPrimLName, -- Pat litPName, varPName, tupPName, unboxedTupPName, conPName, tildePName, bangPName, infixPName, @@ -188,7 +189,8 @@ unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey -------------------- TH.Lib ----------------------- -- data Lit = ... charLName, stringLName, integerLName, intPrimLName, wordPrimLName, - floatPrimLName, doublePrimLName, rationalLName :: Name + floatPrimLName, doublePrimLName, rationalLName, stringPrimLName, + charPrimLName :: Name charLName = libFun (fsLit "charL") charLIdKey stringLName = libFun (fsLit "stringL") stringLIdKey integerLName = libFun (fsLit "integerL") integerLIdKey @@ -197,6 +199,8 @@ wordPrimLName = libFun (fsLit "wordPrimL") wordPrimLIdKey floatPrimLName = libFun (fsLit "floatPrimL") floatPrimLIdKey doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey rationalLName = libFun (fsLit "rationalL") rationalLIdKey +stringPrimLName = libFun (fsLit "stringPrimL") stringPrimLIdKey +charPrimLName = libFun (fsLit "charPrimL") charPrimLIdKey -- data Pat = ... litPName, varPName, tupPName, unboxedTupPName, conPName, infixPName, tildePName, bangPName, @@ -556,7 +560,8 @@ unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 212 -- data Lit = ... charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey, - floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey :: Unique + floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey, stringPrimLIdKey, + charPrimLIdKey:: Unique charLIdKey = mkPreludeMiscIdUnique 220 stringLIdKey = mkPreludeMiscIdUnique 221 integerLIdKey = mkPreludeMiscIdUnique 222 @@ -565,9 +570,11 @@ wordPrimLIdKey = mkPreludeMiscIdUnique 224 floatPrimLIdKey = mkPreludeMiscIdUnique 225 doublePrimLIdKey = mkPreludeMiscIdUnique 226 rationalLIdKey = mkPreludeMiscIdUnique 227 +stringPrimLIdKey = mkPreludeMiscIdUnique 228 +charPrimLIdKey = mkPreludeMiscIdUnique 229 liftStringIdKey :: Unique -liftStringIdKey = mkPreludeMiscIdUnique 228 +liftStringIdKey = mkPreludeMiscIdUnique 230 -- data Pat = ... litPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, bangPIdKey, diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 5ab8654f06..f7d08ff1c4 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -42,6 +42,9 @@ module TysWiredIn ( -- * Word wordTyCon, wordDataCon, wordTyConName, wordTy, + -- * Word8 + word8TyCon, word8DataCon, word8TyConName, word8Ty, + -- * List listTyCon, listTyCon_RDR, listTyConName, listTyConKey, nilDataCon, nilDataConName, nilDataConKey, @@ -152,6 +155,7 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because , floatTyCon , intTyCon , wordTyCon + , word8TyCon , listTyCon , parrTyCon , eqTyCon @@ -198,9 +202,13 @@ listTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "[]") li nilDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon consDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon -wordTyConName, wordDataConName, floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name +wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name wordTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Word") wordTyConKey wordTyCon wordDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#") wordDataConKey wordDataCon +word8TyConName = mkWiredInTyConName UserSyntax gHC_WORD (fsLit "Word8") word8TyConKey word8TyCon +word8DataConName = mkWiredInDataConName UserSyntax gHC_WORD (fsLit "W8#") word8DataConKey word8DataCon + +floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name floatTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Float") floatTyConKey floatTyCon floatDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#") floatDataConKey floatDataCon doubleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey doubleTyCon @@ -617,6 +625,16 @@ wordTyCon = pcNonRecDataTyCon wordTyConName wordDataCon :: DataCon wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon +word8Ty :: Type +word8Ty = mkTyConTy word8TyCon + +word8TyCon :: TyCon +word8TyCon = pcNonRecDataTyCon word8TyConName + (Just (CType "" Nothing ("HsWord8", fsLit "HsWord8"))) [] + [word8DataCon] +word8DataCon :: DataCon +word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon + floatTy :: Type floatTy = mkTyConTy floatTyCon |