[project @ 2004-09-07 12:30:27 by simonmar]

[ghc-hetmet.git] / ghc / compiler / parser / RdrHsSyn.lhs

diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index b011c39..6fb6e86 100644 (file)
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -61,13 +61,12 @@ import Kind         ( liftedTypeKind )
 import HscTypes                ( GenAvailInfo(..) )
 import TysWiredIn      ( unitTyCon ) 
 import ForeignCall     ( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
-                         DNCallSpec(..), DNKind(..))
+                         DNCallSpec(..), DNKind(..), CLabelString )
 import OccName         ( OccName, srcDataName, varName, isDataOcc, isTcOcc, 
                          occNameUserString, isValOcc )
 import BasicTypes      ( initialVersion, StrictnessMark(..) )
 import Module          ( ModuleName )
 import SrcLoc
-import CStrings                ( CLabelString )
 import CmdLineOpts     ( opt_InPackage )
 import OrdList         ( OrdList, fromOL )
 import Bag             ( Bag, emptyBag, snocBag, consBag, foldrBag )
@@ -273,17 +272,17 @@ hsIfaceCons NewType [con] -- newtype
 
 hsIfaceCon :: ConDecl RdrName -> IfaceConDecl
 hsIfaceCon (ConDecl lname ex_tvs ex_ctxt details)
-  = IfaceConDecl (get_occ lname)
+  = IfaceConDecl (get_occ lname) is_infix
                 (hsIfaceTvs ex_tvs)
                 (hsIfaceCtxt (unLoc ex_ctxt))
                 (map (hsIfaceLType . getBangType       . unLoc) args)
                 (map (hsStrictMark . getBangStrictness . unLoc) args)
                 flds
   where
-    (args, flds) = case details of
-                       PrefixCon args -> (args, [])
-                       InfixCon a1 a2 -> ([a1,a2], [])
-                       RecCon fs      -> (map snd fs, map (get_occ . fst) fs)
+    (is_infix, args, flds) = case details of
+                               PrefixCon args -> (False, args, [])
+                               InfixCon a1 a2 -> (True, [a1,a2], [])
+                               RecCon fs      -> (False, map snd fs, map (get_occ . fst) fs)
     get_occ lname = rdrNameOcc (unLoc lname)
 
 hsStrictMark :: HsBang -> StrictnessMark
@@ -763,17 +762,16 @@ patFail loc = parseError loc "Parse error in pattern"
 checkValDef 
        :: LHsExpr RdrName
        -> Maybe (LHsType RdrName)
-       -> GRHSs RdrName
+       -> Located (GRHSs RdrName)
        -> P (HsBind RdrName)
 
-checkValDef lhs opt_sig grhss
+checkValDef lhs opt_sig (L rhs_span grhss)
   | Just (f,inf,es)  <- isFunLhs lhs []
   = if isQual (unLoc f)
        then parseError (getLoc f) ("Qualified name in function definition: "  ++ 
                                        showRdrName (unLoc f))
        else do ps <- checkPatterns es
-               return (FunBind f inf [L (getLoc f) (Match ps opt_sig grhss)])
-                       -- TODO: span is wrong
+               return (FunBind f inf [L rhs_span (Match ps opt_sig grhss)])
   | otherwise = do
        lhs <- checkPattern lhs
        return (PatBind lhs grhss)