[project @ 1996-05-01 18:36:59 by partain]

[ghc-hetmet.git] / ghc / compiler / rename / RnBinds.lhs

diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index d934449..3c27d75 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -20,14 +20,14 @@ module RnBinds (
    ) where
 
 import Ubiq
-import RnLoop          -- break the RnPass4/RnExpr4/RnBinds4 loops
+import RnLoop          -- break the RnPass/RnExpr/RnBinds loops
 
 import HsSyn
 import HsPragmas       ( isNoGenPragmas, noGenPragmas )
 import RdrHsSyn
 import RnHsSyn
 import RnMonad
-import RnExpr          ( rnMatch, rnGRHSsAndBinds, rnPat )
+import RnExpr          ( rnMatch, rnGRHSsAndBinds, rnPat, checkPrecMatch )
 
 import CmdLineOpts     ( opt_SigsRequired )
 import Digraph         ( stronglyConnComp )
@@ -169,13 +169,14 @@ rnMethodBinds class_name EmptyMonoBinds = returnRn EmptyMonoBinds
 
 rnMethodBinds class_name (AndMonoBinds mb1 mb2)
   = andRn AndMonoBinds (rnMethodBinds class_name mb1)
-                       (rnMethodBinds class_name mb2)
+                      (rnMethodBinds class_name mb2)
 
-rnMethodBinds class_name (FunMonoBind occname matches locn)
-  = pushSrcLocRn locn                  $
-    lookupClassOp class_name occname   `thenRn` \ op_name ->
-    mapAndUnzipRn rnMatch matches      `thenRn` \ (new_matches, _) ->
-    returnRn (FunMonoBind op_name new_matches locn)
+rnMethodBinds class_name (FunMonoBind occname inf matches locn)
+  = pushSrcLocRn locn                             $
+    lookupClassOp class_name occname              `thenRn` \ op_name ->
+    mapAndUnzipRn rnMatch matches                 `thenRn` \ (new_matches, _) ->
+    mapRn (checkPrecMatch inf op_name) new_matches `thenRn_`
+    returnRn (FunMonoBind op_name inf new_matches locn)
 
 rnMethodBinds class_name (PatMonoBind (VarPatIn occname) grhss_and_binds locn)
   = pushSrcLocRn locn                  $
@@ -346,10 +347,11 @@ flattenMonoBinds uniq sigs (PatMonoBind pat grhss_and_binds locn)
         )]
     )
 
-flattenMonoBinds uniq sigs (FunMonoBind name matches locn)
-  = pushSrcLocRn locn                  $
-    lookupValue name                   `thenRn` \ name' ->
-    mapAndUnzipRn rnMatch matches      `thenRn` \ (new_matches, fv_lists) ->
+flattenMonoBinds uniq sigs (FunMonoBind name inf matches locn)
+  = pushSrcLocRn locn                           $
+    lookupValue name                            `thenRn` \ name' ->
+    mapAndUnzipRn rnMatch matches               `thenRn` \ (new_matches, fv_lists) ->
+    mapRn (checkPrecMatch inf name') new_matches `thenRn_`
     let
        fvs = unionManyUniqSets fv_lists
 
@@ -362,7 +364,7 @@ flattenMonoBinds uniq sigs (FunMonoBind name matches locn)
       [(uniq,
        unitUniqSet name',
        fvs `unionUniqSets` sigs_fvs,
-       FunMonoBind name' new_matches locn,
+       FunMonoBind name' inf new_matches locn,
        sigs_for_me
        )]
     )
@@ -408,12 +410,12 @@ reconstructRec cycles edges mbi
     reconstructCycle :: FlatMonoBindsInfo -> Cycle -> RenamedHsBinds
 
     reconstructCycle mbi2 cycle
-      = BIND [(binds,sigs) | (vertex, _, _, binds, sigs) <- mbi2, vertex `is_elem` cycle]
-                 _TO_ relevant_binds_and_sigs ->
+      = case [(binds,sigs) | (vertex, _, _, binds, sigs) <- mbi2, vertex `is_elem` cycle]
+                 of { relevant_binds_and_sigs ->
 
-       BIND (unzip relevant_binds_and_sigs) _TO_ (binds, sig_lists) ->
+       case (unzip relevant_binds_and_sigs) of { (binds, sig_lists) ->
 
-       BIND (foldr AndMonoBinds EmptyMonoBinds binds) _TO_ this_gp_binds ->
+       case (foldr AndMonoBinds EmptyMonoBinds binds) of { this_gp_binds ->
        let
            this_gp_sigs        = foldr1 (++) sig_lists
            have_sigs           = not (null sig_lists)
@@ -422,7 +424,7 @@ reconstructRec cycles edges mbi
                -- e.g. "have_sigs [[], [], []]" ???????????
        in
        mk_binds this_gp_binds this_gp_sigs (isCyclic edges cycle) have_sigs
-       BEND BEND BEND
+       }}}
       where
        is_elem = isIn "reconstructRec"