From 5d7ce2f2810df6c30cbba1edcda479897dd90f57 Mon Sep 17 00:00:00 2001
From: Unno Hideyuki <unno.hideyuki@nifty.com>
Date: Sun, 13 Dec 2020 11:03:53 +0900
Subject: [PATCH] fixed the treatment of pattern match fails in list
 comprehensions.

---
 compiler/lib/Prelude.hs              | 6 +-----
 compiler/src/Rename.hs               | 9 ++++++---
 compiler/test/expected/sample323.txt | 1 +
 compiler/test/samples/sample323.hs   | 2 ++
 4 files changed, 10 insertions(+), 8 deletions(-)
 create mode 100644 compiler/test/expected/sample323.txt
 create mode 100644 compiler/test/samples/sample323.hs

diff --git a/compiler/lib/Prelude.hs b/compiler/lib/Prelude.hs
index 131b32d..0e6cf16 100644
--- a/compiler/lib/Prelude.hs
+++ b/compiler/lib/Prelude.hs
@@ -708,16 +708,12 @@ readDec :: (Integral a) => (String -> [(a, String)])
 readDec = readInt 10 isDigit digitToInt
 
 readSigned :: (Real a) => (String -> [(a, String)]) -> (String -> [(a, String)])
-readSigned readPos = {- readParen False -}  read'
-  {-
+readSigned readPos = readParen False read'
   where read' r = read'' r ++
                   [(-x, t) | ("-", s) <- lex r,
                              (x, t) <- read'' s]
         read'' r = [(n, s) | (str, s) <- lex r,
                              (n, "") <- readPos str]
-  -}
-  where read' r | head r == '-' = [(-n, s) | (n, s) <- readPos (tail r)]
-                | otherwise     = readPos r
 
 instance Read Integer where
   readsPrec p = readSigned readDec
diff --git a/compiler/src/Rename.hs b/compiler/src/Rename.hs
index d92834f..5050420 100644
--- a/compiler/src/Rename.hs
+++ b/compiler/src/Rename.hs
@@ -896,7 +896,7 @@ renExp (A.ListCompExp e (A.ExpStmt b : stmts)) =
   renExp (A.IfExp b (A.ListCompExp e stmts) nil)
   where nil = A.VarExp $ Name "[]" (0,0) True
 
--- [e | p <- l, Q] = let ok p = [e | Q] in concatMap ok l
+-- [e | p <- l, Q] = let {ok p = [e | Q]; ok _ = []} in concatMap ok l
 renExp (A.ListCompExp e (A.BindStmt p l : stmts)) = renExp letexp
   where
     ok = Name "OK" (0,0) False -- "OK" is fresh,  will never parsed as a variable.
@@ -904,11 +904,14 @@ renExp (A.ListCompExp e (A.BindStmt p l : stmts)) = renExp letexp
     rhs = case stmts of
       [] -> A.UnguardedRhs (A.ListExp [e]) []
       _  -> A.UnguardedRhs (A.ListCompExp e stmts) []
-    decl = A.VDecl $ A.ValDecl okp rhs
+    okp' = A.FunAppExp (A.VarExp ok) A.WildcardPat
+    rhs' = A.UnguardedRhs (A.VarExp (Name "[]" (0,0) True)) []
+    decl1 = A.VDecl $ A.ValDecl okp rhs
+    decl2 = A.VDecl $ A.ValDecl okp' rhs'
     body = A.FunAppExp (A.FunAppExp (A.VarExp $ Name "concatMap" (0,0) False)
                                     (A.VarExp ok))
                        l
-    letexp = A.LetExp [decl] body
+    letexp = A.LetExp [decl1, decl2] body
 
 -- [e | let dictdefDecls, Q] = let dictdefDecls in [e | Q]
 renExp (A.ListCompExp e (A.LetStmt ddecls : stmts)) = renExp letexp
diff --git a/compiler/test/expected/sample323.txt b/compiler/test/expected/sample323.txt
new file mode 100644
index 0000000..c739b42
--- /dev/null
+++ b/compiler/test/expected/sample323.txt
@@ -0,0 +1 @@
+44
diff --git a/compiler/test/samples/sample323.hs b/compiler/test/samples/sample323.hs
new file mode 100644
index 0000000..54c2b32
--- /dev/null
+++ b/compiler/test/samples/sample323.hs
@@ -0,0 +1,2 @@
+xs = [Just 3, Just 2, Nothing, Just 9, Nothing, Nothing, Just 8]
+main = print $ sum $ [y | Just x <- xs, let y = x * 2]