ghci: fixity declarations for infix data constructors (#10018)
authorThomas Miedema <thomasmiedema@gmail.com>
Tue, 21 Jul 2015 20:01:49 +0000 (22:01 +0200)
committerBen Gamari <ben@smart-cactus.org>
Thu, 23 Jul 2015 14:04:19 +0000 (16:04 +0200)
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

compiler/main/HscMain.hs
compiler/main/HscTypes.hs
testsuite/tests/ghci/scripts/T10018.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T10018.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T

index 13717b6..3c4b92b 100644 (file)
@@ -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)
index 9be5175..f05dbdd 100644 (file)
@@ -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 (file)
index 0000000..f346899
--- /dev/null
@@ -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 (file)
index 0000000..bff8336
--- /dev/null
@@ -0,0 +1,2 @@
+data Infix a b = a :@: b       -- Defined at <interactive>:3:18
+infixl 4 :@:
index 1efa009..bbd69ee 100755 (executable)
@@ -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'])