[Git][ghc/ghc][wip/ttg/lits] Implemented review comments for HsLit changes
Hassan Al-Awwadi (@hassan.awwadi)
gitlab at gitlab.haskell.org
Wed Oct 9 13:21:09 UTC 2024
Hassan Al-Awwadi pushed to branch wip/ttg/lits at Glasgow Haskell Compiler / GHC
Commits:
460d9a83 by Hassan Al-Awwadi at 2024-10-09T15:20:21+02:00
Implemented review comments for HsLit changes
fused the various `convertLit`s together.
moved `lift` into the branches like I did `dsLit`
- - - - -
6 changed files:
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Pat.hs
Changes:
=====================================
compiler/GHC/Hs/Lit.hs
=====================================
@@ -173,65 +173,25 @@ hsLitNeedsParens p = go
-- | Convert a literal from one index type to another
-convertLitPsRn :: HsLit GhcPs -> HsLit GhcRn
-convertLitPsRn (HsChar a x) = HsChar a x
-convertLitPsRn (HsCharPrim a x) = HsCharPrim a x
-convertLitPsRn (HsString a x) = HsString a x
-convertLitPsRn (HsMultilineString a x) = HsMultilineString a x
-convertLitPsRn (HsStringPrim a x) = HsStringPrim a x
-convertLitPsRn (HsInt a x) = HsInt a x
-convertLitPsRn (HsIntPrim a x) = HsIntPrim a x
-convertLitPsRn (HsWordPrim a x) = HsWordPrim a x
-convertLitPsRn (HsInt8Prim a x) = HsInt8Prim a x
-convertLitPsRn (HsInt16Prim a x) = HsInt16Prim a x
-convertLitPsRn (HsInt32Prim a x) = HsInt32Prim a x
-convertLitPsRn (HsInt64Prim a x) = HsInt64Prim a x
-convertLitPsRn (HsWord8Prim a x) = HsWord8Prim a x
-convertLitPsRn (HsWord16Prim a x) = HsWord16Prim a x
-convertLitPsRn (HsWord32Prim a x) = HsWord32Prim a x
-convertLitPsRn (HsWord64Prim a x) = HsWord64Prim a x
-convertLitPsRn (HsFloatPrim a x) = HsFloatPrim a x
-convertLitPsRn (HsDoublePrim a x) = HsDoublePrim a x
-
-convertLitPsTc :: HsLit GhcPs -> HsLit GhcTc
-convertLitPsTc (HsChar a x) = HsChar a x
-convertLitPsTc (HsCharPrim a x) = HsCharPrim a x
-convertLitPsTc (HsString a x) = HsString a x
-convertLitPsTc (HsMultilineString a x) = HsMultilineString a x
-convertLitPsTc (HsStringPrim a x) = HsStringPrim a x
-convertLitPsTc (HsInt a x) = HsInt a x
-convertLitPsTc (HsIntPrim a x) = HsIntPrim a x
-convertLitPsTc (HsWordPrim a x) = HsWordPrim a x
-convertLitPsTc (HsInt8Prim a x) = HsInt8Prim a x
-convertLitPsTc (HsInt16Prim a x) = HsInt16Prim a x
-convertLitPsTc (HsInt32Prim a x) = HsInt32Prim a x
-convertLitPsTc (HsInt64Prim a x) = HsInt64Prim a x
-convertLitPsTc (HsWord8Prim a x) = HsWord8Prim a x
-convertLitPsTc (HsWord16Prim a x) = HsWord16Prim a x
-convertLitPsTc (HsWord32Prim a x) = HsWord32Prim a x
-convertLitPsTc (HsWord64Prim a x) = HsWord64Prim a x
-convertLitPsTc (HsFloatPrim a x) = HsFloatPrim a x
-convertLitPsTc (HsDoublePrim a x) = HsDoublePrim a x
-
-convertLitRnTc :: HsLit GhcRn -> HsLit GhcTc
-convertLitRnTc (HsChar a x) = HsChar a x
-convertLitRnTc (HsCharPrim a x) = HsCharPrim a x
-convertLitRnTc (HsString a x) = HsString a x
-convertLitRnTc (HsMultilineString a x) = HsMultilineString a x
-convertLitRnTc (HsStringPrim a x) = HsStringPrim a x
-convertLitRnTc (HsInt a x) = HsInt a x
-convertLitRnTc (HsIntPrim a x) = HsIntPrim a x
-convertLitRnTc (HsWordPrim a x) = HsWordPrim a x
-convertLitRnTc (HsInt8Prim a x) = HsInt8Prim a x
-convertLitRnTc (HsInt16Prim a x) = HsInt16Prim a x
-convertLitRnTc (HsInt32Prim a x) = HsInt32Prim a x
-convertLitRnTc (HsInt64Prim a x) = HsInt64Prim a x
-convertLitRnTc (HsWord8Prim a x) = HsWord8Prim a x
-convertLitRnTc (HsWord16Prim a x) = HsWord16Prim a x
-convertLitRnTc (HsWord32Prim a x) = HsWord32Prim a x
-convertLitRnTc (HsWord64Prim a x) = HsWord64Prim a x
-convertLitRnTc (HsFloatPrim a x) = HsFloatPrim a x
-convertLitRnTc (HsDoublePrim a x) = HsDoublePrim a x
+convertLit :: XXLit (GhcPass p)~DataConCantHappen => HsLit (GhcPass p) -> HsLit (GhcPass p')
+convertLit (HsChar a x) = HsChar a x
+convertLit (HsCharPrim a x) = HsCharPrim a x
+convertLit (HsString a x) = HsString a x
+convertLit (HsMultilineString a x) = HsMultilineString a x
+convertLit (HsStringPrim a x) = HsStringPrim a x
+convertLit (HsInt a x) = HsInt a x
+convertLit (HsIntPrim a x) = HsIntPrim a x
+convertLit (HsWordPrim a x) = HsWordPrim a x
+convertLit (HsInt8Prim a x) = HsInt8Prim a x
+convertLit (HsInt16Prim a x) = HsInt16Prim a x
+convertLit (HsInt32Prim a x) = HsInt32Prim a x
+convertLit (HsInt64Prim a x) = HsInt64Prim a x
+convertLit (HsWord8Prim a x) = HsWord8Prim a x
+convertLit (HsWord16Prim a x) = HsWord16Prim a x
+convertLit (HsWord32Prim a x) = HsWord32Prim a x
+convertLit (HsWord64Prim a x) = HsWord64Prim a x
+convertLit (HsFloatPrim a x) = HsFloatPrim a x
+convertLit (HsDoublePrim a x) = HsDoublePrim a x
{-
Note [ol_rebindable]
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -3010,14 +3010,14 @@ repLiteral (HsStringPrim _ bs)
rep2_nw stringPrimLName [mkListExpr word8_ty w8s_expr]
repLiteral lit
= do lit' <- case lit of
- HsIntPrim _ i -> dsLit <$> mk_integer i
- HsWordPrim _ w -> dsLit <$> mk_integer w
- HsInt _ i -> dsLit <$> mk_integer (il_value i)
- HsFloatPrim _ r -> dsLit <$> mk_rational r
- HsDoublePrim _ r -> dsLit <$> mk_rational r
- HsCharPrim _ c -> dsLit <$> mk_char c
- _ -> return $ dsLit lit
- lit_expr <- lift lit'
+ HsIntPrim _ i -> lift . dsLit <$> mk_integer i
+ HsWordPrim _ w -> lift . dsLit <$> mk_integer w
+ HsInt _ i -> lift . dsLit <$> mk_integer (il_value i)
+ HsFloatPrim _ r -> lift . dsLit <$> mk_rational r
+ HsDoublePrim _ r -> lift . dsLit <$> mk_rational r
+ HsCharPrim _ c -> lift . dsLit <$> mk_char c
+ _ -> return . lift . dsLit $ lit
+ lit_expr <- lit'
case mb_lit_name of
Just lit_name -> rep2_nw lit_name [lit_expr]
Nothing -> notHandled (ThExoticLiteral lit)
@@ -3040,10 +3040,11 @@ mk_integer i = return $ XLit $ HsInteger NoSourceText i integerTy
mk_rational :: FractionalLit -> MetaM (HsLit GhcTc)
mk_rational r = do rat_ty <- lookupType rationalTyConName
return $ XLit $ HsRat r rat_ty
-mk_string :: FastString -> MetaM (HsLit GhcTc)
+
+mk_string :: FastString -> MetaM (HsLit GhcRn)
mk_string s = return $ HsString NoSourceText s
-mk_char :: Char -> MetaM (HsLit GhcTc)
+mk_char :: Char -> MetaM (HsLit GhcRn)
mk_char c = return $ HsChar NoSourceText c
repOverloadedLiteral :: HsOverLit GhcRn -> MetaM (Core TH.Lit)
@@ -3056,10 +3057,10 @@ repOverloadedLiteral (OverLit { ol_val = val})
repOverLiteralVal :: OverLitVal -> MetaM (Core TH.Lit)
repOverLiteralVal lit = do
lit' <- case lit of
- (HsIntegral i) -> mk_integer (il_value i)
- (HsFractional f) -> mk_rational f
- (HsIsString _ s) -> mk_string s
- lit_expr <- lift $ dsLit lit'
+ (HsIntegral i) -> lift . dsLit <$> mk_integer (il_value i)
+ (HsFractional f) -> lift . dsLit <$> mk_rational f
+ (HsIsString _ s) -> lift . dsLit <$> mk_string s
+ lit_expr <- lit'
let lit_name = case lit of
(HsIntegral _ ) -> integerLName
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -374,7 +374,7 @@ rnExpr (HsLit x lit) | Just (src, s) <- stringLike lit
rnExpr (HsOverLit x (mkHsIsString src s))
else do {
; rnLit lit
- ; return (HsLit x (convertLitPsRn lit), emptyFVs) } }
+ ; return (HsLit x (convertLit lit), emptyFVs) } }
where
stringLike = \case
HsString src s -> Just (src, s)
@@ -383,7 +383,7 @@ rnExpr (HsLit x lit) | Just (src, s) <- stringLike lit
rnExpr (HsLit x lit)
= do { rnLit lit
- ; return (HsLit x(convertLitPsRn lit), emptyFVs) }
+ ; return (HsLit x (convertLit lit), emptyFVs) }
rnExpr (HsOverLit x lit)
= do { ((lit', mb_neg), fvs) <- rnOverLit lit -- See Note [Negative zero]
=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -572,7 +572,7 @@ rnPatAndThen mk (LitPat x lit)
else normal_lit }
| otherwise = normal_lit
where
- normal_lit = do { liftCps (rnLit lit); return (LitPat x (convertLitPsRn lit)) }
+ normal_lit = do { liftCps (rnLit lit); return (LitPat x (convertLit lit)) }
rnPatAndThen _ (NPat x (L l lit) mb_neg _eq)
= do { (lit', mb_neg') <- liftCpsFV $ rnOverLit lit
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -317,7 +317,7 @@ tcExpr (HsUnboundVar _ occ) res_ty
tcExpr e@(HsLit x lit) res_ty
= do { let lit_ty = hsLitType lit
- ; tcWrapResult e (HsLit x (convertLitRnTc lit)) lit_ty res_ty }
+ ; tcWrapResult e (HsLit x (convertLit lit)) lit_ty res_ty }
tcExpr (HsPar x expr) res_ty
= do { expr' <- tcMonoExprNC expr res_ty
=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -829,7 +829,7 @@ Fortunately that's what matchActualFunTy returns anyway.
; wrap <- tc_sub_type penv (scaledThing pat_ty) lit_ty
; res <- thing_inside
; pat_ty <- readExpType (scaledThing pat_ty)
- ; return ( mkHsWrapPat wrap (LitPat x (convertLitRnTc simple_lit)) pat_ty
+ ; return ( mkHsWrapPat wrap (LitPat x (convertLit simple_lit)) pat_ty
, res) }
------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/460d9a83cdb06ac3cbc06ea171b024e3c87d9a28
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/460d9a83cdb06ac3cbc06ea171b024e3c87d9a28
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241009/a635a960/attachment-0001.html>
More information about the ghc-commits
mailing list