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

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

diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c
index 0188b78..45e5936 100644 (file)
--- a/ghc/interpreter/interface.c
+++ b/ghc/interpreter/interface.c
@@ -7,8 +7,8 @@
  * Hugs version 1.4, December 1997
  *
  * $RCSfile: interface.c,v $
- * $Revision: 1.43 $
- * $Date: 2000/04/03 17:27:10 $
+ * $Revision: 1.47 $
+ * $Date: 2000/04/06 15:05:30 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -390,10 +390,12 @@ static Cell deleteUnexportedIFaceEntities ( Cell root )
       hd(t) = zsnd(unap(I_EXPORT,hd(t)));
    /* exlist_list :: [[ ConVarId | ((ConId, [ConVarId])) ]] */
 
+#if 0
    if (isNull(exlist_list)) {
       ERRMSG(0) "Can't find any export lists in interface file"
       EEND;
    }
+#endif
 
    return filterInterface ( root, isExportedIFaceEntity, 
                             exlist_list, NULL );
@@ -697,7 +699,7 @@ void processInterfaces ( List /* of CONID */ iface_modnames )
     for (xs = iface_modnames; nonNull(xs); xs=tl(xs)) {
        mod = findModule(textOf(hd(xs)));
        assert(nonNull(mod));
-       assert(!module(mod).fromSrc);
+       assert(module(mod).mode == FM_OBJECT);
        ifaces = cons ( module(mod).tree, ifaces );
     }
     ifaces = reverse(ifaces);
@@ -1020,7 +1022,7 @@ void processInterfaces ( List /* of CONID */ iface_modnames )
              case I_DATA: {
                 Cell ddecl   = unap(I_DATA,decl);
                 List constrs = finishGHCDataDecl ( zsel35(ddecl) );
-                constructor_list = appendOnto ( constrs, constructor_list );
+                constructor_list = dupOnto ( constrs, constructor_list );
                 break;
              }
              case I_NEWTYPE: {
@@ -1618,6 +1620,7 @@ List  constrs0;  /* [((ConId,[((Type,VarId,Int))]))]  */
     Pair    conArg, ctxElem;
     Text    conArgNm;
     Int     conArgStrictness;
+    Int     conStrictCompCount;
 
     Text t = textOf(tycon);
 #   ifdef DEBUG_IFACE
@@ -1660,6 +1663,7 @@ List  constrs0;  /* [((ConId,[((Type,VarId,Int))]))]  */
            tyvarsMentioned = NIL;  
            /* tyvarsMentioned :: [VarId] */
 
+           conStrictCompCount = 0;
            conArgs = reverse(fields);
            for (; nonNull(conArgs); conArgs=tl(conArgs)) {
               conArg           = hd(conArgs); /* (Type,Text) */
@@ -1668,7 +1672,7 @@ List  constrs0;  /* [((ConId,[((Type,VarId,Int))]))]  */
               conArgStrictness = intOf(zthd3(conArg));
               tyvarsMentioned = dupListOnto(ifTyvarsIn(conArgTy),
                                             tyvarsMentioned);
-              if (conArgStrictness > 0) conArgTy = bang(conArgTy);
+              if (conArgStrictness > 0) conStrictCompCount++;
               ty = fn(conArgTy,ty);
               if (nonNull(conArgNm)) {
                  /* a field name is mentioned too */
@@ -1688,7 +1692,7 @@ List  constrs0;  /* [((ConId,[((Type,VarId,Int))]))]  */
            for (ctx=ctx0; nonNull(ctx); ctx=tl(ctx)) {
               ctxElem = hd(ctx);     
               /* ctxElem :: ((QConId,VarId)) */
-              if (nonNull(cellIsMember(textOf(zsnd(ctxElem)),tyvarsMentioned)))
+              if (nonNull(varIsMember(textOf(zsnd(ctxElem)),tyvarsMentioned)))
                  ctx2 = cons(ctxElem, ctx2);
            }
            if (nonNull(ctx2))
@@ -1701,12 +1705,12 @@ List  constrs0;  /* [((ConId,[((Type,VarId,Int))]))]  */
            ty = tvsToOffsets(line,ty, ktyvars);
 
            /* Finally, stick the constructor's type onto it. */
-           hd(constrs) = ztriple(conid,fields,ty);
+           hd(constrs) = z4ble(conid,fields,ty,mkInt(conStrictCompCount));
         }
 
         /* Final result is that 
-           constrs :: [((ConId,[((Type,Text))],Type))]   
-                      lists the constructors and their types
+           constrs :: [((ConId,[((Type,Text))],Type,Int))]   
+                      lists the constructors, their types and # strict comps
            sels :: [((VarId,Type))]
                    lists the selectors and their types
        */
@@ -1717,9 +1721,9 @@ List  constrs0;  /* [((ConId,[((Type,VarId,Int))]))]  */
 
 static List startGHCConstrs ( Int line, List cons, List sels )
 {
-    /* cons :: [((ConId,[((Type,Text,Int))],Type))] */
-    /* sels :: [((VarId,Type))]                     */
-    /* returns [Name]                               */
+    /* cons :: [((ConId,[((Type,Text,Int))],Type,Int))] */
+    /* sels :: [((VarId,Type))]                         */
+    /* returns [Name]                                   */
     List cs, ss;
     Int  conNo = length(cons)>1 ? 1 : 0;
     for(cs=cons; nonNull(cs); cs=tl(cs), conNo++) {
@@ -1759,15 +1763,16 @@ static Name startGHCSel ( Int line, ZPair sel )
 }
 
 
-static Name startGHCConstr ( Int line, Int conNo, ZTriple constr )
+static Name startGHCConstr ( Int line, Int conNo, Z4Ble constr )
 {
-    /* constr :: ((ConId,[((Type,Text,Int))],Type)) */
+    /* constr :: ((ConId,[((Type,Text,Int))],Type,Int)) */
     /* (ADR) ToDo: add rank2 annotation and existential annotation
      * these affect how constr can be used.
      */
-    Text con   = textOf(zfst3(constr));
-    Type type  = zthd3(constr);
-    Int  arity = arityFromType(type);
+    Text con     = textOf(zsel14(constr));
+    Type type    = zsel34(constr);
+    Int  arity   = arityFromType(type);
+    Int  nStrict = intOf(zsel44(constr));
     Name n = findName(con);     /* Allocate constructor fun name   */
     if (isNull(n)) {
         n = newName(con,NIL);
@@ -1776,10 +1781,11 @@ static Name startGHCConstr ( Int line, Int conNo, ZTriple constr )
             textToStr(con)
         EEND;
     }
-    name(n).arity  = arity;     /* Save constructor fun details    */
-    name(n).line   = line;
-    name(n).number = cfunNo(conNo);
-    name(n).type   = type;
+    name(n).arity     = arity;     /* Save constructor fun details    */
+    name(n).line      = line;
+    name(n).number    = cfunNo(conNo);
+    name(n).type      = type;
+    name(n).hasStrict = nStrict > 0;
     return n;
 }