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

[git at git.haskell.org]

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

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

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

commit ddee1604a0ac0aa4eabc5ed62c44039ed71c4f1d
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.


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

ddee1604a0ac0aa4eabc5ed62c44039ed71c4f1d
 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),