[commit: ghc] wip/T12618: Actually desugar to ConApp (3ed1a8b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T12618
Link       : http://ghc.haskell.org/trac/ghc/changeset/3ed1a8b5f5affcdee19bf456c1c6d23044e0d34f/ghc

>---------------------------------------------------------------

commit 3ed1a8b5f5affcdee19bf456c1c6d23044e0d34f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Sep 30 20:50:42 2016 -0400

    Actually desugar to ConApp
    
    at least if the constructor is saturated. Fall back to the worker
    otherwise.


>---------------------------------------------------------------

3ed1a8b5f5affcdee19bf456c1c6d23044e0d34f
 compiler/coreSyn/MkCore.hs | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs
index e7fc7f9..3861513 100644
--- a/compiler/coreSyn/MkCore.hs
+++ b/compiler/coreSyn/MkCore.hs
@@ -67,7 +67,7 @@ import TcType           ( mkSpecSigmaTy )
 import Type
 import Coercion         ( isCoVar )
 import TysPrim
-import DataCon          ( DataCon, dataConWorkId )
+import DataCon          ( DataCon, dataConRepFullArity, dataConWorkId )
 import IdInfo           ( vanillaIdInfo, setStrictnessInfo,
                           setArityInfo )
 import Demand
@@ -150,7 +150,17 @@ mkCoreApps orig_fun orig_args
 -- expressions to that of a data constructor expression. The leftmost expression
 -- in the list is applied first
 mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr
-mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args
+mkCoreConApps con args
+    | length args >= dataConRepFullArity con
+    = mkCoreApps (ConApp con conArgs) extraArgs
+    -- TODO #12618: Do we need to check needsCaseBinding?
+  where
+    -- TODO #12618: Can there ever be more than dataConRepArity con arguments
+    -- in a type-safe program?
+    (conArgs, extraArgs) = splitAt (dataConRepFullArity con) args
+mkCoreConApps con args
+    -- Unsaturated application. TODO #12618 Use wrapper.
+    = mkCoreApps (Var (dataConWorkId con)) args
 
 mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr
 -- Build an application (e1 e2),