* included in the distribution.
*
* $RCSfile: stg.c,v $
- * $Revision: 1.8 $
- * $Date: 1999/11/12 17:32:45 $
+ * $Revision: 1.11 $
+ * $Date: 2000/02/15 13:16:20 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
* Utility functions
* ------------------------------------------------------------------------*/
-void* stgConInfo( StgDiscr d )
+/* Make an info table for a constructor or tuple. */
+void* stgConInfo ( StgDiscr d )
{
+ int tag;
switch (whatIs(d)) {
- case NAME:
- return asmMkInfo(cfunOf(d),name(d).arity);
- case TUPLE:
- return asmMkInfo(0,tupleOf(d));
- default:
- internal("stgConInfo");
+ case NAME: {
+ tag = cfunOf(d);
+ if (tag > 0) tag--;
+ if (!name(d).itbl)
+ name(d).itbl = asmMkInfo(tag,name(d).arity);
+ return name(d).itbl;
+ }
+ case TUPLE: {
+ tag = 0;
+ if (!tycon(d).itbl)
+ tycon(d).itbl = asmMkInfo(tag,tupleOf(d));
+ return tycon(d).itbl;
+ }
+ default:
+ internal("stgConInfo");
}
}
-int stgDiscrTag( StgDiscr d )
+/* Return the tag for a constructor or tuple, starting at zero. */
+int stgDiscrTag ( StgDiscr d )
{
+ int tag;
switch (whatIs(d)) {
- case NAME:
- return cfunOf(d);
- case TUPLE:
- return 0;
- default:
- internal("stgDiscrTag");
+ case NAME: tag = cfunOf(d); break;
+ case TUPLE: tag = 0;
+ default: internal("stgDiscrTag");
}
+ if (tag > 0) tag--;
+ return tag;
}
/* --------------------------------------------------------------------------
case STGPRIM:
{
Cell op = stgPrimOp(e);
- unlexVar(name(op).text);
+ unlexVarStr(asmGetPrimopName(name(op).primop));
putStgAtoms(stgPrimArgs(e));
break;
}