From 6d1111be32e5f85e4e04fa357bffe1bde77785d1 Mon Sep 17 00:00:00 2001 From: Ingo Wechsung Date: Tue, 19 Apr 2016 19:43:18 +0200 Subject: [PATCH] fix #271 --- frege/compiler/passes/Easy.fr | 32 +++----------------------------- tests/comp/Issue271.fr | 28 ++++++++++++++++++++++++++++ 2 files changed, 31 insertions(+), 29 deletions(-) create mode 100644 tests/comp/Issue271.fr diff --git a/frege/compiler/passes/Easy.fr b/frege/compiler/passes/Easy.fr index 03c98262..dbdede78 100644 --- a/frege/compiler/passes/Easy.fr +++ b/frege/compiler/passes/Easy.fr @@ -533,35 +533,9 @@ mkEasy (x@App f arg t) = do mkEasy (x@Let{env,ex}) = do -- TODO: handle non-recursive let/case/if g <- getST - syms <- mapSt U.findV env - mkEasyLet g x syms - where - mkEasyLet g (x@Let{env=[Local{uid}],ex}) [sym] - | Just (cas@Case{alts=[alt]}) <- Symbol.gExpr sym g = do - -- handle let a = case ... of p -> x in foo a - -- case ... of p -> foo x - ntimes <- references [uid] ex - if ntimes == 1 || isAtomic alt.ex - then do - g <- getST - E.logmsg TRACE9 (getpos x) (text("mkEasyLet before: " ++ nice x g)) - let alt = head cas.alts - ex <- replSid uid alt.ex ex - let ck - | isCaseWhen x.ex = CWhen - | otherwise = cas.ckind - let neu = cas.{alts=[alt.{ex}], ckind = ck} - E.logmsg TRACE9 (getpos x) (text("mkEasyLet after: " ++ nice neu g)) - mkEasy neu - else do - easySym sym - ex <- mkEasy ex - return x.{ex} - mkEasyLet g (x@Let{env,ex}) syms = do - foreach syms easySym - ex <- mkEasy ex - return x.{ex} - mkEasyLet g _ _ = undefined + mapM U.findV env >>= mapM_ easySym + mkEasy ex >>= pure . x.{ex=} + mkEasy (outer@Case{}) = do ea <- mkEasy outer.ex diff --git a/tests/comp/Issue271.fr b/tests/comp/Issue271.fr new file mode 100644 index 00000000..ee93638a --- /dev/null +++ b/tests/comp/Issue271.fr @@ -0,0 +1,28 @@ +--- See 'https://github.com/Frege/frege/issues/271 Issue #271' +--- - Compiler issues a guard-may-fail warning, despite default case available. +--- - Should print Nothing, but dies of tuple pattern not matched + +--- Turns out that the pattern binding in the first clause of 'readDriveShare' morphs to +--- > readDriveShare (x:xs) = let u = (['f', 'g']) in +--- > case u of (a,_) -> case u of (_,b) | x == '/' = Just (x:a,b) +--- and this wrongly attaches the guard to the wrong case clause. + +--- Solution: drop the special handling of +--- > let a = case ... in ... +--- It didn't play well with laziness anyway. + +module tests.comp.Issue271 where + + +readDriveShare (x:xs) | x == '/' = b + where + (a,b) = (['f'], undefined) + -- a = case (['f'],['g']) of (a,_) = a + -- b = case (['f'],['g']) of (_,b) = b + +readDriveShare _ = "" + +main = print $ readDriveShare (toList "file") + +simpler (s:ss) | s == "foo" = (b,a) where (a,b) = (42,true) +simpler _ = (false, 0) \ No newline at end of file