Add support for LambdaCase

Author: bergmark

src/Fay/Compiler/Desugar.hs

@@ -67,6 +67,7 @@ desugar emptyAnnotation md = runDesugar emptyAnnotation $
   >>= desugarTupleSection
   >>= desugarImplicitPrelude
   >>= desugarFFITypeSigs
+  >>= desugarLCase
 
 -- | Desugaring
 
@@ -129,6 +130,12 @@ desugarTupleCon = transformBi $ \ex -> case ex of
           body   = Tuple l b (Var l . UnQual l <$> names)
       _ -> Nothing
 
+-- | \case x of [...] -> \foo -> case foo of [...]
+desugarLCase :: (Data l, Typeable l) => Module l -> Desugar l (Module l)
+desugarLCase = transformBiM $ \ex -> case ex of
+  LCase l alts -> withScopedTmpName l $ \n -> return $ Lambda l [PVar l n] (Case l (Var l (UnQual l n)) alts)
+  _ -> return ex
+
 desugarTupleSection :: (Data l, Typeable l) => Module l -> Desugar l (Module l)
 desugarTupleSection = transformBiM $ \ex -> case ex of
   TupleSection l _ mes -> do

src/Fay/Compiler/Misc.hs

@@ -332,6 +332,7 @@ defaultExtensions = map EnableExtension
   ,GADTs
   ,ImplicitPrelude
   ,KindSignatures
+  ,LambdaCase
   ,NamedFieldPuns
   ,PackageImports
   ,RecordWildCards

tests/LambdaCase.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE LambdaCase #-}
+module LambdaCase where
+
+f :: Int -> Bool
+f = \case
+  2 -> True
+  _ -> False
+
+main :: Fay ()
+main = do
+  print (f 2)

tests/LambdaCase.res

@@ -0,0 +1 @@
+true