X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fhugs.c;h=e2507bcaf4d97f1f8b929d77e07a47c932147888;hb=e4706792d290d4c5cb6a020d2973689efb7457ff;hp=b772f0b46b41aeadb0518548dc18cb5fecdc027d;hpb=366f1a080ac763aa8241817ea52e2bcd254f2280;p=ghc-hetmet.git diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index b772f0b..e2507bc 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.59 $ - * $Date: 2000/04/05 14:13:58 $ + * $Revision: 1.67 $ + * $Date: 2000/04/17 11:39:23 $ * ------------------------------------------------------------------------*/ #include @@ -70,9 +70,6 @@ static Void local listNames ( Void ); static Void local toggleSet ( Char,Bool ); static Void local togglesIn ( Bool ); static Void local optionInfo ( Void ); -#if USE_REGISTRY -static String local optionsToStr ( Void ); -#endif static Void local readOptions ( String ); static Bool local processOption ( String ); static Void local setHeapSize ( String ); @@ -83,6 +80,8 @@ static Void local failed ( Void ); static String local strCopy ( String ); static Void local browseit ( Module,String,Bool ); static Void local browse ( Void ); +static void local clearCurrentFile ( void ); + /* -------------------------------------------------------------------------- * Machine dependent code for Hugs interpreter: @@ -123,6 +122,9 @@ static Bool disableOutput = FALSE; /* TRUE => quiet */ List ifaces_outstanding = NIL; +static ConId currentModule_failed = NIL; /* Remember failed module from :r */ + + /* -------------------------------------------------------------------------- * Hugs entry point: @@ -203,11 +205,9 @@ char *argv[]; { * Initialization, interpret command line args and read prelude: * ------------------------------------------------------------------------*/ -static List /*CONID*/ initialize(argc,argv) /* Interpreter initialization */ -Int argc; -String argv[]; { - Int i; - char argv_0_orig[1000]; +static List /*CONID*/ initialize ( Int argc, String argv[] ) +{ + Int i, j; List initialModules; setLastEdit((String)0,0); @@ -221,19 +221,8 @@ String argv[]; { #endif hugsPath = strCopy(HUGSPATH); readOptions("-p\"%s> \" -r$$"); -#if USE_REGISTRY - projectPath = strCopy(readRegChildStrings(HKEY_LOCAL_MACHINE,ProjectRoot, - "HUGSPATH", PATHSEP, "")); - readOptions(readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"Options","")); - readOptions(readRegString(HKEY_CURRENT_USER, HugsRoot,"Options","")); -#endif /* USE_REGISTRY */ readOptions(fromEnv("STGHUGSFLAGS","")); - strncpy(argv_0_orig,argv[0],1000); /* startupHaskell mangles argv[0] */ - startupHaskell (argc,argv,NULL); - argc = prog_argc; - argv = prog_argv; - # if DEBUG { char exe_name[N_INSTALLDIR + 6]; @@ -243,24 +232,37 @@ String argv[]; { } # endif + /* startupHaskell extracts args between +RTS ... -RTS, and sets + prog_argc/prog_argv to the rest. We want to further process + the rest, so we then get hold of them again. + */ + startupHaskell ( argc, argv, NULL ); + getProgArgv ( &argc, &argv ); + /* Find out early on if we're in combined mode or not. - everybody(PREPREL) needs to know this. + everybody(PREPREL) needs to know this. Also, establish the + heap size; */ - for (i=1; i < argc; ++i) { + 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; + + if (strncmp(argv[i],"+h",2)==0 || strncmp(argv[i],"-h",2)==0) + setHeapSize(&(argv[i][2])); } everybody(PREPREL); initialModules = NIL; - for (i=1; i < argc; ++i) { /* process command line arguments */ - if (strcmp(argv[i], "--")==0) break; - if (argv[i] && argv[i][0]/* workaround for /bin/sh silliness*/ - && !processOption(argv[i])) { - initialModules - = cons ( mkCon(findText(argv[i])), initialModules ); + for (i = 1; i < argc; ++i) { /* process command line arguments */ + if (strcmp(argv[i], "--")==0) + { argv[i] = NULL; break; } + if (argv[i] && argv[i][0]/* workaround for /bin/sh silliness*/) { + if (!processOption(argv[i])) + initialModules + = cons ( mkCon(findText(argv[i])), initialModules ); + argv[i] = NULL; } } @@ -280,6 +282,16 @@ String argv[]; { " combined mode\n\n" ); } + /* slide args back over the deleted ones. */ + j = 1; + for (i = 1; i < argc; i++) + if (argv[i]) + argv[j++] = argv[i]; + + argc = j; + + setProgArgv ( argc, argv ); + initDone = TRUE; return initialModules; } @@ -305,8 +317,9 @@ Bool state; { *toggle[i].flag = state; return; } + clearCurrentFile(); ERRMSG(0) "Unknown toggle `%c'", c - EEND; + EEND_NO_LONGJMP; } static Void local togglesIn(state) /* Print current list of toggles in*/ @@ -375,65 +388,6 @@ ToDo Putchar('\n'); } -#if USE_REGISTRY -#define PUTC(c) \ - *next++=(c) - -#define PUTS(s) \ - strcpy(next,s); \ - next+=strlen(next) - -#define PUTInt(optc,i) \ - sprintf(next,"-%c%d",optc,i); \ - next+=strlen(next) - -#define PUTStr(c,s) \ - next=PUTStr_aux(next,c,s) - -static String local PUTStr_aux ( String,Char, String)); - -static String local PUTStr_aux(next,c,s) -String next; -Char c; -String s; { - if (s) { - String t = 0; - sprintf(next,"-%c\"",c); - next+=strlen(next); - for(t=s; *t; ++t) { - PUTS(unlexChar(*t,'"')); - } - next+=strlen(next); - PUTS("\" "); - } - return next; -} - -static String local optionsToStr() { /* convert options to string */ - static char buffer[2000]; - String next = buffer; - - Int i; - for (i=0; toggle[i].c; ++i) { - PUTC(*toggle[i].flag ? '+' : '-'); - PUTC(toggle[i].c); - PUTC(' '); - } - PUTS(haskell98 ? "+98 " : "-98 "); - PUTInt('h',hpSize); PUTC(' '); - PUTStr('p',prompt); - PUTStr('r',repeatStr); - PUTStr('P',hugsPath); - PUTStr('E',hugsEdit); - PUTInt('c',cutoff); PUTC(' '); -#if USE_PREPROCESSOR && (defined(HAVE_POPEN) || defined(HAVE__POPEN)) - PUTStr('F',preprocessor); -#endif - PUTC('\0'); - return buffer; -} -#endif /* USE_REGISTRY */ - #undef PUTC #undef PUTS #undef PUTInt @@ -497,7 +451,8 @@ String s; { /* return FALSE if none found. */ return TRUE; #endif - case 'h' : setHeapSize(s+1); + case 'h' : /* don't do anything, since pre-scan of args + will have got it already */ return TRUE; case 'c' : /* don't do anything, since pre-scan of args @@ -539,11 +494,7 @@ String s; { hpSize = MAXIMUMHEAP; if (initDone && hpSize != heapSize) { /* ToDo: should this use a message box in winhugs? */ -#if USE_REGISTRY - FPrintf(stderr,"Change to heap size will not take effect until you rerun Hugs\n"); -#else FPrintf(stderr,"You cannot change heap size from inside Hugs\n"); -#endif } else { heapSize = hpSize; } @@ -705,12 +656,9 @@ static Void local set() { /* change command line options from*/ do { if (!processOption(s)) { ERRMSG(0) "Option string must begin with `+' or `-'" - EEND; + EEND_NO_LONGJMP; } } while ((s=readFilename())!=0); -#if USE_REGISTRY - writeRegString("Options", optionsToStr()); -#endif } else optionInfo(); @@ -724,7 +672,7 @@ static Void local changeDir() { /* change directory */ String s = readFilename(); if (s && chdir(s)) { ERRMSG(0) "Unable to change to directory \"%s\"", s - EEND; + EEND_NO_LONGJMP; } } @@ -942,9 +890,8 @@ static void mgFromList ( List /* of CONID */ modgList ) usesT = cons(textOf(hd(u)),usesT); /* artificially give all modules a dependency on Prelude */ - if (mT != textPrelude && mT != textPrimPrel) + if (mT != textPrelude && mT != textPrelPrim) usesT = cons(textPrelude,usesT); - adjList = cons(pair(mT,usesT),adjList); } @@ -1081,23 +1028,23 @@ static void processModule ( Module m ) addUnqualImport(zfst(te2),zsnd(te2)); break; case M_TYCON: - tyconDefn(zsel14(te2),zsel24(te2),zsel34(te2),zsel44(te2)); + tyconDefn(intOf(zsel14(te2)),zsel24(te2),zsel34(te2),zsel44(te2)); break; case M_CLASS: - classDefn(zsel14(te2),zsel24(te2),zsel34(te2),zsel44(te2)); + classDefn(intOf(zsel14(te2)),zsel24(te2),zsel34(te2),zsel44(te2)); break; case M_INST: - instDefn(zfst3(te2),zsnd3(te2),zthd3(te2)); + instDefn(intOf(zfst3(te2)),zsnd3(te2),zthd3(te2)); break; case M_DEFAULT: - defaultDefn(zfst(te2),zsnd(te2)); + defaultDefn(intOf(zfst(te2)),zsnd(te2)); break; case M_FOREIGN_IM: - foreignImport(zsel15(te2),zsel25(te2),zsel35(te2), + foreignImport(intOf(zsel15(te2)),zsel25(te2),zsel35(te2), zsel45(te2),zsel55(te2)); break; case M_FOREIGN_EX: - foreignExport(zsel15(te2),zsel25(te2),zsel35(te2), + foreignExport(intOf(zsel15(te2)),zsel25(te2),zsel35(te2), zsel45(te2),zsel55(te2)); case M_VALUE: valDefns = cons(te2,valDefns); @@ -1168,7 +1115,6 @@ static Module parseModuleOrInterface ( ConId mc, Cell modeRequest ) internal("parseModuleOrInterface"); } - /* Actually do the parsing. */ if (useSource) { module(mod).srcExt = findText(sExt); @@ -1220,8 +1166,12 @@ static void tryLoadGroup ( Cell grp ) assert(nonNull(m)); if (module(m).mode == FM_SOURCE) { processModule ( m ); + module(m).tree = NIL; } else { processInterfaces ( singleton(snd(grp)) ); + m = findModule(textOf(snd(grp))); + assert(nonNull(m)); + module(m).tree = NIL; } break; case GRP_REC: @@ -1235,6 +1185,11 @@ static void tryLoadGroup ( Cell grp ) } } processInterfaces ( snd(grp) ); + for (t = snd(grp); nonNull(t); t=tl(t)) { + m = findModule(textOf(hd(t))); + assert(nonNull(m)); + module(m).tree = NIL; + } break; default: internal("tryLoadGroup"); @@ -1576,26 +1531,56 @@ static Bool loadThePrelude ( void ) } +/* Refresh the current target modules, and attempt to set the + current module to what it was before (ie currentModule): + if currentModule_failed is different from currentModule, + use that instead + if nextCurrMod is non null, try to set it to that instead + if the one we're after insn't available, select a target + from the end of the module group list. +*/ static void refreshActions ( ConId nextCurrMod, Bool cleanAfter ) { List t; - ConId tryFor = mkCon(module(currentModule).text); + ConId tryFor; + + /* Remember what the old current module was. */ + tryFor = mkCon(module(currentModule).text); + + /* Do the Real Work. */ achieveTargetModules(FALSE); + + /* Remember if the current module was invalidated by this + refresh, so later refreshes can attempt to reload it. */ + if (!elemMG(tryFor)) + currentModule_failed = tryFor; + + /* If a previous refresh failed to get an old current module, + try for that instead. */ + if (nonNull(currentModule_failed) + && textOf(currentModule_failed) != textOf(tryFor) + && elemMG(currentModule_failed)) + tryFor = currentModule_failed; + /* If our caller specified a new current module, that overrides + all historical settings. */ if (nonNull(nextCurrMod)) tryFor = nextCurrMod; + /* Finally, if we can't actually get hold of whatever it was we + were after, select something which is possible. */ if (!elemMG(tryFor)) tryFor = selectLatestMG(); + /* combined mode kludge, to get Prelude rather than PrelHugs */ if (combined && textOf(tryFor)==findText("PrelHugs")) tryFor = mkCon(findText("Prelude")); if (cleanAfter) { - /* delete any targetModules which didn't actually get loaded */ - t = targetModules; - targetModules = NIL; - for (; nonNull(t); t=tl(t)) - if (elemMG(hd(t))) - targetModules = cons(hd(t),targetModules); + /* delete any targetModules which didn't actually get loaded */ + t = targetModules; + targetModules = NIL; + for (; nonNull(t); t=tl(t)) + if (elemMG(hd(t))) + targetModules = cons(hd(t),targetModules); } setCurrModule ( findModule(textOf(tryFor)) ); @@ -1778,6 +1763,7 @@ static Void local evaluator() { /* evaluate expr and print value */ bd = type; if (whatIs(bd)==QUAL) { + clearCurrentFile(); ERRMSG(0) "Unresolved overloading" ETHEN ERRTEXT "\n*** Type : " ETHEN ERRTYPE(type); ERRTEXT "\n*** Expression : " ETHEN ERREXPR(inputExpr); @@ -1794,6 +1780,7 @@ static Void local evaluator() { /* evaluate expr and print value */ } else { Cell d = provePred(ks,NIL,ap(classShow,bd)); if (isNull(d)) { + clearCurrentFile(); ERRMSG(0) "Cannot find \"show\" function for:" ETHEN ERRTEXT "\n*** expression : " ETHEN ERREXPR(inputExpr); ERRTEXT "\n*** of type : " ETHEN ERRTYPE(type); @@ -2317,6 +2304,7 @@ static Void local listNames() { /* list names matching optional pat*/ names = addNamesMatching((String)0,names); } if (isNull(names)) { /* Then print them out */ + clearCurrentFile(); ERRMSG(0) "No names selected" EEND_NO_LONGJMP; return; @@ -2380,7 +2368,6 @@ String argv[]; { modConIds = initialize(argc,argv); /* the initial modules to load */ setBreakAction ( HugsIgnoreBreak ); prelOK = loadThePrelude(); - if (combined) everybody(POSTPREL); if (!prelOK) { if (autoMain) @@ -2390,6 +2377,7 @@ String argv[]; { exit(1); } + if (combined) everybody(POSTPREL); loadActions(modConIds); if (autoMain) { @@ -2803,10 +2791,13 @@ Int what; { /* system to respond as appropriate ... */ compiler(what); codegen(what); - mark(moduleGraph); - mark(prelModules); - mark(targetModules); - mark(daSccs); + if (what == MARK) { + mark(moduleGraph); + mark(prelModules); + mark(targetModules); + mark(daSccs); + mark(currentModule_failed); + } } /*-------------------------------------------------------------------------*/