[Git][ghc/ghc][wip/T18103] Define a Quote IO instance

[Ryan Scott]

Ryan Scott pushed to branch wip/T18103 at Glasgow Haskell Compiler / GHC


Commits:
b3caaa6b by Ryan Scott at 2020-04-26T18:11:43-04:00
Define a Quote IO instance

Fixes #18103.

- - - - -


3 changed files:

- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- + testsuite/tests/quotes/T18103.hs
- testsuite/tests/quotes/all.T


Changes:

=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -122,8 +122,7 @@ class (MonadIO m, MonadFail m) => Quasi m where
 -----------------------------------------------------
 
 instance Quasi IO where
-  qNewName s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
-                  ; pure (mkNameU s n) }
+  qNewName = newNameIO
 
   qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
   qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
@@ -150,6 +149,13 @@ instance Quasi IO where
   qIsExtEnabled _       = badIO "isExtEnabled"
   qExtsEnabled          = badIO "extsEnabled"
 
+instance Quote IO where
+  newName = newNameIO
+
+newNameIO :: String -> IO Name
+newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
+                 ; pure (mkNameU s n) }
+
 badIO :: String -> IO a
 badIO op = do   { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
                 ; fail "Template Haskell failure" }


=====================================
testsuite/tests/quotes/T18103.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+module T18103 where
+
+import Language.Haskell.TH
+
+ex :: IO [Dec]
+ex = [d| foo x = x |]


=====================================
testsuite/tests/quotes/all.T
=====================================
@@ -17,6 +17,7 @@ test('T9824', normal, compile, ['-v0'])
 test('T10384', normal, compile_fail, [''])
 test('T16384', req_th, compile, [''])
 test('T17857', normal, compile, [''])
+test('T18103', normal, compile, [''])
 
 test('TH_tf2', normal, compile, ['-v0'])
 test('TH_ppr1', normal, compile_and_run, [''])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3caaa6b72012f2e001754635b5ac9e4833f6163
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/20200426/2dc4ff2c/attachment-0001.html>