[Git][ghc/ghc][wip/T18599] Prepare for disambiguation on RebindableSyntax

Shayne Fletcher gitlab at gitlab.haskell.org
Sun Dec 13 02:15:56 UTC 2020



Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC


Commits:
f3c53246 by Shayne Fletcher at 2020-12-12T21:15:36-05:00
Prepare for disambiguation on RebindableSyntax

- - - - -


6 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Types/Origin.hs


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -494,8 +494,12 @@ data HsExpr p
         gf_ext :: XGetField p
       , gf_expr :: LHsExpr p
       , gf_field :: Located FastString
+      , gf_get_field :: Maybe (IdP p)
       , gf_getField :: LHsExpr p -- Desugared equivalent 'getField' term.
       }
+  -- ^ @Just id@ means @RebindableSyntax@ is in use and gives the id
+  --   of the in-scope 'getField'.
+  --   NB: Not in use after typechecking.
 
   -- Record dot update e.g. @a{foo.bar.baz=1, quux}@.
   --
@@ -510,8 +514,12 @@ data HsExpr p
         rdupd_ext :: XRecordDotUpd p
       , rdupd_expr :: LHsExpr p
       , rdupd_upds :: [LHsRecUpdProj p]
+      , rdupd_get_set_field :: Maybe (IdP p, IdP p)
       , rdupd_setField :: LHsExpr p -- Desugared equivalent 'setField' term.
       }
+  -- ^ @Just id@ means @RebindableSyntax@ is in use and gives the ids
+  --   of the in-scope 'getField' and 'setField'.
+  --   NB: Not in use after typechecking.
 
   -- | Record field selector. e.g. @(.x)@ or @(.x.y)@
   --
@@ -524,8 +532,12 @@ data HsExpr p
   | Projection {
         proj_ext :: XProjection p
       , proj_flds :: [Located FastString]
+      , proj_get_field :: Maybe (IdP p)
       , proj_proj :: LHsExpr p -- Desugared equivalent 'getField' term.
       }
+  -- ^ @Just id@ means @RebindableSyntax@ is in use and gives the id
+  --   of the in-scope 'getField'.
+  --   NB: Not in use after typechecking.
 
   -- | Expression with an explicit type signature. @e :: type@
   --


=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -1154,9 +1154,9 @@ instance HiePass p => ToHie (Located (HsExpr (GhcPass p))) where
       HsSpliceE _ x ->
         [ toHie $ L mspan x
         ]
-      GetField _ _ _ g -> [ toHie $ L mspan (unLoc g) ]
-      Projection _ _ p -> [ toHie $ L mspan (unLoc p) ]
-      RecordDotUpd _ _ _ u -> [ toHie $ L mspan (unLoc u) ]
+      GetField {} -> []
+      Projection {} -> []
+      RecordDotUpd {} -> []
       XExpr x
         | GhcTc <- ghcPass @p
         , WrapExpr (HsWrap w a) <- x


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -2198,7 +2198,9 @@ mkRdrRecordDotUpd dot exp@(L _ _) fbinds =
                   rdupd_ext = noExtField
                 , rdupd_expr = exp
                 , rdupd_upds = updates
-                , rdupd_setField = setField }
+                , rdupd_get_set_field = Nothing
+                , rdupd_setField = setField
+                }
   where
     toProjUpdates :: [Fbind (HsExpr GhcPs)] -> [LHsRecUpdProj GhcPs]
     toProjUpdates = map (\case { Pbind p -> p
@@ -2760,6 +2762,7 @@ mkGetField loc arg field =
       gf_ext = noExtField
     , gf_expr = arg
     , gf_field = field
+    , gf_get_field = Nothing
     , gf_getField = mkGet arg field
     }
 
@@ -2769,6 +2772,7 @@ mkProjection loc flds =
   L loc Projection {
       proj_ext = noExtField
     , proj_flds = flds
+    , proj_get_field = Nothing
     , proj_proj = mkProj flds
     }
 


=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -212,22 +212,22 @@ rnExpr (NegApp _ e _)
 
 ------------------------------------------
 -- Record dot syntax
-rnExpr (GetField x e f g)
+rnExpr (GetField x e f _ g)
   = do { (e', _) <- rnLExpr e
        ; (g', fv) <- rnLExpr g
-       ; return (GetField x e' f g', fv)
+       ; return (GetField x e' f Nothing g', fv)
        }
 
-rnExpr (Projection x fs p)
+rnExpr (Projection x fs _ p)
   = do { (p', fv) <- rnLExpr p
-       ; return (Projection x fs p', fv)
+       ; return (Projection x fs Nothing p', fv)
        }
 
-rnExpr (RecordDotUpd x e us f)
+rnExpr (RecordDotUpd x e us _ f)
   = do { (e', _) <- rnLExpr e
        ; us' <- map fst <$> mapM rnRecUpdProj us
        ; (f', fv) <- rnLExpr f
-       ; return (RecordDotUpd x e' us' f', fv)
+       ; return (RecordDotUpd x e' us' Nothing f', fv)
        }
   where
     rnRecUpdProj :: LHsRecUpdProj GhcPs -> RnM (LHsRecUpdProj GhcRn, FreeVars)


=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -934,9 +934,9 @@ tcExpr (ArithSeq _ witness seq) res_ty
 *                                                                      *
 ************************************************************************
 -}
-tcExpr (GetField _ _ _ (L _ g)) res_ty = tcExpr g res_ty
-tcExpr (Projection _ _ (L _ p)) res_ty = tcExpr p res_ty
-tcExpr (RecordDotUpd _ _ _ (L _ s)) res_ty = tcExpr s res_ty
+tcExpr (GetField _ _ _ _ (L _ g)) res_ty = tcExpr g res_ty
+tcExpr (Projection _ _ _ (L _ p)) res_ty = tcExpr p res_ty
+tcExpr (RecordDotUpd _ _ _ _ (L _ s)) res_ty = tcExpr s res_ty
 
 {-
 ************************************************************************


=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -493,8 +493,8 @@ exprCtOrigin (HsAppType _ e1 _)   = lexprCtOrigin e1
 exprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op
 exprCtOrigin (NegApp _ e _)       = lexprCtOrigin e
 exprCtOrigin (HsPar _ e)          = lexprCtOrigin e
-exprCtOrigin (GetField _ e _ _)   = lexprCtOrigin e
-exprCtOrigin (Projection _ _ _)   = SectionOrigin
+exprCtOrigin (GetField _ e _ _ _) = lexprCtOrigin e
+exprCtOrigin (Projection _ _ _ _) = SectionOrigin
 exprCtOrigin (SectionL _ _ _)     = SectionOrigin
 exprCtOrigin (SectionR _ _ _)     = SectionOrigin
 exprCtOrigin (ExplicitTuple {})   = Shouldn'tHappenOrigin "explicit tuple"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f3c53246107862507f0d6553d7bb126e16af5613

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f3c53246107862507f0d6553d7bb126e16af5613
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/20201212/8a2961d5/attachment-0001.html>


More information about the ghc-commits mailing list