* included in the distribution.
*
* $RCSfile: codegen.c,v $
- * $Revision: 1.12 $
- * $Date: 1999/11/29 18:59:25 $
+ * $Revision: 1.13 $
+ * $Date: 1999/12/06 16:25:23 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
itblNames[nItblNames++] = textToStr(name(con).text);
} else
if (isTuple(con)) {
- char* cc = malloc(10);
- assert(cc);
+ char cc[20];
sprintf(cc, "Tuple%d", tupleOf(con) );
itblNames[nItblNames++] = vv;
itblNames[nItblNames++] = cc;
} else
assert ( /* cant identify constructor name */ 0 );
-
setPos(v,asmAllocCONSTR(bco, vv));
}
break;
}
for (b=binds,i=0; nonNull(b); b=tl(b),i++) {
- //printf("endTop %s\n", maybeName(hd(b)));
+ //printStg( stdout, hd(b) ); printf( "\n\n");
endTop(hd(b));
}
* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.28 $
- * $Date: 1999/12/03 17:01:20 $
+ * $Revision: 1.29 $
+ * $Date: 1999/12/06 16:25:24 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
namesUpto = numScripts = 0;
- for (i=1; i<argc; ++i) { /* process command line arguments */
+ /* Pre-scan flags to see if -c or +c is present. This needs to
+ precede adding the stack entry for Prelude. On the other hand,
+ that stack entry needs to be made before the cmd line args are
+ properly examined. Hence the following pre-scan of them.
+ */
+ for (i=1; i < argc; ++i) {
+ if (strcmp(argv[i], "--")==0) break;
+ if (strcmp(argv[i], "-c")==0) combined = FALSE;
+ if (strcmp(argv[i], "+c")==0) combined = TRUE;
+ }
+
+ addStackEntry("Prelude");
+
+ for (i=1; i < argc; ++i) { /* process command line arguments */
if (strcmp(argv[i], "--")==0) break;
if (strcmp(argv[i],"+")==0 && i+1<argc) {
if (proj) {
}
}
- addStackEntry("Prelude");
-
#if DEBUG
{
char exe_name[N_INSTALLDIR + 6];
"You can't enable/disable combined"
" operation inside Hugs\n" );
} else {
- combined = state;
+ /* don't do anything, since pre-scan of args
+ will have got it already */
}
return TRUE;
* included in the distribution.
*
* $RCSfile: link.c,v $
- * $Revision: 1.19 $
- * $Date: 1999/12/03 17:56:04 $
+ * $Revision: 1.20 $
+ * $Date: 1999/12/06 16:25:25 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
Void linkControl(what)
Int what; {
+ Int i;
switch (what) {
case RESET :
case MARK :
modulePrelude = newModule(textPrelude);
setCurrModule(modulePrelude);
+ for(i=0; i<NUM_TUPLES; ++i) {
+ allocTupleTycon(i);
+ }
+
typeArrow = addPrimTycon(findText("(->)"),
pair(STAR,pair(STAR,STAR)),
2,DATATYPE,NIL);
if [ -f $NROOT/$1/$2/$2.stdin ]
then
-echo "$HUGZ/hugs -Q -P$NROOT/$1/$2 Main -- $3 $4 $5 $6 $7 $8 $9"
+echo "$HUGZ/hugs -Q -c -P$NROOT/$1/$2 Main -- $3 $4 $5 $6 $7 $8 $9"
echo " < $NROOT/$1/$2/$2.stdin 2> /dev/null"
echo " > $TMPFILE"
else
-echo "$HUGZ/hugs -Q -P$NROOT/$1/$2 Main -- $3 $4 $5 $6 $7 $8 $9"
+echo "$HUGZ/hugs -Q -c -P$NROOT/$1/$2 Main -- $3 $4 $5 $6 $7 $8 $9"
echo " < /dev/null 2> /dev/null"
echo " > $TMPFILE"
fi
if [ -f $NROOT/$1/$2/$2.stdin ]
then
-$HUGZ/hugs -Q -P$NROOT/$1/$2 Main -- $3 $4 $5 $6 $7 $8 $9 < $NROOT/$1/$2/$2.stdin 2> /dev/null > $TMPFILE
+$HUGZ/hugs -Q -c -P$NROOT/$1/$2 Main -- $3 $4 $5 $6 $7 $8 $9 < $NROOT/$1/$2/$2.stdin 2> /dev/null > $TMPFILE
else
-$HUGZ/hugs -Q -P$NROOT/$1/$2 Main -- $3 $4 $5 $6 $7 $8 $9 < /dev/null 2> /dev/null > $TMPFILE
+$HUGZ/hugs -Q -c -P$NROOT/$1/$2 Main -- $3 $4 $5 $6 $7 $8 $9 < /dev/null 2> /dev/null > $TMPFILE
fi
if [ $? -ne 0 ]; then
* included in the distribution.
*
* $RCSfile: storage.c,v $
- * $Revision: 1.21 $
- * $Date: 1999/12/03 17:01:23 $
+ * $Revision: 1.22 $
+ * $Date: 1999/12/06 16:25:25 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
tycon(tyconHw).what = NIL;
tycon(tyconHw).conToTag = NIL;
tycon(tyconHw).tagToCon = NIL;
+ tycon(tyconHw).tuple = -1;
tycon(tyconHw).mod = currentModule;
module(currentModule).tycons = cons(tyconHw,module(currentModule).tycons);
tycon(tyconHw).nextTyconHash = tyconHash[h];
static Void local hashTycon(tc) /* Insert Tycon into hash table */
Tycon tc; {
- assert(isTycon(tc));
+ assert(isTycon(tc) || isTuple(tc));
if (1) {
Text t = tycon(tc).text;
Int h = tHash(t);
return findText(buf);
}
+Tycon mkTuple ( Int n )
+{
+ Int i;
+ if (n >= NUM_TUPLES)
+ internal("mkTuple: request for tuple of unsupported size");
+ for (i = TYCMIN; i < tyconHw; i++)
+ if (tycon(i).tuple == n) return i;
+ internal("mkTuple: request for non-existent tuple");
+}
+
+Void allocTupleTycon ( Int n )
+{
+ Int i;
+ char buf[20];
+ Kind k;
+ Tycon t;
+ for (i = TYCMIN; i < tyconHw; i++)
+ if (tycon(i).tuple == n) return;
+ sprintf(buf,"Tuple%d",n);
+ //t = addPrimTycon(findText(buf),simpleKind(n),n, DATATYPE,NIL);
+
+ k = STAR;
+ for (i = 0; i < n; i++) k = ap(STAR,k);
+ t = newTycon(findText(buf));
+ tycon(t).kind = k;
+ tycon(t).tuple = n;
+ tycon(t).what = DATATYPE;
+}
+
/* --------------------------------------------------------------------------
* Name storage:
*
else return CLASS;}
else if (c>=INSTMIN) return INSTANCE;
else return NAME;}
- else if (c>=MODMIN) {if (c>=TYCMIN) return TYCON;
+ else if (c>=MODMIN) {if (c>=TYCMIN) return isTuple(c) ? TUPLE : TYCON;
else return MODULE;}
else if (c>=OFFMIN) return OFFSET;
#if TREX
* included in the distribution.
*
* $RCSfile: storage.h,v $
- * $Revision: 1.16 $
- * $Date: 1999/12/03 17:01:25 $
+ * $Revision: 1.17 $
+ * $Date: 1999/12/06 16:25:27 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
* ------------------------------------------------------------------------*/
#define TUPMIN 201
+
+#if 0
+#error xyzzy
#if TREX
#define isTuple(c) (TUPMIN<=(c) && (c)<EXTMIN)
#else
#endif
#define mkTuple(n) (TUPMIN+(n))
#define tupleOf(n) ((Int)((n)-TUPMIN))
+#endif
+
extern Text ghcTupleText Args((Tycon));
* ------------------------------------------------------------------------*/
#define TYCMIN (MODMIN+NUM_MODULE)
-#define isTycon(c) (TYCMIN<=(c) && (c)<NAMEMIN)
-#define mkTycon(n) (TCMIN+(n))
+#define isTycon(c) (TYCMIN<=(c) && (c)<NAMEMIN && tabTycon[(c)-TYCMIN].tuple==-1)
#define tycon(n) tabTycon[(n)-TYCMIN]
+#define isTuple(c) (TYCMIN<=(c) && (c)<NAMEMIN && tabTycon[(c)-TYCMIN].tuple>=0)
+#define tupleOf(n) (tabTycon[(n)-TYCMIN].tuple)
+extern Tycon mkTuple ( Int );
+extern Void allocTupleTycon ( Int );
+
+
struct strTycon {
Text text;
Int line;
Module mod; /* module that defines it */
+ Int tuple; /* tuple number, or -1 if not tuple */
Int arity;
Kind kind; /* kind (includes arity) of Tycon */
Cell what; /* DATATYPE/SYNONYM/RESTRICTSYN... */
* included in the distribution.
*
* $RCSfile: translate.c,v $
- * $Revision: 1.21 $
- * $Date: 1999/12/03 17:01:26 $
+ * $Revision: 1.22 $
+ * $Date: 1999/12/06 16:25:27 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
}
}
-// ToDo: figure out how to set inlineMe for these (non-Name) things
Void implementTuple(size)
Int size; {
if (size > 0) {
* included in the distribution.
*
* $RCSfile: type.c,v $
- * $Revision: 1.17 $
- * $Date: 1999/11/29 18:59:34 $
+ * $Revision: 1.18 $
+ * $Date: 1999/12/06 16:25:28 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
Int what; {
switch (what) {
case RESET : tcMode = EXPRESSION;
-+ daSccs = NIL;
+ daSccs = NIL;
preds = NIL;
pendingBtyvs = NIL;
daSccs = NIL;