[project @ 2001-05-04 14:40:42 by simonpj]

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

diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs
index d0d3419..c4fa82a 100644 (file)
--- a/ghc/compiler/parser/ParseUtil.lhs
+++ b/ghc/compiler/parser/ParseUtil.lhs
@@ -130,9 +130,9 @@ checkContext t
 checkPred :: RdrNameHsType -> [RdrNameHsType] 
        -> P (HsPred RdrName)
 checkPred (HsTyVar t) args@(_:_) | not (isRdrTyVar t) 
-       = returnP (HsPClass t args)
+       = returnP (HsClassP t args)
 checkPred (HsAppTy l r) args = checkPred l (r:args)
-checkPred (HsPredTy (HsPIParam n ty)) [] = returnP (HsPIParam n ty)
+checkPred (HsPredTy (HsIParam n ty)) [] = returnP (HsIParam n ty)
 checkPred _ _ = parseError "Illegal class assertion"
 
 checkDictTy :: RdrNameHsType -> [RdrNameHsType] -> P RdrNameHsType
@@ -271,6 +271,11 @@ checkValSig other     ty loc = parseError "Type signature given for an expressio
 isFunLhs :: RdrNameHsExpr -> [RdrNameHsExpr] -> Maybe (RdrName, Bool, [RdrNameHsExpr])
 isFunLhs (OpApp l (HsVar op) fix r) es  | not (isRdrDataCon op)
                                = Just (op, True, (l:r:es))
+                                       | otherwise
+                               = case isFunLhs l es of
+                                   Just (op', True, j : k : es') ->
+                                     Just (op', True, j : OpApp k (HsVar op) fix r : es')
+                                   _ -> Nothing
 isFunLhs (HsVar f) es | not (isRdrDataCon f)
                                = Just (f,False,es)
 isFunLhs (HsApp f e) es        = isFunLhs f (e:es)