* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.34 $
- * $Date: 2000/01/10 16:27:03 $
+ * $Revision: 1.43 $
+ * $Date: 2000/03/14 14:34:47 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
#include "prelude.h"
#include "storage.h"
-#include "command.h"
-#include "backend.h"
#include "connect.h"
#include "errors.h"
#include "version.h"
-#include "link.h"
#include "Rts.h"
#include "RtsAPI.h"
* Local function prototypes:
* ------------------------------------------------------------------------*/
-static Void local initialize Args((Int,String []));
-static Void local promptForInput Args((String));
-static Void local interpreter Args((Int,String []));
-static Void local menu Args((Void));
-static Void local guidance Args((Void));
-static Void local forHelp Args((Void));
-static Void local set Args((Void));
-static Void local changeDir Args((Void));
-static Void local load Args((Void));
-static Void local project Args((Void));
-static Void local readScripts Args((Int));
-static Void local whatScripts Args((Void));
-static Void local editor Args((Void));
-static Void local find Args((Void));
-static Bool local startEdit Args((Int,String));
-static Void local runEditor Args((Void));
-static Void local setModule Args((Void));
-static Module local findEvalModule Args((Void));
-static Void local evaluator Args((Void));
-static Void local stopAnyPrinting Args((Void));
-static Void local showtype Args((Void));
-static String local objToStr Args((Module, Cell));
-static Void local info Args((Void));
-static Void local printSyntax Args((Name));
-static Void local showInst Args((Inst));
-static Void local describe Args((Text));
-static Void local listNames Args((Void));
-
-static Void local toggleSet Args((Char,Bool));
-static Void local togglesIn Args((Bool));
-static Void local optionInfo Args((Void));
+static Void local initialize ( Int,String [] );
+static Void local promptForInput ( String );
+static Void local interpreter ( Int,String [] );
+static Void local menu ( Void );
+static Void local guidance ( Void );
+static Void local forHelp ( Void );
+static Void local set ( Void );
+static Void local changeDir ( Void );
+static Void local load ( Void );
+static Void local project ( Void );
+static Void local readScripts ( Int );
+static Void local whatScripts ( Void );
+static Void local editor ( Void );
+static Void local find ( Void );
+static Bool local startEdit ( Int,String );
+static Void local runEditor ( Void );
+static Void local setModule ( Void );
+static Module local findEvalModule ( Void );
+static Void local evaluator ( Void );
+static Void local stopAnyPrinting ( Void );
+static Void local showtype ( Void );
+static String local objToStr ( Module, Cell );
+static Void local info ( Void );
+static Void local printSyntax ( Name );
+static Void local showInst ( Inst );
+static Void local describe ( Text );
+static Void local listNames ( Void );
+
+static Void local toggleSet ( Char,Bool );
+static Void local togglesIn ( Bool );
+static Void local optionInfo ( Void );
#if USE_REGISTRY || HUGS_FOR_WINDOWS
-static String local optionsToStr Args((Void));
+static String local optionsToStr ( Void );
#endif
-static Void local readOptions Args((String));
-static Bool local processOption Args((String));
-static Void local setHeapSize Args((String));
-static Int local argToInt Args((String));
-
-static Void local loadProject Args((String));
-static Void local clearProject Args((Void));
-static Bool local addScript Args((Int));
-static Void local forgetScriptsFrom Args((Script));
-static Void local setLastEdit Args((String,Int));
-static Void local failed Args((Void));
-static String local strCopy Args((String));
-static Void local browseit Args((Module,String,Bool));
-static Void local browse Args((Void));
+static Void local readOptions ( String );
+static Bool local processOption ( String );
+static Void local setHeapSize ( String );
+static Int local argToInt ( String );
+
+static Void local loadProject ( String );
+static Void local clearProject ( Void );
+static Bool local addScript ( Int );
+static Void local forgetScriptsFrom ( Script );
+static Void local setLastEdit ( String,Int );
+static Void local failed ( Void );
+static String local strCopy ( String );
+static Void local browseit ( Module,String,Bool );
+static Void local browse ( Void );
/* --------------------------------------------------------------------------
* Machine dependent code for Hugs interpreter:
* ------------------------------------------------------------------------*/
- Bool combined = TRUE;
#include "machdep.c"
#ifdef WANT_TIMER
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;
typedef
struct {
}
ScriptInfo;
-static Void local makeStackEntry Args((ScriptInfo*,String));
-static Void local addStackEntry Args((String));
+static Void local makeStackEntry ( ScriptInfo*,String );
+static Void local addStackEntry ( String );
static ScriptInfo scriptInfo[NUM_SCRIPTS];
#ifndef NO_MAIN /* we omit main when building the "Hugs server" */
-Main main Args((Int, String [])); /* now every func has a prototype */
+Main main ( Int, String [] ); /* now every func has a prototype */
Main main(argc,argv)
int argc;
}
addStackEntry("Prelude");
+ if (combined) addStackEntry("PrelHugs");
for (i=1; i < argc; ++i) { /* process command line arguments */
if (strcmp(argv[i], "--")==0) break;
#define PUTStr(c,s) \
next=PUTStr_aux(next,c,s)
-static String local PUTStr_aux Args((String,Char, String));
+static String local PUTStr_aux ( String,Char, String));
static String local PUTStr_aux(next,c,s)
String next;
{'w', 1, "Always show which modules are loaded", &listScripts},
{'k', 1, "Show kind errors in full", &kindExpert},
{'o', 0, "Allow overlapping instances", &allowOverlap},
-
-
-#if DEBUG_CODE
- {'D', 1, "Debug: show generated code", &debugCode},
-#endif
+ {'S', 1, "Debug: show generated SC code", &debugSC},
#if EXPLAIN_INSTANCE_RESOLUTION
{'x', 1, "Explain instance resolution", &showInstRes},
#endif
#if MULTI_INST
{'m', 0, "Use multi instance resolution", &multiInstRes},
#endif
-#if DEBUG_CODE
- {'D', 1, "Debug: show generated G code", &debugCode},
-#endif
- {'S', 1, "Debug: show generated SC code", &debugSC},
{0, 0, 0, 0}
};
currProject = s;
projInput(currProject);
scriptFile = currProject;
- forgetScriptsFrom(1);
+ forgetScriptsFrom(N_PRELUDE_SCRIPTS);
while ((s=readFilename())!=0)
addStackEntry(s);
if (namesUpto<=1) {
/* 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, */
{ 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);
ERRTEXT "\n"
EEND;
}
- inputExpr = ap2(findName(findText("show")),d,inputExpr);
- inputExpr = ap(findName(findText("putStr")), inputExpr);
- inputExpr = ap(nameRunIO_toplevel, 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;
Int next; /* next space in buffer */
} HugsStream;
-static Void local vBufferedPrintf Args((HugsStream*, const char*, va_list));
-static Void local bufferedPutchar Args((HugsStream*, Char));
-static String local bufferClear Args((HugsStream *stream));
+static Void local vBufferedPrintf ( HugsStream*, const char*, va_list );
+static Void local bufferedPutchar ( HugsStream*, Char );
+static String local bufferClear ( HugsStream *stream );
static Void local vBufferedPrintf(stream, fmt, ap)
HugsStream* stream;
projects / ghc-hetmet.git / blobdiff