[project @ 1999-11-05 10:09:36 by simonmar]

Allow this syntax on the lhs:

	(e1 `op` e2) e3 = ...

(bug reported by Ralf Hinze).

Add a test for it.

diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs
index 5f63937..8f5fc39 100644 (file)
--- a/ghc/compiler/parser/ParseUtil.lhs
+++ b/ghc/compiler/parser/ParseUtil.lhs
@@ -335,8 +335,8 @@ checkValDef lhs opt_sig grhss loc
 
 -- A variable binding is parsed as an RdrNamePatBind.
 
-isFunLhs (OpApp l (HsVar op) fix r) []  | not (isRdrDataCon op)
-                               = Just (op, True, [l,r])
+isFunLhs (OpApp l (HsVar op) fix r) es  | not (isRdrDataCon op)
+                               = Just (op, True, (l:r:es))
 isFunLhs (HsVar f) es@(_:_)  | not (isRdrDataCon f)
                                = Just (f,False,es)
 isFunLhs (HsApp f e) es        = isFunLhs f (e:es)

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index 63a9a43..e7d98b9 100644 (file)
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -684,7 +684,8 @@ checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnMS ()
 checkPrecMatch False fn match
   = returnRn ()
 
-checkPrecMatch True op (Match _ [p1,p2] _ _)
+checkPrecMatch True op (Match _ (p1:p2:_) _ _)
+       -- True indicates an infix lhs
   = getModeRn          `thenRn` \ mode ->
        -- See comments with rnExpr (OpApp ...)
     case mode of

diff --git a/ghc/tests/reader/should_compile/read026.hs b/ghc/tests/reader/should_compile/read026.hs
new file mode 100644 (file)
index 0000000..0ea695d
--- /dev/null
+++ b/ghc/tests/reader/should_compile/read026.hs
@@ -0,0 +1,6 @@
+module ShouldCompile where
+
+(<>)          :: (a -> Maybe b) -> (b -> Maybe c) -> (a -> Maybe c)
+(m1 <> m2) a1  =  case m1 a1 of
+                      Nothing -> Nothing
+                      Just a2 -> m2 a2