[project @ 2000-04-06 15:05:30 by sewardj]

[ghc-hetmet.git] / ghc / interpreter / translate.c

diff --git a/ghc/interpreter/translate.c b/ghc/interpreter/translate.c
index 54b01b9..d20fd7b 100644 (file)
--- a/ghc/interpreter/translate.c
+++ b/ghc/interpreter/translate.c
@@ -10,8 +10,8 @@
  * included in the distribution.
  *
  * $RCSfile: translate.c,v $
- * $Revision: 1.31 $
- * $Date: 2000/04/05 10:25:09 $
+ * $Revision: 1.33 $
+ * $Date: 2000/04/06 15:05:30 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -410,7 +410,8 @@ StgExpr failExpr;
             if ( (isName(e) && isCfun(e)
                   && name(e).arity > 0 
                   && name(e).arity == length_args
-                  && !name(e).hasStrict)
+                  && !name(e).hasStrict
+                  && numQualifiers(name(e).type) == 0)
                  ||
                  (isTuple(e) && tycon(e).tuple == length_args)
                ) {
@@ -454,11 +455,15 @@ Void stgDefn( Name n, Int arity, Cell e )
 Void implementCfun(c,scs)               /* Build implementation for constr */
 Name c;                                 /* fun c.  scs lists integers (1..)*/
 List scs; {                             /* in incr order of strict fields. */
-    Int a = name(c).arity;
+    Int  a  = name(c).arity;               /* arity, not incl dictionaries */
+    Int  ad = numQualifiers(name(c).type);   /* the number of dictionaries */
+    Type t  = name(c).type;
 
-    if (a > 0) {
+    /* a+ad is total arity for this fn */
+    if (a+ad > 0) {
         StgVar  vcurr, e1, v, vsi;
         List    args  = makeArgs(a);
+        List    argsd = makeArgs(ad);
         StgVar  v0    = mkStgVar(mkStgCon(c,args),NIL);
         List    binds = singleton(v0);
 
@@ -470,7 +475,7 @@ List scs; {                             /* in incr order of strict fields. */
         }
         binds = rev(binds);
         e1    = mkStgLet(binds,vcurr);
-        v     = mkStgVar(mkStgLambda(args,e1),NIL);
+        v     = mkStgVar(mkStgLambda(dupOnto(argsd,args),e1),NIL);
         name(c).stgVar = v;
     } else {
         StgVar v = mkStgVar(mkStgCon(c,NIL),NIL);