Teo Camarasu pushed to branch wip/abstract-q at Glasgow Haskell Compiler / GHC
Commits:
-
d52a3009
by Teo Camarasu at 2026-03-17T20:38:56+00:00
3 changed files:
- compiler/GHC/Tc/Gen/Splice.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghci/GHCi/TH.hs
Changes:
| ... | ... | @@ -1559,9 +1559,10 @@ location = do { m <- getModule |
| 1559 | 1559 | |
| 1560 | 1560 | metaHandlersTcM :: TH.MetaHandlers TcM
|
| 1561 | 1561 | metaHandlersTcM = TH.MetaHandlers {
|
| 1562 | - mNewName = \s -> do { u <- newUnique
|
|
| 1563 | - ; let i = toInteger (getKey u)
|
|
| 1564 | - ; return (TH.mkNameU s i) }
|
|
| 1562 | + mFail = fail
|
|
| 1563 | + , mNewName = \s -> do { u <- newUnique
|
|
| 1564 | + ; let i = toInteger (getKey u)
|
|
| 1565 | + ; return (TH.mkNameU s i) }
|
|
| 1565 | 1566 | |
| 1566 | 1567 | -- 'msg' is forced to ensure exceptions don't escape,
|
| 1567 | 1568 | -- see Note [Exceptions in TH]
|
| ... | ... | @@ -184,7 +184,8 @@ instance Quasi IO where |
| 184 | 184 | |
| 185 | 185 | metaHandlersIO :: MetaHandlers IO
|
| 186 | 186 | metaHandlersIO = MetaHandlers {
|
| 187 | - mNewName = newNameIO
|
|
| 187 | + mFail = fail
|
|
| 188 | + , mNewName = newNameIO
|
|
| 188 | 189 | , mReport = \b msg ->
|
| 189 | 190 | if b then
|
| 190 | 191 | hPutStrLn stderr ("Template Haskell error: " ++ msg)
|
| ... | ... | @@ -221,8 +222,9 @@ instance Quote IO where |
| 221 | 222 | newName = newNameIO
|
| 222 | 223 | |
| 223 | 224 | data MetaHandlers m = MetaHandlers {
|
| 225 | + mFail :: String -> m a
|
|
| 224 | 226 | -- | Fresh names. See 'newName'.
|
| 225 | - mNewName :: String -> m Name
|
|
| 227 | + , mNewName :: String -> m Name
|
|
| 226 | 228 | |
| 227 | 229 | ------- Error reporting and recovery -------
|
| 228 | 230 | -- | Report an error (True) or warning (False)
|
| ... | ... | @@ -351,7 +353,7 @@ instance Monad Q where |
| 351 | 353 | (>>) = (*>)
|
| 352 | 354 | |
| 353 | 355 | instance MonadFail Q where
|
| 354 | - fail s = report True s >> Q (\_ _ -> fail "Q monad failure")
|
|
| 356 | + fail s = report True s >> Q (\r h -> r $ mFail m "Q monad failure")
|
|
| 355 | 357 | |
| 356 | 358 | instance Functor Q where
|
| 357 | 359 | fmap f (Q x) = Q $ \r h -> fmap f (x r h)
|
| ... | ... | @@ -180,7 +180,8 @@ runQinGHCiQ (TH.Q m) = GHCiQ $ \sRef -> m (runInIO sRef) metaHandlersGHCiQ |
| 180 | 180 | runInIO sRef (GHCiQ m) = m sRef
|
| 181 | 181 | |
| 182 | 182 | metaHandlersGHCiQ = TH.MetaHandlers {
|
| 183 | - mNewName = \str -> ghcCmd (NewName str)
|
|
| 183 | + mFail = fail
|
|
| 184 | + , mNewName = \str -> ghcCmd (NewName str)
|
|
| 184 | 185 | , mReport = \isError msg -> ghcCmd (Report isError msg)
|
| 185 | 186 | |
| 186 | 187 | -- See Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice
|