ghc/interpreter/hugs.c

   1
   2 /* --------------------------------------------------------------------------
   3  * Command interpreter
   4  *
   5  * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
   6  * Yale Haskell Group, and the Oregon Graduate Institute of Science and
   7  * Technology, 1994-1999, All rights reserved.  It is distributed as
   8  * free software under the license in the file "License", which is
   9  * included in the distribution.
  10  *
  11  * $RCSfile: hugs.c,v $
  12  * $Revision: 1.67 $
  13  * $Date: 2000/04/17 11:39:23 $
  14  * ------------------------------------------------------------------------*/
  15
  16 #include <setjmp.h>
  17 #include <ctype.h>
  18 #include <stdio.h>
  19
  20 #include "hugsbasictypes.h"
  21 #include "storage.h"
  22 #include "connect.h"
  23 #include "errors.h"
  24 #include "version.h"
  25
  26 #include "Rts.h"
  27 #include "RtsAPI.h"
  28 #include "Schedule.h"
  29 #include "Assembler.h"                                /* DEBUG_LoadSymbols */
  30
  31 Bool haskell98 = TRUE;                  /* TRUE => Haskell 98 compatibility*/
  32 Bool initDone = FALSE;
  33
  34 #if EXPLAIN_INSTANCE_RESOLUTION
  35 Bool showInstRes = FALSE;
  36 #endif
  37 #if MULTI_INST
  38 Bool multiInstRes = FALSE;
  39 #endif
  40
  41 /* --------------------------------------------------------------------------
  42  * Local function prototypes:
  43  * ------------------------------------------------------------------------*/
  44
  45 static List   local initialize        ( Int,String [] );
  46 static Void   local promptForInput    ( String );
  47 static Void   local interpreter       ( Int,String [] );
  48 static Void   local menu              ( Void );
  49 static Void   local guidance          ( Void );
  50 static Void   local forHelp           ( Void );
  51 static Void   local set               ( Void );
  52 static Void   local changeDir         ( Void );
  53 static Void   local load              ( Void );
  54 static Void   local project           ( Void );
  55 static Void   local editor            ( Void );
  56 static Void   local find              ( Void );
  57 static Bool   local startEdit         ( Int,String );
  58 static Void   local runEditor         ( Void );
  59 static Void   local setModule         ( Void );
  60 static Void   local evaluator         ( Void );
  61 static Void   local stopAnyPrinting   ( Void );
  62 static Void   local showtype          ( Void );
  63 static String local objToStr          ( Module, Cell );
  64 static Void   local info              ( Void );
  65 static Void   local printSyntax       ( Name );
  66 static Void   local showInst          ( Inst );
  67 static Void   local describe          ( Text );
  68 static Void   local listNames         ( Void );
  69
  70 static Void   local toggleSet         ( Char,Bool );
  71 static Void   local togglesIn         ( Bool );
  72 static Void   local optionInfo        ( Void );
  73 static Void   local readOptions       ( String );
  74 static Bool   local processOption     ( String );
  75 static Void   local setHeapSize       ( String );
  76 static Int    local argToInt          ( String );
  77
  78 static Void   local setLastEdit       ( String,Int );
  79 static Void   local failed            ( Void );
  80 static String local strCopy           ( String );
  81 static Void   local browseit          ( Module,String,Bool );
  82 static Void   local browse            ( Void );
  83 static void   local clearCurrentFile  ( void );
  84
  85
  86 /* --------------------------------------------------------------------------
  87  * Machine dependent code for Hugs interpreter:
  88  * ------------------------------------------------------------------------*/
  89
  90 #include "machdep.c"
  91
  92 /* --------------------------------------------------------------------------
  93  * Local data areas:
  94  * ------------------------------------------------------------------------*/
  95
  96 static Bool   printing      = FALSE;    /* TRUE => currently printing value*/
  97 static Bool   showStats     = FALSE;    /* TRUE => print stats after eval  */
  98 static Bool   listScripts   = TRUE;   /* TRUE => list scripts after loading*/
  99 static Bool   addType       = FALSE;    /* TRUE => print type with value   */
 100 static Bool   useDots       = RISCOS;   /* TRUE => use dots in progress    */
 101 static Bool   quiet         = FALSE;    /* TRUE => don't show progress     */
 102 static Bool   lastWasObject = FALSE;
 103
 104        Bool   flagAssert    = FALSE;    /* TRUE => assert False <e> causes
 105                                                    an assertion failure    */
 106        Bool   preludeLoaded = FALSE;
 107        Bool   debugSC       = FALSE;
 108        Bool   combined      = FALSE;
 109
 110        Module moduleBeingParsed;        /* so the parser (topModule) knows */
 111 static char*  currentFile;              /* Name of current file, or NULL   */
 112 static char   currentFileName[1000];    /* name is stored here if it exists*/
 113
 114 static Bool   autoMain   = FALSE;
 115 static String lastEdit   = 0;           /* Name of script to edit (if any) */
 116 static Int    lastEdLine = 0;           /* Editor line number (if possible)*/
 117 static String prompt     = 0;           /* Prompt string                   */
 118 static Int    hpSize     = DEFAULTHEAP; /* Desired heap size               */
 119 static Bool   disableOutput = FALSE;    /* TRUE => quiet                   */
 120        String hugsEdit   = 0;           /* String for editor command       */
 121        String hugsPath   = 0;           /* String for file search path     */
 122
 123        List  ifaces_outstanding = NIL;
 124
 125 static ConId currentModule_failed = NIL; /* Remember failed module from :r */
 126
 127
 128
 129 /* --------------------------------------------------------------------------
 130  * Hugs entry point:
 131  * ------------------------------------------------------------------------*/
 132
 133 #ifndef NO_MAIN /* we omit main when building the "Hugs server" */
 134
 135 Main main ( Int, String [] );       /* now every func has a prototype  */
 136
 137 Main main(argc,argv)
 138 int  argc;
 139 char *argv[]; {
 140 #ifdef HAVE_CONSOLE_H /* Macintosh port */
 141     _ftype = 'TEXT';
 142     _fcreator = 'R*ch';       /*  // 'KAHL';      //'*TEX';       //'ttxt'; */
 143
 144     console_options.top = 50;
 145     console_options.left = 20;
 146
 147     console_options.nrows = 32;
 148     console_options.ncols = 80;
 149
 150     console_options.pause_atexit = 1;
 151     console_options.title = "\pHugs";
 152
 153     console_options.procID = 5;
 154     argc = ccommand(&argv);
 155 #endif
 156
 157     CStackBase = &argc;                 /* Save stack base for use in gc   */
 158
 159 #ifdef DEBUG
 160 #if 0
 161     checkBytecodeCount();               /* check for too many bytecodes    */
 162 #endif
 163 #endif
 164
 165     /* If first arg is +Q or -Q, be entirely silent, and automatically run
 166        main after loading scripts.  Useful for running the nofib suite.    */
 167     if (argc > 1 && (strcmp(argv[1],"+Q") == 0 || strcmp(argv[1],"-Q")==0)) {
 168        autoMain = TRUE;
 169        if (strcmp(argv[1],"-Q") == 0) {
 170          EnableOutput(0);
 171        }
 172     }
 173
 174     Printf("__   __ __  __  ____   ___      _________________________________________\n");
 175     Printf("||   || ||  || ||  || ||__      STGHugs: Based on the Haskell 98 standard\n");
 176     Printf("||___|| ||__|| ||__||  __||     Copyright (c) 1994-1999\n");
 177     Printf("||---||         ___||           World Wide Web: http://haskell.org/hugs\n");
 178     Printf("||   ||                         Report bugs to: hugs-bugs@haskell.org\n");
 179     Printf("||   || Version: %s _________________________________________\n\n",HUGS_VERSION);
 180
 181     /* Get the absolute path to the directory containing the hugs
 182        executable, so that we know where the Prelude and nHandle.so/.dll are.
 183        We do this by reading env var STGHUGSDIR.  This needs to succeed, so
 184        setInstallDir won't return unless it succeeds.
 185     */
 186     setInstallDir ( argv[0] );
 187
 188 #if SYMANTEC_C
 189     Printf("   Ported to Macintosh by Hans Aberg, compiled " __DATE__ ".\n\n");
 190 #endif
 191     FlushStdout();
 192     interpreter(argc,argv);
 193     Printf("[Leaving Hugs]\n");
 194     everybody(EXIT);
 195     shutdownHaskell();
 196     FlushStdout();
 197     fflush(stderr);
 198     exit(0);
 199     MainDone();
 200 }
 201
 202 #endif
 203
 204 /* --------------------------------------------------------------------------
 205  * Initialization, interpret command line args and read prelude:
 206  * ------------------------------------------------------------------------*/
 207
 208 static List /*CONID*/ initialize ( Int argc, String argv[] )
 209 {
 210    Int    i, j;
 211    List   initialModules;
 212
 213    setLastEdit((String)0,0);
 214    lastEdit      = 0;
 215    currentFile   = NULL;
 216
 217 #if SYMANTEC_C
 218    hugsEdit      = "";
 219 #else
 220    hugsEdit      = strCopy(fromEnv("EDITOR",NULL));
 221 #endif
 222    hugsPath      = strCopy(HUGSPATH);
 223    readOptions("-p\"%s> \" -r$$");
 224    readOptions(fromEnv("STGHUGSFLAGS",""));
 225
 226 #  if DEBUG
 227    {
 228       char exe_name[N_INSTALLDIR + 6];
 229       strcpy(exe_name, installDir);
 230       strcat(exe_name, "hugs");
 231       DEBUG_LoadSymbols(exe_name);
 232    }
 233 #  endif
 234
 235    /* startupHaskell extracts args between +RTS ... -RTS, and sets
 236       prog_argc/prog_argv to the rest.  We want to further process
 237       the rest, so we then get hold of them again.
 238    */
 239    startupHaskell ( argc, argv, NULL );
 240    getProgArgv ( &argc, &argv );
 241
 242    /* Find out early on if we're in combined mode or not.
 243       everybody(PREPREL) needs to know this.  Also, establish the
 244       heap size;
 245    */
 246    for (i = 1; i < argc; ++i) {
 247       if (strcmp(argv[i], "--")==0) break;
 248       if (strcmp(argv[i], "-c")==0) combined = FALSE;
 249       if (strcmp(argv[i], "+c")==0) combined = TRUE;
 250
 251       if (strncmp(argv[i],"+h",2)==0 || strncmp(argv[i],"-h",2)==0)
 252          setHeapSize(&(argv[i][2]));
 253    }
 254
 255    everybody(PREPREL);
 256    initialModules = NIL;
 257
 258    for (i = 1; i < argc; ++i) {          /* process command line arguments  */
 259       if (strcmp(argv[i], "--")==0)
 260          { argv[i] = NULL; break; }
 261       if (argv[i] && argv[i][0]/* workaround for /bin/sh silliness*/) {
 262          if (!processOption(argv[i]))
 263             initialModules
 264                = cons ( mkCon(findText(argv[i])), initialModules );
 265          argv[i] = NULL;
 266       }
 267    }
 268
 269    if (haskell98) {
 270        Printf("Haskell 98 mode: Restart with command line option -98"
 271               " to enable extensions\n");
 272    } else {
 273        Printf("Hugs mode: Restart with command line option +98 for"
 274               " Haskell 98 mode\n");
 275    }
 276
 277    if (combined) {
 278        Printf("Combined mode: Restart with command line -c for"
 279               " standalone mode\n\n" );
 280    } else {
 281        Printf("Standalone mode: Restart with command line +c for"
 282               " combined mode\n\n" );
 283    }
 284
 285    /* slide args back over the deleted ones. */
 286    j = 1;
 287    for (i = 1; i < argc; i++)
 288       if (argv[i])
 289          argv[j++] = argv[i];
 290
 291    argc = j;
 292
 293    setProgArgv ( argc, argv );
 294
 295    initDone = TRUE;
 296    return initialModules;
 297 }
 298
 299 /* --------------------------------------------------------------------------
 300  * Command line options:
 301  * ------------------------------------------------------------------------*/
 302
 303 struct options {                        /* command line option toggles     */
 304     char   c;                           /* table defined in main app.      */
 305     int    h98;
 306     String description;
 307     Bool   *flag;
 308 };
 309 extern struct options toggle[];
 310
 311 static Void local toggleSet(c,state)    /* Set command line toggle         */
 312 Char c;
 313 Bool state; {
 314     Int i;
 315     for (i=0; toggle[i].c; ++i)
 316         if (toggle[i].c == c) {
 317             *toggle[i].flag = state;
 318             return;
 319         }
 320     clearCurrentFile();
 321     ERRMSG(0) "Unknown toggle `%c'", c
 322     EEND_NO_LONGJMP;
 323 }
 324
 325 static Void local togglesIn(state)      /* Print current list of toggles in*/
 326 Bool state; {                           /* given state                     */
 327     Int count = 0;
 328     Int i;
 329     for (i=0; toggle[i].c; ++i)
 330         if (*toggle[i].flag == state && (!haskell98 || toggle[i].h98)) {
 331             if (count==0)
 332                 Putchar((char)(state ? '+' : '-'));
 333             Putchar(toggle[i].c);
 334             count++;
 335         }
 336     if (count>0)
 337         Putchar(' ');
 338 }
 339
 340 static Void local optionInfo() {        /* Print information about command */
 341     static String fmts = "%-5s%s\n";    /* line settings                   */
 342     static String fmtc = "%-5c%s\n";
 343     Int    i;
 344
 345     Printf("TOGGLES: groups begin with +/- to turn options on/off resp.\n");
 346     for (i=0; toggle[i].c; ++i) {
 347         if (!haskell98 || toggle[i].h98) {
 348             Printf(fmtc,toggle[i].c,toggle[i].description);
 349         }
 350     }
 351
 352     Printf("\nOTHER OPTIONS: (leading + or - makes no difference)\n");
 353     Printf(fmts,"hnum","Set heap size (cannot be changed within Hugs)");
 354     Printf(fmts,"pstr","Set prompt string to str");
 355     Printf(fmts,"rstr","Set repeat last expression string to str");
 356     Printf(fmts,"Pstr","Set search path for modules to str");
 357     Printf(fmts,"Estr","Use editor setting given by str");
 358     Printf(fmts,"cnum","Set constraint cutoff limit");
 359 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 360     Printf(fmts,"Fstr","Set preprocessor filter to str");
 361 #endif
 362
 363     Printf("\nCurrent settings: ");
 364     togglesIn(TRUE);
 365     togglesIn(FALSE);
 366     Printf("-h%d",heapSize);
 367     Printf(" -p");
 368     printString(prompt);
 369     Printf(" -r");
 370     printString(repeatStr);
 371     Printf(" -c%d",cutoff);
 372     Printf("\nSearch path     : -P");
 373     printString(hugsPath);
 374 #if 0
 375 ToDo
 376     if (projectPath!=NULL) {
 377         Printf("\nProject Path    : %s",projectPath);
 378     }
 379 #endif
 380     Printf("\nEditor setting  : -E");
 381     printString(hugsEdit);
 382 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 383     Printf("\nPreprocessor    : -F");
 384     printString(preprocessor);
 385 #endif
 386     Printf("\nCompatibility   : %s", haskell98 ? "Haskell 98 (+98)"
 387                                                : "Hugs Extensions (-98)");
 388     Putchar('\n');
 389 }
 390
 391 #undef PUTC
 392 #undef PUTS
 393 #undef PUTInt
 394 #undef PUTStr
 395
 396 static Void local readOptions(options)         /* read options from string */
 397 String options; {
 398     String s;
 399     if (options) {
 400         stringInput(options);
 401         while ((s=readFilename())!=0) {
 402             if (*s && !processOption(s)) {
 403                 ERRMSG(0) "Option string must begin with `+' or `-'"
 404                 EEND;
 405             }
 406         }
 407     }
 408 }
 409
 410 static Bool local processOption(s)      /* process string s for options,   */
 411 String s; {                             /* return FALSE if none found.     */
 412     Bool state;
 413
 414     if (s[0]=='-')
 415         state = FALSE;
 416     else if (s[0]=='+')
 417         state = TRUE;
 418     else
 419         return FALSE;
 420
 421     while (*++s)
 422         switch (*s) {
 423             case 'Q' : break;                           /* already handled */
 424
 425             case 'p' : if (s[1]) {
 426                            if (prompt) free(prompt);
 427                            prompt = strCopy(s+1);
 428                        }
 429                        return TRUE;
 430
 431             case 'r' : if (s[1]) {
 432                            if (repeatStr) free(repeatStr);
 433                            repeatStr = strCopy(s+1);
 434                        }
 435                        return TRUE;
 436
 437             case 'P' : {
 438                            String p = substPath(s+1,hugsPath ? hugsPath : "");
 439                            if (hugsPath) free(hugsPath);
 440                            hugsPath = p;
 441                            return TRUE;
 442                        }
 443
 444             case 'E' : if (hugsEdit) free(hugsEdit);
 445                        hugsEdit = strCopy(s+1);
 446                        return TRUE;
 447
 448 #if USE_PREPROCESSOR  && (defined(HAVE_POPEN) || defined(HAVE__POPEN))
 449             case 'F' : if (preprocessor) free(preprocessor);
 450                        preprocessor = strCopy(s+1);
 451                        return TRUE;
 452 #endif
 453
 454             case 'h' : /* don't do anything, since pre-scan of args
 455                        will have got it already */
 456                        return TRUE;
 457
 458             case 'c' :  /* don't do anything, since pre-scan of args
 459                            will have got it already */
 460                        return TRUE;
 461
 462             case 'D' : /* hack */
 463                 {
 464                     extern void setRtsFlags( int x );
 465                     setRtsFlags(argToInt(s+1));
 466                     return TRUE;
 467                 }
 468
 469             default  : if (strcmp("98",s)==0) {
 470                            if (initDone && ((state && !haskell98) ||
 471                                                (!state && haskell98))) {
 472                                FPrintf(stderr,
 473                                        "Haskell 98 compatibility cannot be changed"
 474                                        " while the interpreter is running\n");
 475                            } else {
 476                                haskell98 = state;
 477                            }
 478                            return TRUE;
 479                        } else {
 480                            toggleSet(*s,state);
 481                        }
 482                        break;
 483         }
 484     return TRUE;
 485 }
 486
 487 static Void local setHeapSize(s)
 488 String s; {
 489     if (s) {
 490         hpSize = argToInt(s);
 491         if (hpSize < MINIMUMHEAP)
 492             hpSize = MINIMUMHEAP;
 493         else if (MAXIMUMHEAP && hpSize > MAXIMUMHEAP)
 494             hpSize = MAXIMUMHEAP;
 495         if (initDone && hpSize != heapSize) {
 496             /* ToDo: should this use a message box in winhugs? */
 497             FPrintf(stderr,"You cannot change heap size from inside Hugs\n");
 498         } else {
 499             heapSize = hpSize;
 500         }
 501     }
 502 }
 503
 504 static Int local argToInt(s)            /* read integer from argument str  */
 505 String s; {
 506     Int    n = 0;
 507     String t = s;
 508
 509     if (*s=='\0' || !isascii((int)(*s)) || !isdigit((int)(*s))) {
 510         ERRMSG(0) "Missing integer in option setting \"%s\"", t
 511         EEND;
 512     }
 513
 514     do {
 515         Int d = (*s++) - '0';
 516         if (n > ((MAXPOSINT - d)/10)) {
 517             ERRMSG(0) "Option setting \"%s\" is too large", t
 518             EEND;
 519         }
 520         n     = 10*n + d;
 521     } while (isascii((int)(*s)) && isdigit((int)(*s)));
 522
 523     if (*s=='K' || *s=='k') {
 524         if (n > (MAXPOSINT/1000)) {
 525             ERRMSG(0) "Option setting \"%s\" is too large", t
 526             EEND;
 527         }
 528         n *= 1000;
 529         s++;
 530     }
 531
 532 #if MAXPOSINT > 1000000                 /* waste of time on 16 bit systems */
 533     if (*s=='M' || *s=='m') {
 534         if (n > (MAXPOSINT/1000000)) {
 535             ERRMSG(0) "Option setting \"%s\" is too large", t
 536             EEND;
 537         }
 538         n *= 1000000;
 539         s++;
 540     }
 541 #endif
 542
 543 #if MAXPOSINT > 1000000000
 544     if (*s=='G' || *s=='g') {
 545         if (n > (MAXPOSINT/1000000000)) {
 546             ERRMSG(0) "Option setting \"%s\" is too large", t
 547             EEND;
 548         }
 549         n *= 1000000000;
 550         s++;
 551     }
 552 #endif
 553
 554     if (*s!='\0') {
 555         ERRMSG(0) "Unwanted characters after option setting \"%s\"", t
 556         EEND;
 557     }
 558
 559     return n;
 560 }
 561
 562 /* --------------------------------------------------------------------------
 563  * Print Menu of list of commands:
 564  * ------------------------------------------------------------------------*/
 565
 566 static struct cmd cmds[] = {
 567  {":?",      HELP},   {":cd",   CHGDIR},  {":also",    ALSO},
 568  {":type",   TYPEOF}, {":!",    SYSTEM},  {":load",    LOAD},
 569  {":reload", RELOAD}, {":gc",   COLLECT}, {":edit",    EDIT},
 570  {":quit",   QUIT},   {":set",  SET},     {":find",    FIND},
 571  {":names",  NAMES},  {":info", INFO},    {":project", PROJECT},
 572  {":dump",   DUMP},   {":ztats", STATS},
 573  {":module",SETMODULE},
 574  {":browse", BROWSE},
 575 #if EXPLAIN_INSTANCE_RESOLUTION
 576  {":xplain", XPLAIN},
 577 #endif
 578  {":version", PNTVER},
 579  {"",      EVAL},
 580  {0,0}
 581 };
 582
 583 static Void local menu() {
 584     Printf("LIST OF COMMANDS:  Any command may be abbreviated to :c where\n");
 585     Printf("c is the first character in the full name.\n\n");
 586     Printf(":load <filenames>   load modules from specified files\n");
 587     Printf(":load               clear all files except prelude\n");
 588     Printf(":also <filenames>   read additional modules\n");
 589     Printf(":reload             repeat last load command\n");
 590     Printf(":project <filename> use project file\n");
 591     Printf(":edit <filename>    edit file\n");
 592     Printf(":edit               edit last module\n");
 593     Printf(":module <module>    set module for evaluating expressions\n");
 594     Printf("<expr>              evaluate expression\n");
 595     Printf(":type <expr>        print type of expression\n");
 596     Printf(":?                  display this list of commands\n");
 597     Printf(":set <options>      set command line options\n");
 598     Printf(":set                help on command line options\n");
 599     Printf(":names [pat]        list names currently in scope\n");
 600     Printf(":info <names>       describe named objects\n");
 601     Printf(":browse <modules>   browse names defined in <modules>\n");
 602 #if EXPLAIN_INSTANCE_RESOLUTION
 603     Printf(":xplain <context>   explain instance resolution for <context>\n");
 604 #endif
 605     Printf(":find <name>        edit module containing definition of name\n");
 606     Printf(":!command           shell escape\n");
 607     Printf(":cd dir             change directory\n");
 608     Printf(":gc                 force garbage collection\n");
 609     Printf(":version            print Hugs version\n");
 610     Printf(":dump <name>        print STG code for named fn\n");
 611 #ifdef CRUDE_PROFILING
 612     Printf(":ztats <name>       print reduction stats\n");
 613 #endif
 614     Printf(":quit               exit Hugs interpreter\n");
 615 }
 616
 617 static Void local guidance() {
 618     Printf("Command not recognised.  ");
 619     forHelp();
 620 }
 621
 622 static Void local forHelp() {
 623     Printf("Type :? for help\n");
 624 }
 625
 626 /* --------------------------------------------------------------------------
 627  * Setting of command line options:
 628  * ------------------------------------------------------------------------*/
 629
 630 struct options toggle[] = {             /* List of command line toggles    */
 631     {'s', 1, "Print no. reductions/cells after eval", &showStats},
 632     {'t', 1, "Print type after evaluation",           &addType},
 633     {'g', 1, "Print no. cells recovered after gc",    &gcMessages},
 634     {'l', 1, "Literate modules as default",           &literateScripts},
 635     {'e', 1, "Warn about errors in literate modules", &literateErrors},
 636     {'.', 1, "Print dots to show progress",           &useDots},
 637     {'q', 1, "Print nothing to show progress",        &quiet},
 638     {'w', 1, "Always show which modules are loaded",  &listScripts},
 639     {'k', 1, "Show kind errors in full",              &kindExpert},
 640     {'o', 0, "Allow overlapping instances",           &allowOverlap},
 641     {'S', 1, "Debug: show generated SC code",         &debugSC},
 642     {'a', 1, "Raise exception on assert failure",     &flagAssert},
 643 #if EXPLAIN_INSTANCE_RESOLUTION
 644     {'x', 1, "Explain instance resolution",           &showInstRes},
 645 #endif
 646 #if MULTI_INST
 647     {'m', 0, "Use multi instance resolution",         &multiInstRes},
 648 #endif
 649     {0,   0, 0,                                       0}
 650 };
 651
 652 static Void local set() {               /* change command line options from*/
 653     String s;                           /* Hugs command line               */
 654
 655     if ((s=readFilename())!=0) {
 656         do {
 657             if (!processOption(s)) {
 658                 ERRMSG(0) "Option string must begin with `+' or `-'"
 659                 EEND_NO_LONGJMP;
 660             }
 661         } while ((s=readFilename())!=0);
 662     }
 663     else
 664         optionInfo();
 665 }
 666
 667 /* --------------------------------------------------------------------------
 668  * Change directory command:
 669  * ------------------------------------------------------------------------*/
 670
 671 static Void local changeDir() {         /* change directory                */
 672     String s = readFilename();
 673     if (s && chdir(s)) {
 674         ERRMSG(0) "Unable to change to directory \"%s\"", s
 675         EEND_NO_LONGJMP;
 676     }
 677 }
 678
 679
 680 /* --------------------------------------------------------------------------
 681  * Interrupt handling
 682  * ------------------------------------------------------------------------*/
 683
 684 static jmp_buf catch_error;             /* jump buffer for error trapping  */
 685
 686 HugsBreakAction currentBreakAction = HugsIgnoreBreak;
 687
 688 static void handler_IgnoreBreak ( int sig )
 689 {
 690    setHandler ( handler_IgnoreBreak );
 691 }
 692
 693 static void handler_LongjmpOnBreak ( int sig )
 694 {
 695    setHandler ( handler_LongjmpOnBreak );
 696    Printf("{Interrupted!}\n");
 697    longjmp(catch_error,1);
 698 }
 699
 700 static void handler_RtsInterrupt ( int sig )
 701 {
 702    setHandler ( handler_RtsInterrupt );
 703    interruptStgRts();
 704 }
 705
 706 HugsBreakAction setBreakAction ( HugsBreakAction newAction )
 707 {
 708    HugsBreakAction tmp = currentBreakAction;
 709    currentBreakAction = newAction;
 710    switch (newAction) {
 711       case HugsIgnoreBreak:
 712          setHandler ( handler_IgnoreBreak ); break;
 713       case HugsLongjmpOnBreak:
 714          setHandler ( handler_LongjmpOnBreak ); break;
 715       case HugsRtsInterrupt:
 716          setHandler ( handler_RtsInterrupt ); break;
 717       default:
 718          internal("setBreakAction");
 719    }
 720    return tmp;
 721 }
 722
 723
 724 /* --------------------------------------------------------------------------
 725  * The new module chaser, loader, etc
 726  * ------------------------------------------------------------------------*/
 727
 728 List    moduleGraph   = NIL;
 729 List    prelModules   = NIL;
 730 List    targetModules = NIL;
 731
 732 static String modeToString ( Cell mode )
 733 {
 734    switch (mode) {
 735       case FM_SOURCE: return "source";
 736       case FM_OBJECT: return "object";
 737       case FM_EITHER: return "source or object";
 738       default: internal("modeToString");
 739    }
 740 }
 741
 742 static Cell childMode ( Cell modeMeRequest, Cell modeMeActual )
 743 {
 744    assert(modeMeActual == FM_SOURCE ||
 745           modeMeActual == FM_OBJECT);
 746    assert(modeMeRequest == FM_SOURCE ||
 747           modeMeRequest == FM_OBJECT ||
 748           modeMeRequest == FM_EITHER);
 749    if (modeMeRequest == FM_SOURCE) return modeMeRequest;
 750    if (modeMeRequest == FM_OBJECT) return modeMeRequest;
 751    if (modeMeActual == FM_OBJECT) return FM_OBJECT;
 752    if (modeMeActual == FM_SOURCE) return FM_EITHER;
 753    internal("childMode");
 754 }
 755
 756 static Bool compatibleNewMode ( Cell modeNew, Cell modeExisting )
 757 {
 758    if (modeNew == FM_OBJECT && modeExisting == FM_OBJECT) return TRUE;
 759    if (modeNew == FM_SOURCE && modeExisting == FM_SOURCE) return TRUE;
 760    if (modeNew == FM_EITHER && modeExisting == FM_OBJECT) return TRUE;
 761    if (modeNew == FM_EITHER && modeExisting == FM_SOURCE) return TRUE;
 762    return FALSE;
 763 }
 764
 765 static void setCurrentFile ( Module mod )
 766 {
 767    assert(isModule(mod));
 768    strncpy(currentFileName, textToStr(module(mod).text), 990);
 769    strcat(currentFileName, textToStr(module(mod).srcExt));
 770    currentFile       = currentFileName;
 771    moduleBeingParsed = mod;
 772 }
 773
 774 static void clearCurrentFile ( void )
 775 {
 776    currentFile       = NULL;
 777    moduleBeingParsed = NIL;
 778 }
 779
 780 static void ppMG ( void )
 781 {
 782    List t,u,v;
 783    for (t = moduleGraph; nonNull(t); t=tl(t)) {
 784       u = hd(t);
 785       switch (whatIs(u)) {
 786          case GRP_NONREC:
 787             FPrintf ( stderr, "  %s\n", textToStr(textOf(snd(u))));
 788             break;
 789          case GRP_REC:
 790             FPrintf ( stderr, "  {" );
 791             for (v = snd(u); nonNull(v); v=tl(v))
 792                FPrintf ( stderr, "%s ", textToStr(textOf(hd(v))) );
 793             FPrintf ( stderr, "}\n" );
 794             break;
 795          default:
 796             internal("ppMG");
 797       }
 798    }
 799 }
 800
 801
 802 static Bool elemMG ( ConId mod )
 803 {
 804    List gs;
 805    for (gs = moduleGraph; nonNull(gs); gs=tl(gs))
 806      switch (whatIs(hd(gs))) {
 807         case GRP_NONREC:
 808            if (textOf(mod)==textOf(snd(hd(gs)))) return TRUE;
 809            break;
 810         case GRP_REC:
 811            if (varIsMember(textOf(mod),snd(hd(gs)))) return TRUE;
 812            break;
 813         default:
 814            internal("elemMG");
 815      }
 816   return FALSE;
 817 }
 818
 819
 820 static ConId selectArbitrarilyFromGroup ( Cell group )
 821 {
 822    switch (whatIs(group)) {
 823       case GRP_NONREC: return snd(group);
 824       case GRP_REC:    return hd(snd(group));
 825       default:         internal("selectArbitrarilyFromGroup");
 826    }
 827 }
 828
 829 static ConId selectLatestMG ( void )
 830 {
 831    List gs = moduleGraph;
 832    if (isNull(gs)) internal("selectLatestMG(1)");
 833    while (nonNull(gs) && nonNull(tl(gs))) gs = tl(gs);
 834    return selectArbitrarilyFromGroup(hd(gs));
 835 }
 836
 837
 838 static List /* of CONID */ listFromSpecifiedMG ( List mg )
 839 {
 840    List gs;
 841    List cs = NIL;
 842    for (gs = mg; nonNull(gs); gs=tl(gs)) {
 843       switch (whatIs(hd(gs))) {
 844         case GRP_REC:    cs = appendOnto(cs,snd(hd(gs))); break;
 845         case GRP_NONREC: cs = cons(snd(hd(gs)),cs); break;
 846         default:         internal("listFromSpecifiedMG");
 847       }
 848    }
 849    return cs;
 850 }
 851
 852 static List /* of CONID */ listFromMG ( void )
 853 {
 854    return listFromSpecifiedMG ( moduleGraph );
 855 }
 856
 857
 858 /* Calculate the strongly connected components of modgList
 859    and assign them to moduleGraph.  Uses the .uses field of
 860    each of the modules to build the graph structure.
 861 */
 862 #define  SCC             modScc          /* make scc algorithm for StgVars */
 863 #define  LOWLINK         modLowlink
 864 #define  DEPENDS(t)      snd(t)
 865 #define  SETDEPENDS(c,v) snd(c)=v
 866 #include "scc.c"
 867 #undef   SETDEPENDS
 868 #undef   DEPENDS
 869 #undef   LOWLINK
 870 #undef   SCC
 871
 872 static void mgFromList ( List /* of CONID */ modgList )
 873 {
 874    List   t;
 875    List   u;
 876    Text   mT;
 877    List   usesT;
 878    List   adjList; /* :: [ (Text, [Text]) ] */
 879    Module mod;
 880    List   scc;
 881    Bool   isRec;
 882
 883    adjList = NIL;
 884    for (t = modgList; nonNull(t); t=tl(t)) {
 885       mT = textOf(hd(t));
 886       mod = findModule(mT);
 887       assert(nonNull(mod));
 888       usesT = NIL;
 889       for (u = module(mod).uses; nonNull(u); u=tl(u))
 890          usesT = cons(textOf(hd(u)),usesT);
 891
 892       /* artificially give all modules a dependency on Prelude */
 893       if (mT != textPrelude && mT != textPrelPrim)
 894          usesT = cons(textPrelude,usesT);
 895       adjList = cons(pair(mT,usesT),adjList);
 896    }
 897
 898    /* adjList is now [ (module-text, [modules-which-i-import-text]) ].
 899       Modify this so that the adjacency list is a list of pointers
 900       back to bits of adjList -- that's what modScc needs.
 901    */
 902    for (t = adjList; nonNull(t); t=tl(t)) {
 903       List adj = NIL;
 904       /* for each elem of the adjacency list ... */
 905       for (u = snd(hd(t)); nonNull(u); u=tl(u)) {
 906          List v;
 907          Text a = hd(u);
 908          /* find the element of adjList whose fst is a */
 909          for (v = adjList; nonNull(v); v=tl(v)) {
 910             assert(isText(a));
 911             assert(isText(fst(hd(v))));
 912             if (fst(hd(v))==a) break;
 913          }
 914          if (isNull(v)) internal("mgFromList");
 915          adj = cons(hd(v),adj);
 916       }
 917       snd(hd(t)) = adj;
 918    }
 919
 920    adjList = modScc ( adjList );
 921    /* adjList is now [ [(module-text, aux-info-field)] ] */
 922
 923    moduleGraph = NIL;
 924
 925    for (t = adjList; nonNull(t); t=tl(t)) {
 926
 927       scc = hd(t);
 928       /* scc :: [ (module-text, aux-info-field) ] */
 929       for (u = scc; nonNull(u); u=tl(u))
 930          hd(u) = mkCon(fst(hd(u)));
 931
 932       /* scc :: [CONID] */
 933       if (length(scc) > 1) {
 934          isRec = TRUE;
 935       } else {
 936          /* singleton module in scc; does it import itself? */
 937          mod = findModule ( textOf(hd(scc)) );
 938          assert(nonNull(mod));
 939          isRec = FALSE;
 940          for (u = module(mod).uses; nonNull(u); u=tl(u))
 941             if (textOf(hd(u))==textOf(hd(scc)))
 942                isRec = TRUE;
 943       }
 944
 945       if (isRec)
 946          moduleGraph = cons( ap(GRP_REC,scc), moduleGraph ); else
 947          moduleGraph = cons( ap(GRP_NONREC,hd(scc)), moduleGraph );
 948    }
 949    moduleGraph = reverse(moduleGraph);
 950 }
 951
 952
 953 static List /* of CONID */ getModuleImports ( Cell tree )
 954 {
 955    Cell  te;
 956    List  tes;
 957    ConId use;
 958    List  uses = NIL;
 959    for (tes = zthd3(unap(M_MODULE,tree)); nonNull(tes); tes=tl(tes)) {
 960       te = hd(tes);
 961       switch(whatIs(te)) {
 962          case M_IMPORT_Q:
 963             use = zfst(unap(M_IMPORT_Q,te));
 964             assert(isCon(use));
 965             if (!varIsMember(textOf(use),uses)) uses = cons ( use, uses );
 966             break;
 967          case M_IMPORT_UNQ:
 968             use = zfst(unap(M_IMPORT_UNQ,te));
 969             assert(isCon(use));
 970             if (!varIsMember(textOf(use),uses)) uses = cons ( use, uses );
 971             break;
 972          default:
 973             break;
 974       }
 975    }
 976    return uses;
 977 }
 978
 979
 980 static void processModule ( Module m )
 981 {
 982    Cell  tree;
 983    ConId modNm;
 984    List  topEnts;
 985    List  tes;
 986    Cell  te;
 987    Cell  te2;
 988
 989    tyconDefns     = NIL;
 990    typeInDefns    = NIL;
 991    valDefns       = NIL;
 992    classDefns     = NIL;
 993    instDefns      = NIL;
 994    selDefns       = NIL;
 995    genDefns       = NIL;
 996    unqualImports  = NIL;
 997    foreignImports = NIL;
 998    foreignExports = NIL;
 999    defaultDefns   = NIL;
1000    defaultLine    = 0;
1001    inputExpr      = NIL;
1002
1003    setCurrentFile(m);
1004    startModule(m);
1005    tree = unap(M_MODULE,module(m).tree);
1006    modNm = zfst3(tree);
1007
1008    if (textOf(modNm) != module(m).text) {
1009       ERRMSG(0) "Module name \"%s\" does not match file name \"%s%s\"",
1010                 textToStr(textOf(modNm)),
1011                 textToStr(module(m).text),
1012                 textToStr(module(m).srcExt)
1013       EEND;
1014    }
1015
1016    setExportList(zsnd3(tree));
1017    topEnts = zthd3(tree);
1018
1019    for (tes = topEnts; nonNull(tes); tes=tl(tes)) {
1020       te  = hd(tes);
1021       assert(isGenPair(te));
1022       te2 = snd(te);
1023       switch(whatIs(te)) {
1024          case M_IMPORT_Q:
1025             addQualImport(zfst(te2),zsnd(te2));
1026             break;
1027          case M_IMPORT_UNQ:
1028             addUnqualImport(zfst(te2),zsnd(te2));
1029             break;
1030          case M_TYCON:
1031             tyconDefn(intOf(zsel14(te2)),zsel24(te2),zsel34(te2),zsel44(te2));
1032             break;
1033          case M_CLASS:
1034             classDefn(intOf(zsel14(te2)),zsel24(te2),zsel34(te2),zsel44(te2));
1035             break;
1036          case M_INST:
1037             instDefn(intOf(zfst3(te2)),zsnd3(te2),zthd3(te2));
1038             break;
1039          case M_DEFAULT:
1040             defaultDefn(intOf(zfst(te2)),zsnd(te2));
1041             break;
1042          case M_FOREIGN_IM:
1043             foreignImport(intOf(zsel15(te2)),zsel25(te2),zsel35(te2),
1044                           zsel45(te2),zsel55(te2));
1045             break;
1046          case M_FOREIGN_EX:
1047             foreignExport(intOf(zsel15(te2)),zsel25(te2),zsel35(te2),
1048                           zsel45(te2),zsel55(te2));
1049          case M_VALUE:
1050             valDefns = cons(te2,valDefns);
1051             break;
1052          default:
1053             internal("processModule");
1054       }
1055    }
1056    checkDefns(m);
1057    typeCheckDefns();
1058    compileDefns();
1059 }
1060
1061
1062 static Module parseModuleOrInterface ( ConId mc, Cell modeRequest )
1063 {
1064    /* Allocate a module-table entry. */
1065    /* Parse the entity and fill in the .tree and .uses entries. */
1066    String path;
1067    String sExt;
1068    Bool sAvail;  Time sTime;  Long sSize;
1069    Bool oiAvail; Time oiTime; Long oSize; Long iSize;
1070    Bool ok;
1071    Bool useSource;
1072    char name[10000];
1073
1074    Text   mt  = textOf(mc);
1075    Module mod = findModule ( mt );
1076
1077    /* fprintf ( stderr, "parseModuleOrInterface `%s' == %d\n",
1078                 textToStr(mt),mod); */
1079    if (nonNull(mod) && !module(mod).fake)
1080       internal("parseModuleOrInterface");
1081    if (nonNull(mod))
1082       module(mod).fake = FALSE;
1083
1084    if (isNull(mod))
1085       mod = newModule(mt);
1086
1087    /* This call malloc-ates path; we should deallocate it. */
1088    ok = findFilesForModule (
1089            textToStr(module(mod).text),
1090            &path,
1091            &sExt,
1092            &sAvail,  &sTime,  &sSize,
1093            &oiAvail, &oiTime, &oSize, &iSize
1094         );
1095
1096    if (!ok) goto cant_find;
1097    if (!sAvail && !oiAvail) goto cant_find;
1098
1099    /* Find out whether to use source or object. */
1100    switch (modeRequest) {
1101       case FM_SOURCE:
1102          if (!sAvail) goto cant_find;
1103          useSource = TRUE;
1104          break;
1105       case FM_OBJECT:
1106          if (!oiAvail) goto cant_find;
1107          useSource = FALSE;
1108          break;
1109       case FM_EITHER:
1110          if ( sAvail && !oiAvail) { useSource = TRUE; break; }
1111          if (!sAvail &&  oiAvail) { useSource = FALSE; break; }
1112          useSource = firstTimeIsLater ( sTime, oiTime ) ? TRUE : FALSE;
1113          break;
1114       default:
1115          internal("parseModuleOrInterface");
1116    }
1117
1118    /* Actually do the parsing. */
1119    if (useSource) {
1120       module(mod).srcExt = findText(sExt);
1121       setCurrentFile(mod);
1122       strcpy(name, path);
1123       strcat(name, textToStr(mt));
1124       strcat(name, sExt);
1125       module(mod).tree      = parseModule(name,sSize);
1126       module(mod).uses      = getModuleImports(module(mod).tree);
1127       module(mod).mode      = FM_SOURCE;
1128       module(mod).lastStamp = sTime;
1129    } else {
1130       module(mod).srcExt = findText(HI_ENDING);
1131       setCurrentFile(mod);
1132       strcpy(name, path);
1133       strcat(name, textToStr(mt));
1134       strcat(name, DLL_ENDING);
1135       module(mod).objName = findText(name);
1136       module(mod).objSize = oSize;
1137       strcpy(name, path);
1138       strcat(name, textToStr(mt));
1139       strcat(name, ".u_hi");
1140       module(mod).tree      = parseInterface(name,iSize);
1141       module(mod).uses      = getInterfaceImports(module(mod).tree);
1142       module(mod).mode      = FM_OBJECT;
1143       module(mod).lastStamp = oiTime;
1144    }
1145
1146    if (path) free(path);
1147    return mod;
1148
1149   cant_find:
1150    if (path) free(path);
1151    clearCurrentFile();
1152    ERRMSG(0)
1153       "Can't find %s for module \"%s\"",
1154       modeToString(modeRequest), textToStr(mt)
1155    EEND;
1156 }
1157
1158
1159 static void tryLoadGroup ( Cell grp )
1160 {
1161    Module m;
1162    List   t;
1163    switch (whatIs(grp)) {
1164       case GRP_NONREC:
1165          m = findModule(textOf(snd(grp)));
1166          assert(nonNull(m));
1167          if (module(m).mode == FM_SOURCE) {
1168             processModule ( m );
1169             module(m).tree = NIL;
1170          } else {
1171             processInterfaces ( singleton(snd(grp)) );
1172             m = findModule(textOf(snd(grp)));
1173             assert(nonNull(m));
1174             module(m).tree = NIL;
1175          }
1176          break;
1177       case GRP_REC:
1178          for (t = snd(grp); nonNull(t); t=tl(t)) {
1179             m = findModule(textOf(hd(t)));
1180             assert(nonNull(m));
1181             if (module(m).mode == FM_SOURCE) {
1182                ERRMSG(0) "Source module \"%s\" imports itself recursively",
1183                          textToStr(textOf(hd(t)))
1184                EEND;
1185             }
1186          }
1187          processInterfaces ( snd(grp) );
1188          for (t = snd(grp); nonNull(t); t=tl(t)) {
1189             m = findModule(textOf(hd(t)));
1190             assert(nonNull(m));
1191             module(m).tree = NIL;
1192          }
1193          break;
1194       default:
1195          internal("tryLoadGroup");
1196    }
1197 }
1198
1199
1200 static void fallBackToPrelModules ( void )
1201 {
1202    Module m;
1203    for (m = MODULE_BASE_ADDR;
1204         m < MODULE_BASE_ADDR+tabModuleSz; m++)
1205       if (module(m).inUse
1206           && !varIsMember(module(m).text, prelModules))
1207          nukeModule(m);
1208 }
1209
1210
1211 /* This function catches exceptions in most of the system.
1212    So it's only ok for procedures called from this one
1213    to do EENDs (ie, write error messages).  Others should use
1214    EEND_NO_LONGJMP.
1215 */
1216 static void achieveTargetModules ( Bool loadingThePrelude )
1217 {
1218    volatile List   ood;
1219    volatile List   modgList;
1220    volatile List   t;
1221    volatile Module mod;
1222    volatile Bool   ok;
1223
1224    String path = NULL;
1225    String sExt = NULL;
1226    Bool sAvail;  Time sTime;  Long sSize;
1227    Bool oiAvail; Time oiTime; Long oSize; Long iSize;
1228
1229    volatile Time oisTime;
1230    volatile Bool out_of_date;
1231    volatile List ood_new;
1232    volatile List us;
1233    volatile List modgList_new;
1234    volatile List parsedButNotLoaded;
1235    volatile List toChase;
1236    volatile List trans_cl;
1237    volatile List trans_cl_new;
1238    volatile List u;
1239    volatile List mg;
1240    volatile List mg2;
1241    volatile Cell grp;
1242    volatile List badMods;
1243
1244    setBreakAction ( HugsIgnoreBreak );
1245
1246    /* First, examine timestamps to find out which modules are
1247       out of date with respect to the source/interface/object files.
1248    */
1249    ood      = NIL;
1250    modgList = listFromMG();
1251
1252    for (t = modgList; nonNull(t); t=tl(t)) {
1253
1254       if (varIsMember(textOf(hd(t)),prelModules))
1255          continue;
1256
1257       mod = findModule(textOf(hd(t)));
1258       if (isNull(mod)) internal("achieveTargetSet(1)");
1259
1260       /* In standalone mode, only succeeds for source modules. */
1261       ok = findFilesForModule (
1262               textToStr(module(mod).text),
1263               &path,
1264               &sExt,
1265               &sAvail,  &sTime,  &sSize,
1266               &oiAvail, &oiTime, &oSize, &iSize
1267            );
1268
1269       if (!combined && !sAvail) ok = FALSE;
1270       if (!ok) {
1271          fallBackToPrelModules();
1272          ERRMSG(0)
1273             "Can't find source or object+interface for module \"%s\"",
1274             textToStr(module(mod).text)
1275          EEND_NO_LONGJMP;
1276          if (path) free(path);
1277          return;
1278       }
1279
1280       if (sAvail && oiAvail) {
1281          oisTime = whicheverIsLater(sTime,oiTime);
1282       }
1283       else if (sAvail && !oiAvail) {
1284          oisTime = sTime;
1285       }
1286       else if (!sAvail && oiAvail) {
1287          oisTime = oiTime;
1288       }
1289       else {
1290          internal("achieveTargetSet(2)");
1291       }
1292
1293       out_of_date = firstTimeIsLater(oisTime,module(mod).lastStamp);
1294       if (out_of_date) {
1295          assert(!varIsMember(textOf(hd(t)),ood));
1296          ood = cons(hd(t),ood);
1297       }
1298
1299       if (path) { free(path); path = NULL; };
1300    }
1301
1302    /* Second, form a simplistic transitive closure of the out-of-date
1303       modules: a module is out of date if it imports an out-of-date
1304       module.
1305    */
1306    while (1) {
1307       ood_new = NIL;
1308       for (t = modgList; nonNull(t); t=tl(t)) {
1309          mod = findModule(textOf(hd(t)));
1310          assert(nonNull(mod));
1311          for (us = module(mod).uses; nonNull(us); us=tl(us))
1312             if (varIsMember(textOf(hd(us)),ood))
1313                break;
1314          if (nonNull(us)) {
1315             if (varIsMember(textOf(hd(t)),prelModules))
1316                Printf ( "warning: prelude module \"%s\" is out-of-date\n",
1317                         textToStr(textOf(hd(t))) );
1318             else
1319                if (!varIsMember(textOf(hd(t)),ood_new) &&
1320                    !varIsMember(textOf(hd(t)),ood))
1321                   ood_new = cons(hd(t),ood_new);
1322          }
1323       }
1324       if (isNull(ood_new)) break;
1325       ood = appendOnto(ood_new,ood);
1326    }
1327
1328    /* Now ood holds the entire set of modules which are out-of-date.
1329       Throw them out of the system, yielding a "reduced system",
1330       in which the remaining modules are in-date.
1331    */
1332    for (t = ood; nonNull(t); t=tl(t)) {
1333       mod = findModule(textOf(hd(t)));
1334       assert(nonNull(mod));
1335       nukeModule(mod);
1336    }
1337    modgList_new = NIL;
1338    for (t = modgList; nonNull(t); t=tl(t))
1339       if (!varIsMember(textOf(hd(t)),ood))
1340          modgList_new = cons(hd(t),modgList_new);
1341    modgList = modgList_new;
1342
1343    /* Update the module group list to reflect the reduced system.
1344       We do this so that if the following parsing phases fail, we can
1345       safely fall back to the reduced system.
1346    */
1347    mgFromList ( modgList );
1348
1349    /* Parse modules/interfaces, collecting parse trees and chasing
1350       imports, starting from the target set.
1351    */
1352    toChase = dupList(targetModules);
1353    for (t = toChase; nonNull(t); t=tl(t)) {
1354       Cell mode = (!combined)
1355                   ? FM_SOURCE
1356                   : ( (loadingThePrelude && combined)
1357                       ? FM_OBJECT
1358                       : FM_EITHER );
1359       hd(t) = zpair(hd(t), mode);
1360    }
1361
1362    /* toChase :: [ ((ConId, {FM_SOURCE|FM_OBJECT|FM_EITHER} )) ] */
1363
1364    parsedButNotLoaded = NIL;
1365
1366
1367    while (nonNull(toChase)) {
1368       ConId mc   = zfst(hd(toChase));
1369       Cell  mode = zsnd(hd(toChase));
1370       toChase    = tl(toChase);
1371       if (varIsMember(textOf(mc),modgList)
1372           || varIsMember(textOf(mc),parsedButNotLoaded)) {
1373          /* either exists fully, or is at least parsed */
1374          mod = findModule(textOf(mc));
1375          assert(nonNull(mod));
1376          if (!compatibleNewMode(mode,module(mod).mode)) {
1377             clearCurrentFile();
1378             ERRMSG(0)
1379                "module %s: %s required, but %s is more recent",
1380                textToStr(textOf(mc)), modeToString(mode),
1381                modeToString(module(mod).mode)
1382             EEND_NO_LONGJMP;
1383             goto parseException;
1384          }
1385       } else {
1386
1387          setBreakAction ( HugsLongjmpOnBreak );
1388          if (setjmp(catch_error)==0) {
1389             /* try this; it may throw an exception */
1390             mod = parseModuleOrInterface ( mc, mode );
1391          } else {
1392             /* here's the exception handler, if parsing fails */
1393             /* A parse error (or similar).  Clean up and abort. */
1394            parseException:
1395             setBreakAction ( HugsIgnoreBreak );
1396             mod = findModule(textOf(mc));
1397             if (nonNull(mod)) nukeModule(mod);
1398             for (t = parsedButNotLoaded; nonNull(t); t=tl(t)) {
1399                mod = findModule(textOf(hd(t)));
1400                assert(nonNull(mod));
1401                if (nonNull(mod)) nukeModule(mod);
1402             }
1403             return;
1404             /* end of the exception handler */
1405          }
1406          setBreakAction ( HugsIgnoreBreak );
1407
1408          parsedButNotLoaded = cons(mc, parsedButNotLoaded);
1409          for (t = module(mod).uses; nonNull(t); t=tl(t))
1410             toChase = cons(
1411                         zpair( hd(t), childMode(mode,module(mod).mode) ),
1412                         toChase);
1413       }
1414    }
1415
1416    modgList = dupOnto(parsedButNotLoaded, modgList);
1417
1418    /* We successfully parsed all modules reachable from the target
1419       set which were not part of the reduced system.  However, there
1420       may be modules in the reduced system which are not reachable from
1421       the target set.  We detect these now by building the transitive
1422       closure of the target set, and nuking modules in the reduced
1423       system which are not part of that closure.
1424    */
1425    trans_cl = dupList(targetModules);
1426    while (1) {
1427       trans_cl_new = NIL;
1428       for (t = trans_cl; nonNull(t); t=tl(t)) {
1429          mod = findModule(textOf(hd(t)));
1430          assert(nonNull(mod));
1431          for (u = module(mod).uses; nonNull(u); u=tl(u))
1432             if (!varIsMember(textOf(hd(u)),trans_cl)
1433                 && !varIsMember(textOf(hd(u)),trans_cl_new)
1434                 && !varIsMember(textOf(hd(u)),prelModules))
1435                trans_cl_new = cons(hd(u),trans_cl_new);
1436       }
1437       if (isNull(trans_cl_new)) break;
1438       trans_cl = appendOnto(trans_cl_new,trans_cl);
1439    }
1440    modgList_new = NIL;
1441    for (t = modgList; nonNull(t); t=tl(t)) {
1442       if (varIsMember(textOf(hd(t)),trans_cl)) {
1443          modgList_new = cons(hd(t),modgList_new);
1444       } else {
1445          mod = findModule(textOf(hd(t)));
1446          assert(nonNull(mod));
1447          nukeModule(mod);
1448       }
1449    }
1450    modgList = modgList_new;
1451
1452    /* Now, the module symbol tables hold exactly the set of
1453       modules reachable from the target set, and modgList holds
1454       their names.   Calculate the scc-ified module graph,
1455       since we need that to guide the next stage, that of
1456       Actually Loading the modules.
1457
1458       If no errors occur, moduleGraph will reflect the final graph
1459       loaded.  If an error occurs loading a group, we nuke
1460       that group, truncate the moduleGraph just prior to that
1461       group, and exit.  That leaves the system having successfully
1462       loaded all groups prior to the one which failed.
1463    */
1464    mgFromList ( modgList );
1465
1466    for (mg = moduleGraph; nonNull(mg); mg=tl(mg)) {
1467       grp = hd(mg);
1468
1469       if (!varIsMember(textOf(selectArbitrarilyFromGroup(grp)),
1470                        parsedButNotLoaded)) continue;
1471
1472       setBreakAction ( HugsLongjmpOnBreak );
1473       if (setjmp(catch_error)==0) {
1474          /* try this; it may throw an exception */
1475          tryLoadGroup(grp);
1476       } else {
1477          /* here's the exception handler, if static/typecheck etc fails */
1478          /* nuke the entire rest (ie, the unloaded part)
1479             of the module graph */
1480          setBreakAction ( HugsIgnoreBreak );
1481          badMods = listFromSpecifiedMG ( mg );
1482          for (t = badMods; nonNull(t); t=tl(t)) {
1483             mod = findModule(textOf(hd(t)));
1484             if (nonNull(mod)) nukeModule(mod);
1485          }
1486          /* truncate the module graph just prior to this group. */
1487          mg2 = NIL;
1488          mg = moduleGraph;
1489          while (TRUE) {
1490             if (isNull(mg)) break;
1491             if (hd(mg) == grp) break;
1492             mg2 = cons ( hd(mg), mg2 );
1493             mg = tl(mg);
1494          }
1495          moduleGraph = reverse(mg2);
1496          return;
1497          /* end of the exception handler */
1498       }
1499       setBreakAction ( HugsIgnoreBreak );
1500    }
1501
1502    /* Err .. I think that's it.  If we get here, we've successfully
1503       achieved the target set.  Phew!
1504    */
1505    setBreakAction ( HugsIgnoreBreak );
1506 }
1507
1508
1509 static Bool loadThePrelude ( void )
1510 {
1511    Bool ok;
1512    ConId conPrelude;
1513    ConId conPrelHugs;
1514    moduleGraph = prelModules = NIL;
1515
1516    if (combined) {
1517       conPrelude    = mkCon(findText("Prelude"));
1518       conPrelHugs   = mkCon(findText("PrelHugs"));
1519       targetModules = doubleton(conPrelude,conPrelHugs);
1520       achieveTargetModules(TRUE);
1521       ok = elemMG(conPrelude) && elemMG(conPrelHugs);
1522    } else {
1523       conPrelude    = mkCon(findText("Prelude"));
1524       targetModules = singleton(conPrelude);
1525       achieveTargetModules(TRUE);
1526       ok = elemMG(conPrelude);
1527    }
1528
1529    if (ok) prelModules = listFromMG();
1530    return ok;
1531 }
1532
1533
1534 /* Refresh the current target modules, and attempt to set the
1535    current module to what it was before (ie currentModule):
1536      if currentModule_failed is different from currentModule,
1537         use that instead
1538      if nextCurrMod is non null, try to set it to that instead
1539      if the one we're after insn't available, select a target
1540        from the end of the module group list.
1541 */
1542 static void refreshActions ( ConId nextCurrMod, Bool cleanAfter )
1543 {
1544    List t;
1545    ConId tryFor;
1546
1547    /* Remember what the old current module was. */
1548    tryFor = mkCon(module(currentModule).text);
1549
1550    /* Do the Real Work. */
1551    achieveTargetModules(FALSE);
1552
1553    /* Remember if the current module was invalidated by this
1554       refresh, so later refreshes can attempt to reload it. */
1555    if (!elemMG(tryFor))
1556       currentModule_failed = tryFor;
1557
1558    /* If a previous refresh failed to get an old current module,
1559       try for that instead. */
1560    if (nonNull(currentModule_failed)
1561        && textOf(currentModule_failed) != textOf(tryFor)
1562        && elemMG(currentModule_failed))
1563       tryFor = currentModule_failed;
1564    /* If our caller specified a new current module, that overrides
1565       all historical settings. */
1566    if (nonNull(nextCurrMod))
1567       tryFor = nextCurrMod;
1568    /* Finally, if we can't actually get hold of whatever it was we
1569       were after, select something which is possible. */
1570    if (!elemMG(tryFor))
1571       tryFor = selectLatestMG();
1572
1573    /* combined mode kludge, to get Prelude rather than PrelHugs */
1574    if (combined && textOf(tryFor)==findText("PrelHugs"))
1575       tryFor = mkCon(findText("Prelude"));
1576
1577    if (cleanAfter) {
1578       /* delete any targetModules which didn't actually get loaded  */
1579       t = targetModules;
1580       targetModules = NIL;
1581       for (; nonNull(t); t=tl(t))
1582          if (elemMG(hd(t)))
1583             targetModules = cons(hd(t),targetModules);
1584    }
1585
1586    setCurrModule ( findModule(textOf(tryFor)) );
1587    Printf("Hugs session for:\n");
1588    ppMG();
1589 }
1590
1591
1592 static void addActions ( List extraModules /* :: [CONID] */ )
1593 {
1594    List t;
1595    for (t = extraModules; nonNull(t); t=tl(t)) {
1596       ConId extra = hd(t);
1597       if (!varIsMember(textOf(extra),targetModules))
1598          targetModules = cons(extra,targetModules);
1599    }
1600    refreshActions ( isNull(extraModules)
1601                        ? NIL
1602                        : hd(reverse(extraModules)),
1603                     TRUE
1604                   );
1605 }
1606
1607
1608 static void loadActions ( List loadModules /* :: [CONID] */ )
1609 {
1610    List t;
1611    targetModules = dupList ( prelModules );
1612
1613    for (t = loadModules; nonNull(t); t=tl(t)) {
1614       ConId load = hd(t);
1615       if (!varIsMember(textOf(load),targetModules))
1616          targetModules = cons(load,targetModules);
1617    }
1618    refreshActions ( isNull(loadModules)
1619                        ? NIL
1620                        : hd(reverse(loadModules)),
1621                     TRUE
1622                   );
1623 }
1624
1625
1626 /* --------------------------------------------------------------------------
1627  * Access to external editor:
1628  * ------------------------------------------------------------------------*/
1629
1630 /* ToDo: All this editor stuff needs fixing. */
1631
1632 static Void local editor() {            /* interpreter-editor interface    */
1633 #if 0
1634     String newFile  = readFilename();
1635     if (newFile) {
1636         setLastEdit(newFile,0);
1637         if (readFilename()) {
1638             ERRMSG(0) "Multiple filenames not permitted"
1639             EEND;
1640         }
1641     }
1642     runEditor();
1643 #endif
1644 }
1645
1646 static Void local find() {              /* edit file containing definition */
1647 #if 0
1648 ToDo: Fix!
1649     String nm = readFilename();         /* of specified name               */
1650     if (!nm) {
1651         ERRMSG(0) "No name specified"
1652         EEND;
1653     }
1654     else if (readFilename()) {
1655         ERRMSG(0) "Multiple names not permitted"
1656         EEND;
1657     }
1658     else {
1659         Text t;
1660         Cell c;
1661         setCurrModule(findEvalModule());
1662         startNewScript(0);
1663         if (nonNull(c=findTycon(t=findText(nm)))) {
1664             if (startEdit(tycon(c).line,scriptName[scriptThisTycon(c)])) {
1665                 readScripts(N_PRELUDE_SCRIPTS);
1666             }
1667         } else if (nonNull(c=findName(t))) {
1668             if (startEdit(name(c).line,scriptName[scriptThisName(c)])) {
1669                 readScripts(N_PRELUDE_SCRIPTS);
1670             }
1671         } else {
1672             ERRMSG(0) "No current definition for name \"%s\"", nm
1673             EEND;
1674         }
1675     }
1676 #endif
1677 }
1678
1679 static Void local runEditor() {         /* run editor on script lastEdit   */
1680 #if 0
1681     if (startEdit(lastEdLine,lastEdit)) /* at line lastEdLine              */
1682         readScripts(N_PRELUDE_SCRIPTS);
1683 #endif
1684 }
1685
1686 static Void local setLastEdit(fname,line)/* keep name of last file to edit */
1687 String fname;
1688 Int    line; {
1689 #if 0
1690     if (lastEdit)
1691         free(lastEdit);
1692     lastEdit = strCopy(fname);
1693     lastEdLine = line;
1694 #endif
1695 }
1696
1697 /* --------------------------------------------------------------------------
1698  * Read and evaluate an expression:
1699  * ------------------------------------------------------------------------*/
1700
1701 static Void setModule ( void ) {
1702                               /*set module in which to evaluate expressions*/
1703    Module m;
1704    ConId  mc = NIL;
1705    String s  = readFilename();
1706    if (!s) {
1707       mc = selectLatestMG();
1708       if (combined && textOf(mc)==findText("PrelHugs"))
1709          mc = mkCon(findText("Prelude"));
1710       m = findModule(textOf(mc));
1711       assert(nonNull(m));
1712    } else {
1713       m = findModule(findText(s));
1714       if (isNull(m)) {
1715          ERRMSG(0) "Cannot find module \"%s\"", s
1716          EEND_NO_LONGJMP;
1717          return;
1718       }
1719    }
1720    setCurrModule(m);
1721 }
1722
1723 static Module allocEvalModule ( void )
1724 {
1725    Module evalMod = newModule( findText("_Eval_Module_") );
1726    module(evalMod).names   = module(currentModule).names;
1727    module(evalMod).tycons  = module(currentModule).tycons;
1728    module(evalMod).classes = module(currentModule).classes;
1729    module(evalMod).qualImports
1730      = singleton(pair(mkCon(textPrelude),modulePrelude));
1731    return evalMod;
1732 }
1733
1734 static Void local evaluator() {        /* evaluate expr and print value    */
1735     volatile Type   type;
1736     volatile Type   bd;
1737     volatile Kinds  ks      = NIL;
1738     volatile Module evalMod = allocEvalModule();
1739     volatile Module currMod = currentModule;
1740     setCurrModule(evalMod);
1741     currentFile = NULL;
1742
1743     defaultDefns = combined ? stdDefaults : evalDefaults;
1744
1745     setBreakAction ( HugsLongjmpOnBreak );
1746     if (setjmp(catch_error)==0) {
1747        /* try this */
1748        parseExp();
1749        checkExp();
1750        type = typeCheckExp(TRUE);
1751     } else {
1752        /* if an exception happens, we arrive here */
1753        setBreakAction ( HugsIgnoreBreak );
1754        goto cleanup_and_return;
1755     }
1756
1757     setBreakAction ( HugsIgnoreBreak );
1758     if (isPolyType(type)) {
1759         ks = polySigOf(type);
1760         bd = monotypeOf(type);
1761     }
1762     else
1763         bd = type;
1764
1765     if (whatIs(bd)==QUAL) {
1766        clearCurrentFile();
1767        ERRMSG(0) "Unresolved overloading" ETHEN
1768        ERRTEXT   "\n*** Type       : "    ETHEN ERRTYPE(type);
1769        ERRTEXT   "\n*** Expression : "    ETHEN ERREXPR(inputExpr);
1770        ERRTEXT   "\n"
1771        EEND_NO_LONGJMP;
1772        goto cleanup_and_return;
1773     }
1774
1775 #if 1
1776     if (isProgType(ks,bd)) {
1777         inputExpr = ap(nameRunIO_toplevel,inputExpr);
1778         evalExp();
1779         Putchar('\n');
1780     } else {
1781         Cell d = provePred(ks,NIL,ap(classShow,bd));
1782         if (isNull(d)) {
1783        clearCurrentFile();
1784            ERRMSG(0) "Cannot find \"show\" function for:" ETHEN
1785            ERRTEXT   "\n*** expression : "   ETHEN ERREXPR(inputExpr);
1786            ERRTEXT   "\n*** of type    : "   ETHEN ERRTYPE(type);
1787            ERRTEXT   "\n"
1788            EEND_NO_LONGJMP;
1789            goto cleanup_and_return;
1790         }
1791         inputExpr = ap2(nameShow,           d,inputExpr);
1792         inputExpr = ap (namePutStr,         inputExpr);
1793         inputExpr = ap (nameRunIO_toplevel, inputExpr);
1794
1795         evalExp(); printf("\n");
1796         if (addType) {
1797             printf(" :: ");
1798             printType(stdout,type);
1799             Putchar('\n');
1800         }
1801     }
1802
1803 #else
1804
1805    printf ( "result type is " );
1806    printType ( stdout, type );
1807    printf ( "\n" );
1808    evalExp();
1809    printf ( "\n" );
1810
1811 #endif
1812
1813   cleanup_and_return:
1814    setBreakAction ( HugsIgnoreBreak );
1815    nukeModule(evalMod);
1816    setCurrModule(currMod);
1817    setCurrentFile(currMod);
1818 }
1819
1820
1821
1822 /* --------------------------------------------------------------------------
1823  * Print type of input expression:
1824  * ------------------------------------------------------------------------*/
1825
1826 static Void showtype ( void ) {        /* print type of expression (if any)*/
1827
1828     volatile Cell   type;
1829     volatile Module evalMod = allocEvalModule();
1830     volatile Module currMod = currentModule;
1831     setCurrModule(evalMod);
1832
1833     if (setjmp(catch_error)==0) {
1834        /* try this */
1835        parseExp();
1836        checkExp();
1837        defaultDefns = evalDefaults;
1838        type = typeCheckExp(FALSE);
1839        printExp(stdout,inputExpr);
1840        Printf(" :: ");
1841        printType(stdout,type);
1842        Putchar('\n');
1843     } else {
1844        /* if an exception happens, we arrive here */
1845     }
1846
1847     nukeModule(evalMod);
1848     setCurrModule(currMod);
1849 }
1850
1851
1852 static Void local browseit(mod,t,all)
1853 Module mod;
1854 String t;
1855 Bool all; {
1856     if (nonNull(mod)) {
1857         Cell cs;
1858         if (nonNull(t))
1859             Printf("module %s where\n",textToStr(module(mod).text));
1860         for (cs = module(mod).names; nonNull(cs); cs=tl(cs)) {
1861             Name nm = hd(cs);
1862             /* only look at things defined in this module,
1863                unless `all' flag is set */
1864             if (all || name(nm).mod == mod) {
1865                 /* unwanted artifacts, like lambda lifted values,
1866                    are in the list of names, but have no types */
1867                 if (nonNull(name(nm).type)) {
1868                     printExp(stdout,nm);
1869                     Printf(" :: ");
1870                     printType(stdout,name(nm).type);
1871                     if (isCfun(nm)) {
1872                         Printf("  -- data constructor");
1873                     } else if (isMfun(nm)) {
1874                         Printf("  -- class member");
1875                     } else if (isSfun(nm)) {
1876                         Printf("  -- selector function");
1877                     }
1878                     Printf("\n");
1879                 }
1880             }
1881         }
1882     } else {
1883       if (isNull(mod)) {
1884         Printf("Unknown module %s\n",t);
1885       }
1886     }
1887 }
1888
1889 static Void local browse() {            /* browse modules                  */
1890     Int    count = 0;                   /* or give menu of commands        */
1891     String s;
1892     Bool all = FALSE;
1893
1894     for (; (s=readFilename())!=0; count++)
1895         if (strcmp(s,"all") == 0) {
1896             all = TRUE;
1897             --count;
1898         } else
1899             browseit(findModule(findText(s)),s,all);
1900     if (count == 0) {
1901         browseit(currentModule,NULL,all);
1902     }
1903 }
1904
1905 #if EXPLAIN_INSTANCE_RESOLUTION
1906 static Void local xplain() {         /* print type of expression (if any)*/
1907     Cell d;
1908     Bool sir = showInstRes;
1909
1910     setCurrModule(findEvalModule());
1911     startNewScript(0);                 /* Enables recovery of storage      */
1912                                        /* allocated during evaluation      */
1913     parseContext();
1914     checkContext();
1915     showInstRes = TRUE;
1916     d = provePred(NIL,NIL,hd(inputContext));
1917     if (isNull(d)) {
1918         fprintf(stdout, "not Sat\n");
1919     } else {
1920         fprintf(stdout, "Sat\n");
1921     }
1922     showInstRes = sir;
1923 }
1924 #endif
1925
1926 /* --------------------------------------------------------------------------
1927  * Enhanced help system:  print current list of scripts or give information
1928  * about an object.
1929  * ------------------------------------------------------------------------*/
1930
1931 static String local objToStr(m,c)
1932 Module m;
1933 Cell   c; {
1934 #if 1 || DISPLAY_QUANTIFIERS
1935     static char newVar[60];
1936     switch (whatIs(c)) {
1937         case NAME  : if (m == name(c).mod) {
1938                          sprintf(newVar,"%s", textToStr(name(c).text));
1939                      } else {
1940                          sprintf(newVar,"%s.%s",
1941                                         textToStr(module(name(c).mod).text),
1942                                         textToStr(name(c).text));
1943                      }
1944                      break;
1945
1946         case TYCON : if (m == tycon(c).mod) {
1947                          sprintf(newVar,"%s", textToStr(tycon(c).text));
1948                      } else {
1949                          sprintf(newVar,"%s.%s",
1950                                         textToStr(module(tycon(c).mod).text),
1951                                         textToStr(tycon(c).text));
1952                      }
1953                      break;
1954
1955         case CLASS : if (m == cclass(c).mod) {
1956                          sprintf(newVar,"%s", textToStr(cclass(c).text));
1957                      } else {
1958                          sprintf(newVar,"%s.%s",
1959                                         textToStr(module(cclass(c).mod).text),
1960                                         textToStr(cclass(c).text));
1961                      }
1962                      break;
1963
1964         default    : internal("objToStr");
1965     }
1966     return newVar;
1967 #else
1968     static char newVar[33];
1969     switch (whatIs(c)) {
1970         case NAME  : sprintf(newVar,"%s", textToStr(name(c).text));
1971                      break;
1972
1973         case TYCON : sprintf(newVar,"%s", textToStr(tycon(c).text));
1974                      break;
1975
1976         case CLASS : sprintf(newVar,"%s", textToStr(cclass(c).text));
1977                      break;
1978
1979         default    : internal("objToStr");
1980     }
1981     return newVar;
1982 #endif
1983 }
1984
1985 extern Name nameHw;
1986
1987 static Void dumpStg ( void )
1988 {
1989    String s;
1990    Int i;
1991 #if 0
1992    Whats this for?
1993    setCurrModule(findEvalModule());
1994    startNewScript(0);
1995 #endif
1996    s = readFilename();
1997
1998    /* request to locate a symbol by name */
1999    if (s && (*s == '?')) {
2000       Text t = findText(s+1);
2001       locateSymbolByName(t);
2002       return;
2003    }
2004
2005    /* request to dump a bit of the heap */
2006    if (s && (*s == '-' || isdigit(*s))) {
2007       int i = atoi(s);
2008       print(i,100);
2009       printf("\n");
2010       return;
2011    }
2012
2013    /* request to dump a symbol table entry */
2014    if (!s
2015        || !(*s == 't' || *s == 'n' || *s == 'c' || *s == 'i')
2016        || !isdigit(s[1])) {
2017       fprintf(stderr, ":d -- bad request `%s'\n", s );
2018       return;
2019    }
2020    i = atoi(s+1);
2021    switch (*s) {
2022       case 't': dumpTycon(i); break;
2023       case 'n': dumpName(i); break;
2024       case 'c': dumpClass(i); break;
2025       case 'i': dumpInst(i); break;
2026       default: fprintf(stderr, ":d -- `%c' not implemented\n", *s );
2027    }
2028 }
2029
2030
2031 #if 0
2032 static Void local dumpStg( void ) {       /* print STG stuff                 */
2033     String s;
2034     Text   t;
2035     Name   n;
2036     Int    i;
2037     Cell   v;                           /* really StgVar */
2038     setCurrModule(findEvalModule());
2039     startNewScript(0);
2040     for (; (s=readFilename())!=0;) {
2041         t = findText(s);
2042         v = n = NIL;
2043         /* find the name while ignoring module scopes */
2044         for (i=NAMEMIN; i<nameHw; i++)
2045            if (name(i).text == t) n = i;
2046
2047         /* perhaps it's an "idNNNNNN" thing? */
2048         if (isNull(n) &&
2049             strlen(s) >= 3 &&
2050             s[0]=='i' && s[1]=='d' && isdigit(s[2])) {
2051            v = 0;
2052            i = 2;
2053            while (isdigit(s[i])) {
2054               v = v * 10 + (s[i]-'0');
2055               i++;
2056            }
2057            v = -v;
2058            n = nameFromStgVar(v);
2059         }
2060
2061         if (isNull(n) && whatIs(v)==STGVAR) {
2062            Printf ( "\n{- `%s' has no nametable entry -}\n", s );
2063            printStg(stderr, v );
2064         } else
2065         if (isNull(n)) {
2066            Printf ( "Unknown reference `%s'\n", s );
2067         } else
2068         if (!isName(n)) {
2069            Printf ( "Not a Name: `%s'\n", s );
2070         } else
2071         if (isNull(name(n).stgVar)) {
2072            Printf ( "Doesn't have a STG tree: %s\n", s );
2073         } else {
2074            Printf ( "\n{- stgVar of `%s' is id%d -}\n", s, -name(n).stgVar);
2075            printStg(stderr, name(n).stgVar);
2076         }
2077     }
2078 }
2079 #endif
2080
2081 static Void local info() {              /* describe objects                */
2082     Int    count = 0;                   /* or give menu of commands        */
2083     String s;
2084
2085     for (; (s=readFilename())!=0; count++) {
2086         describe(findText(s));
2087     }
2088     if (count == 0) {
2089        /* whatScripts(); */
2090     }
2091 }
2092
2093
2094 static Void local describe(t)           /* describe an object              */
2095 Text t; {
2096     Tycon  tc  = findTycon(t);
2097     Class  cl  = findClass(t);
2098     Name   nm  = findName(t);
2099
2100     if (nonNull(tc)) {                  /* as a type constructor           */
2101         Type t = tc;
2102         Int  i;
2103         Inst in;
2104         for (i=0; i<tycon(tc).arity; ++i) {
2105             t = ap(t,mkOffset(i));
2106         }
2107         Printf("-- type constructor");
2108         if (kindExpert) {
2109             Printf(" with kind ");
2110             printKind(stdout,tycon(tc).kind);
2111         }
2112         Putchar('\n');
2113         switch (tycon(tc).what) {
2114             case SYNONYM      : Printf("type ");
2115                                 printType(stdout,t);
2116                                 Printf(" = ");
2117                                 printType(stdout,tycon(tc).defn);
2118                                 break;
2119
2120             case NEWTYPE      :
2121             case DATATYPE     : {   List cs = tycon(tc).defn;
2122                                     if (tycon(tc).what==DATATYPE) {
2123                                         Printf("data ");
2124                                     } else {
2125                                         Printf("newtype ");
2126                                     }
2127                                     printType(stdout,t);
2128                                     Putchar('\n');
2129                                     mapProc(printSyntax,cs);
2130                                     if (hasCfun(cs)) {
2131                                         Printf("\n-- constructors:");
2132                                     }
2133                                     for (; hasCfun(cs); cs=tl(cs)) {
2134                                         Putchar('\n');
2135                                         printExp(stdout,hd(cs));
2136                                         Printf(" :: ");
2137                                         printType(stdout,name(hd(cs)).type);
2138                                     }
2139                                     if (nonNull(cs)) {
2140                                         Printf("\n-- selectors:");
2141                                     }
2142                                     for (; nonNull(cs); cs=tl(cs)) {
2143                                         Putchar('\n');
2144                                         printExp(stdout,hd(cs));
2145                                         Printf(" :: ");
2146                                         printType(stdout,name(hd(cs)).type);
2147                                     }
2148                                 }
2149                                 break;
2150
2151             case RESTRICTSYN  : Printf("type ");
2152                                 printType(stdout,t);
2153                                 Printf(" = <restricted>");
2154                                 break;
2155         }
2156         Putchar('\n');
2157         if (nonNull(in=findFirstInst(tc))) {
2158             Printf("\n-- instances:\n");
2159             do {
2160                 showInst(in);
2161                 in = findNextInst(tc,in);
2162             } while (nonNull(in));
2163         }
2164         Putchar('\n');
2165     }
2166
2167     if (nonNull(cl)) {                  /* as a class                      */
2168         List  ins = cclass(cl).instances;
2169         Kinds ks  = cclass(cl).kinds;
2170         if (nonNull(ks) && isNull(tl(ks)) && hd(ks)==STAR) {
2171             Printf("-- type class");
2172         } else {
2173             Printf("-- constructor class");
2174             if (kindExpert) {
2175                 Printf(" with arity ");
2176                 printKinds(stdout,ks);
2177             }
2178         }
2179         Putchar('\n');
2180         mapProc(printSyntax,cclass(cl).members);
2181         Printf("class ");
2182         if (nonNull(cclass(cl).supers)) {
2183             printContext(stdout,cclass(cl).supers);
2184             Printf(" => ");
2185         }
2186         printPred(stdout,cclass(cl).head);
2187
2188         if (nonNull(cclass(cl).fds)) {
2189             List   fds = cclass(cl).fds;
2190             String pre = " | ";
2191             for (; nonNull(fds); fds=tl(fds)) {
2192                 Printf(pre);
2193                 printFD(stdout,hd(fds));
2194                 pre = ", ";
2195             }
2196         }
2197
2198         if (nonNull(cclass(cl).members)) {
2199             List ms = cclass(cl).members;
2200             Printf(" where");
2201             do {
2202                 Type t = name(hd(ms)).type;
2203                 if (isPolyType(t)) {
2204                     t = monotypeOf(t);
2205                 }
2206                 Printf("\n  ");
2207                 printExp(stdout,hd(ms));
2208                 Printf(" :: ");
2209                 if (isNull(tl(fst(snd(t))))) {
2210                     t = snd(snd(t));
2211                 } else {
2212                     t = ap(QUAL,pair(tl(fst(snd(t))),snd(snd(t))));
2213                 }
2214                 printType(stdout,t);
2215                 ms = tl(ms);
2216             } while (nonNull(ms));
2217         }
2218         Putchar('\n');
2219         if (nonNull(ins)) {
2220             Printf("\n-- instances:\n");
2221             do {
2222                 showInst(hd(ins));
2223                 ins = tl(ins);
2224             } while (nonNull(ins));
2225         }
2226         Putchar('\n');
2227     }
2228
2229     if (nonNull(nm)) {                  /* as a function/name              */
2230         printSyntax(nm);
2231         printExp(stdout,nm);
2232         Printf(" :: ");
2233         if (nonNull(name(nm).type)) {
2234             printType(stdout,name(nm).type);
2235         } else {
2236             Printf("<unknown type>");
2237         }
2238         if (isCfun(nm)) {
2239             Printf("  -- data constructor");
2240         } else if (isMfun(nm)) {
2241             Printf("  -- class member");
2242         } else if (isSfun(nm)) {
2243             Printf("  -- selector function");
2244         }
2245         Printf("\n\n");
2246     }
2247
2248
2249     if (isNull(tc) && isNull(cl) && isNull(nm)) {
2250         Printf("Unknown reference `%s'\n",textToStr(t));
2251     }
2252 }
2253
2254 static Void local printSyntax(nm)
2255 Name nm; {
2256     Syntax sy = syntaxOf(nm);
2257     Text   t  = name(nm).text;
2258     String s  = textToStr(t);
2259     if (sy != defaultSyntax(t)) {
2260         Printf("infix");
2261         switch (assocOf(sy)) {
2262             case LEFT_ASS  : Putchar('l'); break;
2263             case RIGHT_ASS : Putchar('r'); break;
2264             case NON_ASS   : break;
2265         }
2266         Printf(" %i ",precOf(sy));
2267         if (isascii((int)(*s)) && isalpha((int)(*s))) {
2268             Printf("`%s`",s);
2269         } else {
2270             Printf("%s",s);
2271         }
2272         Putchar('\n');
2273     }
2274 }
2275
2276 static Void local showInst(in)          /* Display instance decl header    */
2277 Inst in; {
2278     Printf("instance ");
2279     if (nonNull(inst(in).specifics)) {
2280         printContext(stdout,inst(in).specifics);
2281         Printf(" => ");
2282     }
2283     printPred(stdout,inst(in).head);
2284     Putchar('\n');
2285 }
2286
2287 /* --------------------------------------------------------------------------
2288  * List all names currently in scope:
2289  * ------------------------------------------------------------------------*/
2290
2291 static Void local listNames() {         /* list names matching optional pat*/
2292     String pat   = readFilename();
2293     List   names = NIL;
2294     Int    width = getTerminalWidth() - 1;
2295     Int    count = 0;
2296     Int    termPos;
2297     Module mod   = currentModule;
2298
2299     if (pat) {                          /* First gather names to list      */
2300         do {
2301             names = addNamesMatching(pat,names);
2302         } while ((pat=readFilename())!=0);
2303     } else {
2304         names = addNamesMatching((String)0,names);
2305     }
2306     if (isNull(names)) {                /* Then print them out             */
2307         clearCurrentFile();
2308         ERRMSG(0) "No names selected"
2309         EEND_NO_LONGJMP;
2310         return;
2311     }
2312     for (termPos=0; nonNull(names); names=tl(names)) {
2313         String s = objToStr(mod,hd(names));
2314         Int    l = strlen(s);
2315         if (termPos+1+l>width) {
2316             Putchar('\n');
2317             termPos = 0;
2318         } else if (termPos>0) {
2319             Putchar(' ');
2320             termPos++;
2321         }
2322         Printf("%s",s);
2323         termPos += l;
2324         count++;
2325     }
2326     Printf("\n(%d names listed)\n", count);
2327 }
2328
2329 /* --------------------------------------------------------------------------
2330  * print a prompt and read a line of input:
2331  * ------------------------------------------------------------------------*/
2332
2333 static Void local promptForInput(moduleName)
2334 String moduleName; {
2335     char promptBuffer[1000];
2336 #if 1
2337     /* This is portable but could overflow buffer */
2338     sprintf(promptBuffer,prompt,moduleName);
2339 #else
2340     /* Works on ANSI C - but pre-ANSI compilers return a pointer to
2341      * promptBuffer instead.
2342      */
2343     if (sprintf(promptBuffer,prompt,moduleName) >= 1000) {
2344         /* Reset prompt to a safe default to avoid an infinite loop */
2345         free(prompt);
2346         prompt = strCopy("? ");
2347         internal("Combined prompt and evaluation module name too long");
2348     }
2349 #endif
2350     if (autoMain)
2351        stringInput("main\0"); else
2352        consoleInput(promptBuffer);
2353 }
2354
2355 /* --------------------------------------------------------------------------
2356  * main read-eval-print loop, with error trapping:
2357  * ------------------------------------------------------------------------*/
2358
2359 static Void local interpreter(argc,argv)/* main interpreter loop           */
2360 Int    argc;
2361 String argv[]; {
2362
2363     List   modConIds; /* :: [CONID] */
2364     Bool   prelOK;
2365     String s;
2366
2367     setBreakAction ( HugsIgnoreBreak );
2368     modConIds = initialize(argc,argv);  /* the initial modules to load     */
2369     setBreakAction ( HugsIgnoreBreak );
2370     prelOK    = loadThePrelude();
2371
2372     if (!prelOK) {
2373        if (autoMain)
2374           fprintf(stderr, "hugs +Q: fatal error: can't load the Prelude.\n" );
2375        else
2376           fprintf(stderr, "hugs: fatal error: can't load the Prelude.\n" );
2377        exit(1);
2378     }
2379
2380     if (combined) everybody(POSTPREL);
2381     loadActions(modConIds);
2382
2383     if (autoMain) {
2384        for (; nonNull(modConIds); modConIds=tl(modConIds))
2385           if (!elemMG(hd(modConIds))) {
2386              fprintf(stderr,
2387                      "hugs +Q: compilation failed -- can't run `main'\n" );
2388              exit(1);
2389           }
2390     }
2391
2392     modConIds = NIL;
2393
2394     /* initialize calls startupHaskell, which trashes our signal handlers */
2395     setBreakAction ( HugsIgnoreBreak );
2396     forHelp();
2397
2398     for (;;) {
2399         Command cmd;
2400         everybody(RESET);               /* reset to sensible initial state */
2401
2402         promptForInput(textToStr(module(currentModule).text));
2403
2404         cmd = readCommand(cmds, (Char)':', (Char)'!');
2405         switch (cmd) {
2406             case EDIT   : editor();
2407                           break;
2408             case FIND   : find();
2409                           break;
2410             case LOAD   : modConIds = NIL;
2411                           while ((s=readFilename())!=0)
2412                              modConIds = cons(mkCon(findText(s)),modConIds);
2413                           loadActions(modConIds);
2414                           modConIds = NIL;
2415                           break;
2416             case ALSO   : modConIds = NIL;
2417                           while ((s=readFilename())!=0)
2418                              modConIds = cons(mkCon(findText(s)),modConIds);
2419                           addActions(modConIds);
2420                           modConIds = NIL;
2421                           break;
2422             case RELOAD : refreshActions(NIL,FALSE);
2423                           break;
2424             case SETMODULE :
2425                           setModule();
2426                           break;
2427             case EVAL   : evaluator();
2428                           break;
2429             case TYPEOF : showtype();
2430                           break;
2431             case BROWSE : browse();
2432                           break;
2433 #if EXPLAIN_INSTANCE_RESOLUTION
2434             case XPLAIN : xplain();
2435                           break;
2436 #endif
2437             case NAMES  : listNames();
2438                           break;
2439             case HELP   : menu();
2440                           break;
2441             case BADCMD : guidance();
2442                           break;
2443             case SET    : set();
2444                           break;
2445             case STATS:
2446 #ifdef CRUDE_PROFILING
2447                           cp_show();
2448 #endif
2449                           break;
2450             case SYSTEM : if (shellEsc(readLine()))
2451                               Printf("Warning: Shell escape terminated abnormally\n");
2452                           break;
2453             case CHGDIR : changeDir();
2454                           break;
2455             case INFO   : info();
2456                           break;
2457             case PNTVER: Printf("-- Hugs Version %s\n",
2458                                  HUGS_VERSION);
2459                           break;
2460             case DUMP   : dumpStg();
2461                           break;
2462             case QUIT   : return;
2463             case COLLECT: consGC = FALSE;
2464                           garbageCollect();
2465                           consGC = TRUE;
2466                           Printf("Garbage collection recovered %d cells\n",
2467                                  cellsRecovered);
2468                           break;
2469             case NOCMD  : break;
2470         }
2471
2472         if (autoMain) break;
2473     }
2474 }
2475
2476 /* --------------------------------------------------------------------------
2477  * Display progress towards goal:
2478  * ------------------------------------------------------------------------*/
2479
2480 static Target currTarget;
2481 static Bool   aiming = FALSE;
2482 static Int    currPos;
2483 static Int    maxPos;
2484 static Int    charCount;
2485
2486 Void setGoal(what, t)                  /* Set goal for what to be t        */
2487 String what;
2488 Target t; {
2489     if (quiet)
2490       return;
2491 #if EXPLAIN_INSTANCE_RESOLUTION
2492     if (showInstRes)
2493       return;
2494 #endif
2495     currTarget = (t?t:1);
2496     aiming     = TRUE;
2497     if (useDots) {
2498         currPos = strlen(what);
2499         maxPos  = getTerminalWidth() - 1;
2500         Printf("%s",what);
2501     }
2502     else
2503         for (charCount=0; *what; charCount++)
2504             Putchar(*what++);
2505     FlushStdout();
2506 }
2507
2508 Void soFar(t)                          /* Indicate progress towards goal   */
2509 Target t; {                            /* has now reached t                */
2510     if (quiet)
2511       return;
2512 #if EXPLAIN_INSTANCE_RESOLUTION
2513     if (showInstRes)
2514       return;
2515 #endif
2516     if (useDots) {
2517         Int newPos = (Int)((maxPos * ((long)t))/currTarget);
2518
2519         if (newPos>maxPos)
2520             newPos = maxPos;
2521
2522         if (newPos>currPos) {
2523             do
2524                 Putchar('.');
2525             while (newPos>++currPos);
2526             FlushStdout();
2527         }
2528         FlushStdout();
2529     }
2530 }
2531
2532 Void done() {                          /* Goal has now been achieved       */
2533     if (quiet)
2534       return;
2535 #if EXPLAIN_INSTANCE_RESOLUTION
2536     if (showInstRes)
2537       return;
2538 #endif
2539     if (useDots) {
2540         while (maxPos>currPos++)
2541             Putchar('.');
2542         Putchar('\n');
2543     }
2544     else
2545         for (; charCount>0; charCount--) {
2546             Putchar('\b');
2547             Putchar(' ');
2548             Putchar('\b');
2549         }
2550     aiming = FALSE;
2551     FlushStdout();
2552 }
2553
2554 static Void local failed() {           /* Goal cannot be reached due to    */
2555     if (aiming) {                      /* errors                           */
2556         aiming = FALSE;
2557         Putchar('\n');
2558         FlushStdout();
2559     }
2560 }
2561
2562 /* --------------------------------------------------------------------------
2563  * Error handling:
2564  * ------------------------------------------------------------------------*/
2565
2566 static Void local stopAnyPrinting() {  /* terminate printing of expression,*/
2567     if (printing) {                    /* after successful termination or  */
2568         printing = FALSE;              /* runtime error (e.g. interrupt)   */
2569         Putchar('\n');
2570         if (showStats) {
2571 #define plural(v)   v, (v==1?"":"s")
2572             Printf("%lu cell%s",plural(numCells));
2573             if (numGcs>0)
2574                 Printf(", %u garbage collection%s",plural(numGcs));
2575             Printf(")\n");
2576 #undef plural
2577         }
2578         FlushStdout();
2579         garbageCollect();
2580     }
2581 }
2582
2583 Cell errAssert(l)   /* message to use when raising asserts, etc */
2584 Int l; {
2585   Cell str;
2586   if (currentFile) {
2587     str = mkStr(findText(currentFile));
2588   } else {
2589     str = mkStr(findText(""));
2590   }
2591   return (ap2(nameTangleMessage,str,mkInt(l)));
2592 }
2593
2594 Void errHead(l)                        /* print start of error message     */
2595 Int l; {
2596     failed();                          /* failed to reach target ...       */
2597     stopAnyPrinting();
2598     FPrintf(errorStream,"ERROR");
2599
2600     if (currentFile) {
2601         FPrintf(errorStream," \"%s\"", currentFile);
2602         setLastEdit(currentFile,l);
2603         if (l) FPrintf(errorStream," (line %d)",l);
2604         currentFile = NULL;
2605     }
2606     FPrintf(errorStream,": ");
2607     FFlush(errorStream);
2608 }
2609
2610 Void errFail() {                        /* terminate error message and     */
2611     Putc('\n',errorStream);             /* produce exception to return to  */
2612     FFlush(errorStream);                /* main command loop               */
2613     longjmp(catch_error,1);
2614 }
2615
2616 Void errFail_no_longjmp() {             /* terminate error message but     */
2617     Putc('\n',errorStream);             /* don't produce an exception      */
2618     FFlush(errorStream);
2619 }
2620
2621 Void errAbort() {                       /* altern. form of error handling  */
2622     failed();                           /* used when suitable error message*/
2623     stopAnyPrinting();                  /* has already been printed        */
2624     errFail();
2625 }
2626
2627 Void internal(msg)                      /* handle internal error           */
2628 String msg; {
2629     failed();
2630     stopAnyPrinting();
2631     Printf("INTERNAL ERROR: %s\n",msg);
2632     FlushStdout();
2633 exit(9);
2634     longjmp(catch_error,1);
2635 }
2636
2637 Void fatal(msg)                         /* handle fatal error              */
2638 String msg; {
2639     FlushStdout();
2640     Printf("\nFATAL ERROR: %s\n",msg);
2641     everybody(EXIT);
2642     exit(1);
2643 }
2644
2645
2646 /* --------------------------------------------------------------------------
2647  * Read value from environment variable or registry:
2648  * ------------------------------------------------------------------------*/
2649
2650 String fromEnv(var,def)         /* return value of:                        */
2651 String var;                     /*     environment variable named by var   */
2652 String def; {                   /* or: default value given by def          */
2653     String s = getenv(var);
2654     return (s ? s : def);
2655 }
2656
2657 /* --------------------------------------------------------------------------
2658  * String manipulation routines:
2659  * ------------------------------------------------------------------------*/
2660
2661 static String local strCopy(s)         /* make malloced copy of a string   */
2662 String s; {
2663     if (s && *s) {
2664         char *t, *r;
2665         if ((t=(char *)malloc(strlen(s)+1))==0) {
2666             ERRMSG(0) "String storage space exhausted"
2667             EEND;
2668         }
2669         for (r=t; (*r++ = *s++)!=0; ) {
2670         }
2671         return t;
2672     }
2673     return NULL;
2674 }
2675
2676
2677 /* --------------------------------------------------------------------------
2678  * Compiler output
2679  * We can redirect compiler output (prompts, error messages, etc) by
2680  * tweaking these functions.
2681  * ------------------------------------------------------------------------*/
2682
2683 #ifdef HAVE_STDARG_H
2684 #include <stdarg.h>
2685 #else
2686 #include <varargs.h>
2687 #endif
2688
2689 Void hugsEnableOutput(f)
2690 Bool f; {
2691     disableOutput = !f;
2692 }
2693
2694 #ifdef HAVE_STDARG_H
2695 Void hugsPrintf(const char *fmt, ...) {
2696     va_list ap;                    /* pointer into argument list           */
2697     va_start(ap, fmt);             /* make ap point to first arg after fmt */
2698     if (!disableOutput) {
2699         vprintf(fmt, ap);
2700     } else {
2701     }
2702     va_end(ap);                    /* clean up                             */
2703 }
2704 #else
2705 Void hugsPrintf(fmt, va_alist)
2706 const char *fmt;
2707 va_dcl {
2708     va_list ap;                    /* pointer into argument list           */
2709     va_start(ap);                  /* make ap point to first arg after fmt */
2710     if (!disableOutput) {
2711         vprintf(fmt, ap);
2712     } else {
2713     }
2714     va_end(ap);                    /* clean up                             */
2715 }
2716 #endif
2717
2718 Void hugsPutchar(c)
2719 int c; {
2720     if (!disableOutput) {
2721         putchar(c);
2722     } else {
2723     }
2724 }
2725
2726 Void hugsFlushStdout() {
2727     if (!disableOutput) {
2728         fflush(stdout);
2729     }
2730 }
2731
2732 Void hugsFFlush(fp)
2733 FILE* fp; {
2734     if (!disableOutput) {
2735         fflush(fp);
2736     }
2737 }
2738
2739 #ifdef HAVE_STDARG_H
2740 Void hugsFPrintf(FILE *fp, const char* fmt, ...) {
2741     va_list ap;
2742     va_start(ap, fmt);
2743     if (!disableOutput) {
2744         vfprintf(fp, fmt, ap);
2745     } else {
2746     }
2747     va_end(ap);
2748 }
2749 #else
2750 Void hugsFPrintf(FILE *fp, const char* fmt, va_list)
2751 FILE* fp;
2752 const char* fmt;
2753 va_dcl {
2754     va_list ap;
2755     va_start(ap);
2756     if (!disableOutput) {
2757         vfprintf(fp, fmt, ap);
2758     } else {
2759     }
2760     va_end(ap);
2761 }
2762 #endif
2763
2764 Void hugsPutc(c, fp)
2765 int   c;
2766 FILE* fp; {
2767     if (!disableOutput) {
2768         putc(c,fp);
2769     } else {
2770     }
2771 }
2772
2773 /* --------------------------------------------------------------------------
2774  * Send message to each component of system:
2775  * ------------------------------------------------------------------------*/
2776
2777 Void everybody(what)            /* send command `what' to each component of*/
2778 Int what; {                     /* system to respond as appropriate ...    */
2779 #if 0
2780   fprintf ( stderr, "EVERYBODY %d\n", what );
2781 #endif
2782     machdep(what);              /* The order of calling each component is  */
2783     storage(what);              /* important for the PREPREL command       */
2784     substitution(what);
2785     input(what);
2786     translateControl(what);
2787     linkControl(what);
2788     staticAnalysis(what);
2789     deriveControl(what);
2790     typeChecker(what);
2791     compiler(what);
2792     codegen(what);
2793
2794     if (what == MARK) {
2795        mark(moduleGraph);
2796        mark(prelModules);
2797        mark(targetModules);
2798        mark(daSccs);
2799        mark(currentModule_failed);
2800     }
2801 }
2802
2803 /*-------------------------------------------------------------------------*/