[Git][ghc/ghc][wip/21619] Fix nested type splices in hie files
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Oct 12 14:52:59 UTC 2022
Matthew Pickering pushed to branch wip/21619 at Glasgow Haskell Compiler / GHC
Commits:
c6d11bf5 by Matthew Pickering at 2022-10-12T15:52:49+01:00
Fix nested type splices in hie files
The issue is that when we compile a typed bracket we replace the splice
with HsSpliced (unTypeCode ...).
Then when computing types for
> [|| T $$(...) ||]
GHC is asked to compute the type of `T $$(..)`, which panics because
of the bogus type of T applied to `HsSpliced`, which is not type
correct.
The fix is to not attempt to compute the type for `HsSpliceE`
constructors if we come across them as they should have either been
already evaluated or lifted into a splice environment.
As part of the patch I made hie files traverse into the splice
environments so now we also get type information for things used inside
nested splices.
Fixes #21619
- - - - -
8 changed files:
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Iface/Ext/Ast.hs
- testsuite/tests/hiefile/should_compile/all.T
- + testsuite/tests/hiefile/should_compile/hie011.hs
- + testsuite/tests/hiefile/should_compile/hie011.stderr
- + testsuite/tests/hiefile/should_run/SpliceTypes.hs
- + testsuite/tests/hiefile/should_run/SpliceTypes.stdout
- testsuite/tests/hiefile/should_run/all.T
Changes:
=====================================
compiler/GHC/Hs/Syn/Type.hs
=====================================
@@ -133,9 +133,9 @@ hsExprType (HsTypedBracket (HsBracketTc _ ty _wrap _pending) _) = ty
hsExprType (HsUntypedBracket (HsBracketTc _ ty _wrap _pending) _) = ty
hsExprType e@(HsSpliceE{}) = pprPanic "hsExprType: Unexpected HsSpliceE"
(ppr e)
- -- Typed splices should have been eliminated during zonking, but we
- -- can't use `dataConCantHappen` since they are still present before
- -- than in the typechecked AST.
+ -- Typed splices should have been eliminated during zonking, but we
+ -- can't use `dataConCantHappen` since they are still present before
+ -- than in the typechecked AST
hsExprType (HsProc _ _ lcmd_top) = lhsCmdTopType lcmd_top
hsExprType (HsStatic (_, ty) _s) = ty
hsExprType (HsPragE _ _ e) = lhsExprType e
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -744,6 +744,9 @@ instance HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where
RecordCon con_expr _ _ -> computeType con_expr
ExprWithTySig _ e _ -> computeLType e
HsPragE _ _ e -> computeLType e
+ -- By this point all splices are lifted into splice environments so
+ -- the remaining HsSpliceE in the syntax tree contain bogus information.
+ HsSpliceE {} -> Nothing
XExpr (ExpansionExpr (HsExpanded (HsGetField _ _ _) e)) -> Just (hsExprType e) -- for record-dot-syntax
XExpr (ExpansionExpr (HsExpanded _ e)) -> computeType e
XExpr (HsTick _ e) -> computeLType e
@@ -1873,10 +1876,10 @@ instance ToHie (HsQuote a) where
toHie _ = pure []
instance ToHie PendingRnSplice where
- toHie _ = pure []
+ toHie (PendingRnSplice _ _ e) = toHie e
instance ToHie PendingTcSplice where
- toHie _ = pure []
+ toHie (PendingTcSplice _ e) = toHie e
instance ToHie (LBooleanFormula (LocatedN Name)) where
toHie (L span form) = concatM $ makeNode form (locA span) : case form of
=====================================
testsuite/tests/hiefile/should_compile/all.T
=====================================
@@ -16,6 +16,7 @@ test('hie007', normal, compile, ['-fno-code -fwrite-ide-
test('hie008', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
test('hie009', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
test('hie010', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
+test('hie011', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
test('CPP', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
test('Constructors', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
test('Scopes', normal, compile, ['-fno-code -fwrite-ide-info -fvalidate-ide-info'])
=====================================
testsuite/tests/hiefile/should_compile/hie011.hs
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fwrite-ide-info #-}
+module M where
+
+import Language.Haskell.TH.Syntax
+
+newtype T = T { getT :: Int }
+
+instance Lift T where
+ lift = undefined
+ liftTyped v = [||T $$(liftTyped (getT v))||]
+
+
+top_level :: ()
+top_level = $$([|| () ||])
=====================================
testsuite/tests/hiefile/should_compile/hie011.stderr
=====================================
@@ -0,0 +1,2 @@
+Got valid scopes
+Got no roundtrip errors
=====================================
testsuite/tests/hiefile/should_run/SpliceTypes.hs
=====================================
@@ -0,0 +1,47 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main where
+
+import TestUtils
+import qualified Data.Map as M
+import Data.Foldable
+import Language.Haskell.TH.Syntax
+
+
+newtype T = T { getT :: Int }
+
+instance Lift T where
+ liftTyped v = [||T $$(liftTyped (getT v))||]
+-- ^ ^ ^ ^ ^
+-- 1 2 3 4 5
+--
+
+top_level :: ()
+top_level = $$([|| () ||])
+-- ^ ^
+-- 1 2
+
+p1,p2, p3, p4:: (Int,Int)
+p1 = (14,18)
+p2 = (14,21)
+p3 = (14,24)
+p4 = (14,29)
+p5 = (14,41)
+
+q1 = (20, 19)
+q2 = (20, 21)
+
+selectPoint' :: HieFile -> (Int,Int) -> HieAST Int
+selectPoint' hf loc =
+ maybe (error "point not found") id $ selectPoint hf loc
+
+main = do
+ (df, hf) <- readTestHie "SpliceTypes.hie"
+ forM_ [p1,p2,p3, p4, p5, q1, q2] $ \point -> do
+ let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point
+ case types of
+ [] -> putStrLn $ "No types at " ++ show point
+ _ -> do
+ putStr $ "At " ++ show point ++ ", got type: "
+ forM_ types $ \typ -> do
+ putStrLn (renderHieType df $ recoverFullType typ (hie_types hf))
=====================================
testsuite/tests/hiefile/should_run/SpliceTypes.stdout
=====================================
@@ -0,0 +1,9 @@
+No types at (14,18)
+At (14,21), got type: Int -> T
+No types at (14,24)
+At (14,29), got type: Int -> Code m Int
+forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
+forall (m :: * -> *). Quote m => Int -> Code m Int
+At (14,41), got type: T
+No types at (20,19)
+No types at (20,21)
=====================================
testsuite/tests/hiefile/should_run/all.T
=====================================
@@ -2,3 +2,4 @@ test('PatTypes', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, [
test('HieQueries', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('T20341', [extra_run_opts('"' + config.libdir + '"')], compile_and_run, ['-package ghc -fwrite-ide-info'])
test('RecordDotTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
+test('SpliceTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6d11bf560c5b7c55f87de310561b60f728739a1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6d11bf560c5b7c55f87de310561b60f728739a1
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/20221012/6899eb5d/attachment-0001.html>
More information about the ghc-commits
mailing list