From 391358678567341041284d0062ea606552460a14 Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 6 Dec 1999 16:25:28 +0000 Subject: [PATCH] [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. --- ghc/interpreter/codegen.c | 10 ++++------ ghc/interpreter/hugs.c | 24 ++++++++++++++++++------ ghc/interpreter/link.c | 9 +++++++-- ghc/interpreter/runnofib | 8 ++++---- ghc/interpreter/storage.c | 38 ++++++++++++++++++++++++++++++++++---- ghc/interpreter/storage.h | 19 +++++++++++++++---- ghc/interpreter/translate.c | 5 ++--- ghc/interpreter/type.c | 6 +++--- 8 files changed, 87 insertions(+), 32 deletions(-) diff --git a/ghc/interpreter/codegen.c b/ghc/interpreter/codegen.c index 2ffd55a..c47ca21 100644 --- a/ghc/interpreter/codegen.c +++ b/ghc/interpreter/codegen.c @@ -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)); } diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index 8aad0eb..f5c69a1 100644 --- a/ghc/interpreter/hugs.c +++ b/ghc/interpreter/hugs.c @@ -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 @@ -306,7 +306,20 @@ String argv[]; { namesUpto = numScripts = 0; - for (i=1; i)"), pair(STAR,pair(STAR,STAR)), 2,DATATYPE,NIL); diff --git a/ghc/interpreter/runnofib b/ghc/interpreter/runnofib index 3aeca64..38cc5be 100644 --- a/ghc/interpreter/runnofib +++ b/ghc/interpreter/runnofib @@ -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 diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index a050959..1ee4eb8 100644 --- a/ghc/interpreter/storage.c +++ b/ghc/interpreter/storage.c @@ -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 diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h index 36bb320..a81ec69 100644 --- a/ghc/interpreter/storage.h +++ b/ghc/interpreter/storage.h @@ -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)=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... */ diff --git a/ghc/interpreter/translate.c b/ghc/interpreter/translate.c index 0fb0439..392472b 100644 --- a/ghc/interpreter/translate.c +++ b/ghc/interpreter/translate.c @@ -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) { diff --git a/ghc/interpreter/type.c b/ghc/interpreter/type.c index 9c625e9..12c0458 100644 --- a/ghc/interpreter/type.c +++ b/ghc/interpreter/type.c @@ -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; -- 1.7.10.4