* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.25 $
- * $Date: 1999/11/29 18:59:26 $
+ * $Revision: 1.26 $
+ * $Date: 1999/12/03 12:39:38 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
* Local data areas:
* ------------------------------------------------------------------------*/
-static Bool printing = FALSE; /* TRUE => currently printing value*/
-static Bool showStats = FALSE; /* TRUE => print stats after eval */
-static Bool listScripts = TRUE; /* TRUE => list scripts after loading*/
-static Bool addType = FALSE; /* TRUE => print type with value */
-static Bool useDots = RISCOS; /* TRUE => use dots in progress */
-static Bool quiet = FALSE; /* TRUE => don't show progress */
+static Bool printing = FALSE; /* TRUE => currently printing value*/
+static Bool showStats = FALSE; /* TRUE => print stats after eval */
+static Bool listScripts = TRUE; /* TRUE => list scripts after loading*/
+static Bool addType = FALSE; /* TRUE => print type with value */
+static Bool useDots = RISCOS; /* TRUE => use dots in progress */
+static Bool quiet = FALSE; /* TRUE => don't show progress */
static Bool lastWasObject = FALSE;
Bool preludeLoaded = FALSE;
Bool debugSC = FALSE;
+ Bool combined = TRUE; //FALSE;
typedef
struct {
#endif
if (haskell98) {
- Printf("Haskell 98 mode: Restart with command line option -98 to enable extensions\n\n");
+ Printf("Haskell 98 mode: Restart with command line option -98 to enable extensions\n");
} else {
- Printf("Hugs mode: Restart with command line option +98 for Haskell 98 mode\n\n");
+ Printf("Hugs mode: Restart with command line option +98 for Haskell 98 mode\n");
+ }
+
+ if (combined) {
+ Printf("Combined mode: Restart with command line -c for standalone mode\n\n" );
+ } else {
+ Printf("Standalone mode: Restart with command line +c for combined mode\n\n" );
}
everybody(INSTALL);
case 'h' : setHeapSize(s+1);
return TRUE;
+ case 'c' : if (heapBuilt()) {
+ FPrintf(stderr,
+ "You can't enable/disable combined"
+ " operation inside Hugs\n" );
+ } else {
+ combined = state;
+ }
+ return TRUE;
+
case 'D' : /* hack */
{
extern void setRtsFlags( int x );
#if USE_REGISTRY
FPrintf(stderr,"Change to heap size will not take effect until you rerun Hugs\n");
#else
- FPrintf(stderr,"Cannot change heap size\n");
+ FPrintf(stderr,"You cannot change heap size from inside Hugs\n");
#endif
} else {
heapSize = hpSize;
{'D', 1, "Debug: show generated G code", &debugCode},
#endif
{'S', 1, "Debug: show generated SC code", &debugSC},
-#if 0
- {'f', 1, "Terminate evaluation on first error", &failOnError},
- {'u', 1, "Use \"show\" to display results", &useShow},
- {'i', 1, "Chase imports while loading modules", &chaseImports},
-#endif
{0, 0, 0, 0}
};
/* 11 Oct 99: disable object loading in the interim.
Will probably only reinstate when HEP becomes available.
*/
- fromObj = sAvail
+ if (combined) {
+ fromObj = sAvail
? (oAvail && iAvail && timeEarlier(sTime,oTime))
: TRUE;
+ } else {
+ fromObj = FALSE;
+ }
/* ToDo: namesUpto overflow */
ent->modName = strCopy(iname);
static Void nukeEnding( String s )
{
Int l = strlen(s);
- if (l > 2 && strncmp(s+l-2,".o" ,3)==0) s[l-2] = 0; else
- if (l > 3 && strncmp(s+l-3,".hi" ,3)==0) s[l-3] = 0; else
- if (l > 3 && strncmp(s+l-3,".hs" ,3)==0) s[l-3] = 0; else
- if (l > 4 && strncmp(s+l-4,".lhs",4)==0) s[l-4] = 0; else
- if (l > 4 && strncmp(s+l-4,".dll",4)==0) s[l-4] = 0; else
- if (l > 4 && strncmp(s+l-4,".DLL",4)==0) s[l-4] = 0;
+ if (l > 4 && strncmp(s+l-4,".u_o" ,4)==0) s[l-4] = 0; else
+ if (l > 5 && strncmp(s+l-5,".u_hi",5)==0) s[l-5] = 0; else
+ if (l > 3 && strncmp(s+l-3,".hs" ,3)==0) s[l-3] = 0; else
+ if (l > 4 && strncmp(s+l-4,".lhs" ,4)==0) s[l-4] = 0; else
+ if (l > 4 && strncmp(s+l-4,".dll" ,4)==0) s[l-4] = 0; else
+ if (l > 4 && strncmp(s+l-4,".DLL" ,4)==0) s[l-4] = 0;
}
static Void local addStackEntry(s) /* Add script to list of scripts */
strcat(name, scriptInfo[stacknum].modName);
if (scriptInfo[stacknum].fromSource)
strcat(name, scriptInfo[stacknum].srcExt); else
- strcat(name, ".hi");
+ strcat(name, ".u_hi");
scriptFile = name;
strcat(name, scriptInfo[n].modName);
if (scriptInfo[n].fromSource)
strcat(name, scriptInfo[n].srcExt); else
- strcat(name, ".hi"); //ToDo: should be .o
+ strcat(name, ".u_hi"); //ToDo: should be .o
getFileInfo(name,&timeStamp, &fileSize);
if (timeChanged(timeStamp,scriptInfo[n].lastChange)) {
dropScriptsFrom(n-1);
* included in the distribution.
*
* $RCSfile: input.c,v $
- * $Revision: 1.15 $
- * $Date: 1999/12/01 11:50:34 $
+ * $Revision: 1.16 $
+ * $Date: 1999/12/03 12:39:39 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
static Text textModule, textImport, textInterface, textInstImport;
static Text textHiding, textQualified, textAsMod;
static Text textExport, textDynamic, textUUExport;
-static Text textUnsafe, textUUAll;
+static Text textUnsafe, textUUAll, textUUUsage;
Text textCcall; /* ccall */
Text textStdcall; /* stdcall */
*
* At the lowest level of input, characters are read one at a time, with the
* current character held in c0 and the following (lookahead) character in
- * c1. The corrdinates of c0 within the file are held in (column,row).
+ * c1. The coordinates of c0 within the file are held in (column,row).
* The input stream is advanced by one character using the skip() function.
* ------------------------------------------------------------------------*/
* Now try to identify token type:
* --------------------------------------------------------------------*/
+ if (c0 == '(' && c1 == '#') { skip(); skip(); return UTL; };
+ if (c0 == '#' && c1 == ')') { skip(); skip(); return UTR; };
+
switch (c0) {
case EOF : return 0; /* End of file/input */
if (it==textDlet && !haskell98) lookAhead(DLET);
#endif
if (it==textUUAll) return ALL;
+ if (it==textUUUsage) return UUUSAGE;
if (it==textRepeat && reading==KEYBOARD)
return repeatLast();
textWildcard = findText("_");
textAll = findText("forall");
textUUAll = findText("__forall");
+ textUUUsage = findText("__u");
varMinus = mkVar(textMinus);
varPlus = mkVar(textPlus);
varBang = mkVar(textBang);
* Hugs version 1.4, December 1997
*
* $RCSfile: interface.c,v $
- * $Revision: 1.7 $
- * $Date: 1999/11/29 18:59:28 $
+ * $Revision: 1.8 $
+ * $Date: 1999/12/03 12:39:40 $
* ------------------------------------------------------------------------*/
/* ToDo:
#include "Assembler.h" /* for wrapping GHC objects */
#include "dynamic.h"
-#define DEBUG_IFACE
-#define VERBOSITY TRUE
+// #define DEBUG_IFACE
+#define VERBOSE FALSE
extern void print ( Cell, Int );
}
// Last, but by no means least ...
- resolveReferencesInObjectModule ( mod, FALSE );
+ resolveReferencesInObjectModule ( mod, TRUE );
}
Void openGHCIface(t)
Module m = findModule(t);
if (isNull(m)) {
m = newModule(t);
-printf ( "new module %s\n", textToStr(t) );
+ //printf ( "new module %s\n", textToStr(t) );
} else if (m != modulePrelude) {
ERRMSG(0) "Module \"%s\" already loaded", textToStr(t)
EEND;
ERRMSG(0) "Read of object file \"%s\" failed", nameObj
EEND;
}
- if (!validateOImage(img,sizeObj,VERBOSITY)) {
+ if (!validateOImage(img,sizeObj,VERBOSE)) {
ERRMSG(0) "Validation of object file \"%s\" failed", nameObj
EEND;
}
assert(!module(m).oImage);
module(m).oImage = img;
- readSyms(m,VERBOSITY);
+ readSyms(m,VERBOSE);
if (!cellIsMember(m, ghcModules))
ghcModules = cons(m, ghcModules);
}
}
-Void addGHCClass(line,ctxt,tc_name,tv,mems0)
+Void addGHCClass(line,ctxt,tc_name,kinded_tv,mems0)
Int line;
List ctxt; /* [(QConId, VarId)] */
Cell tc_name; /* ConId */
-Text tv; /* VarId */
+Text kinded_tv; /* (VarId, Kind) */
List mems0; { /* [(VarId, Type)] */
List mems; /* [(VarId, Type)] */
List tvsInT; /* [VarId] and then [(VarId,Kind)] */
List tvs; /* [(VarId,Kind)] */
Text ct = textOf(tc_name);
- Pair newCtx = pair(tc_name, tv);
+ Pair newCtx = pair(tc_name, fst(kinded_tv));
# ifdef DEBUG_IFACE
printf ( "\nbegin addGHCclass %s\n", textToStr(ct) );
# endif
/* Kludge to map the single tyvar in the context to Offset 0.
Need to do something better for multiparam type classes.
- */
+
cclass(nw).supers = tvsToOffsets(line,ctxt,
singleton(pair(tv,STAR)));
+ */
+ cclass(nw).supers = tvsToOffsets(line,ctxt,
+ singleton(kinded_tv));
+
for (mems=mems0; nonNull(mems); mems=tl(mems)) {
Pair mem = hd(mems);
Void addGHCInstance (line,ctxt0,cls,var)
Int line;
List ctxt0; /* [(QConId, Type)] */
-Pair cls; /* (ConId, [Type]) */
+List cls; /* [(ConId, Type)] */
Text var; { /* Text */
List tmp, tvs, ks;
Inst in = newInst();
# endif
/* Make tvs into a list of tyvars with bogus kinds. */
- tvs = nubList(ifTyvarsIn(snd(cls)));
+ //print ( cls, 10 ); printf ( "\n");
+ tvs = nubList(ifTyvarsIn(cls));
+ //print ( tvs, 10 );
ks = NIL;
for (tmp = tvs; nonNull(tmp); tmp=tl(tmp)) {
hd(tmp) = pair(hd(tmp),STAR);
tvsToOffsets(line,snd(snd(type)),ktyvars)));
case DICTAP: /* bogus ?? */
return ap(DICTAP, tvsToOffsets(line,snd(type),ktyvars));
+ case UNBOXEDTUP: /* bogus?? */
+ return ap(UNBOXEDTUP, tvsToOffsets(line,snd(type),ktyvars));
case VARIDCELL: /* Ha! some real work to do! */
{ Int i = 0;
Text tv = textOf(type);
return NIL; /* NOTREACHED */
}
+/* ToDo: nuke this */
+static Text kludgeGHCPrelText ( Text m )
+{
+ return m;
+#if 0
+ if (strncmp(textToStr(m), "Prel", 4)==0)
+ return textPrelude; else return m;
+#endif
+}
+
/* This is called from the finishGHC* functions. It traverses a structure
and converts conidcells, ie, type constructors parsed by the interface
Tycons or Classes have been loaded into the symbol tables and can be
looked up.
*/
-static Text kludgeGHCPrelText ( Text m )
-{
- if (strncmp(textToStr(m), "Prel", 4)==0)
- return textPrelude; else return m;
-}
static Type local conidcellsToTycons(line,type)
Int line;
conidcellsToTycons(line,snd(snd(type)))));
case DICTAP: /* bogus?? */
return ap(DICTAP, conidcellsToTycons(line, snd(type)));
+ case UNBOXEDTUP:
+ return ap(UNBOXEDTUP, conidcellsToTycons(line, snd(type)));
default:
fprintf(stderr, "conidcellsToTycons: unknown stuff %d\n",
whatIs(type));
Elf32_Word* targ;
// first find "the" symbol table
// why is this commented out???
- stab = findElfSection ( ehdrC, SHT_SYMTAB );
+ stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
// also go find the string table
strtab = findElfSection ( ehdrC, SHT_STRTAB );
)
&&
( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
- ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT )
+ ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
+ ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE)
) {
char* nm = strtab + stab[j].st_name;
char* ad = ehdrC
ad, textToStr(module(m).text), nm );
addOTabName ( m, nm, ad );
}
+ //else fprintf(stderr, "skipping `%s'\n", strtab + stab[j].st_name );
}
}
extern int __ap_2_upd_info;
extern int MainRegTable;
extern int Upd_frame_info;
+extern int CAF_BLACKHOLE_info;
+extern int IND_STATIC_info;
+extern int newCAF;
OSym rtsTab[]
= {
- { "stg_gc_enter_1", &stg_gc_enter_1 },
- { "stg_chk_0", &stg_chk_0 },
- { "stg_chk_1", &stg_chk_1 },
- { "stg_update_PAP", &stg_update_PAP },
- { "__ap_2_upd_info", &__ap_2_upd_info },
- { "MainRegTable", &MainRegTable },
- { "Upd_frame_info", &Upd_frame_info },
+ { "stg_gc_enter_1", &stg_gc_enter_1 },
+ { "stg_chk_0", &stg_chk_0 },
+ { "stg_chk_1", &stg_chk_1 },
+ { "stg_update_PAP", &stg_update_PAP },
+ { "__ap_2_upd_info", &__ap_2_upd_info },
+ { "MainRegTable", &MainRegTable },
+ { "Upd_frame_info", &Upd_frame_info },
+ { "CAF_BLACKHOLE_info", &CAF_BLACKHOLE_info },
+ { "IND_STATIC_info", &IND_STATIC_info },
+ { "newCAF", &newCAF },
{0,0}
};
pp = strchr(nm2, '_');
if (!pp) goto not_found;
*pp = 0;
- t = unZcodeThenFindText(nm2);
+ t = kludgeGHCPrelText( unZcodeThenFindText(nm2) );
m = findModule(t);
if (isNull(m)) goto not_found;
a = lookupOTabName ( m, nm );
* included in the distribution.
*
* $RCSfile: machdep.c,v $
- * $Revision: 1.14 $
- * $Date: 1999/11/25 10:19:16 $
+ * $Revision: 1.15 $
+ * $Date: 1999/12/03 12:39:42 $
* ------------------------------------------------------------------------*/
#ifdef HAVE_SIGNAL_H
return (0 == access(f,4));
#elif defined HAVE_SYS_STAT_H || defined HAVE_STAT_H
struct stat scbuf;
- //fprintf(stderr, "readable: %s\n", f );
+ /* fprintf(stderr, "readable: %s\n", f ); */
return ( !stat(f,&scbuf)
&& (scbuf.st_mode & S_IREAD) /* readable */
&& (scbuf.st_mode & S_IFREG) /* regular file */
# define SLASH '\\'
# define isSLASH(c) ((c)=='\\' || (c)=='/')
# define PATHSEP ';'
+# define PATHSEP_STR ";"
# define DLL_ENDING ".dll"
#elif MAC_FILENAMES
# define SLASH ':'
# define isSLASH(c) ((c)==SLASH)
# define PATHSEP ';'
+# define PATHSEP_STR ";"
/* Mac PEF (Preferred Executable Format) file */
# define DLL_ENDING ".pef"
#else
# define SLASH '/'
# define isSLASH(c) ((c)==SLASH)
# define PATHSEP ':'
-# define DLL_ENDING ".o"
+# define PATHSEP_STR ":"
+# define DLL_ENDING ".u_o"
#endif
static String local hugsdir() { /* directory containing lib/Prelude.hs */
}
#if HSCRIPT
-static String endings[] = { "", ".hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
+static String endings[] = { "", ".u_hi", ".hs", ".lhs", ".hsx", ".hash", 0 };
#else
-static String endings[] = { "", ".hi", ".hs", ".lhs", 0 };
+static String endings[] = { "", ".u_hi", ".hs", ".lhs", 0 };
#endif
static char searchBuf[FILENAME_MAX+1];
static Int searchPos;
Int nPath;
Bool literate;
String peStart, peEnd;
- String augdPath; /* .:hugsPath:installDir/lib */
+ String augdPath; /* .:hugsPath:installDir/GhcPrel:installDir/lib */
*path = *sExt = NULL;
*sAvail = *iAvail = *oAvail = FALSE;
*sSize = *iSize = *oSize = 0;
- augdPath = malloc(4+3+strlen(installDir)+strlen(hugsPath));
+ augdPath = malloc( 2*(10+3+strlen(installDir))
+ +strlen(hugsPath) +10/*paranoia*/);
if (!augdPath)
internal("moduleNameToFileNames: malloc failed(2)");
- augdPath[0] = '.';
- augdPath[1] = PATHSEP;
- augdPath[2] = 0;
- strcat ( augdPath, hugsPath );
- augdPath[2+strlen(hugsPath)] = PATHSEP;
- augdPath[3+strlen(hugsPath)] = 0;
- strcat(augdPath,installDir);
- strcat(augdPath,"lib");
+
+ augdPath[0] = 0;
+ strcat(augdPath, ".");
+ strcat(augdPath, PATHSEP_STR);
+
+ strcat(augdPath, hugsPath);
+ strcat(augdPath, PATHSEP_STR);
+
+ strcat(augdPath, installDir);
+ strcat(augdPath, "GhcPrel");
+ strcat(augdPath, PATHSEP_STR);
+
+ strcat(augdPath, installDir);
+ strcat(augdPath, "lib");
+ strcat(augdPath, PATHSEP_STR);
+
+ /* fprintf ( stderr, "augdpath = `%s'\n", augdPath ); */
peEnd = augdPath-1;
while (1) {
getFileInfo(searchBuf, oTime, oSize);
}
- strcpy(searchBuf+nPath, ".hi");
+ strcpy(searchBuf+nPath, ".u_hi");
if (readable(searchBuf)) {
*iAvail = TRUE;
getFileInfo(searchBuf, iTime, iSize);
* included in the distribution.
*
* $RCSfile: parser.y,v $
- * $Revision: 1.15 $
- * $Date: 1999/11/29 18:53:14 $
+ * $Revision: 1.16 $
+ * $Date: 1999/12/03 12:39:42 $
* ------------------------------------------------------------------------*/
%{
%token TMODULE IMPORT HIDING QUALIFIED ASMOD
%token EXPORT UUEXPORT INTERFACE REQUIRES UNSAFE
%token INSTIMPORT DYNAMIC CCALL STDKALL
+%token UTL UTR UUUSAGE
%%
/*- Top level script/module structure -------------------------------------*/
opt_bang : '!' {$$=gc1(NIL);}
| {$$=gc0(NIL);}
;
+opt_COCO : COCO {$$=gc1(NIL);}
+ | {$$=gc0(NIL);}
+ ;
+
ifName : CONID {openGHCIface(textOf($1));
$$ = gc1(NIL);}
checkVersion
: NUMLIT {$$ = gc1(NIL); }
;
ifDecl
- : IMPORT CONID NUMLIT opt_bang COCO version_list_junk
+ : IMPORT CONID NUMLIT opt_bang opt_COCO version_list_junk
{ addGHCImports(intOf($3),textOf($2),
$6);
$$ = gc6(NIL);
{$$ = gc4(fixdecl($2,singleton($4),
NON_ASS,$3)); }
- | TINSTANCE ifCtxInst ifInstHd '=' ifVar
+ | TINSTANCE ifCtxInst ifInstHdL '=' ifVar
{ addGHCInstance(intOf($1),$2,$3,
textOf($5));
$$ = gc5(NIL); }
{ addGHCNewType(intOf($2),
$3,$4,$5,$6);
$$ = gc6(NIL); }
- | NUMLIT TCLASS ifCtxDecl ifCon ifTyvar ifCmeths
+ | NUMLIT TCLASS ifCtxDecl ifCon ifKindedTyvar ifCmeths
{ addGHCClass(intOf($2),$3,$4,$5,$6);
$$ = gc6(NIL); }
| NUMLIT ifVar COCO ifType
| ALL ifForall IMPLIES {$$=gc3(NIL);}
| {$$=gc0(NIL);}
;
-ifInstHd /* { Class aType } :: (ConId, Type) */
- : '{' ifCon ifAType '}' {$$=gc4(pair($2,$3));}
+ifInstHd /* { Class aType } :: (ConId, Type) */
+ : '{' ifCon ifAType '}' {$$=gc4(ap(DICTAP,pair($2,singleton($3))));}
+ ;
+
+ifInstHdL /* { C a1 } -> { C2 a2 } -> ... -> { Cn an } :: [(ConId, Type)] */
+ /* Note: not constructing the list with fn($1,$3) */
+ : ifInstHd ARROW ifInstHdL {$$=gc3(fn($1,$3));}
+ | ifInstHd {$$=gc1(NIL);}
;
-ifCtxDecl /* {M.C1 a, C2 b} :: [(QConId, VarId)] */
+
+ifCtxDecl /* {M.C1 a, C2 b} => :: [(QConId, VarId)] */
: { $$ = gc0(NIL); }
| '{' ifCtxDeclL '}' IMPLIES { $$ = gc4($2); }
;
| ifBType ARROW ifType { $$ = gc3(fn($1,$3)); }
| ifBType { $$ = gc1($1); }
;
-ifForall /* [(VarId,Kind)] */
+ifForall /* [(VarId,Kind)] */
: '[' ifKindedTyvarL ']' { $$ = gc3($2); }
- ;
-ifTypes2 : ifType ',' ifType { $$ = gc3(doubleton($1,$3)); }
- | ifType ',' ifTypes2 { $$ = gc3(cons($1,$3)); }
;
+
+ifTypeL2 /* [Type], 2 or more */
+ : ifType ',' ifType { $$ = gc3(doubleton($1,$3)); }
+ | ifType ',' ifTypeL2 { $$ = gc3(cons($1,$3)); }
+ ;
+
+ifTypeL /* [Type], 0 or more */
+ : ifType ',' ifTypeL { $$ = gc3(cons($1,$3)); }
+ | ifType { $$ = gc1(singleton($1)); }
+ | { $$ = gc0(NIL); }
+ ;
+
ifBType : ifAType { $$ = gc1($1); }
| ifBType ifAType { $$ = gc2(ap($1,$2)); }
+ | UUUSAGE ifUsage ifAType { $$ = gc3($3); }
;
+
ifAType : ifQTCName { $$ = gc1($1); }
| ifTyvar { $$ = gc1($1); }
| '(' ')' { $$ = gc2(typeUnit); }
- | '(' ifTypes2 ')' { $$ = gc3(buildTuple($2)); }
+ | '(' ifTypeL2 ')' { $$ = gc3(buildTuple($2)); }
| '[' ifType ']' { $$ = gc3(ap(typeList,$2));}
| '{' ifQTCName ifATypes '}' { $$ = gc4(ap(DICTAP,
pair($2,$3))); }
| '(' ifType ')' { $$ = gc3($2); }
+ | UTL ifTypeL UTR { $$ = gc3(ap(UNBOXEDTUP,$2)); }
;
ifATypes : { $$ = gc0(NIL); }
| ifAType ifATypes { $$ = gc2(cons($1,$2)); }
;
+/*- KW's usage stuff --------------------------------------*/
+ifUsage : '-' { $$ = gc1(NIL); }
+ | '!' { $$ = gc1(NIL); }
+ | ifVar { $$ = gc1(NIL); }
+ ;
+
+
/*- Interface kinds ---------------------------------------*/
ifKindedTyvarL /* [(VarId,Kind)] */
: { $$ = gc0(NIL); }
* included in the distribution.
*
* $RCSfile: static.c,v $
- * $Revision: 1.18 $
- * $Date: 1999/11/29 18:59:30 $
+ * $Revision: 1.19 $
+ * $Date: 1999/12/03 12:39:44 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
List us; /* from left to right ignoring any */
List ws; /* listed in us. */
List vs; { /* ws = explicitly quantified vars */
+ if (isNull(ty)) return vs;
switch (whatIs(ty)) {
+ case DICTAP : return typeVarsIn(snd(snd(ty)),us,ws,vs);
+ case UNBOXEDTUP: return typeVarsIn(snd(ty),us,ws,vs);
+
case AP : return typeVarsIn(snd(ty),us,ws,
typeVarsIn(fst(ty),us,ws,vs));
}
return vs;
}
+ case TUPLE:
+ case TYCON:
+ case CONIDCELL:
+ case QUALIDENT: return vs;
+
+ default: fprintf(stderr, " bad tag = %d\n", whatIs(ty));internal("typeVarsIn");
}
- return vs;
+ assert(0);
}
static List local maybeAppendVar(v,vs) /* append variable to list if not */
* included in the distribution.
*
* $RCSfile: storage.c,v $
- * $Revision: 1.19 $
- * $Date: 1999/11/29 18:59:32 $
+ * $Revision: 1.20 $
+ * $Date: 1999/12/03 12:39:46 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
}
+Text textOf ( Cell c )
+{
+ Bool ok =
+ (whatIs(c)==VARIDCELL
+ || whatIs(c)==CONIDCELL
+ || whatIs(c)==VAROPCELL
+ || whatIs(c)==CONOPCELL
+ || whatIs(c)==STRCELL
+ || whatIs(c)==DICTVAR
+ );
+ if (!ok) {
+ fprintf(stderr, "\ntextOf: bad tag %d\n",whatIs(c) );
+ internal("textOf: bad tag");
+ }
+ return snd(c);
+}
+
/* --------------------------------------------------------------------------
* Ext storage:
*
{
int i;
for (i = 0; i < module(m).usedoTab; i++) {
- if (0)
+ if (1)
fprintf ( stderr,
"lookupOTabName: request %s, table has %s\n",
nm, module(m).oTab[i].nm );
print(snd(snd(c)),depth-1);
Putchar(')');
break;
+ case DICTAP:
+ Printf("(DICTAP,");
+ print(snd(c),depth-1);
+ Putchar(')');
+ break;
+ case UNBOXEDTUP:
+ Printf("(UNBOXEDTUP,");
+ print(snd(c),depth-1);
+ Putchar(')');
+ break;
default:
if (isBoxTag(tag)) {
Printf("Tag(%d)=%d", c, tag);
* included in the distribution.
*
* $RCSfile: storage.h,v $
- * $Revision: 1.14 $
- * $Date: 1999/11/29 18:59:34 $
+ * $Revision: 1.15 $
+ * $Date: 1999/12/03 12:39:48 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
#define EXTCOPY 22 /* Copy of an Ext: snd :: Text */
#endif
-//#define textOf(c) ((Text)(snd(c))) /* c :: (VAR|CON)(ID|OP) */
-
-#if 1
-static Text textOf( Cell c )
-{
- Bool ok =
- (whatIs(c)==VARIDCELL
- || whatIs(c)==CONIDCELL
- || whatIs(c)==VAROPCELL
- || whatIs(c)==CONOPCELL
- || whatIs(c)==STRCELL
- || whatIs(c)==DICTVAR
- );
- if (!ok) {
-fprintf(stderr, "\ntextOf -- tag %d\n",whatIs(c) );
- assert(ok);
- }
- return snd(c);
-}
-#endif
-
#define qmodOf(c) (textOf(fst(snd(c)))) /* c :: QUALIDENT */
#define qtextOf(c) (textOf(snd(snd(c)))) /* c :: QUALIDENT */
#define mkVar(t) ap(VARIDCELL,t)
#else
#define isIP(p) FALSE
#endif
-extern Bool isVar Args((Cell));
-extern Bool isCon Args((Cell));
-extern Bool isQVar Args((Cell));
-extern Bool isQCon Args((Cell));
-extern Bool isQualIdent Args((Cell));
-extern Bool isIdent Args((Cell));
-extern String stringNegate Args((String));
+extern Bool isVar Args((Cell));
+extern Bool isCon Args((Cell));
+extern Bool isQVar Args((Cell));
+extern Bool isQCon Args((Cell));
+extern Bool isQualIdent Args((Cell));
+extern Bool isIdent Args((Cell));
+extern String stringNegate Args((String));
+extern Text textOf Args((Cell));
#define isFloat(c) (isPair(c) && fst(c)==FLOATCELL)
#define stringToFloat(s) pair(FLOATCELL,findText(s))
#define stringToBignum(s) pair(BIGCELL,findText(s))
#define bignumToString(b) textToStr(snd(b))
-
#if PTR_ON_HEAP
#define isPtr(c) (isPair(c) && fst(c)==PTRCELL)
extern Cell mkPtr Args((Ptr));
#define NEG 79 /* NEG snd :: Exp */
/* Used when parsing GHC interface files */
-#define DICTAP 80 /* DICTTYPE snd :: (QClassId,[Type]) */
+#define DICTAP 80 /* DICTAP snd :: (QClassId,[Type]) */
+#define UNBOXEDTUP 81 /* UNBOXEDTUP snd :: [Type] */
#if SIZEOF_INTP != SIZEOF_INT
-#define PTRCELL 81 /* C Heap Pointer snd :: (Int,Int) */
+#define PTRCELL 82 /* C Heap Pointer snd :: (Int,Int) */
#endif
#define STGVAR 92 /* STGVAR snd :: (StgRhs,info) */
projects / ghc-hetmet.git / commitdiff