* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.30 $
- * $Date: 1999/12/10 15:59:44 $
+ * $Revision: 1.39 $
+ * $Date: 2000/02/15 13:16:19 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
}
addStackEntry("Prelude");
+ if (combined) addStackEntry("PrelHugs");
for (i=1; i < argc; ++i) { /* process command line arguments */
if (strcmp(argv[i], "--")==0) break;
currProject = s;
projInput(currProject);
scriptFile = currProject;
- forgetScriptsFrom(1);
+ forgetScriptsFrom(N_PRELUDE_SCRIPTS);
while ((s=readFilename())!=0)
addStackEntry(s);
if (namesUpto<=1) {
/* Return TRUE if no imports were needed; FALSE otherwise. */
static Bool local addScript(stacknum) /* read single file */
Int stacknum; {
+ Bool didPrelude;
static char name[FILENAME_MAX+1];
Int len = scriptInfo[stacknum].size;
scriptFile = name;
if (scriptInfo[stacknum].fromSource) {
- if (lastWasObject) processInterfaces();
+ if (lastWasObject) {
+ didPrelude = processInterfaces();
+ if (didPrelude) {
+ preludeLoaded = TRUE;
+ everybody(POSTPREL);
+ }
+ }
lastWasObject = FALSE;
Printf("Reading script \"%s\":\n",name);
needsImports = FALSE;
scriptFile = 0;
- if (strcmp(scriptInfo[stacknum].modName, "Prelude")==0) {
- preludeLoaded = TRUE;
- everybody(POSTPREL);
- }
return TRUE;
}
/* to be read */
while ((s=readFilename())!=0)
addStackEntry(s);
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
static Void local project() { /* read list of script names from */
EEND;
}
loadProject(s);
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
static Void local readScripts(n) /* Reread current list of scripts, */
Time timeStamp; /* including the first script which*/
Long fileSize; /* has been either changed or added*/
static char name[FILENAME_MAX+1];
+ Bool didPrelude;
lastWasObject = FALSE;
ppSmStack("readscripts-begin");
if (numScripts==namesUpto) ppSmStack( "readscripts-final") ;
}
- processInterfaces();
+ didPrelude = processInterfaces();
+ if (didPrelude) {
+ preludeLoaded = TRUE;
+ everybody(POSTPREL);
+ }
+
{ Int m = namesUpto-1;
Text mtext = findText(scriptInfo[m].modName);
+
+ /* Hack to avoid starting up in PrelHugs */
+ if (mtext == findText("PrelHugs")) mtext = findText("Prelude");
+
+
/* Commented out till we understand what
* this is trying to do.
* Problem, you cant find a module till later.
startNewScript(0);
if (nonNull(c=findTycon(t=findText(nm)))) {
if (startEdit(tycon(c).line,scriptName[scriptThisTycon(c)])) {
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
} else if (nonNull(c=findName(t))) {
if (startEdit(name(c).line,scriptName[scriptThisName(c)])) {
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
} else {
ERRMSG(0) "No current definition for name \"%s\"", nm
static Void local runEditor() { /* run editor on script lastEdit */
if (startEdit(lastEdLine,lastEdit)) /* at line lastEdLine */
- readScripts(1);
+ readScripts(N_PRELUDE_SCRIPTS);
}
static Void local setLastEdit(fname,line)/* keep name of last file to edit */
/* allocated during evaluation */
parseExp();
checkExp();
- defaultDefns = evalDefaults;
+ defaultDefns = combined ? stdDefaults : evalDefaults;
type = typeCheckExp(TRUE);
+
if (isPolyType(type)) {
ks = polySigOf(type);
bd = monotypeOf(type);
#if 1
if (isProgType(ks,bd)) {
- inputExpr = ap(nameRunIO,inputExpr);
+ inputExpr = ap(nameRunIO_toplevel,inputExpr);
evalExp();
Putchar('\n');
} else {
ERRTEXT "\n"
EEND;
}
- inputExpr = ap2(findName(findText("show")),d,inputExpr);
- inputExpr = ap(findName(findText("putStr")), inputExpr);
- inputExpr = ap(nameRunIO, inputExpr);
+ inputExpr = ap2(nameShow, d,inputExpr);
+ inputExpr = ap (namePutStr, inputExpr);
+ inputExpr = ap (nameRunIO_toplevel, inputExpr);
evalExp(); printf("\n");
if (addType) {
extern Name nameHw;
+static Void dumpStg ( void )
+{
+ String s;
+ Int i;
+ setCurrModule(findEvalModule());
+ startNewScript(0);
+ s = readFilename();
+
+ /* request to locate a symbol by name */
+ if (s && (*s == '?')) {
+ Text t = findText(s+1);
+ locateSymbolByName(t);
+ return;
+ }
+
+ /* request to dump a bit of the heap */
+ if (s && (*s == '-' || isdigit(*s))) {
+ int i = atoi(s);
+ print(i,100);
+ printf("\n");
+ return;
+ }
+
+ /* request to dump a symbol table entry */
+ if (!s
+ || !(*s == 't' || *s == 'n' || *s == 'c' || *s == 'i')
+ || !isdigit(s[1])) {
+ fprintf(stderr, ":d -- bad request `%s'\n", s );
+ return;
+ }
+ i = atoi(s+1);
+ switch (*s) {
+ case 't': dumpTycon(i); break;
+ case 'n': dumpName(i); break;
+ case 'c': dumpClass(i); break;
+ case 'i': dumpInst(i); break;
+ default: fprintf(stderr, ":d -- `%c' not implemented\n", *s );
+ }
+}
+
+
+#if 0
static Void local dumpStg( void ) { /* print STG stuff */
String s;
Text t;
}
}
}
+#endif
static Void local info() { /* describe objects */
Int count = 0; /* or give menu of commands */
} else {
Printf("<unknown type>");
}
-
+printf("\n");print(name(nm).type,10);printf("\n");
if (isCfun(nm)) {
Printf(" -- data constructor");
} else if (isMfun(nm)) {
case FIND : find();
break;
case LOAD : clearProject();
- forgetScriptsFrom(1);
+ forgetScriptsFrom(N_PRELUDE_SCRIPTS);
load();
break;
case ALSO : clearProject();
forgetScriptsFrom(numScripts);
load();
break;
- case RELOAD : readScripts(1);
+ case RELOAD : readScripts(N_PRELUDE_SCRIPTS);
break;
case PROJECT: project();
break;
Void everybody(what) /* send command `what' to each component of*/
Int what; { /* system to respond as appropriate ... */
-fprintf ( stderr, "EVERYBODY %d\n", what );
+#if 0
+ fprintf ( stderr, "EVERYBODY %d\n", what );
+#endif
machdep(what); /* The order of calling each component is */
storage(what); /* important for the PREPREL command */
substitution(what);
projects / ghc-hetmet.git / blobdiff