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.60 $
  13  * $Date: 2000/04/05 16:57:18 $
  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 != textPrimPrel)
 952          usesT = cons(textPrelude,usesT);
 953
 954       adjList = cons(pair(mT,usesT),adjList);
 955    }
 956
 957    /* adjList is now [ (module-text, [modules-which-i-import-text]) ].
 958       Modify this so that the adjacency list is a list of pointers
 959       back to bits of adjList -- that's what modScc needs.
 960    */
 961    for (t = adjList; nonNull(t); t=tl(t)) {
 962       List adj = NIL;
 963       /* for each elem of the adjacency list ... */
 964       for (u = snd(hd(t)); nonNull(u); u=tl(u)) {
 965          List v;
 966          Text a = hd(u);
 967          /* find the element of adjList whose fst is a */
 968          for (v = adjList; nonNull(v); v=tl(v)) {
 969             assert(isText(a));
 970             assert(isText(fst(hd(v))));
 971             if (fst(hd(v))==a) break;
 972          }
 973          if (isNull(v)) internal("mgFromList");
 974          adj = cons(hd(v),adj);
 975       }
 976       snd(hd(t)) = adj;
 977    }
 978
 979    adjList = modScc ( adjList );
 980    /* adjList is now [ [(module-text, aux-info-field)] ] */
 981
 982    moduleGraph = NIL;
 983
 984    for (t = adjList; nonNull(t); t=tl(t)) {
 985
 986       scc = hd(t);
 987       /* scc :: [ (module-text, aux-info-field) ] */
 988       for (u = scc; nonNull(u); u=tl(u))
 989          hd(u) = mkCon(fst(hd(u)));
 990
 991       /* scc :: [CONID] */
 992       if (length(scc) > 1) {
 993          isRec = TRUE;
 994       } else {
 995          /* singleton module in scc; does it import itself? */
 996          mod = findModule ( textOf(hd(scc)) );
 997          assert(nonNull(mod));
 998          isRec = FALSE;
 999          for (u = module(mod).uses; nonNull(u); u=tl(u))
1000             if (textOf(hd(u))==textOf(hd(scc)))
1001                isRec = TRUE;
1002       }
1003
1004       if (isRec)
1005          moduleGraph = cons( ap(GRP_REC,scc), moduleGraph ); else
1006          moduleGraph = cons( ap(GRP_NONREC,hd(scc)), moduleGraph );
1007    }
1008    moduleGraph = reverse(moduleGraph);
1009 }
1010
1011
1012 static List /* of CONID */ getModuleImports ( Cell tree )
1013 {
1014    Cell  te;
1015    List  tes;
1016    ConId use;
1017    List  uses = NIL;
1018    for (tes = zthd3(unap(M_MODULE,tree)); nonNull(tes); tes=tl(tes)) {
1019       te = hd(tes);
1020       switch(whatIs(te)) {
1021          case M_IMPORT_Q:
1022             use = zfst(unap(M_IMPORT_Q,te));
1023             assert(isCon(use));
1024             if (!varIsMember(textOf(use),uses)) uses = cons ( use, uses );
1025             break;
1026          case M_IMPORT_UNQ:
1027             use = zfst(unap(M_IMPORT_UNQ,te));
1028             assert(isCon(use));
1029             if (!varIsMember(textOf(use),uses)) uses = cons ( use, uses );
1030             break;
1031          default:
1032             break;
1033       }
1034    }
1035    return uses;
1036 }
1037
1038
1039 static void processModule ( Module m )
1040 {
1041    Cell  tree;
1042    ConId modNm;
1043    List  topEnts;
1044    List  tes;
1045    Cell  te;
1046    Cell  te2;
1047
1048    tyconDefns     = NIL;
1049    typeInDefns    = NIL;
1050    valDefns       = NIL;
1051    classDefns     = NIL;
1052    instDefns      = NIL;
1053    selDefns       = NIL;
1054    genDefns       = NIL;
1055    unqualImports  = NIL;
1056    foreignImports = NIL;
1057    foreignExports = NIL;
1058    defaultDefns   = NIL;
1059    defaultLine    = 0;
1060    inputExpr      = NIL;
1061
1062    setCurrentFile(m);
1063    startModule(m);
1064    tree = unap(M_MODULE,module(m).tree);
1065    modNm = zfst3(tree);
1066
1067    if (textOf(modNm) != module(m).text) {
1068       ERRMSG(0) "Module name \"%s\" does not match file name \"%s%s\"",
1069                 textToStr(textOf(modNm)),
1070                 textToStr(module(m).text),
1071                 textToStr(module(m).srcExt)
1072       EEND;
1073    }
1074
1075    setExportList(zsnd3(tree));
1076    topEnts = zthd3(tree);
1077
1078    for (tes = topEnts; nonNull(tes); tes=tl(tes)) {
1079       te  = hd(tes);
1080       assert(isGenPair(te));
1081       te2 = snd(te);
1082       switch(whatIs(te)) {
1083          case M_IMPORT_Q:
1084             addQualImport(zfst(te2),zsnd(te2));
1085             break;
1086          case M_IMPORT_UNQ:
1087             addUnqualImport(zfst(te2),zsnd(te2));
1088             break;
1089          case M_TYCON:
1090             tyconDefn(zsel14(te2),zsel24(te2),zsel34(te2),zsel44(te2));
1091             break;
1092          case M_CLASS:
1093             classDefn(zsel14(te2),zsel24(te2),zsel34(te2),zsel44(te2));
1094             break;
1095          case M_INST:
1096             instDefn(zfst3(te2),zsnd3(te2),zthd3(te2));
1097             break;
1098          case M_DEFAULT:
1099             defaultDefn(zfst(te2),zsnd(te2));
1100             break;
1101          case M_FOREIGN_IM:
1102             foreignImport(zsel15(te2),zsel25(te2),zsel35(te2),
1103                           zsel45(te2),zsel55(te2));
1104             break;
1105          case M_FOREIGN_EX:
1106             foreignExport(zsel15(te2),zsel25(te2),zsel35(te2),
1107                           zsel45(te2),zsel55(te2));
1108          case M_VALUE:
1109             valDefns = cons(te2,valDefns);
1110             break;
1111          default:
1112             internal("processModule");
1113       }
1114    }
1115    checkDefns(m);
1116    typeCheckDefns();
1117    compileDefns();
1118 }
1119
1120
1121 static Module parseModuleOrInterface ( ConId mc, Cell modeRequest )
1122 {
1123    /* Allocate a module-table entry. */
1124    /* Parse the entity and fill in the .tree and .uses entries. */
1125    String path;
1126    String sExt;
1127    Bool sAvail;  Time sTime;  Long sSize;
1128    Bool oiAvail; Time oiTime; Long oSize; Long iSize;
1129    Bool ok;
1130    Bool useSource;
1131    char name[10000];
1132
1133    Text   mt  = textOf(mc);
1134    Module mod = findModule ( mt );
1135
1136    /* fprintf ( stderr, "parseModuleOrInterface `%s' == %d\n",
1137                 textToStr(mt),mod); */
1138    if (nonNull(mod) && !module(mod).fake)
1139       internal("parseModuleOrInterface");
1140    if (nonNull(mod))
1141       module(mod).fake = FALSE;
1142
1143    if (isNull(mod))
1144       mod = newModule(mt);
1145
1146    /* This call malloc-ates path; we should deallocate it. */
1147    ok = findFilesForModule (
1148            textToStr(module(mod).text),
1149            &path,
1150            &sExt,
1151            &sAvail,  &sTime,  &sSize,
1152            &oiAvail, &oiTime, &oSize, &iSize
1153         );
1154
1155    if (!ok) goto cant_find;
1156    if (!sAvail && !oiAvail) goto cant_find;
1157
1158    /* Find out whether to use source or object. */
1159    switch (modeRequest) {
1160       case FM_SOURCE:
1161          if (!sAvail) goto cant_find;
1162          useSource = TRUE;
1163          break;
1164       case FM_OBJECT:
1165          if (!oiAvail) goto cant_find;
1166          useSource = FALSE;
1167          break;
1168       case FM_EITHER:
1169          if ( sAvail && !oiAvail) { useSource = TRUE; break; }
1170          if (!sAvail &&  oiAvail) { useSource = FALSE; break; }
1171          useSource = firstTimeIsLater ( sTime, oiTime ) ? TRUE : FALSE;
1172          break;
1173       default:
1174          internal("parseModuleOrInterface");
1175    }
1176
1177
1178    /* Actually do the parsing. */
1179    if (useSource) {
1180       module(mod).srcExt = findText(sExt);
1181       setCurrentFile(mod);
1182       strcpy(name, path);
1183       strcat(name, textToStr(mt));
1184       strcat(name, sExt);
1185       module(mod).tree      = parseModule(name,sSize);
1186       module(mod).uses      = getModuleImports(module(mod).tree);
1187       module(mod).mode      = FM_SOURCE;
1188       module(mod).lastStamp = sTime;
1189    } else {
1190       module(mod).srcExt = findText(HI_ENDING);
1191       setCurrentFile(mod);
1192       strcpy(name, path);
1193       strcat(name, textToStr(mt));
1194       strcat(name, DLL_ENDING);
1195       module(mod).objName = findText(name);
1196       module(mod).objSize = oSize;
1197       strcpy(name, path);
1198       strcat(name, textToStr(mt));
1199       strcat(name, ".u_hi");
1200       module(mod).tree      = parseInterface(name,iSize);
1201       module(mod).uses      = getInterfaceImports(module(mod).tree);
1202       module(mod).mode      = FM_OBJECT;
1203       module(mod).lastStamp = oiTime;
1204    }
1205
1206    if (path) free(path);
1207    return mod;
1208
1209   cant_find:
1210    if (path) free(path);
1211    clearCurrentFile();
1212    ERRMSG(0)
1213       "Can't find %s for module \"%s\"",
1214       modeToString(modeRequest), textToStr(mt)
1215    EEND;
1216 }
1217
1218
1219 static void tryLoadGroup ( Cell grp )
1220 {
1221    Module m;
1222    List   t;
1223    switch (whatIs(grp)) {
1224       case GRP_NONREC:
1225          m = findModule(textOf(snd(grp)));
1226          assert(nonNull(m));
1227          if (module(m).mode == FM_SOURCE) {
1228             processModule ( m );
1229             module(m).tree = NIL;
1230          } else {
1231             processInterfaces ( singleton(snd(grp)) );
1232             m = findModule(textOf(snd(grp)));
1233             assert(nonNull(m));
1234             module(m).tree = NIL;
1235          }
1236          break;
1237       case GRP_REC:
1238          for (t = snd(grp); nonNull(t); t=tl(t)) {
1239             m = findModule(textOf(hd(t)));
1240             assert(nonNull(m));
1241             if (module(m).mode == FM_SOURCE) {
1242                ERRMSG(0) "Source module \"%s\" imports itself recursively",
1243                          textToStr(textOf(hd(t)))
1244                EEND;
1245             }
1246          }
1247          processInterfaces ( snd(grp) );
1248          for (t = snd(grp); nonNull(t); t=tl(t)) {
1249             m = findModule(textOf(hd(t)));
1250             assert(nonNull(m));
1251             module(m).tree = NIL;
1252          }
1253          break;
1254       default:
1255          internal("tryLoadGroup");
1256    }
1257 }
1258
1259
1260 static void fallBackToPrelModules ( void )
1261 {
1262    Module m;
1263    for (m = MODULE_BASE_ADDR;
1264         m < MODULE_BASE_ADDR+tabModuleSz; m++)
1265       if (module(m).inUse
1266           && !varIsMember(module(m).text, prelModules))
1267          nukeModule(m);
1268 }
1269
1270
1271 /* This function catches exceptions in most of the system.
1272    So it's only ok for procedures called from this one
1273    to do EENDs (ie, write error messages).  Others should use
1274    EEND_NO_LONGJMP.
1275 */
1276 static void achieveTargetModules ( Bool loadingThePrelude )
1277 {
1278    volatile List   ood;
1279    volatile List   modgList;
1280    volatile List   t;
1281    volatile Module mod;
1282    volatile Bool   ok;
1283
1284    String path = NULL;
1285    String sExt = NULL;
1286    Bool sAvail;  Time sTime;  Long sSize;
1287    Bool oiAvail; Time oiTime; Long oSize; Long iSize;
1288
1289    volatile Time oisTime;
1290    volatile Bool out_of_date;
1291    volatile List ood_new;
1292    volatile List us;
1293    volatile List modgList_new;
1294    volatile List parsedButNotLoaded;
1295    volatile List toChase;
1296    volatile List trans_cl;
1297    volatile List trans_cl_new;
1298    volatile List u;
1299    volatile List mg;
1300    volatile List mg2;
1301    volatile Cell grp;
1302    volatile List badMods;
1303
1304    setBreakAction ( HugsIgnoreBreak );
1305
1306    /* First, examine timestamps to find out which modules are
1307       out of date with respect to the source/interface/object files.
1308    */
1309    ood      = NIL;
1310    modgList = listFromMG();
1311
1312    for (t = modgList; nonNull(t); t=tl(t)) {
1313
1314       if (varIsMember(textOf(hd(t)),prelModules))
1315          continue;
1316
1317       mod = findModule(textOf(hd(t)));
1318       if (isNull(mod)) internal("achieveTargetSet(1)");
1319
1320       /* In standalone mode, only succeeds for source modules. */
1321       ok = findFilesForModule (
1322               textToStr(module(mod).text),
1323               &path,
1324               &sExt,
1325               &sAvail,  &sTime,  &sSize,
1326               &oiAvail, &oiTime, &oSize, &iSize
1327            );
1328
1329       if (!combined && !sAvail) ok = FALSE;
1330       if (!ok) {
1331          fallBackToPrelModules();
1332          ERRMSG(0)
1333             "Can't find source or object+interface for module \"%s\"",
1334             textToStr(module(mod).text)
1335          EEND_NO_LONGJMP;
1336          if (path) free(path);
1337          return;
1338       }
1339
1340       if (sAvail && oiAvail) {
1341          oisTime = whicheverIsLater(sTime,oiTime);
1342       }
1343       else if (sAvail && !oiAvail) {
1344          oisTime = sTime;
1345       }
1346       else if (!sAvail && oiAvail) {
1347          oisTime = oiTime;
1348       }
1349       else {
1350          internal("achieveTargetSet(2)");
1351       }
1352
1353       out_of_date = firstTimeIsLater(oisTime,module(mod).lastStamp);
1354       if (out_of_date) {
1355          assert(!varIsMember(textOf(hd(t)),ood));
1356          ood = cons(hd(t),ood);
1357       }
1358
1359       if (path) { free(path); path = NULL; };
1360    }
1361
1362    /* Second, form a simplistic transitive closure of the out-of-date
1363       modules: a module is out of date if it imports an out-of-date
1364       module.
1365    */
1366    while (1) {
1367       ood_new = NIL;
1368       for (t = modgList; nonNull(t); t=tl(t)) {
1369          mod = findModule(textOf(hd(t)));
1370          assert(nonNull(mod));
1371          for (us = module(mod).uses; nonNull(us); us=tl(us))
1372             if (varIsMember(textOf(hd(us)),ood))
1373                break;
1374          if (nonNull(us)) {
1375             if (varIsMember(textOf(hd(t)),prelModules))
1376                Printf ( "warning: prelude module \"%s\" is out-of-date\n",
1377                         textToStr(textOf(hd(t))) );
1378             else
1379                if (!varIsMember(textOf(hd(t)),ood_new) &&
1380                    !varIsMember(textOf(hd(t)),ood))
1381                   ood_new = cons(hd(t),ood_new);
1382          }
1383       }
1384       if (isNull(ood_new)) break;
1385       ood = appendOnto(ood_new,ood);
1386    }
1387
1388    /* Now ood holds the entire set of modules which are out-of-date.
1389       Throw them out of the system, yielding a "reduced system",
1390       in which the remaining modules are in-date.
1391    */
1392    for (t = ood; nonNull(t); t=tl(t)) {
1393       mod = findModule(textOf(hd(t)));
1394       assert(nonNull(mod));
1395       nukeModule(mod);
1396    }
1397    modgList_new = NIL;
1398    for (t = modgList; nonNull(t); t=tl(t))
1399       if (!varIsMember(textOf(hd(t)),ood))
1400          modgList_new = cons(hd(t),modgList_new);
1401    modgList = modgList_new;
1402
1403    /* Update the module group list to reflect the reduced system.
1404       We do this so that if the following parsing phases fail, we can
1405       safely fall back to the reduced system.
1406    */
1407    mgFromList ( modgList );
1408
1409    /* Parse modules/interfaces, collecting parse trees and chasing
1410       imports, starting from the target set.
1411    */
1412    toChase = dupList(targetModules);
1413    for (t = toChase; nonNull(t); t=tl(t)) {
1414       Cell mode = (!combined)
1415                   ? FM_SOURCE
1416                   : ( (loadingThePrelude && combined)
1417                       ? FM_OBJECT
1418                       : FM_EITHER );
1419       hd(t) = zpair(hd(t), mode);
1420    }
1421
1422    /* toChase :: [ ((ConId, {FM_SOURCE|FM_OBJECT|FM_EITHER} )) ] */
1423
1424    parsedButNotLoaded = NIL;
1425
1426
1427    while (nonNull(toChase)) {
1428       ConId mc   = zfst(hd(toChase));
1429       Cell  mode = zsnd(hd(toChase));
1430       toChase    = tl(toChase);
1431       if (varIsMember(textOf(mc),modgList)
1432           || varIsMember(textOf(mc),parsedButNotLoaded)) {
1433          /* either exists fully, or is at least parsed */
1434          mod = findModule(textOf(mc));
1435          assert(nonNull(mod));
1436          if (!compatibleNewMode(mode,module(mod).mode)) {
1437             clearCurrentFile();
1438             ERRMSG(0)
1439                "module %s: %s required, but %s is more recent",
1440                textToStr(textOf(mc)), modeToString(mode),
1441                modeToString(module(mod).mode)
1442             EEND_NO_LONGJMP;
1443             goto parseException;
1444          }
1445       } else {
1446
1447          setBreakAction ( HugsLongjmpOnBreak );
1448          if (setjmp(catch_error)==0) {
1449             /* try this; it may throw an exception */
1450             mod = parseModuleOrInterface ( mc, mode );
1451          } else {
1452             /* here's the exception handler, if parsing fails */
1453             /* A parse error (or similar).  Clean up and abort. */
1454            parseException:
1455             setBreakAction ( HugsIgnoreBreak );
1456             mod = findModule(textOf(mc));
1457             if (nonNull(mod)) nukeModule(mod);
1458             for (t = parsedButNotLoaded; nonNull(t); t=tl(t)) {
1459                mod = findModule(textOf(hd(t)));
1460                assert(nonNull(mod));
1461                if (nonNull(mod)) nukeModule(mod);
1462             }
1463             return;
1464             /* end of the exception handler */
1465          }
1466          setBreakAction ( HugsIgnoreBreak );
1467
1468          parsedButNotLoaded = cons(mc, parsedButNotLoaded);
1469          for (t = module(mod).uses; nonNull(t); t=tl(t))
1470             toChase = cons(
1471                         zpair( hd(t), childMode(mode,module(mod).mode) ),
1472                         toChase);
1473       }
1474    }
1475
1476    modgList = dupOnto(parsedButNotLoaded, modgList);
1477
1478    /* We successfully parsed all modules reachable from the target
1479       set which were not part of the reduced system.  However, there
1480       may be modules in the reduced system which are not reachable from
1481       the target set.  We detect these now by building the transitive
1482       closure of the target set, and nuking modules in the reduced
1483       system which are not part of that closure.
1484    */
1485    trans_cl = dupList(targetModules);
1486    while (1) {
1487       trans_cl_new = NIL;
1488       for (t = trans_cl; nonNull(t); t=tl(t)) {
1489          mod = findModule(textOf(hd(t)));
1490          assert(nonNull(mod));
1491          for (u = module(mod).uses; nonNull(u); u=tl(u))
1492             if (!varIsMember(textOf(hd(u)),trans_cl)
1493                 && !varIsMember(textOf(hd(u)),trans_cl_new)
1494                 && !varIsMember(textOf(hd(u)),prelModules))
1495                trans_cl_new = cons(hd(u),trans_cl_new);
1496       }
1497       if (isNull(trans_cl_new)) break;
1498       trans_cl = appendOnto(trans_cl_new,trans_cl);
1499    }
1500    modgList_new = NIL;
1501    for (t = modgList; nonNull(t); t=tl(t)) {
1502       if (varIsMember(textOf(hd(t)),trans_cl)) {
1503          modgList_new = cons(hd(t),modgList_new);
1504       } else {
1505          mod = findModule(textOf(hd(t)));
1506          assert(nonNull(mod));
1507          nukeModule(mod);
1508       }
1509    }
1510    modgList = modgList_new;
1511
1512    /* Now, the module symbol tables hold exactly the set of
1513       modules reachable from the target set, and modgList holds
1514       their names.   Calculate the scc-ified module graph,
1515       since we need that to guide the next stage, that of
1516       Actually Loading the modules.
1517
1518       If no errors occur, moduleGraph will reflect the final graph
1519       loaded.  If an error occurs loading a group, we nuke
1520       that group, truncate the moduleGraph just prior to that
1521       group, and exit.  That leaves the system having successfully
1522       loaded all groups prior to the one which failed.
1523    */
1524    mgFromList ( modgList );
1525
1526    for (mg = moduleGraph; nonNull(mg); mg=tl(mg)) {
1527       grp = hd(mg);
1528
1529       if (!varIsMember(textOf(selectArbitrarilyFromGroup(grp)),
1530                        parsedButNotLoaded)) continue;
1531
1532       setBreakAction ( HugsLongjmpOnBreak );
1533       if (setjmp(catch_error)==0) {
1534          /* try this; it may throw an exception */
1535          tryLoadGroup(grp);
1536       } else {
1537          /* here's the exception handler, if static/typecheck etc fails */
1538          /* nuke the entire rest (ie, the unloaded part)
1539             of the module graph */
1540          setBreakAction ( HugsIgnoreBreak );
1541          badMods = listFromSpecifiedMG ( mg );
1542          for (t = badMods; nonNull(t); t=tl(t)) {
1543             mod = findModule(textOf(hd(t)));
1544             if (nonNull(mod)) nukeModule(mod);
1545          }
1546          /* truncate the module graph just prior to this group. */
1547          mg2 = NIL;
1548          mg = moduleGraph;
1549          while (TRUE) {
1550             if (isNull(mg)) break;
1551             if (hd(mg) == grp) break;
1552             mg2 = cons ( hd(mg), mg2 );
1553             mg = tl(mg);
1554          }
1555          moduleGraph = reverse(mg2);
1556          return;
1557          /* end of the exception handler */
1558       }
1559       setBreakAction ( HugsIgnoreBreak );
1560    }
1561
1562    /* Err .. I think that's it.  If we get here, we've successfully
1563       achieved the target set.  Phew!
1564    */
1565    setBreakAction ( HugsIgnoreBreak );
1566 }
1567
1568
1569 static Bool loadThePrelude ( void )
1570 {
1571    Bool ok;
1572    ConId conPrelude;
1573    ConId conPrelHugs;
1574    moduleGraph = prelModules = NIL;
1575
1576    if (combined) {
1577       conPrelude    = mkCon(findText("Prelude"));
1578       conPrelHugs   = mkCon(findText("PrelHugs"));
1579       targetModules = doubleton(conPrelude,conPrelHugs);
1580       achieveTargetModules(TRUE);
1581       ok = elemMG(conPrelude) && elemMG(conPrelHugs);
1582    } else {
1583       conPrelude    = mkCon(findText("Prelude"));
1584       targetModules = singleton(conPrelude);
1585       achieveTargetModules(TRUE);
1586       ok = elemMG(conPrelude);
1587    }
1588
1589    if (ok) prelModules = listFromMG();
1590    return ok;
1591 }
1592
1593
1594 static void refreshActions ( ConId nextCurrMod, Bool cleanAfter )
1595 {
1596    List t;
1597    ConId tryFor = mkCon(module(currentModule).text);
1598    achieveTargetModules(FALSE);
1599    if (nonNull(nextCurrMod))
1600       tryFor = nextCurrMod;
1601    if (!elemMG(tryFor))
1602       tryFor = selectLatestMG();
1603    /* combined mode kludge, to get Prelude rather than PrelHugs */
1604    if (combined && textOf(tryFor)==findText("PrelHugs"))
1605       tryFor = mkCon(findText("Prelude"));
1606
1607    if (cleanAfter) {
1608    /* delete any targetModules which didn't actually get loaded  */
1609    t = targetModules;
1610    targetModules = NIL;
1611    for (; nonNull(t); t=tl(t))
1612       if (elemMG(hd(t)))
1613          targetModules = cons(hd(t),targetModules);
1614    }
1615
1616    setCurrModule ( findModule(textOf(tryFor)) );
1617    Printf("Hugs session for:\n");
1618    ppMG();
1619 }
1620
1621
1622 static void addActions ( List extraModules /* :: [CONID] */ )
1623 {
1624    List t;
1625    for (t = extraModules; nonNull(t); t=tl(t)) {
1626       ConId extra = hd(t);
1627       if (!varIsMember(textOf(extra),targetModules))
1628          targetModules = cons(extra,targetModules);
1629    }
1630    refreshActions ( isNull(extraModules)
1631                        ? NIL
1632                        : hd(reverse(extraModules)),
1633                     TRUE
1634                   );
1635 }
1636
1637
1638 static void loadActions ( List loadModules /* :: [CONID] */ )
1639 {
1640    List t;
1641    targetModules = dupList ( prelModules );
1642
1643    for (t = loadModules; nonNull(t); t=tl(t)) {
1644       ConId load = hd(t);
1645       if (!varIsMember(textOf(load),targetModules))
1646          targetModules = cons(load,targetModules);
1647    }
1648    refreshActions ( isNull(loadModules)
1649                        ? NIL
1650                        : hd(reverse(loadModules)),
1651                     TRUE
1652                   );
1653 }
1654
1655
1656 /* --------------------------------------------------------------------------
1657  * Access to external editor:
1658  * ------------------------------------------------------------------------*/
1659
1660 /* ToDo: All this editor stuff needs fixing. */
1661
1662 static Void local editor() {            /* interpreter-editor interface    */
1663 #if 0
1664     String newFile  = readFilename();
1665     if (newFile) {
1666         setLastEdit(newFile,0);
1667         if (readFilename()) {
1668             ERRMSG(0) "Multiple filenames not permitted"
1669             EEND;
1670         }
1671     }
1672     runEditor();
1673 #endif
1674 }
1675
1676 static Void local find() {              /* edit file containing definition */
1677 #if 0
1678 ToDo: Fix!
1679     String nm = readFilename();         /* of specified name               */
1680     if (!nm) {
1681         ERRMSG(0) "No name specified"
1682         EEND;
1683     }
1684     else if (readFilename()) {
1685         ERRMSG(0) "Multiple names not permitted"
1686         EEND;
1687     }
1688     else {
1689         Text t;
1690         Cell c;
1691         setCurrModule(findEvalModule());
1692         startNewScript(0);
1693         if (nonNull(c=findTycon(t=findText(nm)))) {
1694             if (startEdit(tycon(c).line,scriptName[scriptThisTycon(c)])) {
1695                 readScripts(N_PRELUDE_SCRIPTS);
1696             }
1697         } else if (nonNull(c=findName(t))) {
1698             if (startEdit(name(c).line,scriptName[scriptThisName(c)])) {
1699                 readScripts(N_PRELUDE_SCRIPTS);
1700             }
1701         } else {
1702             ERRMSG(0) "No current definition for name \"%s\"", nm
1703             EEND;
1704         }
1705     }
1706 #endif
1707 }
1708
1709 static Void local runEditor() {         /* run editor on script lastEdit   */
1710 #if 0
1711     if (startEdit(lastEdLine,lastEdit)) /* at line lastEdLine              */
1712         readScripts(N_PRELUDE_SCRIPTS);
1713 #endif
1714 }
1715
1716 static Void local setLastEdit(fname,line)/* keep name of last file to edit */
1717 String fname;
1718 Int    line; {
1719 #if 0
1720     if (lastEdit)
1721         free(lastEdit);
1722     lastEdit = strCopy(fname);
1723     lastEdLine = line;
1724 #endif
1725 }
1726
1727 /* --------------------------------------------------------------------------
1728  * Read and evaluate an expression:
1729  * ------------------------------------------------------------------------*/
1730
1731 static Void setModule ( void ) {
1732                               /*set module in which to evaluate expressions*/
1733    Module m;
1734    ConId  mc = NIL;
1735    String s  = readFilename();
1736    if (!s) {
1737       mc = selectLatestMG();
1738       if (combined && textOf(mc)==findText("PrelHugs"))
1739          mc = mkCon(findText("Prelude"));
1740       m = findModule(textOf(mc));
1741       assert(nonNull(m));
1742    } else {
1743       m = findModule(findText(s));
1744       if (isNull(m)) {
1745          ERRMSG(0) "Cannot find module \"%s\"", s
1746          EEND_NO_LONGJMP;
1747          return;
1748       }
1749    }
1750    setCurrModule(m);
1751 }
1752
1753 static Module allocEvalModule ( void )
1754 {
1755    Module evalMod = newModule( findText("_Eval_Module_") );
1756    module(evalMod).names   = module(currentModule).names;
1757    module(evalMod).tycons  = module(currentModule).tycons;
1758    module(evalMod).classes = module(currentModule).classes;
1759    module(evalMod).qualImports
1760      = singleton(pair(mkCon(textPrelude),modulePrelude));
1761    return evalMod;
1762 }
1763
1764 static Void local evaluator() {        /* evaluate expr and print value    */
1765     volatile Type   type;
1766     volatile Type   bd;
1767     volatile Kinds  ks      = NIL;
1768     volatile Module evalMod = allocEvalModule();
1769     volatile Module currMod = currentModule;
1770     setCurrModule(evalMod);
1771     currentFile = NULL;
1772
1773     defaultDefns = combined ? stdDefaults : evalDefaults;
1774
1775     setBreakAction ( HugsLongjmpOnBreak );
1776     if (setjmp(catch_error)==0) {
1777        /* try this */
1778        parseExp();
1779        checkExp();
1780        type = typeCheckExp(TRUE);
1781     } else {
1782        /* if an exception happens, we arrive here */
1783        setBreakAction ( HugsIgnoreBreak );
1784        goto cleanup_and_return;
1785     }
1786
1787     setBreakAction ( HugsIgnoreBreak );
1788     if (isPolyType(type)) {
1789         ks = polySigOf(type);
1790         bd = monotypeOf(type);
1791     }
1792     else
1793         bd = type;
1794
1795     if (whatIs(bd)==QUAL) {
1796        ERRMSG(0) "Unresolved overloading" ETHEN
1797        ERRTEXT   "\n*** Type       : "    ETHEN ERRTYPE(type);
1798        ERRTEXT   "\n*** Expression : "    ETHEN ERREXPR(inputExpr);
1799        ERRTEXT   "\n"
1800        EEND_NO_LONGJMP;
1801        goto cleanup_and_return;
1802     }
1803
1804 #if 1
1805     if (isProgType(ks,bd)) {
1806         inputExpr = ap(nameRunIO_toplevel,inputExpr);
1807         evalExp();
1808         Putchar('\n');
1809     } else {
1810         Cell d = provePred(ks,NIL,ap(classShow,bd));
1811         if (isNull(d)) {
1812            ERRMSG(0) "Cannot find \"show\" function for:" ETHEN
1813            ERRTEXT   "\n*** expression : "   ETHEN ERREXPR(inputExpr);
1814            ERRTEXT   "\n*** of type    : "   ETHEN ERRTYPE(type);
1815            ERRTEXT   "\n"
1816            EEND_NO_LONGJMP;
1817            goto cleanup_and_return;
1818         }
1819         inputExpr = ap2(nameShow,           d,inputExpr);
1820         inputExpr = ap (namePutStr,         inputExpr);
1821         inputExpr = ap (nameRunIO_toplevel, inputExpr);
1822
1823         evalExp(); printf("\n");
1824         if (addType) {
1825             printf(" :: ");
1826             printType(stdout,type);
1827             Putchar('\n');
1828         }
1829     }
1830
1831 #else
1832
1833    printf ( "result type is " );
1834    printType ( stdout, type );
1835    printf ( "\n" );
1836    evalExp();
1837    printf ( "\n" );
1838
1839 #endif
1840
1841   cleanup_and_return:
1842    setBreakAction ( HugsIgnoreBreak );
1843    nukeModule(evalMod);
1844    setCurrModule(currMod);
1845    setCurrentFile(currMod);
1846 }
1847
1848
1849
1850 /* --------------------------------------------------------------------------
1851  * Print type of input expression:
1852  * ------------------------------------------------------------------------*/
1853
1854 static Void showtype ( void ) {        /* print type of expression (if any)*/
1855
1856     volatile Cell   type;
1857     volatile Module evalMod = allocEvalModule();
1858     volatile Module currMod = currentModule;
1859     setCurrModule(evalMod);
1860
1861     if (setjmp(catch_error)==0) {
1862        /* try this */
1863        parseExp();
1864        checkExp();
1865        defaultDefns = evalDefaults;
1866        type = typeCheckExp(FALSE);
1867        printExp(stdout,inputExpr);
1868        Printf(" :: ");
1869        printType(stdout,type);
1870        Putchar('\n');
1871     } else {
1872        /* if an exception happens, we arrive here */
1873     }
1874
1875     nukeModule(evalMod);
1876     setCurrModule(currMod);
1877 }
1878
1879
1880 static Void local browseit(mod,t,all)
1881 Module mod;
1882 String t;
1883 Bool all; {
1884     if (nonNull(mod)) {
1885         Cell cs;
1886         if (nonNull(t))
1887             Printf("module %s where\n",textToStr(module(mod).text));
1888         for (cs = module(mod).names; nonNull(cs); cs=tl(cs)) {
1889             Name nm = hd(cs);
1890             /* only look at things defined in this module,
1891                unless `all' flag is set */
1892             if (all || name(nm).mod == mod) {
1893                 /* unwanted artifacts, like lambda lifted values,
1894                    are in the list of names, but have no types */
1895                 if (nonNull(name(nm).type)) {
1896                     printExp(stdout,nm);
1897                     Printf(" :: ");
1898                     printType(stdout,name(nm).type);
1899                     if (isCfun(nm)) {
1900                         Printf("  -- data constructor");
1901                     } else if (isMfun(nm)) {
1902                         Printf("  -- class member");
1903                     } else if (isSfun(nm)) {
1904                         Printf("  -- selector function");
1905                     }
1906                     Printf("\n");
1907                 }
1908             }
1909         }
1910     } else {
1911       if (isNull(mod)) {
1912         Printf("Unknown module %s\n",t);
1913       }
1914     }
1915 }
1916
1917 static Void local browse() {            /* browse modules                  */
1918     Int    count = 0;                   /* or give menu of commands        */
1919     String s;
1920     Bool all = FALSE;
1921
1922     for (; (s=readFilename())!=0; count++)
1923         if (strcmp(s,"all") == 0) {
1924             all = TRUE;
1925             --count;
1926         } else
1927             browseit(findModule(findText(s)),s,all);
1928     if (count == 0) {
1929         browseit(currentModule,NULL,all);
1930     }
1931 }
1932
1933 #if EXPLAIN_INSTANCE_RESOLUTION
1934 static Void local xplain() {         /* print type of expression (if any)*/
1935     Cell d;
1936     Bool sir = showInstRes;
1937
1938     setCurrModule(findEvalModule());
1939     startNewScript(0);                 /* Enables recovery of storage      */
1940                                        /* allocated during evaluation      */
1941     parseContext();
1942     checkContext();
1943     showInstRes = TRUE;
1944     d = provePred(NIL,NIL,hd(inputContext));
1945     if (isNull(d)) {
1946         fprintf(stdout, "not Sat\n");
1947     } else {
1948         fprintf(stdout, "Sat\n");
1949     }
1950     showInstRes = sir;
1951 }
1952 #endif
1953
1954 /* --------------------------------------------------------------------------
1955  * Enhanced help system:  print current list of scripts or give information
1956  * about an object.
1957  * ------------------------------------------------------------------------*/
1958
1959 static String local objToStr(m,c)
1960 Module m;
1961 Cell   c; {
1962 #if 1 || DISPLAY_QUANTIFIERS
1963     static char newVar[60];
1964     switch (whatIs(c)) {
1965         case NAME  : if (m == name(c).mod) {
1966                          sprintf(newVar,"%s", textToStr(name(c).text));
1967                      } else {
1968                          sprintf(newVar,"%s.%s",
1969                                         textToStr(module(name(c).mod).text),
1970                                         textToStr(name(c).text));
1971                      }
1972                      break;
1973
1974         case TYCON : if (m == tycon(c).mod) {
1975                          sprintf(newVar,"%s", textToStr(tycon(c).text));
1976                      } else {
1977                          sprintf(newVar,"%s.%s",
1978                                         textToStr(module(tycon(c).mod).text),
1979                                         textToStr(tycon(c).text));
1980                      }
1981                      break;
1982
1983         case CLASS : if (m == cclass(c).mod) {
1984                          sprintf(newVar,"%s", textToStr(cclass(c).text));
1985                      } else {
1986                          sprintf(newVar,"%s.%s",
1987                                         textToStr(module(cclass(c).mod).text),
1988                                         textToStr(cclass(c).text));
1989                      }
1990                      break;
1991
1992         default    : internal("objToStr");
1993     }
1994     return newVar;
1995 #else
1996     static char newVar[33];
1997     switch (whatIs(c)) {
1998         case NAME  : sprintf(newVar,"%s", textToStr(name(c).text));
1999                      break;
2000
2001         case TYCON : sprintf(newVar,"%s", textToStr(tycon(c).text));
2002                      break;
2003
2004         case CLASS : sprintf(newVar,"%s", textToStr(cclass(c).text));
2005                      break;
2006
2007         default    : internal("objToStr");
2008     }
2009     return newVar;
2010 #endif
2011 }
2012
2013 extern Name nameHw;
2014
2015 static Void dumpStg ( void )
2016 {
2017    String s;
2018    Int i;
2019 #if 0
2020    Whats this for?
2021    setCurrModule(findEvalModule());
2022    startNewScript(0);
2023 #endif
2024    s = readFilename();
2025
2026    /* request to locate a symbol by name */
2027    if (s && (*s == '?')) {
2028       Text t = findText(s+1);
2029       locateSymbolByName(t);
2030       return;
2031    }
2032
2033    /* request to dump a bit of the heap */
2034    if (s && (*s == '-' || isdigit(*s))) {
2035       int i = atoi(s);
2036       print(i,100);
2037       printf("\n");
2038       return;
2039    }
2040
2041    /* request to dump a symbol table entry */
2042    if (!s
2043        || !(*s == 't' || *s == 'n' || *s == 'c' || *s == 'i')
2044        || !isdigit(s[1])) {
2045       fprintf(stderr, ":d -- bad request `%s'\n", s );
2046       return;
2047    }
2048    i = atoi(s+1);
2049    switch (*s) {
2050       case 't': dumpTycon(i); break;
2051       case 'n': dumpName(i); break;
2052       case 'c': dumpClass(i); break;
2053       case 'i': dumpInst(i); break;
2054       default: fprintf(stderr, ":d -- `%c' not implemented\n", *s );
2055    }
2056 }
2057
2058
2059 #if 0
2060 static Void local dumpStg( void ) {       /* print STG stuff                 */
2061     String s;
2062     Text   t;
2063     Name   n;
2064     Int    i;
2065     Cell   v;                           /* really StgVar */
2066     setCurrModule(findEvalModule());
2067     startNewScript(0);
2068     for (; (s=readFilename())!=0;) {
2069         t = findText(s);
2070         v = n = NIL;
2071         /* find the name while ignoring module scopes */
2072         for (i=NAMEMIN; i<nameHw; i++)
2073            if (name(i).text == t) n = i;
2074
2075         /* perhaps it's an "idNNNNNN" thing? */
2076         if (isNull(n) &&
2077             strlen(s) >= 3 &&
2078             s[0]=='i' && s[1]=='d' && isdigit(s[2])) {
2079            v = 0;
2080            i = 2;
2081            while (isdigit(s[i])) {
2082               v = v * 10 + (s[i]-'0');
2083               i++;
2084            }
2085            v = -v;
2086            n = nameFromStgVar(v);
2087         }
2088
2089         if (isNull(n) && whatIs(v)==STGVAR) {
2090            Printf ( "\n{- `%s' has no nametable entry -}\n", s );
2091            printStg(stderr, v );
2092         } else
2093         if (isNull(n)) {
2094            Printf ( "Unknown reference `%s'\n", s );
2095         } else
2096         if (!isName(n)) {
2097            Printf ( "Not a Name: `%s'\n", s );
2098         } else
2099         if (isNull(name(n).stgVar)) {
2100            Printf ( "Doesn't have a STG tree: %s\n", s );
2101         } else {
2102            Printf ( "\n{- stgVar of `%s' is id%d -}\n", s, -name(n).stgVar);
2103            printStg(stderr, name(n).stgVar);
2104         }
2105     }
2106 }
2107 #endif
2108
2109 static Void local info() {              /* describe objects                */
2110     Int    count = 0;                   /* or give menu of commands        */
2111     String s;
2112
2113     for (; (s=readFilename())!=0; count++) {
2114         describe(findText(s));
2115     }
2116     if (count == 0) {
2117        /* whatScripts(); */
2118     }
2119 }
2120
2121
2122 static Void local describe(t)           /* describe an object              */
2123 Text t; {
2124     Tycon  tc  = findTycon(t);
2125     Class  cl  = findClass(t);
2126     Name   nm  = findName(t);
2127
2128     if (nonNull(tc)) {                  /* as a type constructor           */
2129         Type t = tc;
2130         Int  i;
2131         Inst in;
2132         for (i=0; i<tycon(tc).arity; ++i) {
2133             t = ap(t,mkOffset(i));
2134         }
2135         Printf("-- type constructor");
2136         if (kindExpert) {
2137             Printf(" with kind ");
2138             printKind(stdout,tycon(tc).kind);
2139         }
2140         Putchar('\n');
2141         switch (tycon(tc).what) {
2142             case SYNONYM      : Printf("type ");
2143                                 printType(stdout,t);
2144                                 Printf(" = ");
2145                                 printType(stdout,tycon(tc).defn);
2146                                 break;
2147
2148             case NEWTYPE      :
2149             case DATATYPE     : {   List cs = tycon(tc).defn;
2150                                     if (tycon(tc).what==DATATYPE) {
2151                                         Printf("data ");
2152                                     } else {
2153                                         Printf("newtype ");
2154                                     }
2155                                     printType(stdout,t);
2156                                     Putchar('\n');
2157                                     mapProc(printSyntax,cs);
2158                                     if (hasCfun(cs)) {
2159                                         Printf("\n-- constructors:");
2160                                     }
2161                                     for (; hasCfun(cs); cs=tl(cs)) {
2162                                         Putchar('\n');
2163                                         printExp(stdout,hd(cs));
2164                                         Printf(" :: ");
2165                                         printType(stdout,name(hd(cs)).type);
2166                                     }
2167                                     if (nonNull(cs)) {
2168                                         Printf("\n-- selectors:");
2169                                     }
2170                                     for (; nonNull(cs); cs=tl(cs)) {
2171                                         Putchar('\n');
2172                                         printExp(stdout,hd(cs));
2173                                         Printf(" :: ");
2174                                         printType(stdout,name(hd(cs)).type);
2175                                     }
2176                                 }
2177                                 break;
2178
2179             case RESTRICTSYN  : Printf("type ");
2180                                 printType(stdout,t);
2181                                 Printf(" = <restricted>");
2182                                 break;
2183         }
2184         Putchar('\n');
2185         if (nonNull(in=findFirstInst(tc))) {
2186             Printf("\n-- instances:\n");
2187             do {
2188                 showInst(in);
2189                 in = findNextInst(tc,in);
2190             } while (nonNull(in));
2191         }
2192         Putchar('\n');
2193     }
2194
2195     if (nonNull(cl)) {                  /* as a class                      */
2196         List  ins = cclass(cl).instances;
2197         Kinds ks  = cclass(cl).kinds;
2198         if (nonNull(ks) && isNull(tl(ks)) && hd(ks)==STAR) {
2199             Printf("-- type class");
2200         } else {
2201             Printf("-- constructor class");
2202             if (kindExpert) {
2203                 Printf(" with arity ");
2204                 printKinds(stdout,ks);
2205             }
2206         }
2207         Putchar('\n');
2208         mapProc(printSyntax,cclass(cl).members);
2209         Printf("class ");
2210         if (nonNull(cclass(cl).supers)) {
2211             printContext(stdout,cclass(cl).supers);
2212             Printf(" => ");
2213         }
2214         printPred(stdout,cclass(cl).head);
2215
2216         if (nonNull(cclass(cl).fds)) {
2217             List   fds = cclass(cl).fds;
2218             String pre = " | ";
2219             for (; nonNull(fds); fds=tl(fds)) {
2220                 Printf(pre);
2221                 printFD(stdout,hd(fds));
2222                 pre = ", ";
2223             }
2224         }
2225
2226         if (nonNull(cclass(cl).members)) {
2227             List ms = cclass(cl).members;
2228             Printf(" where");
2229             do {
2230                 Type t = name(hd(ms)).type;
2231                 if (isPolyType(t)) {
2232                     t = monotypeOf(t);
2233                 }
2234                 Printf("\n  ");
2235                 printExp(stdout,hd(ms));
2236                 Printf(" :: ");
2237                 if (isNull(tl(fst(snd(t))))) {
2238                     t = snd(snd(t));
2239                 } else {
2240                     t = ap(QUAL,pair(tl(fst(snd(t))),snd(snd(t))));
2241                 }
2242                 printType(stdout,t);
2243                 ms = tl(ms);
2244             } while (nonNull(ms));
2245         }
2246         Putchar('\n');
2247         if (nonNull(ins)) {
2248             Printf("\n-- instances:\n");
2249             do {
2250                 showInst(hd(ins));
2251                 ins = tl(ins);
2252             } while (nonNull(ins));
2253         }
2254         Putchar('\n');
2255     }
2256
2257     if (nonNull(nm)) {                  /* as a function/name              */
2258         printSyntax(nm);
2259         printExp(stdout,nm);
2260         Printf(" :: ");
2261         if (nonNull(name(nm).type)) {
2262             printType(stdout,name(nm).type);
2263         } else {
2264             Printf("<unknown type>");
2265         }
2266         if (isCfun(nm)) {
2267             Printf("  -- data constructor");
2268         } else if (isMfun(nm)) {
2269             Printf("  -- class member");
2270         } else if (isSfun(nm)) {
2271             Printf("  -- selector function");
2272         }
2273         Printf("\n\n");
2274     }
2275
2276
2277     if (isNull(tc) && isNull(cl) && isNull(nm)) {
2278         Printf("Unknown reference `%s'\n",textToStr(t));
2279     }
2280 }
2281
2282 static Void local printSyntax(nm)
2283 Name nm; {
2284     Syntax sy = syntaxOf(nm);
2285     Text   t  = name(nm).text;
2286     String s  = textToStr(t);
2287     if (sy != defaultSyntax(t)) {
2288         Printf("infix");
2289         switch (assocOf(sy)) {
2290             case LEFT_ASS  : Putchar('l'); break;
2291             case RIGHT_ASS : Putchar('r'); break;
2292             case NON_ASS   : break;
2293         }
2294         Printf(" %i ",precOf(sy));
2295         if (isascii((int)(*s)) && isalpha((int)(*s))) {
2296             Printf("`%s`",s);
2297         } else {
2298             Printf("%s",s);
2299         }
2300         Putchar('\n');
2301     }
2302 }
2303
2304 static Void local showInst(in)          /* Display instance decl header    */
2305 Inst in; {
2306     Printf("instance ");
2307     if (nonNull(inst(in).specifics)) {
2308         printContext(stdout,inst(in).specifics);
2309         Printf(" => ");
2310     }
2311     printPred(stdout,inst(in).head);
2312     Putchar('\n');
2313 }
2314
2315 /* --------------------------------------------------------------------------
2316  * List all names currently in scope:
2317  * ------------------------------------------------------------------------*/
2318
2319 static Void local listNames() {         /* list names matching optional pat*/
2320     String pat   = readFilename();
2321     List   names = NIL;
2322     Int    width = getTerminalWidth() - 1;
2323     Int    count = 0;
2324     Int    termPos;
2325     Module mod   = currentModule;
2326
2327     if (pat) {                          /* First gather names to list      */
2328         do {
2329             names = addNamesMatching(pat,names);
2330         } while ((pat=readFilename())!=0);
2331     } else {
2332         names = addNamesMatching((String)0,names);
2333     }
2334     if (isNull(names)) {                /* Then print them out             */
2335         ERRMSG(0) "No names selected"
2336         EEND_NO_LONGJMP;
2337         return;
2338     }
2339     for (termPos=0; nonNull(names); names=tl(names)) {
2340         String s = objToStr(mod,hd(names));
2341         Int    l = strlen(s);
2342         if (termPos+1+l>width) {
2343             Putchar('\n');
2344             termPos = 0;
2345         } else if (termPos>0) {
2346             Putchar(' ');
2347             termPos++;
2348         }
2349         Printf("%s",s);
2350         termPos += l;
2351         count++;
2352     }
2353     Printf("\n(%d names listed)\n", count);
2354 }
2355
2356 /* --------------------------------------------------------------------------
2357  * print a prompt and read a line of input:
2358  * ------------------------------------------------------------------------*/
2359
2360 static Void local promptForInput(moduleName)
2361 String moduleName; {
2362     char promptBuffer[1000];
2363 #if 1
2364     /* This is portable but could overflow buffer */
2365     sprintf(promptBuffer,prompt,moduleName);
2366 #else
2367     /* Works on ANSI C - but pre-ANSI compilers return a pointer to
2368      * promptBuffer instead.
2369      */
2370     if (sprintf(promptBuffer,prompt,moduleName) >= 1000) {
2371         /* Reset prompt to a safe default to avoid an infinite loop */
2372         free(prompt);
2373         prompt = strCopy("? ");
2374         internal("Combined prompt and evaluation module name too long");
2375     }
2376 #endif
2377     if (autoMain)
2378        stringInput("main\0"); else
2379        consoleInput(promptBuffer);
2380 }
2381
2382 /* --------------------------------------------------------------------------
2383  * main read-eval-print loop, with error trapping:
2384  * ------------------------------------------------------------------------*/
2385
2386 static Void local interpreter(argc,argv)/* main interpreter loop           */
2387 Int    argc;
2388 String argv[]; {
2389
2390     List   modConIds; /* :: [CONID] */
2391     Bool   prelOK;
2392     String s;
2393
2394     setBreakAction ( HugsIgnoreBreak );
2395     modConIds = initialize(argc,argv);  /* the initial modules to load     */
2396     setBreakAction ( HugsIgnoreBreak );
2397     prelOK    = loadThePrelude();
2398     if (combined) everybody(POSTPREL);
2399
2400     if (!prelOK) {
2401        if (autoMain)
2402           fprintf(stderr, "hugs +Q: fatal error: can't load the Prelude.\n" );
2403        else
2404           fprintf(stderr, "hugs: fatal error: can't load the Prelude.\n" );
2405        exit(1);
2406     }
2407
2408     loadActions(modConIds);
2409
2410     if (autoMain) {
2411        for (; nonNull(modConIds); modConIds=tl(modConIds))
2412           if (!elemMG(hd(modConIds))) {
2413              fprintf(stderr,
2414                      "hugs +Q: compilation failed -- can't run `main'\n" );
2415              exit(1);
2416           }
2417     }
2418
2419     modConIds = NIL;
2420
2421     /* initialize calls startupHaskell, which trashes our signal handlers */
2422     setBreakAction ( HugsIgnoreBreak );
2423     forHelp();
2424
2425     for (;;) {
2426         Command cmd;
2427         everybody(RESET);               /* reset to sensible initial state */
2428
2429         promptForInput(textToStr(module(currentModule).text));
2430
2431         cmd = readCommand(cmds, (Char)':', (Char)'!');
2432         switch (cmd) {
2433             case EDIT   : editor();
2434                           break;
2435             case FIND   : find();
2436                           break;
2437             case LOAD   : modConIds = NIL;
2438                           while ((s=readFilename())!=0)
2439                              modConIds = cons(mkCon(findText(s)),modConIds);
2440                           loadActions(modConIds);
2441                           modConIds = NIL;
2442                           break;
2443             case ALSO   : modConIds = NIL;
2444                           while ((s=readFilename())!=0)
2445                              modConIds = cons(mkCon(findText(s)),modConIds);
2446                           addActions(modConIds);
2447                           modConIds = NIL;
2448                           break;
2449             case RELOAD : refreshActions(NIL,FALSE);
2450                           break;
2451             case SETMODULE :
2452                           setModule();
2453                           break;
2454             case EVAL   : evaluator();
2455                           break;
2456             case TYPEOF : showtype();
2457                           break;
2458             case BROWSE : browse();
2459                           break;
2460 #if EXPLAIN_INSTANCE_RESOLUTION
2461             case XPLAIN : xplain();
2462                           break;
2463 #endif
2464             case NAMES  : listNames();
2465                           break;
2466             case HELP   : menu();
2467                           break;
2468             case BADCMD : guidance();
2469                           break;
2470             case SET    : set();
2471                           break;
2472             case STATS:
2473 #ifdef CRUDE_PROFILING
2474                           cp_show();
2475 #endif
2476                           break;
2477             case SYSTEM : if (shellEsc(readLine()))
2478                               Printf("Warning: Shell escape terminated abnormally\n");
2479                           break;
2480             case CHGDIR : changeDir();
2481                           break;
2482             case INFO   : info();
2483                           break;
2484             case PNTVER: Printf("-- Hugs Version %s\n",
2485                                  HUGS_VERSION);
2486                           break;
2487             case DUMP   : dumpStg();
2488                           break;
2489             case QUIT   : return;
2490             case COLLECT: consGC = FALSE;
2491                           garbageCollect();
2492                           consGC = TRUE;
2493                           Printf("Garbage collection recovered %d cells\n",
2494                                  cellsRecovered);
2495                           break;
2496             case NOCMD  : break;
2497         }
2498
2499         if (autoMain) break;
2500     }
2501 }
2502
2503 /* --------------------------------------------------------------------------
2504  * Display progress towards goal:
2505  * ------------------------------------------------------------------------*/
2506
2507 static Target currTarget;
2508 static Bool   aiming = FALSE;
2509 static Int    currPos;
2510 static Int    maxPos;
2511 static Int    charCount;
2512
2513 Void setGoal(what, t)                  /* Set goal for what to be t        */
2514 String what;
2515 Target t; {
2516     if (quiet)
2517       return;
2518 #if EXPLAIN_INSTANCE_RESOLUTION
2519     if (showInstRes)
2520       return;
2521 #endif
2522     currTarget = (t?t:1);
2523     aiming     = TRUE;
2524     if (useDots) {
2525         currPos = strlen(what);
2526         maxPos  = getTerminalWidth() - 1;
2527         Printf("%s",what);
2528     }
2529     else
2530         for (charCount=0; *what; charCount++)
2531             Putchar(*what++);
2532     FlushStdout();
2533 }
2534
2535 Void soFar(t)                          /* Indicate progress towards goal   */
2536 Target t; {                            /* has now reached t                */
2537     if (quiet)
2538       return;
2539 #if EXPLAIN_INSTANCE_RESOLUTION
2540     if (showInstRes)
2541       return;
2542 #endif
2543     if (useDots) {
2544         Int newPos = (Int)((maxPos * ((long)t))/currTarget);
2545
2546         if (newPos>maxPos)
2547             newPos = maxPos;
2548
2549         if (newPos>currPos) {
2550             do
2551                 Putchar('.');
2552             while (newPos>++currPos);
2553             FlushStdout();
2554         }
2555         FlushStdout();
2556     }
2557 }
2558
2559 Void done() {                          /* Goal has now been achieved       */
2560     if (quiet)
2561       return;
2562 #if EXPLAIN_INSTANCE_RESOLUTION
2563     if (showInstRes)
2564       return;
2565 #endif
2566     if (useDots) {
2567         while (maxPos>currPos++)
2568             Putchar('.');
2569         Putchar('\n');
2570     }
2571     else
2572         for (; charCount>0; charCount--) {
2573             Putchar('\b');
2574             Putchar(' ');
2575             Putchar('\b');
2576         }
2577     aiming = FALSE;
2578     FlushStdout();
2579 }
2580
2581 static Void local failed() {           /* Goal cannot be reached due to    */
2582     if (aiming) {                      /* errors                           */
2583         aiming = FALSE;
2584         Putchar('\n');
2585         FlushStdout();
2586     }
2587 }
2588
2589 /* --------------------------------------------------------------------------
2590  * Error handling:
2591  * ------------------------------------------------------------------------*/
2592
2593 static Void local stopAnyPrinting() {  /* terminate printing of expression,*/
2594     if (printing) {                    /* after successful termination or  */
2595         printing = FALSE;              /* runtime error (e.g. interrupt)   */
2596         Putchar('\n');
2597         if (showStats) {
2598 #define plural(v)   v, (v==1?"":"s")
2599             Printf("%lu cell%s",plural(numCells));
2600             if (numGcs>0)
2601                 Printf(", %u garbage collection%s",plural(numGcs));
2602             Printf(")\n");
2603 #undef plural
2604         }
2605         FlushStdout();
2606         garbageCollect();
2607     }
2608 }
2609
2610 Cell errAssert(l)   /* message to use when raising asserts, etc */
2611 Int l; {
2612   Cell str;
2613   if (currentFile) {
2614     str = mkStr(findText(currentFile));
2615   } else {
2616     str = mkStr(findText(""));
2617   }
2618   return (ap2(nameTangleMessage,str,mkInt(l)));
2619 }
2620
2621 Void errHead(l)                        /* print start of error message     */
2622 Int l; {
2623     failed();                          /* failed to reach target ...       */
2624     stopAnyPrinting();
2625     FPrintf(errorStream,"ERROR");
2626
2627     if (currentFile) {
2628         FPrintf(errorStream," \"%s\"", currentFile);
2629         setLastEdit(currentFile,l);
2630         if (l) FPrintf(errorStream," (line %d)",l);
2631         currentFile = NULL;
2632     }
2633     FPrintf(errorStream,": ");
2634     FFlush(errorStream);
2635 }
2636
2637 Void errFail() {                        /* terminate error message and     */
2638     Putc('\n',errorStream);             /* produce exception to return to  */
2639     FFlush(errorStream);                /* main command loop               */
2640     longjmp(catch_error,1);
2641 }
2642
2643 Void errFail_no_longjmp() {             /* terminate error message but     */
2644     Putc('\n',errorStream);             /* don't produce an exception      */
2645     FFlush(errorStream);
2646 }
2647
2648 Void errAbort() {                       /* altern. form of error handling  */
2649     failed();                           /* used when suitable error message*/
2650     stopAnyPrinting();                  /* has already been printed        */
2651     errFail();
2652 }
2653
2654 Void internal(msg)                      /* handle internal error           */
2655 String msg; {
2656     failed();
2657     stopAnyPrinting();
2658     Printf("INTERNAL ERROR: %s\n",msg);
2659     FlushStdout();
2660 exit(9);
2661     longjmp(catch_error,1);
2662 }
2663
2664 Void fatal(msg)                         /* handle fatal error              */
2665 String msg; {
2666     FlushStdout();
2667     Printf("\nFATAL ERROR: %s\n",msg);
2668     everybody(EXIT);
2669     exit(1);
2670 }
2671
2672
2673 /* --------------------------------------------------------------------------
2674  * Read value from environment variable or registry:
2675  * ------------------------------------------------------------------------*/
2676
2677 String fromEnv(var,def)         /* return value of:                        */
2678 String var;                     /*     environment variable named by var   */
2679 String def; {                   /* or: default value given by def          */
2680     String s = getenv(var);
2681     return (s ? s : def);
2682 }
2683
2684 /* --------------------------------------------------------------------------
2685  * String manipulation routines:
2686  * ------------------------------------------------------------------------*/
2687
2688 static String local strCopy(s)         /* make malloced copy of a string   */
2689 String s; {
2690     if (s && *s) {
2691         char *t, *r;
2692         if ((t=(char *)malloc(strlen(s)+1))==0) {
2693             ERRMSG(0) "String storage space exhausted"
2694             EEND;
2695         }
2696         for (r=t; (*r++ = *s++)!=0; ) {
2697         }
2698         return t;
2699     }
2700     return NULL;
2701 }
2702
2703
2704 /* --------------------------------------------------------------------------
2705  * Compiler output
2706  * We can redirect compiler output (prompts, error messages, etc) by
2707  * tweaking these functions.
2708  * ------------------------------------------------------------------------*/
2709
2710 #ifdef HAVE_STDARG_H
2711 #include <stdarg.h>
2712 #else
2713 #include <varargs.h>
2714 #endif
2715
2716 Void hugsEnableOutput(f)
2717 Bool f; {
2718     disableOutput = !f;
2719 }
2720
2721 #ifdef HAVE_STDARG_H
2722 Void hugsPrintf(const char *fmt, ...) {
2723     va_list ap;                    /* pointer into argument list           */
2724     va_start(ap, fmt);             /* make ap point to first arg after fmt */
2725     if (!disableOutput) {
2726         vprintf(fmt, ap);
2727     } else {
2728     }
2729     va_end(ap);                    /* clean up                             */
2730 }
2731 #else
2732 Void hugsPrintf(fmt, va_alist)
2733 const char *fmt;
2734 va_dcl {
2735     va_list ap;                    /* pointer into argument list           */
2736     va_start(ap);                  /* make ap point to first arg after fmt */
2737     if (!disableOutput) {
2738         vprintf(fmt, ap);
2739     } else {
2740     }
2741     va_end(ap);                    /* clean up                             */
2742 }
2743 #endif
2744
2745 Void hugsPutchar(c)
2746 int c; {
2747     if (!disableOutput) {
2748         putchar(c);
2749     } else {
2750     }
2751 }
2752
2753 Void hugsFlushStdout() {
2754     if (!disableOutput) {
2755         fflush(stdout);
2756     }
2757 }
2758
2759 Void hugsFFlush(fp)
2760 FILE* fp; {
2761     if (!disableOutput) {
2762         fflush(fp);
2763     }
2764 }
2765
2766 #ifdef HAVE_STDARG_H
2767 Void hugsFPrintf(FILE *fp, const char* fmt, ...) {
2768     va_list ap;
2769     va_start(ap, fmt);
2770     if (!disableOutput) {
2771         vfprintf(fp, fmt, ap);
2772     } else {
2773     }
2774     va_end(ap);
2775 }
2776 #else
2777 Void hugsFPrintf(FILE *fp, const char* fmt, va_list)
2778 FILE* fp;
2779 const char* fmt;
2780 va_dcl {
2781     va_list ap;
2782     va_start(ap);
2783     if (!disableOutput) {
2784         vfprintf(fp, fmt, ap);
2785     } else {
2786     }
2787     va_end(ap);
2788 }
2789 #endif
2790
2791 Void hugsPutc(c, fp)
2792 int   c;
2793 FILE* fp; {
2794     if (!disableOutput) {
2795         putc(c,fp);
2796     } else {
2797     }
2798 }
2799
2800 /* --------------------------------------------------------------------------
2801  * Send message to each component of system:
2802  * ------------------------------------------------------------------------*/
2803
2804 Void everybody(what)            /* send command `what' to each component of*/
2805 Int what; {                     /* system to respond as appropriate ...    */
2806 #if 0
2807   fprintf ( stderr, "EVERYBODY %d\n", what );
2808 #endif
2809     machdep(what);              /* The order of calling each component is  */
2810     storage(what);              /* important for the PREPREL command       */
2811     substitution(what);
2812     input(what);
2813     translateControl(what);
2814     linkControl(what);
2815     staticAnalysis(what);
2816     deriveControl(what);
2817     typeChecker(what);
2818     compiler(what);
2819     codegen(what);
2820
2821     mark(moduleGraph);
2822     mark(prelModules);
2823     mark(targetModules);
2824     mark(daSccs);
2825 }
2826
2827 /*-------------------------------------------------------------------------*/