Commit 39135867 authored by sewardj's avatar sewardj
Browse files

[project @ 1999-12-06 16:25:23 by sewardj]

Remove Hugs' special treatment of tuples, and instead have them as
just another Tycon.  This is to make interworking with GHC simpler.

Put tuple entries in the Tycon table.  Modify isTycon, isTuple, tupleOf,
mkTuple and whatIs so that client code doesn't see any difference.
Add allocTupleTycon to manufacture tuple Tycon entries as startup.
parent 7c0ef81a
......@@ -9,8 +9,8 @@
* 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"
......@@ -476,14 +476,12 @@ static Void alloc( AsmBCO bco, StgVar v )
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;
......@@ -745,7 +743,7 @@ Void cgBinds( List binds )
}
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));
}
......
......@@ -9,8 +9,8 @@
* 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>
......@@ -306,7 +306,20 @@ String argv[]; {
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) {
......@@ -321,8 +334,6 @@ String argv[]; {
}
}
addStackEntry("Prelude");
#if DEBUG
{
char exe_name[N_INSTALLDIR + 6];
......@@ -586,7 +597,8 @@ String s; { /* return FALSE if none found. */
"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;
......
......@@ -9,8 +9,8 @@
* 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"
......@@ -474,6 +474,7 @@ Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
Void linkControl(what)
Int what; {
Int i;
switch (what) {
case RESET :
case MARK :
......@@ -484,6 +485,10 @@ Int what; {
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);
......
......@@ -19,20 +19,20 @@ fi
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
......
......@@ -9,8 +9,8 @@
* 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"
......@@ -466,6 +466,7 @@ Text t; {
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];
......@@ -496,7 +497,7 @@ Tycon tc; {
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);
......@@ -590,6 +591,35 @@ Tycon tup; {
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:
*
......@@ -1818,7 +1848,7 @@ register Cell c; {
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
......
......@@ -10,8 +10,8 @@
* 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 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -355,6 +355,9 @@ extern Ptr cptrOf Args((Cell));
* ------------------------------------------------------------------------*/
#define TUPMIN 201
#if 0
#error xyzzy
#if TREX
#define isTuple(c) (TUPMIN<=(c) && (c)<EXTMIN)
#else
......@@ -362,6 +365,8 @@ extern Ptr cptrOf Args((Cell));
#endif
#define mkTuple(n) (TUPMIN+(n))
#define tupleOf(n) ((Int)((n)-TUPMIN))
#endif
extern Text ghcTupleText Args((Tycon));
......@@ -483,14 +488,20 @@ extern DLSect lookupDLSect Args((void*));
* ------------------------------------------------------------------------*/
#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... */
......
......@@ -10,8 +10,8 @@
* 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"
......@@ -1006,7 +1006,6 @@ Void implementForeignExport ( Name n )
}
}
// ToDo: figure out how to set inlineMe for these (non-Name) things
Void implementTuple(size)
Int size; {
if (size > 0) {
......
......@@ -9,8 +9,8 @@
* 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"
......@@ -2765,7 +2765,7 @@ Void typeChecker(what)
Int what; {
switch (what) {
case RESET : tcMode = EXPRESSION;
+ daSccs = NIL;
daSccs = NIL;
preds = NIL;
pendingBtyvs = NIL;
daSccs = NIL;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment