[Git][ghc/ghc][wip/ghc-18740-lookup-update] Undo the workaround in 'cvt', fix 'repVarOrCon'

Vladislav Zavialov gitlab at gitlab.haskell.org
Fri Oct 9 15:45:05 UTC 2020



Vladislav Zavialov pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC


Commits:
0560fa91 by Vladislav Zavialov at 2020-10-09T18:43:34+03:00
Undo the workaround in 'cvt', fix 'repVarOrCon'

- - - - -


5 changed files:

- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/ThToHs.hs
- + testsuite/tests/th/T18740d.hs
- + testsuite/tests/th/T18740d.stderr
- testsuite/tests/th/all.T


Changes:

=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -2248,8 +2248,11 @@ repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
 
 --------------- Expressions -----------------
 repVarOrCon :: Name -> Core TH.Name -> MetaM (Core (M TH.Exp))
-repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
-                   | otherwise                  = repVar str
+repVarOrCon vc str
+    | isVarNameSpace ns = repVar str  -- Both type and term variables (#18740)
+    | otherwise         = repCon str
+  where
+    ns = nameNameSpace vc
 
 repVar :: Core TH.Name -> MetaM (Core (M TH.Exp))
 repVar (MkC s) = rep2 varEName [s]


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -889,19 +889,8 @@ cvtImplicitParamBind n e = do
 cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs)
 cvtl e = wrapL (cvt e)
   where
-    cvt (VarE s)
-      | isVarName s           = do { s' <- vName s; return $ HsVar noExtField (noLoc s') }
-      | isTyConName s         = cvt (ConE s)
-      -- If VarE contains a type constructor,
-      -- then we process this name as a data constructor
-      -- in order to cause an "Illegal term-level
-      -- use of a type constructor" error.
-      -- See Note [Promotion] in GHC.Rename.Env.
-      -- In particular, this clause (together with the next one)
-      -- improves the error messages in test cases like
-      -- T14627, T7667a, and T15270B.
-      | otherwise             = failWith (badOcc OccName.varName (nameBase s))
-    cvt (ConE s)              = do { s' <- cName s; return $ HsVar noExtField (noLoc s') }
+    cvt (VarE s)        = do { s' <- vName s; return $ HsVar noExtField (noLoc s') }
+    cvt (ConE s)        = do { s' <- cName s; return $ HsVar noExtField (noLoc s') }
     cvt (LitE l)
       | overloadedLit l = go cvtOverLit (HsOverLit noExtField)
                              (hsOverLitNeedsParens appPrec)
@@ -1926,12 +1915,6 @@ isVarName (TH.Name occ _)
       ""    -> False
       (c:_) -> startsVarId c || startsVarSym c
 
-isTyConName :: TH.Name -> Bool
-isTyConName name
-  = case nameSpace name of
-      Just TcClsName -> True
-      _              -> False
-
 badOcc :: OccName.NameSpace -> String -> SDoc
 badOcc ctxt_ns occ
   = text "Illegal" <+> pprNameSpace ctxt_ns


=====================================
testsuite/tests/th/T18740d.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T18740d where
+
+import Language.Haskell.TH
+
+-- If we used 'ConE' here, then we would expect this error message:
+--
+--   Illegal term-level use of the type constructor ‘Bool’
+--     imported from ‘Prelude’ at T18740d.hs:3:8-14
+--     (and originally defined in ‘GHC.Types’)
+--
+-- But we used 'VarE', so the error message should say:
+--
+--   Illegal variable name: ‘Bool’
+--
+e1 = $(return (VarE ''Bool))


=====================================
testsuite/tests/th/T18740d.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T18740d.hs:17:7: error:
+    • Illegal variable name: ‘Bool’
+      When splicing a TH expression: GHC.Types.Bool
+    • In the untyped splice: $(return (VarE ''Bool))


=====================================
testsuite/tests/th/all.T
=====================================
@@ -516,3 +516,4 @@ test('T18123', normal, compile, [''])
 test('T18388', normal, compile, [''])
 test('T18612', normal, compile, [''])
 test('T18740c', normal, compile_fail, [''])
+test('T18740d', normal, compile_fail, [''])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0560fa91ba213800c1722ee6defc70d9efab58b7
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/20201009/3eb482c4/attachment-0001.html>


More information about the ghc-commits mailing list