Skip to content

GitLab

GHC
GHC
Commit 6821c8a4 authored by Ian Lynagh's avatar Ian Lynagh
Browse files
Options

Add 123## literals for Word#

parent 1cd9b26d
Hide whitespace changes
Inline Side-by-side
Showing with 47 additions and 10 deletions
compiler/deSugar/DsMeta.hs
View file @ 6821c8a4
......@@ -1260,6 +1260,7 @@ repLiteral :: HsLit -> DsM (Core TH.Lit)
repLiteral lit
= do lit' <- case lit of
HsIntPrim i -> mk_integer i
HsWordPrim w -> mk_integer w
HsInt i -> mk_integer i
HsFloatPrim r -> mk_rational r
HsDoublePrim r -> mk_rational r
......@@ -1273,6 +1274,7 @@ repLiteral lit
HsInteger _ _ -> Just integerLName
HsInt _ -> Just integerLName
HsIntPrim _ -> Just intPrimLName
HsWordPrim _ -> Just wordPrimLName
HsFloatPrim _ -> Just floatPrimLName
HsDoublePrim _ -> Just doublePrimLName
HsChar _ -> Just charLName
......@@ -1368,7 +1370,7 @@ templateHaskellNames = [
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
-- Lit
charLName, stringLName, integerLName, intPrimLName,
charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
floatPrimLName, doublePrimLName, rationalLName,
-- Pat
litPName, varPName, tupPName, conPName, tildePName, infixPName,
......@@ -1473,6 +1475,7 @@ charLName = libFun (fsLit "charL") charLIdKey
stringLName = libFun (fsLit "stringL") stringLIdKey
integerLName = libFun (fsLit "integerL") integerLIdKey
intPrimLName = libFun (fsLit "intPrimL") intPrimLIdKey
wordPrimLName = libFun (fsLit "wordPrimL") wordPrimLIdKey
floatPrimLName = libFun (fsLit "floatPrimL") floatPrimLIdKey
doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey
rationalLName = libFun (fsLit "rationalL") rationalLIdKey
......@@ -1658,9 +1661,10 @@ charLIdKey = mkPreludeMiscIdUnique 210
stringLIdKey = mkPreludeMiscIdUnique 211
integerLIdKey = mkPreludeMiscIdUnique 212
intPrimLIdKey = mkPreludeMiscIdUnique 213
floatPrimLIdKey = mkPreludeMiscIdUnique 214
doublePrimLIdKey = mkPreludeMiscIdUnique 215
rationalLIdKey = mkPreludeMiscIdUnique 216
wordPrimLIdKey = mkPreludeMiscIdUnique 214
floatPrimLIdKey = mkPreludeMiscIdUnique 215
doublePrimLIdKey = mkPreludeMiscIdUnique 216
rationalLIdKey = mkPreludeMiscIdUnique 217
-- data Pat = ...
litPIdKey = mkPreludeMiscIdUnique 220
......
compiler/deSugar/MatchLit.lhs
View file @ 6821c8a4
......@@ -69,6 +69,7 @@ dsLit :: HsLit -> DsM CoreExpr
dsLit (HsStringPrim s) = return (mkLit (MachStr s))
dsLit (HsCharPrim c) = return (mkLit (MachChar c))
dsLit (HsIntPrim i) = return (mkLit (MachInt i))
dsLit (HsWordPrim w) = return (mkLit (MachWord w))
dsLit (HsFloatPrim f) = return (mkLit (MachFloat f))
dsLit (HsDoublePrim d) = return (mkLit (MachDouble d))
......@@ -103,6 +104,7 @@ hsLitKey :: HsLit -> Literal
-- It only works for primitive types and strings;
-- others have been removed by tidy
hsLitKey (HsIntPrim i) = mkMachInt i
hsLitKey (HsWordPrim w) = mkMachWord w
hsLitKey (HsCharPrim c) = MachChar c
hsLitKey (HsStringPrim s) = MachStr s
hsLitKey (HsFloatPrim f) = MachFloat f
......@@ -128,7 +130,7 @@ hsOverLitKey (HsIsString s _ _) False = MachStr s
\begin{code}
tidyLitPat :: HsLit -> Pat Id
-- Result has only the following HsLits:
-- HsIntPrim, HsCharPrim, HsFloatPrim
-- HsIntPrim, HsWordPrim, HsCharPrim, HsFloatPrim
-- HsDoublePrim, HsStringPrim, HsString
-- * HsInteger, HsRat, HsInt can't show up in LitPats
-- * We get rid of HsChar right here
......@@ -145,6 +147,7 @@ tidyLitPat lit = LitPat lit
tidyNPat :: HsOverLit Id -> Maybe (SyntaxExpr Id) -> SyntaxExpr Id -> Pat Id
tidyNPat over_lit mb_neg eq
| isIntTy (overLitType over_lit) = mk_con_pat intDataCon (HsIntPrim int_val)
| isWordTy (overLitType over_lit) = mk_con_pat wordDataCon (HsWordPrim int_val)
| isFloatTy (overLitType over_lit) = mk_con_pat floatDataCon (HsFloatPrim rat_val)
| isDoubleTy (overLitType over_lit) = mk_con_pat doubleDataCon (HsDoublePrim rat_val)
-- | isStringTy lit_ty = mk_con_pat stringDataCon (HsStringPrim str_val)
......
compiler/hsSyn/Convert.lhs
View file @ 6821c8a4
......@@ -455,6 +455,7 @@ cvtOverLit (StringL s) = do { let { s' = mkFastString s }; force s'; return $
cvtLit :: Lit -> CvtM HsLit
cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim i }
cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim w }
cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim f }
cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim f }
cvtLit (CharL c) = do { force c; return $ HsChar c }
......
compiler/hsSyn/HsLit.lhs
View file @ 6821c8a4
......@@ -34,6 +34,7 @@ data HsLit
| HsInt Integer -- Genuinely an Int; arises from TcGenDeriv,
-- and from TRANSLATION
| HsIntPrim Integer -- Unboxed Int
| HsWordPrim Integer -- Unboxed Word
| HsInteger Integer Type -- Genuinely an integer; arises only from TRANSLATION
-- (overloaded literals are done with HsOverLit)
| HsRat Rational Type -- Genuinely a rational; arises only from TRANSLATION
......@@ -48,6 +49,7 @@ instance Eq HsLit where
(HsStringPrim x1) == (HsStringPrim x2) = x1==x2
(HsInt x1) == (HsInt x2) = x1==x2
(HsIntPrim x1) == (HsIntPrim x2) = x1==x2
(HsWordPrim x1) == (HsWordPrim x2) = x1==x2
(HsInteger x1 _) == (HsInteger x2 _) = x1==x2
(HsRat x1 _) == (HsRat x2 _) = x1==x2
(HsFloatPrim x1) == (HsFloatPrim x2) = x1==x2
......@@ -112,6 +114,7 @@ instance Outputable HsLit where
ppr (HsFloatPrim f) = rational f <> char '#'
ppr (HsDoublePrim d) = rational d <> text "##"
ppr (HsIntPrim i) = integer i <> char '#'
ppr (HsWordPrim w) = integer w <> text "##"
-- in debug mode, print the expression that it's resolved to, too
instance OutputableBndr id => Outputable (HsOverLit id) where
......
compiler/parser/Lexer.x
View file @ 6821c8a4
......@@ -385,7 +385,7 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") }
}
<0> {
-- Unboxed ints (:: Int#)
-- Unboxed ints (:: Int#) and words (:: Word#)
-- It's simpler (and faster?) to give separate cases to the negatives,
-- especially considering octal/hexadecimal prefixes.
@decimal \# / { ifExtension magicHashEnabled } { tok_primint positive 0 1 decimal }
......@@ -395,6 +395,10 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") }
@negative 0[oO] @octal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 octal }
@negative 0[xX] @hexadecimal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 hexadecimal }
@decimal \# \# / { ifExtension magicHashEnabled } { tok_primword 0 2 decimal }
0[oO] @octal \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 octal }
0[xX] @hexadecimal \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 hexadecimal }
-- Unboxed floats and doubles (:: Float#, :: Double#)
-- prim_{float,double} work with signed literals
@signed @floating_point \# / { ifExtension magicHashEnabled } { init_strtoken 1 tok_primfloat }
......@@ -533,6 +537,7 @@ data Token
| ITprimchar Char
| ITprimstring FastString
| ITprimint Integer
| ITprimword Integer
| ITprimfloat Rational
| ITprimdouble Rational
......@@ -971,6 +976,7 @@ tok_integral itint transint transbuf translen (radix,char_to_int) span buf len =
-- some conveniences for use with tok_integral
tok_num = tok_integral ITinteger
tok_primint = tok_integral ITprimint
tok_primword = tok_integral ITprimword positive
positive = id
negative = negate
decimal = (10,octDecDigit)
......
compiler/parser/Parser.y.pp
View file @ 6821c8a4
......@@ -316,6 +316,7 @@ incorrect.
PRIMCHAR { L _ (ITprimchar _) }
PRIMSTRING { L _ (ITprimstring _) }
PRIMINTEGER { L _ (ITprimint _) }
PRIMWORD { L _ (ITprimword _) }
PRIMFLOAT { L _ (ITprimfloat _) }
PRIMDOUBLE { L _ (ITprimdouble _) }
......@@ -1862,6 +1863,7 @@ literal :: { Located HsLit }
: CHAR { L1 $ HsChar $ getCHAR $1 }
| STRING { L1 $ HsString $ getSTRING $1 }
| PRIMINTEGER { L1 $ HsIntPrim $ getPRIMINTEGER $1 }
| PRIMWORD { L1 $ HsWordPrim $ getPRIMWORD $1 }
| PRIMCHAR { L1 $ HsCharPrim $ getPRIMCHAR $1 }
| PRIMSTRING { L1 $ HsStringPrim $ getPRIMSTRING $1 }
| PRIMFLOAT { L1 $ HsFloatPrim $ getPRIMFLOAT $1 }
......@@ -1955,6 +1957,7 @@ getRATIONAL (L _ (ITrational x)) = x
getPRIMCHAR (L _ (ITprimchar x)) = x
getPRIMSTRING (L _ (ITprimstring x)) = x
getPRIMINTEGER (L _ (ITprimint x)) = x
getPRIMWORD (L _ (ITprimword x)) = x
getPRIMFLOAT (L _ (ITprimfloat x)) = x
getPRIMDOUBLE (L _ (ITprimdouble x)) = x
getTH_ID_SPLICE (L _ (ITidEscape x)) = x
......
compiler/prelude/TysWiredIn.lhs
View file @ 6821c8a4
......@@ -28,6 +28,8 @@ module TysWiredIn (
intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
intTy,
wordTyCon, wordDataCon, wordTyConName, wordTy,
listTyCon, nilDataCon, consDataCon,
listTyCon_RDR, consDataCon_RDR, listTyConName,
mkListTy,
......@@ -351,6 +353,16 @@ intDataCon :: DataCon
intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon
\end{code}
\begin{code}
wordTy :: Type
wordTy = mkTyConTy wordTyCon
wordTyCon :: TyCon
wordTyCon = pcNonRecDataTyCon wordTyConName [] [wordDataCon]
wordDataCon :: DataCon
wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon
\end{code}
\begin{code}
floatTy :: Type
floatTy = mkTyConTy floatTyCon
......
compiler/typecheck/Inst.lhs
View file @ 6821c8a4
......@@ -474,6 +474,7 @@ newMethod inst_loc id tys = do
shortCutIntLit :: Integer -> TcType -> Maybe (HsExpr TcId)
shortCutIntLit i ty
| isIntTy ty && inIntRange i = Just (HsLit (HsInt i))
| isWordTy ty && inWordRange i = Just (mkLit wordDataCon (HsWordPrim i))
| isIntegerTy ty = Just (HsLit (HsInteger i ty))
| otherwise = shortCutFracLit (fromInteger i) ty
-- The 'otherwise' case is important
......@@ -484,11 +485,13 @@ shortCutIntLit i ty
shortCutFracLit :: Rational -> TcType -> Maybe (HsExpr TcId)
shortCutFracLit f ty
| isFloatTy ty = Just (mk_lit floatDataCon (HsFloatPrim f))
| isDoubleTy ty = Just (mk_lit doubleDataCon (HsDoublePrim f))
| isFloatTy ty = Just (mkLit floatDataCon (HsFloatPrim f))
| isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim f))
| otherwise = Nothing
where
mk_lit con lit = HsApp (nlHsVar (dataConWrapId con)) (nlHsLit lit)
mkLit :: DataCon -> HsLit -> HsExpr Id
mkLit con lit = HsApp (nlHsVar (dataConWrapId con)) (nlHsLit lit)
shortCutStringLit :: FastString -> TcType -> Maybe (HsExpr TcId)
shortCutStringLit s ty
......
compiler/typecheck/TcHsSyn.lhs
View file @ 6821c8a4
......@@ -118,6 +118,7 @@ hsLitType (HsString str) = stringTy
hsLitType (HsStringPrim s) = addrPrimTy
hsLitType (HsInt i) = intTy
hsLitType (HsIntPrim i) = intPrimTy
hsLitType (HsWordPrim w) = wordPrimTy
hsLitType (HsInteger i ty) = ty
hsLitType (HsRat _ ty) = ty
hsLitType (HsFloatPrim f) = floatPrimTy
......
compiler/typecheck/TcType.lhs
View file @ 6821c8a4
......@@ -62,7 +62,7 @@ module TcType (
tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
eqKind,
isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy,
isDoubleTy, isFloatTy, isIntTy, isStringTy,
isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
isIntegerTy, isBoolTy, isUnitTy, isCharTy,
isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
isOpenSynTyConApp,
......@@ -972,6 +972,7 @@ isFloatTy = is_tc floatTyConKey
isDoubleTy = is_tc doubleTyConKey
isIntegerTy = is_tc integerTyConKey
isIntTy = is_tc intTyConKey
isWordTy = is_tc wordTyConKey
isBoolTy = is_tc boolTyConKey
isUnitTy = is_tc unitTyConKey
isCharTy = is_tc charTyConKey
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment