[commit: ghc] master: ghci: fixity declarations for infix data constructors (#10018) (e809ef5)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e809ef57d841695f76ab9b2758f7aeb774d6b223/ghc

>---------------------------------------------------------------

commit e809ef57d841695f76ab9b2758f7aeb774d6b223
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Tue Jul 21 22:01:49 2015 +0200

    ghci: fixity declarations for infix data constructors (#10018)
    
    Declaring a custom fixity for an infix data constructor should work:
    
        Prelude> data Infix a b = a :@: b; infixl 4 :@:
    
    This is a followup to #2947, which handled fixity declarations in ghci
    statements (e.g. let add = (+); infixl 6 `add`).
    
    Support for declarations (data, type, newtype, class, instance,
    deriving, and foreign) was added to GHCi in #4929.
    
    Reviewers: simonpj, austin, thomie
    
    Subscribers: thomie, bgamari
    
    Differential Revision: https://phabricator.haskell.org/D1028
    
    GHC Trac Issues: #10018


>---------------------------------------------------------------

e809ef57d841695f76ab9b2758f7aeb774d6b223
 compiler/main/HscMain.hs                   | 4 +++-
 compiler/main/HscTypes.hs                  | 7 +++++--
 testsuite/tests/ghci/scripts/T10018.script | 3 +++
 testsuite/tests/ghci/scripts/T10018.stdout | 2 ++
 testsuite/tests/ghci/scripts/all.T         | 1 +
 5 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 13717b6..3c4b92b 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1467,6 +1467,7 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
     -- been done. See the notes at the definition of InteractiveContext
     -- (ic_instances) for more details.
     let defaults = tcg_default tc_gblenv
+    let fix_env  = tcg_fix_env tc_gblenv
 
     {- Desugar it -}
     -- We use a basically null location for iNTERACTIVE
@@ -1520,7 +1521,8 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
 
         new_tythings = map AnId ext_ids ++ map ATyCon tcs ++ map (AConLike . PatSynCon) patsyns
         ictxt        = hsc_IC hsc_env
-        new_ictxt    = extendInteractiveContext ictxt new_tythings cls_insts fam_insts defaults
+        new_ictxt    = extendInteractiveContext ictxt new_tythings cls_insts
+                                                fam_insts defaults fix_env
     return (new_tythings, new_ictxt)
 
 hscImport :: HscEnv -> String -> IO (ImportDecl RdrName)
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 9be5175..f05dbdd 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1425,8 +1425,9 @@ extendInteractiveContext :: InteractiveContext
                          -> [TyThing]
                          -> [ClsInst] -> [FamInst]
                          -> Maybe [Type]
+                         -> FixityEnv
                          -> InteractiveContext
-extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults
+extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults fix_env
   = ictxt { ic_mod_index  = ic_mod_index ictxt + 1
                             -- Always bump this; even instances should create
                             -- a new mod_index (Trac #9426)
@@ -1434,7 +1435,9 @@ extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults
           , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings
           , ic_instances  = ( new_cls_insts ++ old_cls_insts
                             , new_fam_insts ++ old_fam_insts )
-          , ic_default    = defaults }
+          , ic_default    = defaults
+          , ic_fix_env    = fix_env  -- # 10018
+          }
   where
     new_ids = [id | AnId id <- new_tythings]
     old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
diff --git a/testsuite/tests/ghci/scripts/T10018.script b/testsuite/tests/ghci/scripts/T10018.script
new file mode 100644
index 0000000..f346899
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T10018.script
@@ -0,0 +1,3 @@
+-- Declaring a custom fixity for an infix data constructor should work.
+data Infix a b = a :@: b; infixl 4 :@:
+:i (:@:)
diff --git a/testsuite/tests/ghci/scripts/T10018.stdout b/testsuite/tests/ghci/scripts/T10018.stdout
new file mode 100644
index 0000000..bff8336
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T10018.stdout
@@ -0,0 +1,2 @@
+data Infix a b = a :@: b 	-- Defined at <interactive>:3:18
+infixl 4 :@:
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 1efa009..bbd69ee 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -209,6 +209,7 @@ test('T9878b',
       extra_run_opts('-fobject-code'),
       extra_clean(['T9878b.hi','T9878b.o'])],
     ghci_script, ['T9878b.script'])
+test('T10018', normal, ghci_script, ['T10018.script'])
 test('T10122', normal, ghci_script, ['T10122.script'])
 
 test('T10321', normal, ghci_script, ['T10321.script'])