Fix RecordWildCards regression using new haskell-names, and fix bug in R{a=x,..} construction

Author: bergmark

src/Fay/Compiler/Exp.hs

@@ -29,6 +29,7 @@ import           Control.Applicative
 import           Control.Monad.Error
 import           Control.Monad.RWS
 import           Language.Haskell.Exts.Annotated
+import           Language.Haskell.Names
 
 -- | Compile Haskell expression.
 compileExp :: S.Exp -> Compile JsExp
@@ -287,14 +288,18 @@ compileRecConstr name fieldUpdates = do
         updateStmt (unAnn -> o) (FieldUpdate _ (unAnn -> field) value) = do
           exp <- compileExp value
           return [JsSetProp (JsNameVar $ unQualify o) (JsNameVar $ unQualify field) exp]
-        updateStmt name (FieldWildcard _) = do
-          fields <- map (UnQual ()) <$> recToFields name
+        updateStmt name (FieldWildcard (wildcardFields -> fields)) = do
           return $ for fields $ \fieldName -> JsSetProp (JsNameVar $ unAnn name)
                                                         (JsNameVar fieldName)
                                                         (JsName $ JsNameVar fieldName)
         -- I couldn't find a code that generates (FieldUpdate (FieldPun ..))
         updateStmt _ u = error ("updateStmt: " ++ show u)
 
+        wildcardFields l = case l of
+          Scoped (RecExpWildcard es) _ -> map (\(OrigName _ o) -> unQualify $ gname2Qname o) . map fst $ es
+          _ -> []
+
+
 -- | Compile a record update.
 compileRecUpdate :: S.Exp -> [S.FieldUpdate] -> Compile JsExp
 compileRecUpdate rec fieldUpdates = do

tests/recordWildCards.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE NamedFieldPuns  #-}
+{-# LANGUAGE RecordWildCards #-}
+
+import           FFI
+import           Prelude
+
+data C = C { a :: Int, b :: Int, c :: Int, d :: Int }
+
+data X = X { foo :: Int } | Y { foo :: Int }
+
+partialMatch :: C -> Int
+partialMatch C{a=x, ..} = x + d
+
+con :: C
+con = let {a=10; b=20; c=30; d=40} in C{..}
+
+match :: X -> Int
+match X{..} = foo
+
+partialCon :: C
+partialCon = let a = 11; b = 2; c = 3; d = 4 in C { a = 1, ..}
+
+partialMatch2 c =
+  let a = 100
+  in case c of
+       C{a=x,..} -> a
+
+main = do
+  print con
+  print partialCon
+
+  print $ match X{foo=9}
+  print $ partialMatch C{a=1, b=2, c=3, d=4}
+  print $ partialMatch2 $ C 1 2 3 4
+
+
+  -- non exhaustive pattern match in `match`
+  let y = Y{foo=6}
+  print (match y)

…/regressions/recordWildCards_partial.res tests/recordWildCards_partial.restests/regressions/recordWildCards_partial.res renamed to tests/recordWildCards_partial.res tests/regressions/recordWildCards_partial.res renamed to tests/recordWildCards_partial.res

@@ -1,3 +1,5 @@
-5
 { instance: 'C', a: 10, b: 20, c: 30, d: 40 }
+{ instance: 'C', a: 1, b: 2, c: 3, d: 4 }
 9
+5
+100