[Git][ghc/ghc][wip/T18599] Have the parser construct GetField syntax

[Shayne Fletcher]

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


Commits:
b3ec6df1 by Shayne Fletcher at 2020-10-10T17:51:08-04:00
Have the parser construct GetField syntax

rnExpr (GetField {...}) calculates a GetField, tcExpr returns the
enclosed typed getField function.

- - - - -


6 changed files:

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


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -668,7 +668,7 @@ type instance XRecordUpd     GhcTc = RecordUpdTc
 
 type instance XGetField     GhcPs = NoExtField
 type instance XGetField     GhcRn = NoExtField
-type instance XGetField     GhcTc = GetFieldTc
+type instance XGetField     GhcTc = NoExtField
 
 type instance XExprWithTySig (GhcPass _) = NoExtField
 


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


=====================================
compiler/GHC/Parser.y
=====================================
@@ -2625,8 +2625,8 @@ fexp    :: { ECP }
                   -- a projection 'r.a' (say) then we want the parse
                   -- '(r.a).b'.
                   ; return . ecpFromExp $ case $1 of
-                      L _ (HsApp _ f arg) | not $ isGet f -> f `mkApp` mkGet arg $3
-                      _ -> mkGet $1 $3
+                      L _ (HsApp _ f arg) | not $ isGetField f -> f `mkApp` mkGetField (comb2 arg $3) arg $3
+                      _ -> mkGetField (comb2 $1 $>) $1 $3
             }}
 
         | aexp                       { $1 }


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -19,7 +19,7 @@
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
 module GHC.Parser.PostProcess (
-        mkApp, mkGet, mkVar, mkFieldUpdater, mkProj, isGet, applyFieldUpdates, Fbind(..), -- RecordDot
+        mkApp, mkGetField, mkVar, mkFieldUpdater, mkProj, isGetField, applyFieldUpdates, Fbind(..), -- RecordDot
         mkHsOpApp,
         mkHsIntegral, mkHsFractional, mkHsIsString,
         mkHsDo, mkSpliceDecl,
@@ -2967,9 +2967,9 @@ get_field = mkVar "getField"
 set_field = mkVar "setField"
 
 -- Test if the expression is a 'getField @"..."' expression.
-isGet :: LHsExpr GhcPs -> Bool
-isGet (L _ (HsAppType _ (L _ (HsVar _ (L _ name))) _)) = occNameString (rdrNameOcc name) == "getField"
-isGet _ = False
+isGetField :: LHsExpr GhcPs -> Bool
+isGetField (L _ GetField{}) = True
+isGetField _ = False
 
 zPat :: LPat GhcPs
 zVar, circ :: LHsExpr GhcPs
@@ -2997,6 +2997,15 @@ mkGet' :: [LHsExpr GhcPs] -> Located FastString -> [LHsExpr GhcPs]
 mkGet' l@(r : _) (L _ fIELD) = get_field `mkAppType` mkSelector fIELD `mkApp` mkParen r : l
 mkGet' [] _ = panic "mkGet' : The impossible has happened!"
 
+mkGetField :: SrcSpan -> LHsExpr GhcPs -> Located FastString -> LHsExpr GhcPs
+mkGetField loc arg fIELD =
+  L loc GetField {
+      gf_ext = noExtField
+    , gf_expr = arg
+    , gf_fIELD = fIELD
+    , gf_getField = mkGet arg fIELD
+    }
+
 -- mkSet a fIELD b calculates a set_field @fIELD expression.
 -- e.g mkSet a fIELD b = set_field @"fIELD" a b (read as "set field 'fIELD' on a to b").
 mkSet :: LHsExpr GhcPs -> Located FastString -> LHsExpr GhcPs -> LHsExpr GhcPs


=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -210,6 +210,14 @@ rnExpr (NegApp _ e _)
        ; final_e            <- mkNegAppRn e' neg_name
        ; return (final_e, fv_e `plusFV` fv_neg) }
 
+------------------------------------------
+-- Record dot syntax
+rnExpr (GetField x e f g)
+  = do { (e', _) <- rnLExpr e
+       ; (g', fv) <- rnLExpr g
+       ; return (GetField x e' f g', fv)
+       }
+
 ------------------------------------------
 -- Template Haskell extensions
 rnExpr e@(HsBracket _ br_body) = rnBracket e br_body


=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -1029,6 +1029,15 @@ tcExpr e@(HsRecFld _ f) res_ty
 tcExpr (ArithSeq _ witness seq) res_ty
   = tcArithSeq witness seq res_ty
 
+{-
+************************************************************************
+*                                                                      *
+                Record dot syntax
+*                                                                      *
+************************************************************************
+-}
+tcExpr (GetField _ _ _ (L _ g)) res_ty = tcExpr g res_ty
+
 {-
 ************************************************************************
 *                                                                      *



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3ec6df1e9a337b413756e3485cd94c5af9bdfda
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/20201010/535fb8c0/attachment-0001.html>