[nhc-bugs] Bug in pattern matching with nkpat

[Malcolm Wallace]

> With the following code nhc98 prints 7, not 6 as I'd expect

Absolutely right, this is a bug.  The defining feature that triggers
the bug is that both equations for 'foo' use the same (n+k) pattern.

> module Main where
> 
> data Wibble = Foo | Bar
> 
> main :: IO()
> main = putStrLn $ show $ foo 1 Bar
> 
> foo :: Int -> Wibble -> Int
> foo (n+1) Foo = 5
> foo (n+1) Bar = 6
> foo _ _ = 7

A patch is attached which fixes the problem.  The patch is also
available via the nhc98 download page.

Regards,
    Malcolm


Index: src/compiler98/Case.hs
===================================================================
RCS file: /usr/src/master/nhc/src/compiler98/Case.hs,v
retrieving revision 1.16
diff -u -r1.16 Case.hs
--- src/compiler98/Case.hs	2001/05/03 17:17:03	1.16
+++ src/compiler98/Case.hs	2001/09/14 16:00:12
@@ -370,7 +370,8 @@
   caseTranslate v (concatMap (getTrans.fst) x) >=>
   mapS (matchNK v ces) x >>>= \ nks ->
   def >>>= \ e2 ->
-  optFatBar (f (foldr ($) PosExpFail nks)) e2
+--optFatBar (f (foldr ($) PosExpFail nks)) e2
+  optFatBar (f (foldr1 (PosExpFatBar True) nks)) e2
 
 matchOne (ce:ces) (PatternIf x) def =
   varExp ce >>>= \ (v,f,ce) ->
@@ -475,7 +476,8 @@
   match ces funs (unitS PosExpFail) >>>= \ exp ->
   unitS (PosAltInt noPos i  exp)
 
-matchNK :: Int -> [PosExp] -> (ExpI,Fun Int) -> CaseFun (PosExp->PosExp)
+--matchNK :: Int -> [PosExp] -> (ExpI,Fun Int) -> CaseFun (PosExp->PosExp)
+matchNK :: Int -> [PosExp] -> (ExpI,Fun Int) -> CaseFun PosExp
 matchNK v ces (PatNplusK pos n n' k kle ksub, fun) =
   match ces [fun] (unitS PosExpFail) >>>= \ exp ->
   caseDecl 
@@ -485,7 +487,8 @@
   caseDecl 
     (DeclFun pos n [Fun [] (Unguarded ksub) (DeclsScc [])]) >>>= \ binding ->
   unitS 
-    (\f-> PosExpLet pos local (PosExpIf pos cond (PosExpLet pos binding exp) f))
+--  (\f-> PosExpLet pos local (PosExpIf pos cond (PosExpLet pos binding exp) f))
+    (PosExpLet pos local (PosExpIf pos cond (PosExpLet pos binding exp) PosExpFail))
 
 ------------------