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